src/ZF/Arith.ML
changeset 14 1c0926788772
parent 6 8ce8c4d13d4d
child 25 3ac1c0c0016e
equal deleted inserted replaced
13:b73f7e42135e 14:1c0926788772
    26 by (rtac rec_trans 1);
    26 by (rtac rec_trans 1);
    27 by (rtac nat_case_0 1);
    27 by (rtac nat_case_0 1);
    28 val rec_0 = result();
    28 val rec_0 = result();
    29 
    29 
    30 goal Arith.thy "rec(succ(m),a,b) = b(m, rec(m,a,b))";
    30 goal Arith.thy "rec(succ(m),a,b) = b(m, rec(m,a,b))";
    31 val rec_ss = ZF_ss 
       
    32       addsimps [nat_case_succ, nat_succI];
       
    33 by (rtac rec_trans 1);
    31 by (rtac rec_trans 1);
    34 by (simp_tac rec_ss 1);
    32 by (simp_tac (ZF_ss addsimps [nat_case_succ, nat_succI]) 1);
    35 val rec_succ = result();
    33 val rec_succ = result();
    36 
    34 
    37 val major::prems = goal Arith.thy
    35 val major::prems = goal Arith.thy
    38     "[| n: nat;  \
    36     "[| n: nat;  \
    39 \       a: C(0);  \
    37 \       a: C(0);  \
   101  (fn prems=>
    99  (fn prems=>
   102   [ (asm_simp_tac (nat_ss addsimps prems) 1),
   100   [ (asm_simp_tac (nat_ss addsimps prems) 1),
   103     (nat_ind_tac "n" prems 1),
   101     (nat_ind_tac "n" prems 1),
   104     (ALLGOALS (asm_simp_tac (nat_ss addsimps prems))) ]);
   102     (ALLGOALS (asm_simp_tac (nat_ss addsimps prems))) ]);
   105 
   103 
       
   104 (*The conclusion is equivalent to m#-n <= m *)
   106 val prems = goal Arith.thy 
   105 val prems = goal Arith.thy 
   107     "[| m:nat;  n:nat |] ==> m #- n : succ(m)";
   106     "[| m:nat;  n:nat |] ==> m #- n : succ(m)";
   108 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   107 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   109 by (resolve_tac prems 1);
   108 by (resolve_tac prems 1);
   110 by (resolve_tac prems 1);
   109 by (resolve_tac prems 1);
   111 by (etac succE 3);
   110 by (etac succE 3);
   112 by (ALLGOALS
   111 by (ALLGOALS
   113     (asm_simp_tac
   112     (asm_simp_tac
   114      (nat_ss addsimps (prems@[diff_0,diff_0_eq_0,diff_succ_succ]))));
   113      (nat_ss addsimps (prems @ [succ_iff, diff_0, diff_0_eq_0, 
   115 val diff_leq = result();
   114 				diff_succ_succ]))));
       
   115 val diff_less_succ = result();
   116 
   116 
   117 (*** Simplification over add, mult, diff ***)
   117 (*** Simplification over add, mult, diff ***)
   118 
   118 
   119 val arith_typechecks = [add_type, mult_type, diff_type];
   119 val arith_typechecks = [add_type, mult_type, diff_type];
   120 val arith_rews = [add_0, add_succ,
   120 val arith_rews = [add_0, add_succ,
   191     (ALLGOALS (asm_simp_tac
   191     (ALLGOALS (asm_simp_tac
   192 	     (arith_ss addsimps (prems@[mult_0_right, mult_succ_right])))) ]);
   192 	     (arith_ss addsimps (prems@[mult_0_right, mult_succ_right])))) ]);
   193 
   193 
   194 (*addition distributes over multiplication*)
   194 (*addition distributes over multiplication*)
   195 val add_mult_distrib = prove_goal Arith.thy 
   195 val add_mult_distrib = prove_goal Arith.thy 
   196     "[| m:nat;  k:nat |] ==> (m #+ n) #* k = (m #* k) #+ (n #* k)"
   196     "!!m n. [| m:nat;  k:nat |] ==> (m #+ n) #* k = (m #* k) #+ (n #* k)"
   197  (fn prems=>
   197  (fn _=>
   198   [ (nat_ind_tac "m" prems 1),
   198   [ (etac nat_induct 1),
   199     (ALLGOALS (asm_simp_tac (arith_ss addsimps ([add_assoc RS sym]@prems)))) ]);
   199     (ALLGOALS (asm_simp_tac (arith_ss addsimps [add_assoc RS sym]))) ]);
   200 
   200 
   201 (*Distributive law on the left; requires an extra typing premise*)
   201 (*Distributive law on the left; requires an extra typing premise*)
   202 val add_mult_distrib_left = prove_goal Arith.thy 
   202 val add_mult_distrib_left = prove_goal Arith.thy 
   203     "[| m:nat;  n:nat;  k:nat |] ==> k #* (m #+ n) = (k #* m) #+ (k #* n)"
   203     "[| m:nat;  n:nat;  k:nat |] ==> k #* (m #+ n) = (k #* m) #+ (k #* n)"
   204  (fn prems=>
   204  (fn prems=>
   207       in [ (simp_tac ss 1) ]
   207       in [ (simp_tac ss 1) ]
   208       end);
   208       end);
   209 
   209 
   210 (*Associative law for multiplication*)
   210 (*Associative law for multiplication*)
   211 val mult_assoc = prove_goal Arith.thy 
   211 val mult_assoc = prove_goal Arith.thy 
   212     "[| m:nat;  n:nat;  k:nat |] ==> (m #* n) #* k = m #* (n #* k)"
   212     "!!m n k. [| m:nat;  n:nat;  k:nat |] ==> (m #* n) #* k = m #* (n #* k)"
   213  (fn prems=>
   213  (fn _=>
   214   [ (nat_ind_tac "m" prems 1),
   214   [ (etac nat_induct 1),
   215     (ALLGOALS (asm_simp_tac (arith_ss addsimps (prems@[add_mult_distrib])))) ]);
   215     (ALLGOALS (asm_simp_tac (arith_ss addsimps [add_mult_distrib]))) ]);
   216 
   216 
   217 
   217 
   218 (*** Difference ***)
   218 (*** Difference ***)
   219 
   219 
   220 val diff_self_eq_0 = prove_goal Arith.thy 
   220 val diff_self_eq_0 = prove_goal Arith.thy 
   229 by (rtac (notless RS rev_mp) 1);
   229 by (rtac (notless RS rev_mp) 1);
   230 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   230 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   231 by (resolve_tac prems 1);
   231 by (resolve_tac prems 1);
   232 by (resolve_tac prems 1);
   232 by (resolve_tac prems 1);
   233 by (ALLGOALS (asm_simp_tac
   233 by (ALLGOALS (asm_simp_tac
   234 	      (arith_ss addsimps (prems@[succ_mem_succ_iff, Ord_0_mem_succ, 
   234 	      (arith_ss addsimps (prems@[succ_mem_succ_iff, nat_0_in_succ,
   235 				  naturals_are_ordinals]))));
   235 					 naturals_are_ordinals]))));
   236 val add_diff_inverse = result();
   236 val add_diff_inverse = result();
   237 
   237 
   238 
   238 
   239 (*Subtraction is the inverse of addition. *)
   239 (*Subtraction is the inverse of addition. *)
   240 val [mnat,nnat] = goal Arith.thy
   240 val [mnat,nnat] = goal Arith.thy
   255 (*In ordinary notation: if 0<n and n<=m then m-n < m *)
   255 (*In ordinary notation: if 0<n and n<=m then m-n < m *)
   256 goal Arith.thy "!!m n. [| 0:n; ~ m:n;  m:nat;  n:nat |] ==> m #- n : m";
   256 goal Arith.thy "!!m n. [| 0:n; ~ m:n;  m:nat;  n:nat |] ==> m #- n : m";
   257 by (etac rev_mp 1);
   257 by (etac rev_mp 1);
   258 by (etac rev_mp 1);
   258 by (etac rev_mp 1);
   259 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   259 by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
   260 by (ALLGOALS (asm_simp_tac (nat_ss addsimps [diff_leq,diff_succ_succ])));
   260 by (ALLGOALS (asm_simp_tac (nat_ss addsimps [diff_less_succ,diff_succ_succ])));
   261 val div_termination = result();
   261 val div_termination = result();
   262 
   262 
   263 val div_rls =
   263 val div_rls =
   264     [Ord_transrec_type, apply_type, div_termination, if_type] @ 
   264     [Ord_transrec_type, apply_type, div_termination, if_type] @ 
   265     nat_typechecks;
   265     nat_typechecks;
   333     "[| m:nat;  n:nat |] ==> m : succ(m #+ n)";
   333     "[| m:nat;  n:nat |] ==> m : succ(m #+ n)";
   334 by (rtac (mnat RS nat_induct) 1);
   334 by (rtac (mnat RS nat_induct) 1);
   335 (*May not simplify even with ZF_ss because it would expand m:succ(...) *)
   335 (*May not simplify even with ZF_ss because it would expand m:succ(...) *)
   336 by (rtac (add_0 RS ssubst) 1);
   336 by (rtac (add_0 RS ssubst) 1);
   337 by (rtac (add_succ RS ssubst) 2);
   337 by (rtac (add_succ RS ssubst) 2);
   338 by (REPEAT (ares_tac [nnat, Ord_0_mem_succ, succ_mem_succI, 
   338 by (REPEAT (ares_tac [nnat, nat_0_in_succ, succ_mem_succI, 
   339 		      naturals_are_ordinals, nat_succI, add_type] 1));
   339 		      naturals_are_ordinals, nat_succI, add_type] 1));
   340 val add_less_succ_self = result();
   340 val add_less_succ_self = result();
       
   341 
       
   342 goal Arith.thy "!!m n. [| m:nat;  n:nat |] ==> m <= m #+ n";
       
   343 by (rtac (add_less_succ_self RS member_succD) 1);
       
   344 by (REPEAT (ares_tac [naturals_are_ordinals, add_type] 1));
       
   345 val add_leq_self = result();
       
   346 
       
   347 goal Arith.thy "!!m n. [| m:nat;  n:nat |] ==> m <= n #+ m";
       
   348 by (rtac (add_commute RS ssubst) 1);
       
   349 by (REPEAT (ares_tac [add_leq_self] 1));
       
   350 val add_leq_self2 = result();
       
   351 
       
   352 (** Monotonicity of addition **)
       
   353 
       
   354 (*strict, in 1st argument*)
       
   355 goal Arith.thy "!!i j k. [| i:j; j:nat |] ==> i#+k : j#+k";
       
   356 by (etac succ_less_induct 1);
       
   357 by (ALLGOALS (asm_simp_tac (arith_ss addsimps [succ_iff])));
       
   358 val add_less_mono1 = result();
       
   359 
       
   360 (*strict, in both arguments*)
       
   361 goal Arith.thy "!!i j k l. [| i:j; k:l; j:nat; l:nat |] ==> i#+k : j#+l";
       
   362 by (rtac (add_less_mono1 RS Ord_trans) 1);
       
   363 by (REPEAT_FIRST (ares_tac [add_type, naturals_are_ordinals]));
       
   364 by (EVERY [rtac (add_commute RS ssubst) 1,
       
   365 	   rtac (add_commute RS ssubst) 3,
       
   366 	   rtac add_less_mono1 5]);
       
   367 by (REPEAT (ares_tac [Ord_nat RSN (3,Ord_trans)] 1));
       
   368 val add_less_mono = result();
       
   369 
       
   370 (*A [clumsy] way of lifting < monotonictity to <= monotonicity *)
       
   371 val less_mono::ford::prems = goal Ord.thy
       
   372      "[| !!i j. [| i:j; j:k |] ==> f(i) : f(j);	\
       
   373 \        !!i. i:k ==> f(i):k;			\
       
   374 \        i<=j;  i:k;  j:k;  Ord(k)		\
       
   375 \     |] ==> f(i) <= f(j)";
       
   376 by (cut_facts_tac prems 1);
       
   377 by (rtac member_succD 1);
       
   378 by (dtac member_succI 1);
       
   379 by (fast_tac (ZF_cs addSIs [less_mono]) 3);
       
   380 by (REPEAT (ares_tac [ford,Ord_in_Ord] 1));
       
   381 val Ord_less_mono_imp_mono = result();
       
   382 
       
   383 (*<=, in 1st argument*)
       
   384 goal Arith.thy
       
   385     "!!i j k. [| i<=j; i:nat; j:nat; k:nat |] ==> i#+k <= j#+k";
       
   386 by (res_inst_tac [("f", "%j.j#+k")] Ord_less_mono_imp_mono 1);
       
   387 by (REPEAT (ares_tac [add_less_mono1, add_type, Ord_nat] 1));
       
   388 val add_mono1 = result();
       
   389 
       
   390 (*<=, in both arguments*)
       
   391 goal Arith.thy
       
   392     "!!i j k. [| i<=j; k<=l; i:nat; j:nat; k:nat; l:nat |] ==> i#+k <= j#+l";
       
   393 by (rtac (add_mono1 RS subset_trans) 1);
       
   394 by (REPEAT (assume_tac 1));
       
   395 by (EVERY [rtac (add_commute RS ssubst) 1,
       
   396 	   rtac (add_commute RS ssubst) 3,
       
   397 	   rtac add_mono1 5]);
       
   398 by (REPEAT (assume_tac 1));
       
   399 val add_mono = result();