src/HOL/Integ/IntDiv.ML
changeset 6943 2cde117d2738
parent 6917 eba301caceea
child 6992 8113992d3f45
equal deleted inserted replaced
6942:f291292d727c 6943:2cde117d2738
    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