F# で STUDENT

PAIP [1] の第7章に出てくる STUDENT プログラム [2]（の方程式を解く部分のみ）を F# で書いてみた。どの辺が OCaml でなく F# かというと active pattern を使っている部分と num 型のリテラルの部分。

#nowarn "57";;

open Num;;
type op = Add | Sub | Mul | Div;;
type expr = Val of num | Var of string | App of op * expr * expr;;
type equation = expr * expr;;
type binding = string * num;;

let rec eval bs = function
| Val n -> n
| Var s -> List.assoc s bs
| App (Add, l, r) -> add_num  (eval bs l) (eval bs r)
| App (Sub, l, r) -> sub_num  (eval bs l) (eval bs r)
| App (Mul, l, r) -> mult_num (eval bs l) (eval bs r)
| App (Div, l, r) -> div_num  (eval bs l) (eval bs r)
;;

let rec show_expr = function
| Val n -> string_of_num n
| Var s -> s
| App (Add, l, r) -> "(" ^ show_expr l ^ " + " ^ show_expr r ^ ")"
| App (Sub, l, r) -> "(" ^ show_expr l ^ " - " ^ show_expr r ^ ")"
| App (Mul, l, r) -> "(" ^ show_expr l ^ " * " ^ show_expr r ^ ")"
| App (Div, l, r) -> "(" ^ show_expr l ^ " / " ^ show_expr r ^ ")"
;;

let show_equation (lhs, rhs) = show_expr lhs ^ " = " ^ show_expr rhs;;

let inverse_op = function Add -> Sub | Sub -> Add | Mul -> Div | Div -> Mul;;

let rec no_unknown bs = function
| Val _ -> true
| Var s when List.mem_assoc s bs -> true
| Var _ -> false
| App (_, l, r) -> (no_unknown bs l) && (no_unknown bs r)
;;

let rec one_unknown bs = function
| Val _ -> None
| Var s when List.mem_assoc s bs -> None
| Var s -> Some s
| App (_, l, r) when no_unknown bs l -> one_unknown bs r
| App (_, l, r) when no_unknown bs r -> one_unknown bs l
| App _ -> None
;;

let either_or x y = match (x, y) with
| None, Some x -> Some x
| Some x, None -> Some x
| _ -> None
;;

let rec ( |One_unknown|_| ) bs = function
| [] -> None
| ((lhs, rhs) as equation)::xs -> match (either_or (one_unknown bs lhs) (one_unknown bs rhs)) with
  | Some x -> Some (x, equation)
  | None -> ( |One_unknown|_| ) bs xs
;;

let rec in_expr x = function
| Val _ -> false
| Var y when x = y -> true
| Var y -> false
| App (_, l, r) -> (in_expr x l) || (in_expr x r)
;;

let rec isolate x = function
| (Var y, rhs) as expr when x = y -> expr
| (lhs, rhs) when in_expr x rhs -> isolate x (rhs, lhs)
| App (op, l, r), rhs when in_expr x l -> isolate x (l, App (inverse_op op, rhs, r))
| App (Add, l, r), rhs when in_expr x r -> isolate x (r, App (Sub, rhs, l))
| App (Mul, l, r), rhs when in_expr x r -> isolate x (r, App (Div, rhs, l))
| App (Sub, l, r), rhs when in_expr x r -> isolate x (r, App (Sub, l, rhs))
| App (Div, l, r), rhs when in_expr x r -> isolate x (r, App (Div, l, rhs))
;;

let solve_arith bs (Var s, rhs) = (s, (eval bs rhs));;

(* remove e xs removes the first occurrence of e from the list xs *)
let rec remove e = function
| [] -> []
| x::xs when x = e -> xs
| x::xs -> x::(remove e xs)
;;

let rec solve bs = function
| (One_unknown bs (variable, equation)) as equations ->
  let answer = solve_arith bs (isolate variable equation) in
  solve (answer::bs) (remove equation equations)
| _ -> bs
;;

let show_binding (s, n) = s ^ " = " ^ (string_of_num n);;

let solve_equations equations =
  print_endline "The equations to be solved are:";
  List.iter (fun x -> print_string (show_equation x); print_newline ()) equations;
  print_endline "The solution is:";
  List.iter (fun x -> print_string (show_binding x); print_newline ()) (solve [] equations)
;;

let e1 = (App (Add,Val 3N,Val 4N),
         App (Mul,App (Sub,Val 5N,App (Add,Val 2N,Var "x")),Val 7N));;
let e2  = (App (Add,App (Mul,Val 3N,Var "x"),Var "y"), Val 12N);;

solve_equations [e1; e2];;

実行結果:

The equations to be solved are:
(3 + 4) = ((5 - (2 + x)) * 7)
((3 * x) + y) = 12
The solution is:
y = 6
x = 2

解説すると、このプログラムは等式群が与えられると

1. 未知の変数が1つしか現れない等式を探し出す
2. その等式を解いて変数を既知にする

を繰り返して最後に既知のリストを返すもので、等式を解くには

1. 左辺値が当該変数だけになるように式を変形する
2. 右辺値を評価する

というのをやる。日本語で書くと単純だけど…

PAIP の Common Lisp 版では変数が既知になった時点で式中の変数を実際の値に置き換えているのだけど、この F# 版では既知の情報を環境として式を評価するように eval 関数を書いた。
Lisp 版では eval が Lisp の eval そのものなので置き換えたほうが楽なのだが F# では特にそういうボーナスはなくて、むしろ式の置き換えと既知情報の更新を両方やるのが redundant だと思ったため。

実はこれは最初 Haskell の練習として書いていたのだけど solve 関数の

「等式のリスト equations が与えられたときに
- one_unknown な等式があるかどうかを判定して
- あればその等式 equation と未知変数名 variable を得て
- variable と equation を使って等式を解き (solve_arith, isolate)
- なおかつ equations から equation を除去する」

という部分が私の Haskell 力ではどうしてもごちゃごちゃな感じにしかならなかったので諦めた。そして active pattern を使うと構文上すっきりさせられることに気づいて F# で書きなおした。

[1] http://norvig.com/paip.html
[2] http://norvig.com/paip/student.lisp