Evil114514

114514.ml

let rec remove_nth n = function
    | x :: xs ->
        if n = 0
        then xs
        else x :: remove_nth (n - 1) xs
    | [] -> raise (Failure "remove_nth");;

let rec arrange = function
    | [] -> [[]]
    | list ->
        let res = ref [] in
        for i = 0 to List.length list - 1 do
            let x = List.nth list i in
            let xss = arrange (remove_nth i list) in
            let arrs = List.map (fun xs -> x :: xs) xss in
            res := !res @ arrs
        done;
        !res;;

let rec choose_n opt = function
    | 0 -> [[]]
    | n when n < 0 -> raise (Failure "choose_n")
    | n ->
        let res = ref [] in
        for i = 0 to List.length opt - 1 do
            let x = List.nth opt i in
            let xss = choose_n opt (n - 1) in
            let poss = List.map (fun xs -> x :: xs) xss in
            res := !res @ poss
        done;
        !res;;

let min_index list =
    let min = ref max_int in
    let index = ref (-1) in
    for i = 0 to List.length list - 1 do
        if List.nth list i < !min then begin
            min := List.nth list i;
            index := i
        end
    done;
    if !index = -1
    then raise (Invalid_argument "min_index []")
    else !index;;

let rec cut n list =
    if n = 0
    then ([], list)
    else match list with
    | [] -> raise (Failure "cut")
    | x :: xs ->
        let (y, ys) = cut (n - 1) xs in
        (x :: y, ys);;

type op = Add | Min | Mul | Div | Exp;;

let all_ops = choose_n [Add; Min; Mul; Div; Exp] 5;;
let all_order = arrange [0; 1; 2; 3; 4];;

type 'a tree =
    | Leaf of 'a
    | Node of op * ('a tree) * ('a tree)

let rec to_tree ops order oprs =
    match ops with
    | [] -> Leaf (List.nth oprs 0)
    | _ :: _ ->
        let i = min_index order in
        let (ops_l, ops_rr) = cut i ops in
        let (order_l, order_rr) = cut i order in
        let (oprs_l, oprs_r) = cut (i + 1) oprs in
        Node ((List.nth ops i), (to_tree ops_l order_l oprs_l), (to_tree (List.tl ops_rr) (List.tl order_rr) oprs_r));;

let rec eval = function
    | Leaf a -> a
    | Node (Add, l, r) -> eval l +. eval r
    | Node (Min, l, r) -> eval l -. eval r
    | Node (Mul, l, r) -> eval l *. eval r
    | Node (Div, l, r) -> eval l /. eval r
    | Node (Exp, l, r) -> eval l ** eval r;;

let rec string_of_tree = function
    | Leaf a -> string_of_float a
    | Node (Add, l, r) -> Printf.sprintf "(%s + %s)" (string_of_tree l) (string_of_tree r)
    | Node (Min, l, r) -> Printf.sprintf "(%s - %s)" (string_of_tree l) (string_of_tree r)
    | Node (Mul, l, r) -> Printf.sprintf "(%s * %s)" (string_of_tree l) (string_of_tree r)
    | Node (Div, l, r) -> Printf.sprintf "(%s / %s)" (string_of_tree l) (string_of_tree r)
    | Node (Exp, l, r) -> Printf.sprintf "(%s ^ %s)" (string_of_tree l) (string_of_tree r);;

let all_tree =
    all_ops
    |> List.map (fun ops ->
        List.map (fun order -> 
            let tree = to_tree ops order [1.; 1.; 4.; 5.; 1.; 4.] in
            try
                let value = eval tree in
                if value <> value || value = Float.infinity || value = Float.neg_infinity
                then []
                else [(tree, value)]
            with Division_by_zero -> [])
        all_order
        |> List.concat)
    |> List.concat (* Don't call List.map from now on. It'll overflow the stack QAQ. *)
    |> List.fast_sort (function (_, a) -> function (_, b) -> compare a b)
    |> List.iter (function (tree, value) -> Printf.printf "%s = %g\n" (string_of_tree tree) value);;