55 qed "unique_remainder"; |
55 qed "unique_remainder"; |
56 |
56 |
57 |
57 |
58 (*** Correctness of posDivAlg, the division algorithm for a>=0 and b>0 ***) |
58 (*** Correctness of posDivAlg, the division algorithm for a>=0 and b>0 ***) |
59 |
59 |
60 Goal "adjust a b (q,r) = (if #0 <= r-b then (#2*q + #1, r-b) \ |
60 (*Unfold all "let"s involving constants*) |
61 \ else (#2*q, r))"; |
61 Addsimps [read_instantiate_sg (sign_of IntDiv.thy) |
62 by (simp_tac (simpset() addsimps [adjust_def]) 1); |
62 [("s", "number_of ?v")] Let_def]; |
|
63 |
|
64 |
|
65 Goal "adjust a b (q,r) = (let diff = r-b in \ |
|
66 \ if #0 <= diff then (#2*q + #1, diff) \ |
|
67 \ else (#2*q, r))"; |
|
68 by (simp_tac (simpset() addsimps [Let_def,adjust_def]) 1); |
63 qed "adjust_eq"; |
69 qed "adjust_eq"; |
64 Addsimps [adjust_eq]; |
70 Addsimps [adjust_eq]; |
65 |
71 |
66 (*Proving posDivAlg's termination condition*) |
72 (*Proving posDivAlg's termination condition*) |
67 val [tc] = posDivAlg.tcs; |
73 val [tc] = posDivAlg.tcs; |
88 Goal "#0 <= a --> #0 < b --> quorem ((a, b), posDivAlg (a, b))"; |
94 Goal "#0 <= a --> #0 < b --> quorem ((a, b), posDivAlg (a, b))"; |
89 by (res_inst_tac [("u", "a"), ("v", "b")] posDivAlg_induct 1); |
95 by (res_inst_tac [("u", "a"), ("v", "b")] posDivAlg_induct 1); |
90 by Auto_tac; |
96 by Auto_tac; |
91 by (ALLGOALS |
97 by (ALLGOALS |
92 (asm_full_simp_tac (simpset() addsimps [quorem_def, |
98 (asm_full_simp_tac (simpset() addsimps [quorem_def, |
93 pos_times_pos_is_pos]))); |
99 pos_imp_zmult_pos_iff]))); |
94 (*base case: a<b*) |
100 (*base case: a<b*) |
95 by (asm_full_simp_tac (simpset() addsimps [posDivAlg_eqn]) 1); |
101 by (asm_full_simp_tac (simpset() addsimps [posDivAlg_eqn]) 1); |
96 (*main argument*) |
102 (*main argument*) |
97 by (stac posDivAlg_eqn 1); |
103 by (stac posDivAlg_eqn 1); |
98 by (ALLGOALS Asm_simp_tac); |
104 by (ALLGOALS Asm_simp_tac); |
99 by (etac splitE 1); |
105 by (etac splitE 1); |
100 by Auto_tac; |
106 by (auto_tac (claset(), simpset() addsimps [Let_def])); |
101 (*the "add one" case*) |
107 (*the "add one" case*) |
102 by (asm_full_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
108 by (asm_full_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
103 (*the "just double" case*) |
109 (*the "just double" case*) |
104 by (asm_full_simp_tac (simpset() addsimps zcompare_rls@[zmult_2_right]) 1); |
110 by (asm_full_simp_tac (simpset() addsimps zcompare_rls@[zmult_2_right]) 1); |
105 qed_spec_mp "posDivAlg_correct"; |
111 qed_spec_mp "posDivAlg_correct"; |
133 Goal "a < #0 --> #0 < b --> quorem ((a, b), negDivAlg (a, b))"; |
139 Goal "a < #0 --> #0 < b --> quorem ((a, b), negDivAlg (a, b))"; |
134 by (res_inst_tac [("u", "a"), ("v", "b")] negDivAlg_induct 1); |
140 by (res_inst_tac [("u", "a"), ("v", "b")] negDivAlg_induct 1); |
135 by Auto_tac; |
141 by Auto_tac; |
136 by (ALLGOALS |
142 by (ALLGOALS |
137 (asm_full_simp_tac (simpset() addsimps [quorem_def, |
143 (asm_full_simp_tac (simpset() addsimps [quorem_def, |
138 pos_times_pos_is_pos]))); |
144 pos_imp_zmult_pos_iff]))); |
139 (*base case: 0<=a+b*) |
145 (*base case: 0<=a+b*) |
140 by (asm_full_simp_tac (simpset() addsimps [negDivAlg_eqn]) 1); |
146 by (asm_full_simp_tac (simpset() addsimps [negDivAlg_eqn]) 1); |
141 (*main argument*) |
147 (*main argument*) |
142 by (stac negDivAlg_eqn 1); |
148 by (stac negDivAlg_eqn 1); |
143 by (ALLGOALS Asm_simp_tac); |
149 by (ALLGOALS Asm_simp_tac); |
144 by (etac splitE 1); |
150 by (etac splitE 1); |
145 by Auto_tac; |
151 by (auto_tac (claset(), simpset() addsimps [Let_def])); |
146 (*the "add one" case*) |
152 (*the "add one" case*) |
147 by (asm_full_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
153 by (asm_full_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
148 (*the "just double" case*) |
154 (*the "just double" case*) |
149 by (asm_full_simp_tac (simpset() addsimps zcompare_rls@[zmult_2_right]) 1); |
155 by (asm_full_simp_tac (simpset() addsimps zcompare_rls@[zmult_2_right]) 1); |
150 qed_spec_mp "negDivAlg_correct"; |
156 qed_spec_mp "negDivAlg_correct"; |
297 by Auto_tac; |
303 by Auto_tac; |
298 qed "zdiv_minus1"; |
304 qed "zdiv_minus1"; |
299 Addsimps [zdiv_minus1]; |
305 Addsimps [zdiv_minus1]; |
300 |
306 |
301 |
307 |
302 (** Monotonicity results **) |
308 (*** Monotonicity in the first argument (divisor) ***) |
303 |
|
304 |
309 |
305 Goal "[| a <= a'; #0 < (b::int) |] ==> a div b <= a' div b"; |
310 Goal "[| a <= a'; #0 < (b::int) |] ==> a div b <= a' div b"; |
306 by (cut_inst_tac [("a","a"),("b","b")] zmod_zdiv_equality 1); |
311 by (cut_inst_tac [("a","a"),("b","b")] zmod_zdiv_equality 1); |
307 by (cut_inst_tac [("a","a'"),("b","b")] zmod_zdiv_equality 2); |
312 by (cut_inst_tac [("a","a'"),("b","b")] zmod_zdiv_equality 2); |
308 by Auto_tac; |
313 by Auto_tac; |
319 by (rtac unique_quotient_lemma_neg 1); |
324 by (rtac unique_quotient_lemma_neg 1); |
320 by (etac subst 1); |
325 by (etac subst 1); |
321 by (etac subst 1); |
326 by (etac subst 1); |
322 by (ALLGOALS (asm_simp_tac (simpset() addsimps [neg_mod_sign,neg_mod_bound]))); |
327 by (ALLGOALS (asm_simp_tac (simpset() addsimps [neg_mod_sign,neg_mod_bound]))); |
323 qed "zdiv_mono1_neg"; |
328 qed "zdiv_mono1_neg"; |
|
329 |
|
330 |
|
331 |
|
332 (*** Monotonicity in the second argument (dividend) ***) |
|
333 |
|
334 Goal "[| r + b*q = r' + b'*q'; #0 <= r' + b'*q'; \ |
|
335 \ r' < b'; #0 <= r; #0 < b'; b' <= b |] \ |
|
336 \ ==> q <= (q'::int)"; |
|
337 by (subgoal_tac "#0 <= q'" 1); |
|
338 by (subgoal_tac "#0 < b'*(q' + #1)" 2); |
|
339 by (asm_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 3); |
|
340 by (asm_full_simp_tac (simpset() addsimps [pos_imp_zmult_pos_iff]) 2); |
|
341 by (subgoal_tac "b*q < b*(q' + #1)" 1); |
|
342 by (Asm_full_simp_tac 1); |
|
343 by (subgoal_tac "b*q = r' - r + b'*q'" 1); |
|
344 by (simp_tac (simpset() addsimps zcompare_rls) 2); |
|
345 by (asm_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
|
346 by (res_inst_tac [("z1","b'*q'")] (zadd_commute RS ssubst) 1); |
|
347 by (rtac zadd_zless_mono 1); |
|
348 by (arith_tac 1); |
|
349 by (rtac zmult_zle_mono1 1); |
|
350 by Auto_tac; |
|
351 qed "zdiv_mono2_lemma"; |
|
352 |
|
353 |
|
354 Goal "[| (#0::int) <= a; #0 < b'; b' <= b |] \ |
|
355 \ ==> a div b <= a div b'"; |
|
356 by (subgoal_tac "b ~= #0" 1); |
|
357 by (arith_tac 2); |
|
358 by (cut_inst_tac [("a","a"),("b","b")] zmod_zdiv_equality 1); |
|
359 by (cut_inst_tac [("a","a"),("b","b'")] zmod_zdiv_equality 2); |
|
360 by Auto_tac; |
|
361 by (rtac zdiv_mono2_lemma 1); |
|
362 by (etac subst 1); |
|
363 by (etac subst 1); |
|
364 by (ALLGOALS (asm_simp_tac (simpset() addsimps [pos_mod_sign,pos_mod_bound]))); |
|
365 qed "zdiv_mono2"; |
|
366 |
|
367 Goal "[| r + b*q = r' + b'*q'; r' + b'*q' < #0; \ |
|
368 \ r < b; #0 <= r'; #0 < b'; b' <= b |] \ |
|
369 \ ==> q' <= (q::int)"; |
|
370 by (subgoal_tac "q' < #0" 1); |
|
371 by (subgoal_tac "b'*q' < #0" 2); |
|
372 by (arith_tac 3); |
|
373 by (asm_full_simp_tac (simpset() addsimps [pos_imp_zmult_neg_iff]) 2); |
|
374 by (subgoal_tac "b*q' < b*(q + #1)" 1); |
|
375 by (Asm_full_simp_tac 1); |
|
376 by (asm_simp_tac (simpset() addsimps [zadd_zmult_distrib2]) 1); |
|
377 by (subgoal_tac "b*q' <= b'*q'" 1); |
|
378 by (asm_simp_tac (simpset() addsimps [zmult_zle_mono1_neg]) 2); |
|
379 by (subgoal_tac "b'*q' < b + b*q" 1); |
|
380 by (Asm_simp_tac 2); |
|
381 by (arith_tac 1); |
|
382 qed "zdiv_mono2_neg_lemma"; |
|
383 |
|
384 Goal "[| a < (#0::int); #0 < b'; b' <= b |] \ |
|
385 \ ==> a div b' <= a div b"; |
|
386 by (subgoal_tac "b ~= #0" 1); |
|
387 by (arith_tac 2); |
|
388 by (cut_inst_tac [("a","a"),("b","b")] zmod_zdiv_equality 1); |
|
389 by (cut_inst_tac [("a","a"),("b","b'")] zmod_zdiv_equality 2); |
|
390 by Auto_tac; |
|
391 by (rtac zdiv_mono2_neg_lemma 1); |
|
392 by (etac subst 1); |
|
393 by (etac subst 1); |
|
394 by (ALLGOALS (asm_simp_tac (simpset() addsimps [pos_mod_sign,pos_mod_bound]))); |
|
395 qed "zdiv_mono2_neg"; |
324 |
396 |
325 |
397 |
326 |
398 |
327 (** The division algorithm in ML **) |
399 (** The division algorithm in ML **) |
328 |
400 |