let ROWINSERT = let lxt = `\x:real. T` in fun i const_thm interpsigns_thm -> let isigns_thms = interpsigns_thms2 interpsigns_thm in let isigns_thm = hd isigns_thms in let set,_,_ = if concl isigns_thm = t_tm then lxt,t_tm,t_tm else dest_interpsign (hd isigns_thms) in let const_thm' = MATCH_MP (ISPEC set matinsert_lem0) const_thm in let const_thm'' = PURE_REWRITE_RULE[GSYM interpsign] const_thm' in let isigns_thms' = insertat i const_thm'' isigns_thms in let isigns_thms'' = if isigns_thm = TRUTH then butlast isigns_thms' else isigns_thms' in mk_interpsigns isigns_thms'';; let MATINSERT vars i const_thm cont mat_thm = let const_thm' = GEN (hd vars) const_thm in let rol_thm,all2_thm = interpmat_thms mat_thm in let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in let isigns_thms' = map (ROWINSERT i const_thm') isigns_thms in let all2_thm' = mk_all2_interpsigns part_thm isigns_thms' in let mat_thm' = mk_interpmat_thm rol_thm all2_thm' in cont mat_thm';; (* ---------------------------------------------------------------------- *) (* Opt *) (* ---------------------------------------------------------------------- *) (* OPT FAILED... slightly slower, even with hashtables *) let rec mk_suc = let zero = `0` in let suc = `SUC` in fun n -> match n with 0 -> zero | n -> mk_comb(suc,mk_suc (n-1));; let rec MK_SUC = let f n = prove(mk_eq(mk_small_numeral n,mk_suc n),ARITH_TAC) in let size = 100 in let range = 0--size in let suc_tbl = Hashtbl.create size in map2 (Hashtbl.add suc_tbl) range (map f range); fun n -> try Hashtbl.find suc_tbl n with _ -> f n;; let PL_LENGTH = let pl_tm = `partition_line` in let len_tm = `LENGTH:(real -> bool) list -> num` in fun pts -> let lpts = mk_comb(len_tm,mk_comb(pl_tm,pts)) in let lthm = ARITH_SIMP_CONV[PARTITION_LINE_LENGTH;LENGTH] lpts in let pts' = snd(dest_eq(concl lthm)) in let n = dest_small_numeral pts' in let suc_thm = MK_SUC n in TRANS lthm suc_thm;; let rec MK_LT = let f(n1,n2) = prove(mk_binop nle (mk_suc n1) (mk_suc n2),ARITH_TAC) in let size1 = 20 in let size2 = 20 in let range1 = 0--size1 in let range2 = 0--size2 in let range = filter (fun (x,y) -> x <= y) (allpairs (fun x y -> x,y) range1 range2) in let suc_tbl = Hashtbl.create (size1 * size2) in map2 (Hashtbl.add suc_tbl) range (map f range); fun (n1,n2) -> try Hashtbl.find suc_tbl (n1,n2) with _ -> f(n1,n2);; (* let vars,i,const_thm,mat_thm = !ti,!tconst,!tmat #trace MATINSERT *) (* ---------------------------------------------------------------------- *) (* Timing *) (* ---------------------------------------------------------------------- *) let MATINSERT vars i const_thm cont mat_thm = let start_time = Sys.time() in let res = MATINSERT vars i const_thm cont mat_thm in matinsert_timer +.= (Sys.time() -. start_time); res;; (* let vars,i,const_thm, cont,mat_thm = [ry;rx], 0, ASSUME `-- &1 < &0`, I, ASSUME `interpmat [x_24] [\x. &0 + x * &1] [[Neg]; [Zero]; [Pos]]` MATINSERT vars i const_thm cont mat_thm let vars,i,const_thm, cont,mat_thm = [ry;rx], 0, ASSUME `&0 + x * &1 < &0`, I, ASSUME `interpmat [] [\y. &1] [[Pos]]` MATINSERT vars i const_thm cont mat_thm let vars,i,const_thm, cont,mat_thm = [`x:real`; `a:real`; `b:real`; `c:real`], 0, ASSUME `&0 + a * &2 < &0`, I, ASSUME `interpmat [x_408] [\x. (&0 + b * &1) + x * (&0 + a * &2)] [[Pos]; [Zero]; [Neg]]` MATINSERT vars i const_thm cont mat_thm *)