open String;; type tree = Num of int | Plus of tree * tree | Mul of tree * tree | Minus of tree * tree | Div of tree * tree | UnMinus of tree;; let first (x,y) = x;; let tree_of_string s = let rec parse_s s i = let (t, i') = parse_x s i in if i' = (length s) then (t, i') else let rec f s (t', j) = match s.[j] with '+' -> let (tr, i'') = parse_s s (j + 1) in (Plus (t', tr), i'') |'-' -> (let (tr, i'') = parse_s s (j + 1) in if (tr, i'') = parse_x s (j + 1) then (Minus (t', tr), i'') else let (tre, i''') = parse_x s (j + 1) in f s ((Minus (t', tre)), i''')) |_ -> (t', j) in f s (t,i') and parse_x s i = let (t, i') = parse_a s i "" 0 in if i' = (length s) then (t, i') else let rec f s (t', j) = match s.[j] with '*' -> let (tr, i'') = parse_x s (j + 1) in (Mul (t', tr), i'') |'/' -> let (tr, i'') = parse_x s (j + 1) in if (tr, i'') = parse_a s (j + 1) "" 0 then (Div (t', tr), i'') else let (tre, i''') = parse_a s (j + 1) "" 0 in f s ((Div (t', tre)), i''') |_ -> (t', j) in f s (t, i') and parse_a s i acc x= if x = 0 && s.[i] = '-' && s.[i + 1] = '-' then let (t, i) = parse_a s (i+2) acc x in (t, i) else if x = 0 && s.[i] = '-' then let (t, i) = parse_a s (i+1) acc x in (UnMinus t, i) else if (i+1) = (length s) then (Num (int_of_string (acc^(make 1 s.[i]))), i + 1) else match s.[i] with '(' -> let (t, i') = parse_s s (i + 1) in if s.[i'] <> ')' then failwith "?" else (t, i'+1) |'+'|'-'|'*'|'/' -> (Num (int_of_string acc), i) |'0' .. '9' as y -> if (s.[i+1]) = ')' then (Num (int_of_string (acc^(make 1 s.[i]))), i+1) else parse_a s (i+1) (acc^(make 1 y)) 1 |_ -> failwith "?" in first (parse_s s 0);; let ios = int_of_string;; let soi = string_of_int;; let rec list_of_string' s i acc = if i+1=length s then (acc^(make 1 s.[i]))::[] else match s.[i] with '-' -> list_of_string' s (i+1) (acc^(make 1 '-')) |'0' -> list_of_string' s (i+1) (acc^(make 1 '0')) |'1' -> list_of_string' s (i+1) (acc^(make 1 '1')) |'2' -> list_of_string' s (i+1) (acc^(make 1 '2')) |'3' -> list_of_string' s (i+1) (acc^(make 1 '3')) |'4' -> list_of_string' s (i+1) (acc^(make 1 '4')) |'5' -> list_of_string' s (i+1) (acc^(make 1 '5')) |'6' -> list_of_string' s (i+1) (acc^(make 1 '6')) |'7' -> list_of_string' s (i+1) (acc^(make 1 '7')) |'8' -> list_of_string' s (i+1) (acc^(make 1 '8')) |'9' -> list_of_string' s (i+1) (acc^(make 1 '9')) |' ' -> acc::(list_of_string' s (i+1) "") |'+' -> (make 1 '+')::(list_of_string' s (i+2) "") |'*' -> (make 1 '*')::(list_of_string' s (i+2) "") |'/' -> (make 1 '/')::(list_of_string' s (i+2) "");; let rec obrez s i = if i=length s then "" else (make 1 s.[i])^(obrez s (i+1));; let rec antiminus s = if s="-" then "-" else (match s.[0] with '-' -> if s.[1] = '-' then antiminus (obrez s 2) else s |_ -> s);; let list_of_string s = List.map (fun x -> antiminus x) (list_of_string' s 0 "");; let rec rigth_calc l = match l with l1::l2::l3::ls -> (match l3 with "+" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_calc ((soi ((ios l1)+(ios l2)))::ls) |"-" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_calc ((soi ((ios l1)-(ios l2)))::ls) |"*" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_calc ((soi ((ios l1)*(ios l2)))::ls) |"/" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_calc ((soi ((ios l1)/(ios l2)))::ls) |_-> rigth_calc (l1::(rigth_calc (l2::l3::ls)))) |l1::l2::[] -> l1::l2::[] |l1::[] -> l1::[] |[] -> [];; let rec rigth_often l = match l with l1::l2::l3::ls -> (match l3 with "+" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_often (("("^l1^"+"^l2^")")::ls) |"-" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_often (("("^l1^"-"^l2^")")::ls) |"*" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_often (("("^l1^"*"^l2^")")::ls) |"/" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else rigth_often (("("^l1^"/"^l2^")")::ls) |_-> rigth_often (l1::(rigth_often (l2::l3::ls)))) |l1::l2::[] -> l1::l2::[] |l1::[] -> l1::[] |[] -> [];; let rec left_calc l = match l with l1::l2::l3::ls -> (match l3 with "+" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_calc ((soi ((ios l2)+(ios l1)))::ls) |"-" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_calc ((soi ((ios l2)-(ios l1)))::ls) |"*" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_calc ((soi ((ios l2)*(ios l1)))::ls) |"/" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_calc ((soi ((ios l2)/(ios l1)))::ls) |_-> left_calc (l1::(left_calc (l2::l3::ls)))) |l1::l2::[] -> l1::l2::[] |l1::[] -> l1::[] |[] -> [];; let rec left_often l = match l with l1::l2::l3::ls -> (match l3 with "+" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_often (("("^l2^"+"^l1^")")::ls) |"-" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_often (("("^l2^"-"^l1^")")::ls) |"*" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_often (("("^l2^"*"^l1^")")::ls) |"/" -> if List.mem l2 ["+";"*";"-";"/"] then l1::l2::l3::ls else left_often (("("^l2^"/"^l1^")")::ls) |_-> left_often (l1::(left_often (l2::l3::ls)))) |l1::l2::[] -> l1::l2::[] |l1::[] -> l1::[] |[] -> [];; let rec right_list_of_tree s= match s with Num a -> string_of_int a |UnMinus a -> "-"^(right_list_of_tree a) |Plus (a,b) -> (right_list_of_tree a)^" "^(right_list_of_tree b)^" + " |Mul (a,b) -> (right_list_of_tree a)^" "^(right_list_of_tree b)^" * " |Minus (a,b) -> (right_list_of_tree a)^" "^(right_list_of_tree b)^" - " |Div (a,b) -> (right_list_of_tree a)^" "^(right_list_of_tree b)^" / ";; let rec left_list_of_tree s= match s with Num a -> string_of_int a |UnMinus a -> "-"^(left_list_of_tree a) |Plus (a,b) -> " + "^(left_list_of_tree a)^" "^(left_list_of_tree b) |Mul (a,b) -> " * "^(left_list_of_tree a)^" "^(left_list_of_tree b) |Minus (a,b) -> " - "^(left_list_of_tree a)^" "^(left_list_of_tree b) |Div (a,b) -> " / "^(left_list_of_tree a)^" "^(left_list_of_tree b);; print_string "Операции +,*,/,-\nВведите правильное выражение в обратной польской записи через пробел:\n" let x = read_line ();; print_int (ios (List.hd (rigth_calc (list_of_string x))));; print_string "\nВведите правильное выражение в прямой польской записи через пробел:\n" let y = read_line ();; print_int (ios (List.hd (left_calc (List.rev (list_of_string y)))));; print_string "\nВведите правильное выражение в обратной польской записи через пробел:\n" let z = read_line ();; print_string ("Обычный вид: "^(List.hd (rigth_often (list_of_string z))));; print_string "\nВведите правильное выражение в прямой польской записи через пробел:\n" let zz = read_line ();; print_string ("Обычный вид: "^(List.hd (left_often (List.rev (list_of_string zz)))));; print_string "\nВведите выражение:\n" let zza = read_line ();; print_string ("Прямой польский вид: "^(right_list_of_tree (tree_of_string zza)));; print_string "\nВведите выражение:\n" let zzb = read_line ();; print_string ("Обратный польский вид: "^(left_list_of_tree (tree_of_string zza)));;