Last active
August 3, 2016 16:11
-
-
Save c-cube/748e790dd75d99093b5c39ee0b1c71c3 to your computer and use it in GitHub Desktop.
generate all possible expressions from a list of basic values
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* ocamlfind opt -package sequence,benchmark -linkpkg truc.ml -o truc; ./truc*) | |
open Sequence.Infix | |
type op = | |
| Add | |
| Mult | |
| Div | |
| Minus | |
| Int of int | |
let pp_op out = function | |
| Int i -> Format.fprintf out "%d" i | |
| Add -> Format.pp_print_string out "+" | |
| Mult -> Format.pp_print_string out "*" | |
| Div -> Format.pp_print_string out "/" | |
| Minus -> Format.pp_print_string out "-" | |
let rec pp_expr out l = match l with | |
| [] -> () | |
| a :: l -> Format.fprintf out "%a.%a" pp_op a pp_expr l | |
let eval (e:op list): int = | |
(* evaluation with a stack *) | |
let rec aux e st = match e, st with | |
| [], [i] -> i | |
| Int i :: e', _ -> aux e' (i::st) | |
| Add :: e', a :: b :: st' -> aux e' ((a+b)::st') | |
| Mult :: e', a :: b :: st' -> aux e' ((a*b)::st') | |
| Div :: e', a :: b :: st' -> aux e' ((a/b)::st') | |
| Minus :: e', a :: b :: st' -> aux e' ((a-b)::st') | |
| _ -> assert false | |
in | |
aux e [] | |
(* generate permutations *) | |
let rec perms (l:'a list): 'a list Sequence.t = match l with | |
| [] -> Sequence.return [] | |
| x :: xs -> perms xs >>= insert x | |
and insert x l = match l with | |
| [] -> Sequence.return [x] | |
| y :: tail -> | |
Sequence.cons | |
(x :: l) | |
(insert x tail >|= fun tail' -> y :: tail') | |
let insert_ops (l:int list) : op list Sequence.t = | |
let pick_op = Sequence.of_list [Add; Mult; Div; Minus] in | |
(* l: remaining integers to use | |
n: current height of stack *) | |
let rec aux n l res = match l with | |
| [] when n=1 -> Sequence.return (List.rev res) | |
| [] -> | |
assert (n>=2); | |
pick_op >>= fun o -> aux (n-1) l (o::res) | |
| a :: tail -> | |
(* can we insert an operator right here? *) | |
let s1 = | |
if n>=2 | |
then pick_op >>= fun o -> aux (n-1) l (o::res) | |
else Sequence.empty | |
(* push [a] now *) | |
and s2 = | |
aux (n+1) tail (Int a::res) | |
in | |
Sequence.append s2 s1 | |
in | |
aux 0 l [] | |
(* take a list of ints, and make all possible expressions that use | |
every int exactly once *) | |
let all_ops (l:int list): op list Sequence.t = | |
perms l >>= insert_ops | |
let () = | |
let n = | |
if Array.length Sys.argv < 1 then 5 else int_of_string Sys.argv.(1) | |
in | |
Printf.printf "base list: [1…%d]\n" n; | |
let l = Array.init n succ |> Array.to_list in | |
all_ops l | |
|> Sequence.iter | |
(fun e -> | |
try Format.printf "@[<2>@[%a@]@ = %d@]@." pp_expr e (eval e) | |
with Division_by_zero -> | |
Format.printf "@[<2>@[%a@]@ = div_by_zero@]@." pp_expr e | |
) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment