Advertisement
Guest User

Untitled

a guest
Mar 16th, 2019
75
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
OCaml 10.13 KB | None | 0 0
  1. let nip str = String.sub str 1 ((String.length str) - 1);;
  2.  
  3. type expr = Var of string | Not of expr | And of (expr * expr) | Or of (expr * expr) | Conj of (expr * expr);;
  4.  
  5. let rec print_expr expr = match expr with
  6.     | Var a       -> a
  7.     | Not a       -> "!" ^ (print_expr a) ^ ""
  8.     | And  (a, b) -> "(" ^ (print_expr a) ^ "&" ^ (print_expr b) ^ ")"
  9.     | Or   (a, b) -> "(" ^ (print_expr a) ^ "|" ^ (print_expr b) ^ ")"
  10.     | Conj (a, b) -> "(" ^ (print_expr a) ^ "->" ^ (print_expr b) ^ ")";;
  11.  
  12. let strange = "'";;
  13.  
  14. let checkOnFence str = String.length str > 2 && str.[0] = '|' && str.[1] = '-';;
  15.  
  16. let rec make_var str have = if String.length str == 0
  17.     then (Var have, str)
  18.     else if String.length str >= String.length strange && String.sub str 0 (String.length strange) = strange
  19.     then make_var (String.sub str (String.length strange) (String.length str - String.length strange)) (have ^ strange)
  20.     else match str.[0] with
  21.     | 'A'..'Z' | '0'..'9' -> make_var (nip str) (have ^ Char.escaped str.[0])
  22.     | _                   -> (Var have, (String.trim str))
  23.  
  24. and make_nnot str = match str.[0] with
  25.     | '!'      -> let (item, str) = make_nnot (String.trim (nip str)) in (Not item, str)
  26.     | 'A'..'Z' -> let (item, str) = make_var  (nip str) (Char.escaped str.[0]) in (item, str)
  27.     | '('      -> let (item, str) = make_expr (String.trim (nip str)) in (item, (String.trim (nip str)))
  28.     | _        -> failwith "Error4"
  29.  
  30. and make_aand str = let (item, str) = make_nnot str in
  31.     let rec make_aand_internal str have =
  32.         if String.length str == 0 || checkOnFence str then (have, str)
  33.         else
  34.         match str.[0] with
  35.         | '&' -> let (item, str) = make_nnot (String.trim (nip str)) in make_aand_internal str (And (have, item))
  36.         | ')' | '|' | '-' | ',' -> (have, str)
  37.         | _   -> failwith "Error1"
  38.     in make_aand_internal str item
  39.  
  40. and make_oor str = let (item, str) = make_aand str in
  41.     let rec make_oor_internal str have =
  42.         if String.length str == 0 || checkOnFence str then (have, str)
  43.         else
  44.         match str.[0] with
  45.         | '|' -> let (item, str) = make_aand (String.trim (nip str)) in make_oor_internal str (Or (have, item))
  46.         | ')' | '-' | ',' -> (have, str)
  47.         | _   -> failwith "Error2"
  48.     in make_oor_internal str item
  49.        
  50. and make_expr str = let (item, str) = make_oor str in
  51.     if String.length str == 0 || checkOnFence str
  52.     then (item, str)
  53.     else match str.[0] with
  54.         | '-' -> let (item2, str) = make_expr (String.trim (nip (nip str))) in (Conj (item, item2), str)
  55.         | ')' | ',' -> (item, str)
  56.         | _   -> failwith "Error3";;
  57.        
  58. let parse_expr str = let (a, _) = make_expr (String.trim str) in a;;
  59.  
  60. let rec make_context str =
  61.     let (first, str) = make_expr (String.trim str) in
  62.     let str = String.trim str in
  63.     match str.[0] with
  64.         | ',' -> let (lst, str) = make_context (String.trim (nip str)) in (first :: lst, str)
  65.         | _   -> ([first], str);;
  66.  
  67. type need = Need of expr list * expr;;
  68.  
  69. let make_first_expr str =
  70.     let (context, str) =
  71.         if str.[0] = '|' then ([], str) else make_context str in
  72.     let str = String.trim (nip (nip (String.trim str))) in
  73.     let (expr, _) = make_expr str in Need (context, expr);;
  74.    
  75. let (>>=) x f = match x with
  76.     | Some a -> f a
  77.     | None   -> None;;
  78.  
  79. let takeMon x y = match x with
  80.     | Some a -> a
  81.     | None   -> y;;
  82.  
  83. let rNone x y = None;;
  84. let rNone2 a b y = None;;
  85.    
  86. let checkExpr f1 f2 f3 f4 f5 expr = match expr with
  87.     | Var a       -> f1 a
  88.     | Not a       -> f2 a
  89.     | And  (a, b) -> f3 a b
  90.     | Or   (a, b) -> f4 a b
  91.     | Conj (a, b) -> f5 a b;;
  92. let checkVar (proj, setter) expr took = match proj took with
  93.     | None   -> Some (setter took (Some expr))
  94.     | Some a -> if a = expr then Some took else None;;
  95. let checkNot  f = checkExpr rNone f rNone2 rNone2 rNone2;;
  96. let checkAnd  f = checkExpr rNone rNone f rNone2 rNone2;;
  97. let checkOr   f = checkExpr rNone rNone rNone2 f rNone2;;
  98. let checkConj f = checkExpr rNone rNone rNone2 rNone2 f;;
  99.    
  100. let l1 = (fun (a, _, _) -> a), fun (_, b, c) a -> (a, b, c);;
  101. let l2 = (fun (_, a, _) -> a), fun (a, _, c) b -> (a, b, c);;
  102. let l3 = (fun (_, _, a) -> a), fun (a, b, _) c -> (a, b, c);;
  103.                    
  104. let rec print_expr_ expr = match expr with
  105.     | Var a -> let linz = match a with
  106.         | "A" -> l1
  107.         | "B" -> l2
  108.         | _   -> l3 in checkVar linz
  109.     | Not a       -> checkNot  (print_expr_ a)
  110.     | And  (a, b) -> checkAnd  (fun left right x -> print_expr_ a left x >>= (print_expr_ b right))
  111.     | Or   (a, b) -> checkOr   (fun left right x -> print_expr_ a left x >>= (print_expr_ b right))
  112.     | Conj (a, b) -> checkConj (fun left right x -> print_expr_ a left x >>= (print_expr_ b right))
  113.  
  114. let axioms = List.map (fun x -> print_expr_ (parse_expr x))
  115. (       "A -> B -> A" ::
  116.         "(A -> B) -> (A -> B -> C) -> (A -> C)" ::
  117.         "A -> B -> A & B" ::
  118.         "A & B -> A" ::
  119.         "A & B -> B" ::
  120.         "A -> A | B" ::
  121.         "B -> A | B" ::
  122.         "(A -> B) -> (C -> B) -> (A | C -> B)" ::
  123.         "(A -> B) -> (A -> !B) -> !A" ::
  124.         "!!A -> A":: []);;
  125.        
  126. module ExprMap = Map.Make(struct type t = expr let compare = compare end);;
  127. module ExprSet = Set.Make(struct type t = expr let compare = compare end);;
  128.        
  129. let list_find_opt f l = try Some (List   .find f l) with _ -> None;;
  130. let map_find_opt  k m = try Some (ExprMap.find k m) with _ -> None;;
  131.  
  132. let checkAxioms to_check = let rec func lst = match lst with
  133.     | None :: rem_ -> func rem_
  134.     | Some a :: _  -> Some a
  135.     | _            -> None in
  136.     func (List.mapi (fun ind chain -> chain to_check (None, None, None) >>= (fun _ -> Some ind)) axioms);;
  137.  
  138. type node = Axiom of (expr * int) | MP of (expr * node * node) | Context of (expr * int);;
  139.  
  140. let add_nonexisting key value mp = if ExprMap.mem key mp then mp else ExprMap.add key value mp;;
  141.  
  142. let checkEverything context need evidence =
  143.     let contextMap = List.fold_right (fun (x, ind) mp -> add_nonexisting x ind mp) (List.mapi (fun ind x -> (x, ind)) context) ExprMap.empty in
  144.     let rec checkStepByStep alreadyHadMap possibleMap evidenceMap lst =
  145.         match lst with
  146.             | [] -> None
  147.             | now :: rem_list ->
  148.         let the_node = match map_find_opt now possibleMap with
  149.         | Some the_node -> Some the_node
  150.         | None -> match checkAxioms now with
  151.         | Some ind -> Some (Axiom (now, ind))
  152.         | None -> match map_find_opt now contextMap with
  153.         | Some ind -> Some (Context (now, ind))
  154.         | None -> None in
  155.         if now = need
  156.         then the_node
  157.         else
  158.         the_node >>= fun the_node ->
  159.             let to_add = ExprMap.fold (fun _expr _node have -> (_expr, MP(_expr, _node, the_node)) :: have) (takeMon (map_find_opt now evidenceMap) ExprMap.empty) [] in
  160.             let evidenceMap = ExprMap.remove now evidenceMap in
  161.             let (smth_to_add, new_evidenceMap) = match now with
  162.                 | Conj (a, b) -> (match map_find_opt a alreadyHadMap with
  163.                     | Some the_node1 -> ([(b, MP (b, the_node, the_node1))], evidenceMap)
  164.                     | _ -> ([], ExprMap.add a (add_nonexisting b the_node (takeMon (map_find_opt a evidenceMap) ExprMap.empty)) evidenceMap))
  165.                 | _ -> ([], evidenceMap) in
  166.             let new_list = List.concat (smth_to_add :: to_add :: []) in
  167.             let new_possibleMap = List.fold_right (fun (x, y) mp -> add_nonexisting x y mp) new_list possibleMap in
  168.             let new_alreadyHadMap = add_nonexisting now the_node alreadyHadMap in
  169.             checkStepByStep new_alreadyHadMap new_possibleMap new_evidenceMap rem_list in
  170.     checkStepByStep ExprMap.empty ExprMap.empty ExprMap.empty evidence;;
  171.        
  172. let rec generateNodeList node st = match node with
  173.     | Axiom   (expr_, _) | Context (expr_, _) -> if ExprSet.mem expr_ st then ([], st) else ([node], ExprSet.add expr_ st)
  174.     | MP (expr_, node1, node2) ->
  175.         if ExprSet.mem expr_ st
  176.         then ([], st)
  177.         else
  178.         let (result1, st) = generateNodeList node1 st in
  179.         let (result2, st) = generateNodeList node2 st in
  180.         (node :: List.concat (result1 :: result2 :: []), ExprSet.add expr_ st);;
  181.        
  182. let extractExpr node = match node with
  183.     | Axiom (expr_, _) | Context (expr_, _) | MP (expr_, _, _) -> expr_;;
  184.        
  185. let printNode the_node toSort =
  186.     let (init_list, _) = generateNodeList the_node ExprSet.empty in
  187.     let lst = List.sort (fun x y -> ExprMap.find (extractExpr x) toSort - ExprMap.find (extractExpr y) toSort) init_list in
  188.     let mp  = List.fold_right (fun (num, x) mp -> ExprMap.add (extractExpr x) num mp) (List.mapi (fun num x -> (num + 1, x)) lst) ExprMap.empty in
  189.     let strings = List.map (fun x -> match x with
  190.     | Axiom   (expr_, num) -> "[" ^ string_of_int (ExprMap.find expr_ mp) ^ ". Ax. sch. " ^ string_of_int (num + 1) ^ "] " ^ print_expr expr_
  191.     | Context (expr_, num) -> "[" ^ string_of_int (ExprMap.find expr_ mp) ^ ". Hypothesis " ^ string_of_int (num + 1) ^ "] " ^ print_expr expr_
  192.     | MP (expr_, node1, node2) -> "[" ^ string_of_int (ExprMap.find expr_ mp) ^ ". M.P. " ^ string_of_int (ExprMap.find (extractExpr node1) mp) ^ ", " ^ string_of_int(ExprMap.find (extractExpr node2) mp) ^ "] " ^ print_expr expr_) lst in
  193.     String.concat "\n" strings;;
  194.        
  195. let make_evidence lines = match lines with
  196.     | []                        -> failwith "Error blyat!"
  197.     | first_line :: other_lines ->
  198.         let Need (context, expr) = make_first_expr first_line in
  199.         let other_expr = List.map parse_expr other_lines in
  200.         let toSort = List.fold_right (fun (num, x) mp -> add_nonexisting x num mp) (List.mapi (fun num x -> (num, x)) other_expr) ExprMap.empty in
  201.         match checkEverything context expr other_expr with
  202.             | None   -> "Proof is incorrect"
  203.             | Some a -> String.concat ", " (List.map print_expr context) ^ "|- " ^ (print_expr expr) ^ "\n" ^ printNode a toSort;;
  204.        
  205. let rec mainImpl () =
  206.     try let cur = input_line stdin in cur :: mainImpl () with _ -> [];;
  207.    
  208. print_string (make_evidence (mainImpl ()));;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement