wenzelm@23164: (* Title: HOL/IntDiv.thy wenzelm@23164: Author: Lawrence C Paulson, Cambridge University Computer Laboratory wenzelm@23164: Copyright 1999 University of Cambridge wenzelm@23164: *) wenzelm@23164: haftmann@29651: header{* The Division Operators div and mod *} wenzelm@23164: wenzelm@23164: theory IntDiv haftmann@25919: imports Int Divides FunDef haftmann@33340: uses haftmann@33340: "~~/src/Provers/Arith/assoc_fold.ML" haftmann@33340: "~~/src/Provers/Arith/cancel_numerals.ML" haftmann@33340: "~~/src/Provers/Arith/combine_numerals.ML" haftmann@33340: "~~/src/Provers/Arith/cancel_numeral_factor.ML" haftmann@33340: "~~/src/Provers/Arith/extract_common_term.ML" haftmann@33340: ("Tools/numeral_simprocs.ML") haftmann@33340: ("Tools/nat_numeral_simprocs.ML") wenzelm@23164: begin wenzelm@23164: haftmann@33340: definition divmod_int_rel :: "int \ int \ int \ int \ bool" where wenzelm@23164: --{*definition of quotient and remainder*} haftmann@33340: [code]: "divmod_int_rel a b = (\(q, r). a = b * q + r \ haftmann@29651: (if 0 < b then 0 \ r \ r < b else b < r \ r \ 0))" wenzelm@23164: haftmann@29651: definition adjust :: "int \ int \ int \ int \ int" where wenzelm@23164: --{*for the division algorithm*} haftmann@29651: [code]: "adjust b = (\(q, r). if 0 \ r - b then (2 * q + 1, r - b) haftmann@29651: else (2 * q, r))" wenzelm@23164: wenzelm@23164: text{*algorithm for the case @{text "a\0, b>0"}*} haftmann@29651: function posDivAlg :: "int \ int \ int \ int" where haftmann@29651: "posDivAlg a b = (if a < b \ b \ 0 then (0, a) haftmann@29651: else adjust b (posDivAlg a (2 * b)))" wenzelm@23164: by auto haftmann@33340: termination by (relation "measure (\(a, b). nat (a - b + 1))") haftmann@33340: (auto simp add: mult_2) wenzelm@23164: wenzelm@23164: text{*algorithm for the case @{text "a<0, b>0"}*} haftmann@29651: function negDivAlg :: "int \ int \ int \ int" where haftmann@29651: "negDivAlg a b = (if 0 \a + b \ b \ 0 then (-1, a + b) haftmann@29651: else adjust b (negDivAlg a (2 * b)))" wenzelm@23164: by auto haftmann@33340: termination by (relation "measure (\(a, b). nat (- a - b))") haftmann@33340: (auto simp add: mult_2) wenzelm@23164: wenzelm@23164: text{*algorithm for the general case @{term "b\0"}*} haftmann@29651: definition negateSnd :: "int \ int \ int \ int" where haftmann@32069: [code_unfold]: "negateSnd = apsnd uminus" wenzelm@23164: haftmann@33340: definition divmod_int :: "int \ int \ int \ int" where wenzelm@23164: --{*The full division algorithm considers all possible signs for a, b wenzelm@23164: including the special case @{text "a=0, b<0"} because wenzelm@23164: @{term negDivAlg} requires @{term "a<0"}.*} haftmann@33340: "divmod_int a b = (if 0 \ a then if 0 \ b then posDivAlg a b haftmann@29651: else if a = 0 then (0, 0) wenzelm@23164: else negateSnd (negDivAlg (-a) (-b)) wenzelm@23164: else haftmann@29651: if 0 < b then negDivAlg a b haftmann@29651: else negateSnd (posDivAlg (-a) (-b)))" wenzelm@23164: haftmann@25571: instantiation int :: Divides.div haftmann@25571: begin haftmann@25571: haftmann@25571: definition haftmann@33340: "a div b = fst (divmod_int a b)" haftmann@25571: haftmann@25571: definition haftmann@33340: "a mod b = snd (divmod_int a b)" haftmann@25571: haftmann@25571: instance .. haftmann@25571: haftmann@25571: end wenzelm@23164: haftmann@33340: lemma divmod_int_mod_div: haftmann@33340: "divmod_int p q = (p div q, p mod q)" haftmann@33340: by (auto simp add: div_int_def mod_int_def) wenzelm@23164: wenzelm@23164: text{* wenzelm@23164: Here is the division algorithm in ML: wenzelm@23164: wenzelm@23164: \begin{verbatim} wenzelm@23164: fun posDivAlg (a,b) = wenzelm@23164: if ar-b then (2*q+1, r-b) else (2*q, r) wenzelm@32960: end wenzelm@23164: wenzelm@23164: fun negDivAlg (a,b) = wenzelm@23164: if 0\a+b then (~1,a+b) wenzelm@23164: else let val (q,r) = negDivAlg(a, 2*b) wenzelm@32960: in if 0\r-b then (2*q+1, r-b) else (2*q, r) wenzelm@32960: end; wenzelm@23164: wenzelm@23164: fun negateSnd (q,r:int) = (q,~r); wenzelm@23164: haftmann@29651: fun divmod (a,b) = if 0\a then wenzelm@32960: if b>0 then posDivAlg (a,b) wenzelm@32960: else if a=0 then (0,0) wenzelm@32960: else negateSnd (negDivAlg (~a,~b)) wenzelm@32960: else wenzelm@32960: if 0 b*q + r; 0 \ r'; r' < b; r < b |] wenzelm@23164: ==> q' \ (q::int)" wenzelm@23164: apply (subgoal_tac "r' + b * (q'-q) \ r") wenzelm@23164: prefer 2 apply (simp add: right_diff_distrib) wenzelm@23164: apply (subgoal_tac "0 < b * (1 + q - q') ") wenzelm@23164: apply (erule_tac [2] order_le_less_trans) wenzelm@23164: prefer 2 apply (simp add: right_diff_distrib right_distrib) wenzelm@23164: apply (subgoal_tac "b * q' < b * (1 + q) ") wenzelm@23164: prefer 2 apply (simp add: right_diff_distrib right_distrib) wenzelm@23164: apply (simp add: mult_less_cancel_left) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma unique_quotient_lemma_neg: wenzelm@23164: "[| b*q' + r' \ b*q + r; r \ 0; b < r; b < r' |] wenzelm@23164: ==> q \ (q'::int)" wenzelm@23164: by (rule_tac b = "-b" and r = "-r'" and r' = "-r" in unique_quotient_lemma, wenzelm@23164: auto) wenzelm@23164: wenzelm@23164: lemma unique_quotient: haftmann@33340: "[| divmod_int_rel a b (q, r); divmod_int_rel a b (q', r'); b \ 0 |] wenzelm@23164: ==> q = q'" haftmann@33340: apply (simp add: divmod_int_rel_def linorder_neq_iff split: split_if_asm) wenzelm@23164: apply (blast intro: order_antisym wenzelm@23164: dest: order_eq_refl [THEN unique_quotient_lemma] wenzelm@23164: order_eq_refl [THEN unique_quotient_lemma_neg] sym)+ wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: lemma unique_remainder: haftmann@33340: "[| divmod_int_rel a b (q, r); divmod_int_rel a b (q', r'); b \ 0 |] wenzelm@23164: ==> r = r'" wenzelm@23164: apply (subgoal_tac "q = q'") haftmann@33340: apply (simp add: divmod_int_rel_def) wenzelm@23164: apply (blast intro: unique_quotient) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Correctness of @{term posDivAlg}, the Algorithm for Non-Negative Dividends*} wenzelm@23164: wenzelm@23164: text{*And positive divisors*} wenzelm@23164: wenzelm@23164: lemma adjust_eq [simp]: wenzelm@23164: "adjust b (q,r) = wenzelm@23164: (let diff = r-b in wenzelm@32960: if 0 \ diff then (2*q + 1, diff) wenzelm@23164: else (2*q, r))" wenzelm@23164: by (simp add: Let_def adjust_def) wenzelm@23164: wenzelm@23164: declare posDivAlg.simps [simp del] wenzelm@23164: wenzelm@23164: text{*use with a simproc to avoid repeatedly proving the premise*} wenzelm@23164: lemma posDivAlg_eqn: wenzelm@23164: "0 < b ==> wenzelm@23164: posDivAlg a b = (if a a" and "0 < b" haftmann@33340: shows "divmod_int_rel a b (posDivAlg a b)" wenzelm@23164: using prems apply (induct a b rule: posDivAlg.induct) wenzelm@23164: apply auto haftmann@33340: apply (simp add: divmod_int_rel_def) wenzelm@23164: apply (subst posDivAlg_eqn, simp add: right_distrib) wenzelm@23164: apply (case_tac "a < b") wenzelm@23164: apply simp_all wenzelm@23164: apply (erule splitE) haftmann@33340: apply (auto simp add: right_distrib Let_def mult_ac mult_2_right) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Correctness of @{term negDivAlg}, the Algorithm for Negative Dividends*} wenzelm@23164: wenzelm@23164: text{*And positive divisors*} wenzelm@23164: wenzelm@23164: declare negDivAlg.simps [simp del] wenzelm@23164: wenzelm@23164: text{*use with a simproc to avoid repeatedly proving the premise*} wenzelm@23164: lemma negDivAlg_eqn: wenzelm@23164: "0 < b ==> wenzelm@23164: negDivAlg a b = wenzelm@23164: (if 0\a+b then (-1,a+b) else adjust b (negDivAlg a (2*b)))" wenzelm@23164: by (rule negDivAlg.simps [THEN trans], simp) wenzelm@23164: wenzelm@23164: (*Correctness of negDivAlg: it computes quotients correctly wenzelm@23164: It doesn't work if a=0 because the 0/b equals 0, not -1*) wenzelm@23164: lemma negDivAlg_correct: wenzelm@23164: assumes "a < 0" and "b > 0" haftmann@33340: shows "divmod_int_rel a b (negDivAlg a b)" wenzelm@23164: using prems apply (induct a b rule: negDivAlg.induct) wenzelm@23164: apply (auto simp add: linorder_not_le) haftmann@33340: apply (simp add: divmod_int_rel_def) wenzelm@23164: apply (subst negDivAlg_eqn, assumption) wenzelm@23164: apply (case_tac "a + b < (0\int)") wenzelm@23164: apply simp_all wenzelm@23164: apply (erule splitE) haftmann@33340: apply (auto simp add: right_distrib Let_def mult_ac mult_2_right) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Existence Shown by Proving the Division Algorithm to be Correct*} wenzelm@23164: wenzelm@23164: (*the case a=0*) haftmann@33340: lemma divmod_int_rel_0: "b \ 0 ==> divmod_int_rel 0 b (0, 0)" haftmann@33340: by (auto simp add: divmod_int_rel_def linorder_neq_iff) wenzelm@23164: wenzelm@23164: lemma posDivAlg_0 [simp]: "posDivAlg 0 b = (0, 0)" wenzelm@23164: by (subst posDivAlg.simps, auto) wenzelm@23164: wenzelm@23164: lemma negDivAlg_minus1 [simp]: "negDivAlg -1 b = (-1, b - 1)" wenzelm@23164: by (subst negDivAlg.simps, auto) wenzelm@23164: wenzelm@23164: lemma negateSnd_eq [simp]: "negateSnd(q,r) = (q,-r)" wenzelm@23164: by (simp add: negateSnd_def) wenzelm@23164: haftmann@33340: lemma divmod_int_rel_neg: "divmod_int_rel (-a) (-b) qr ==> divmod_int_rel a b (negateSnd qr)" haftmann@33340: by (auto simp add: split_ifs divmod_int_rel_def) wenzelm@23164: haftmann@33340: lemma divmod_int_correct: "b \ 0 ==> divmod_int_rel a b (divmod_int a b)" haftmann@33340: by (force simp add: linorder_neq_iff divmod_int_rel_0 divmod_int_def divmod_int_rel_neg wenzelm@23164: posDivAlg_correct negDivAlg_correct) wenzelm@23164: wenzelm@23164: text{*Arbitrary definitions for division by zero. Useful to simplify wenzelm@23164: certain equations.*} wenzelm@23164: wenzelm@23164: lemma DIVISION_BY_ZERO [simp]: "a div (0::int) = 0 & a mod (0::int) = a" haftmann@33340: by (simp add: div_int_def mod_int_def divmod_int_def posDivAlg.simps) wenzelm@23164: wenzelm@23164: wenzelm@23164: text{*Basic laws about division and remainder*} wenzelm@23164: wenzelm@23164: lemma zmod_zdiv_equality: "(a::int) = b * (a div b) + (a mod b)" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (cut_tac a = a and b = b in divmod_int_correct) haftmann@33340: apply (auto simp add: divmod_int_rel_def div_int_def mod_int_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_zmod_equality: "(b * (a div b) + (a mod b)) + k = (a::int)+k" wenzelm@23164: by(simp add: zmod_zdiv_equality[symmetric]) wenzelm@23164: wenzelm@23164: lemma zdiv_zmod_equality2: "((a div b) * b + (a mod b)) + k = (a::int)+k" wenzelm@23164: by(simp add: mult_commute zmod_zdiv_equality[symmetric]) wenzelm@23164: wenzelm@23164: text {* Tool setup *} wenzelm@23164: wenzelm@26480: ML {* haftmann@30934: local wenzelm@23164: haftmann@33340: fun mk_number T n = HOLogic.number_of_const T $ HOLogic.mk_numeral n; haftmann@33340: haftmann@33340: fun find_first_numeral past (t::terms) = haftmann@33340: ((snd (HOLogic.dest_number t), rev past @ terms) haftmann@33340: handle TERM _ => find_first_numeral (t::past) terms) haftmann@33340: | find_first_numeral past [] = raise TERM("find_first_numeral", []); haftmann@33340: haftmann@33340: val mk_plus = HOLogic.mk_binop @{const_name HOL.plus}; haftmann@33340: haftmann@33340: fun mk_minus t = haftmann@33340: let val T = Term.fastype_of t haftmann@33340: in Const (@{const_name HOL.uminus}, T --> T) $ t end; haftmann@33340: haftmann@33340: (*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*) haftmann@33340: fun mk_sum T [] = mk_number T 0 haftmann@33340: | mk_sum T [t,u] = mk_plus (t, u) haftmann@33340: | mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts); haftmann@33340: haftmann@33340: (*this version ALWAYS includes a trailing zero*) haftmann@33340: fun long_mk_sum T [] = mk_number T 0 haftmann@33340: | long_mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts); haftmann@33340: haftmann@33340: val dest_plus = HOLogic.dest_bin @{const_name HOL.plus} Term.dummyT; haftmann@33340: haftmann@33340: (*decompose additions AND subtractions as a sum*) haftmann@33340: fun dest_summing (pos, Const (@{const_name HOL.plus}, _) $ t $ u, ts) = haftmann@33340: dest_summing (pos, t, dest_summing (pos, u, ts)) haftmann@33340: | dest_summing (pos, Const (@{const_name HOL.minus}, _) $ t $ u, ts) = haftmann@33340: dest_summing (pos, t, dest_summing (not pos, u, ts)) haftmann@33340: | dest_summing (pos, t, ts) = haftmann@33340: if pos then t::ts else mk_minus t :: ts; haftmann@33340: haftmann@33340: fun dest_sum t = dest_summing (true, t, []); haftmann@33340: haftmann@30934: structure CancelDivMod = CancelDivModFun(struct haftmann@30934: haftmann@30934: val div_name = @{const_name div}; haftmann@30934: val mod_name = @{const_name mod}; wenzelm@23164: val mk_binop = HOLogic.mk_binop; haftmann@33340: val mk_sum = mk_sum HOLogic.intT; haftmann@33340: val dest_sum = dest_sum; haftmann@30934: haftmann@30934: val div_mod_eqs = map mk_meta_eq [@{thm zdiv_zmod_equality}, @{thm zdiv_zmod_equality2}]; haftmann@30934: wenzelm@23164: val trans = trans; haftmann@30934: haftmann@30934: val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac haftmann@30934: (@{thm diff_minus} :: @{thms add_0s} @ @{thms add_ac})) haftmann@30934: wenzelm@23164: end) wenzelm@23164: wenzelm@23164: in wenzelm@23164: wenzelm@32010: val cancel_div_mod_int_proc = Simplifier.simproc @{theory} haftmann@30934: "cancel_zdiv_zmod" ["(k::int) + l"] (K CancelDivMod.proc); wenzelm@23164: haftmann@30934: val _ = Addsimprocs [cancel_div_mod_int_proc]; wenzelm@23164: haftmann@30934: end wenzelm@23164: *} wenzelm@23164: wenzelm@23164: lemma pos_mod_conj : "(0::int) < b ==> 0 \ a mod b & a mod b < b" haftmann@33340: apply (cut_tac a = a and b = b in divmod_int_correct) haftmann@33340: apply (auto simp add: divmod_int_rel_def mod_int_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemmas pos_mod_sign [simp] = pos_mod_conj [THEN conjunct1, standard] wenzelm@23164: and pos_mod_bound [simp] = pos_mod_conj [THEN conjunct2, standard] wenzelm@23164: wenzelm@23164: lemma neg_mod_conj : "b < (0::int) ==> a mod b \ 0 & b < a mod b" haftmann@33340: apply (cut_tac a = a and b = b in divmod_int_correct) haftmann@33340: apply (auto simp add: divmod_int_rel_def div_int_def mod_int_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemmas neg_mod_sign [simp] = neg_mod_conj [THEN conjunct1, standard] wenzelm@23164: and neg_mod_bound [simp] = neg_mod_conj [THEN conjunct2, standard] wenzelm@23164: wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*General Properties of div and mod*} wenzelm@23164: haftmann@33340: lemma divmod_int_rel_div_mod: "b \ 0 ==> divmod_int_rel a b (a div b, a mod b)" wenzelm@23164: apply (cut_tac a = a and b = b in zmod_zdiv_equality) haftmann@33340: apply (force simp add: divmod_int_rel_def linorder_neq_iff) wenzelm@23164: done wenzelm@23164: haftmann@33340: lemma divmod_int_rel_div: "[| divmod_int_rel a b (q, r); b \ 0 |] ==> a div b = q" haftmann@33340: by (simp add: divmod_int_rel_div_mod [THEN unique_quotient]) wenzelm@23164: haftmann@33340: lemma divmod_int_rel_mod: "[| divmod_int_rel a b (q, r); b \ 0 |] ==> a mod b = r" haftmann@33340: by (simp add: divmod_int_rel_div_mod [THEN unique_remainder]) wenzelm@23164: wenzelm@23164: lemma div_pos_pos_trivial: "[| (0::int) \ a; a < b |] ==> a div b = 0" haftmann@33340: apply (rule divmod_int_rel_div) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma div_neg_neg_trivial: "[| a \ (0::int); b < a |] ==> a div b = 0" haftmann@33340: apply (rule divmod_int_rel_div) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma div_pos_neg_trivial: "[| (0::int) < a; a+b \ 0 |] ==> a div b = -1" haftmann@33340: apply (rule divmod_int_rel_div) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: (*There is no div_neg_pos_trivial because 0 div b = 0 would supersede it*) wenzelm@23164: wenzelm@23164: lemma mod_pos_pos_trivial: "[| (0::int) \ a; a < b |] ==> a mod b = a" haftmann@33340: apply (rule_tac q = 0 in divmod_int_rel_mod) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma mod_neg_neg_trivial: "[| a \ (0::int); b < a |] ==> a mod b = a" haftmann@33340: apply (rule_tac q = 0 in divmod_int_rel_mod) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma mod_pos_neg_trivial: "[| (0::int) < a; a+b \ 0 |] ==> a mod b = a+b" haftmann@33340: apply (rule_tac q = "-1" in divmod_int_rel_mod) haftmann@33340: apply (auto simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: text{*There is no @{text mod_neg_pos_trivial}.*} wenzelm@23164: wenzelm@23164: wenzelm@23164: (*Simpler laws such as -a div b = -(a div b) FAIL, but see just below*) wenzelm@23164: lemma zdiv_zminus_zminus [simp]: "(-a) div (-b) = a div (b::int)" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (simp add: divmod_int_rel_div_mod [THEN divmod_int_rel_neg, simplified, haftmann@33340: THEN divmod_int_rel_div, THEN sym]) wenzelm@23164: wenzelm@23164: done wenzelm@23164: wenzelm@23164: (*Simpler laws such as -a mod b = -(a mod b) FAIL, but see just below*) wenzelm@23164: lemma zmod_zminus_zminus [simp]: "(-a) mod (-b) = - (a mod (b::int))" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (subst divmod_int_rel_div_mod [THEN divmod_int_rel_neg, simplified, THEN divmod_int_rel_mod], wenzelm@23164: auto) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Laws for div and mod with Unary Minus*} wenzelm@23164: wenzelm@23164: lemma zminus1_lemma: haftmann@33340: "divmod_int_rel a b (q, r) haftmann@33340: ==> divmod_int_rel (-a) b (if r=0 then -q else -q - 1, haftmann@29651: if r=0 then 0 else b-r)" haftmann@33340: by (force simp add: split_ifs divmod_int_rel_def linorder_neq_iff right_diff_distrib) wenzelm@23164: wenzelm@23164: wenzelm@23164: lemma zdiv_zminus1_eq_if: wenzelm@23164: "b \ (0::int) wenzelm@23164: ==> (-a) div b = wenzelm@23164: (if a mod b = 0 then - (a div b) else - (a div b) - 1)" haftmann@33340: by (blast intro: divmod_int_rel_div_mod [THEN zminus1_lemma, THEN divmod_int_rel_div]) wenzelm@23164: wenzelm@23164: lemma zmod_zminus1_eq_if: wenzelm@23164: "(-a::int) mod b = (if a mod b = 0 then 0 else b - (a mod b))" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (blast intro: divmod_int_rel_div_mod [THEN zminus1_lemma, THEN divmod_int_rel_mod]) wenzelm@23164: done wenzelm@23164: haftmann@29936: lemma zmod_zminus1_not_zero: haftmann@29936: fixes k l :: int haftmann@29936: shows "- k mod l \ 0 \ k mod l \ 0" haftmann@29936: unfolding zmod_zminus1_eq_if by auto haftmann@29936: wenzelm@23164: lemma zdiv_zminus2: "a div (-b) = (-a::int) div b" wenzelm@23164: by (cut_tac a = "-a" in zdiv_zminus_zminus, auto) wenzelm@23164: wenzelm@23164: lemma zmod_zminus2: "a mod (-b) = - ((-a::int) mod b)" wenzelm@23164: by (cut_tac a = "-a" and b = b in zmod_zminus_zminus, auto) wenzelm@23164: wenzelm@23164: lemma zdiv_zminus2_eq_if: wenzelm@23164: "b \ (0::int) wenzelm@23164: ==> a div (-b) = wenzelm@23164: (if a mod b = 0 then - (a div b) else - (a div b) - 1)" wenzelm@23164: by (simp add: zdiv_zminus1_eq_if zdiv_zminus2) wenzelm@23164: wenzelm@23164: lemma zmod_zminus2_eq_if: wenzelm@23164: "a mod (-b::int) = (if a mod b = 0 then 0 else (a mod b) - b)" wenzelm@23164: by (simp add: zmod_zminus1_eq_if zmod_zminus2) wenzelm@23164: haftmann@29936: lemma zmod_zminus2_not_zero: haftmann@29936: fixes k l :: int haftmann@29936: shows "k mod - l \ 0 \ k mod l \ 0" haftmann@29936: unfolding zmod_zminus2_eq_if by auto haftmann@29936: wenzelm@23164: wenzelm@23164: subsection{*Division of a Number by Itself*} wenzelm@23164: wenzelm@23164: lemma self_quotient_aux1: "[| (0::int) < a; a = r + a*q; r < a |] ==> 1 \ q" wenzelm@23164: apply (subgoal_tac "0 < a*q") wenzelm@23164: apply (simp add: zero_less_mult_iff, arith) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma self_quotient_aux2: "[| (0::int) < a; a = r + a*q; 0 \ r |] ==> q \ 1" wenzelm@23164: apply (subgoal_tac "0 \ a* (1-q) ") wenzelm@23164: apply (simp add: zero_le_mult_iff) wenzelm@23164: apply (simp add: right_diff_distrib) wenzelm@23164: done wenzelm@23164: haftmann@33340: lemma self_quotient: "[| divmod_int_rel a a (q, r); a \ (0::int) |] ==> q = 1" haftmann@33340: apply (simp add: split_ifs divmod_int_rel_def linorder_neq_iff) wenzelm@23164: apply (rule order_antisym, safe, simp_all) wenzelm@23164: apply (rule_tac [3] a = "-a" and r = "-r" in self_quotient_aux1) wenzelm@23164: apply (rule_tac a = "-a" and r = "-r" in self_quotient_aux2) wenzelm@23164: apply (force intro: self_quotient_aux1 self_quotient_aux2 simp add: add_commute)+ wenzelm@23164: done wenzelm@23164: haftmann@33340: lemma self_remainder: "[| divmod_int_rel a a (q, r); a \ (0::int) |] ==> r = 0" wenzelm@23164: apply (frule self_quotient, assumption) haftmann@33340: apply (simp add: divmod_int_rel_def) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_self [simp]: "a \ 0 ==> a div a = (1::int)" haftmann@33340: by (simp add: divmod_int_rel_div_mod [THEN self_quotient]) wenzelm@23164: wenzelm@23164: (*Here we have 0 mod 0 = 0, also assumed by Knuth (who puts m mod 0 = 0) *) wenzelm@23164: lemma zmod_self [simp]: "a mod a = (0::int)" wenzelm@23164: apply (case_tac "a = 0", simp) haftmann@33340: apply (simp add: divmod_int_rel_div_mod [THEN self_remainder]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Computation of Division and Remainder*} wenzelm@23164: wenzelm@23164: lemma zdiv_zero [simp]: "(0::int) div b = 0" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma div_eq_minus1: "(0::int) < b ==> -1 div b = -1" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma zmod_zero [simp]: "(0::int) mod b = 0" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma zmod_minus1: "(0::int) < b ==> -1 mod b = b - 1" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: text{*a positive, b positive *} wenzelm@23164: wenzelm@23164: lemma div_pos_pos: "[| 0 < a; 0 \ b |] ==> a div b = fst (posDivAlg a b)" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma mod_pos_pos: "[| 0 < a; 0 \ b |] ==> a mod b = snd (posDivAlg a b)" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: text{*a negative, b positive *} wenzelm@23164: wenzelm@23164: lemma div_neg_pos: "[| a < 0; 0 < b |] ==> a div b = fst (negDivAlg a b)" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma mod_neg_pos: "[| a < 0; 0 < b |] ==> a mod b = snd (negDivAlg a b)" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: text{*a positive, b negative *} wenzelm@23164: wenzelm@23164: lemma div_pos_neg: wenzelm@23164: "[| 0 < a; b < 0 |] ==> a div b = fst (negateSnd (negDivAlg (-a) (-b)))" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma mod_pos_neg: wenzelm@23164: "[| 0 < a; b < 0 |] ==> a mod b = snd (negateSnd (negDivAlg (-a) (-b)))" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: text{*a negative, b negative *} wenzelm@23164: wenzelm@23164: lemma div_neg_neg: wenzelm@23164: "[| a < 0; b \ 0 |] ==> a div b = fst (negateSnd (posDivAlg (-a) (-b)))" haftmann@33340: by (simp add: div_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: lemma mod_neg_neg: wenzelm@23164: "[| a < 0; b \ 0 |] ==> a mod b = snd (negateSnd (posDivAlg (-a) (-b)))" haftmann@33340: by (simp add: mod_int_def divmod_int_def) wenzelm@23164: wenzelm@23164: text {*Simplify expresions in which div and mod combine numerical constants*} wenzelm@23164: haftmann@33340: lemma divmod_int_relI: huffman@24481: "\a == b * q + r; if 0 < b then 0 \ r \ r < b else b < r \ r \ 0\ haftmann@33340: \ divmod_int_rel a b (q, r)" haftmann@33340: unfolding divmod_int_rel_def by simp huffman@24481: haftmann@33340: lemmas divmod_int_rel_div_eq = divmod_int_relI [THEN divmod_int_rel_div, THEN eq_reflection] haftmann@33340: lemmas divmod_int_rel_mod_eq = divmod_int_relI [THEN divmod_int_rel_mod, THEN eq_reflection] huffman@24481: lemmas arithmetic_simps = huffman@24481: arith_simps huffman@24481: add_special huffman@24481: OrderedGroup.add_0_left huffman@24481: OrderedGroup.add_0_right huffman@24481: mult_zero_left huffman@24481: mult_zero_right huffman@24481: mult_1_left huffman@24481: mult_1_right huffman@24481: huffman@24481: (* simprocs adapted from HOL/ex/Binary.thy *) huffman@24481: ML {* huffman@24481: local haftmann@30517: val mk_number = HOLogic.mk_number HOLogic.intT; haftmann@30517: fun mk_cert u k l = @{term "plus :: int \ int \ int"} $ haftmann@30517: (@{term "times :: int \ int \ int"} $ u $ mk_number k) $ haftmann@30517: mk_number l; haftmann@30517: fun prove ctxt prop = Goal.prove ctxt [] [] prop haftmann@30517: (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps @{thms arithmetic_simps})))); huffman@24481: fun binary_proc proc ss ct = huffman@24481: (case Thm.term_of ct of huffman@24481: _ $ t $ u => huffman@24481: (case try (pairself (`(snd o HOLogic.dest_number))) (t, u) of huffman@24481: SOME args => proc (Simplifier.the_context ss) args huffman@24481: | NONE => NONE) huffman@24481: | _ => NONE); huffman@24481: in haftmann@30517: fun divmod_proc rule = binary_proc (fn ctxt => fn ((m, t), (n, u)) => haftmann@30517: if n = 0 then NONE haftmann@30517: else let val (k, l) = Integer.div_mod m n; haftmann@30517: in SOME (rule OF [prove ctxt (Logic.mk_equals (t, mk_cert u k l))]) end); haftmann@30517: end huffman@24481: *} huffman@24481: huffman@24481: simproc_setup binary_int_div ("number_of m div number_of n :: int") = haftmann@33340: {* K (divmod_proc (@{thm divmod_int_rel_div_eq})) *} huffman@24481: huffman@24481: simproc_setup binary_int_mod ("number_of m mod number_of n :: int") = haftmann@33340: {* K (divmod_proc (@{thm divmod_int_rel_mod_eq})) *} huffman@24481: wenzelm@23164: lemmas posDivAlg_eqn_number_of [simp] = wenzelm@23164: posDivAlg_eqn [of "number_of v" "number_of w", standard] wenzelm@23164: wenzelm@23164: lemmas negDivAlg_eqn_number_of [simp] = wenzelm@23164: negDivAlg_eqn [of "number_of v" "number_of w", standard] wenzelm@23164: wenzelm@23164: wenzelm@23164: text{*Special-case simplification *} wenzelm@23164: wenzelm@23164: lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0" wenzelm@23164: apply (cut_tac a = a and b = "-1" in neg_mod_sign) wenzelm@23164: apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound) wenzelm@23164: apply (auto simp del: neg_mod_sign neg_mod_bound) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_minus1_right [simp]: "a div (-1::int) = -a" wenzelm@23164: by (cut_tac a = a and b = "-1" in zmod_zdiv_equality, auto) wenzelm@23164: wenzelm@23164: (** The last remaining special cases for constant arithmetic: wenzelm@23164: 1 div z and 1 mod z **) wenzelm@23164: wenzelm@23164: lemmas div_pos_pos_1_number_of [simp] = wenzelm@23164: div_pos_pos [OF int_0_less_1, of "number_of w", standard] wenzelm@23164: wenzelm@23164: lemmas div_pos_neg_1_number_of [simp] = wenzelm@23164: div_pos_neg [OF int_0_less_1, of "number_of w", standard] wenzelm@23164: wenzelm@23164: lemmas mod_pos_pos_1_number_of [simp] = wenzelm@23164: mod_pos_pos [OF int_0_less_1, of "number_of w", standard] wenzelm@23164: wenzelm@23164: lemmas mod_pos_neg_1_number_of [simp] = wenzelm@23164: mod_pos_neg [OF int_0_less_1, of "number_of w", standard] wenzelm@23164: wenzelm@23164: wenzelm@23164: lemmas posDivAlg_eqn_1_number_of [simp] = wenzelm@23164: posDivAlg_eqn [of concl: 1 "number_of w", standard] wenzelm@23164: wenzelm@23164: lemmas negDivAlg_eqn_1_number_of [simp] = wenzelm@23164: negDivAlg_eqn [of concl: 1 "number_of w", standard] wenzelm@23164: wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Monotonicity in the First Argument (Dividend)*} wenzelm@23164: wenzelm@23164: lemma zdiv_mono1: "[| a \ a'; 0 < (b::int) |] ==> a div b \ a' div b" wenzelm@23164: apply (cut_tac a = a and b = b in zmod_zdiv_equality) wenzelm@23164: apply (cut_tac a = a' and b = b in zmod_zdiv_equality) wenzelm@23164: apply (rule unique_quotient_lemma) wenzelm@23164: apply (erule subst) wenzelm@23164: apply (erule subst, simp_all) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_mono1_neg: "[| a \ a'; (b::int) < 0 |] ==> a' div b \ a div b" wenzelm@23164: apply (cut_tac a = a and b = b in zmod_zdiv_equality) wenzelm@23164: apply (cut_tac a = a' and b = b in zmod_zdiv_equality) wenzelm@23164: apply (rule unique_quotient_lemma_neg) wenzelm@23164: apply (erule subst) wenzelm@23164: apply (erule subst, simp_all) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Monotonicity in the Second Argument (Divisor)*} wenzelm@23164: wenzelm@23164: lemma q_pos_lemma: wenzelm@23164: "[| 0 \ b'*q' + r'; r' < b'; 0 < b' |] ==> 0 \ (q'::int)" wenzelm@23164: apply (subgoal_tac "0 < b'* (q' + 1) ") wenzelm@23164: apply (simp add: zero_less_mult_iff) wenzelm@23164: apply (simp add: right_distrib) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_mono2_lemma: wenzelm@23164: "[| b*q + r = b'*q' + r'; 0 \ b'*q' + r'; wenzelm@23164: r' < b'; 0 \ r; 0 < b'; b' \ b |] wenzelm@23164: ==> q \ (q'::int)" wenzelm@23164: apply (frule q_pos_lemma, assumption+) wenzelm@23164: apply (subgoal_tac "b*q < b* (q' + 1) ") wenzelm@23164: apply (simp add: mult_less_cancel_left) wenzelm@23164: apply (subgoal_tac "b*q = r' - r + b'*q'") wenzelm@23164: prefer 2 apply simp wenzelm@23164: apply (simp (no_asm_simp) add: right_distrib) wenzelm@23164: apply (subst add_commute, rule zadd_zless_mono, arith) wenzelm@23164: apply (rule mult_right_mono, auto) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_mono2: wenzelm@23164: "[| (0::int) \ a; 0 < b'; b' \ b |] ==> a div b \ a div b'" wenzelm@23164: apply (subgoal_tac "b \ 0") wenzelm@23164: prefer 2 apply arith wenzelm@23164: apply (cut_tac a = a and b = b in zmod_zdiv_equality) wenzelm@23164: apply (cut_tac a = a and b = b' in zmod_zdiv_equality) wenzelm@23164: apply (rule zdiv_mono2_lemma) wenzelm@23164: apply (erule subst) wenzelm@23164: apply (erule subst, simp_all) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma q_neg_lemma: wenzelm@23164: "[| b'*q' + r' < 0; 0 \ r'; 0 < b' |] ==> q' \ (0::int)" wenzelm@23164: apply (subgoal_tac "b'*q' < 0") wenzelm@23164: apply (simp add: mult_less_0_iff, arith) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_mono2_neg_lemma: wenzelm@23164: "[| b*q + r = b'*q' + r'; b'*q' + r' < 0; wenzelm@23164: r < b; 0 \ r'; 0 < b'; b' \ b |] wenzelm@23164: ==> q' \ (q::int)" wenzelm@23164: apply (frule q_neg_lemma, assumption+) wenzelm@23164: apply (subgoal_tac "b*q' < b* (q + 1) ") wenzelm@23164: apply (simp add: mult_less_cancel_left) wenzelm@23164: apply (simp add: right_distrib) wenzelm@23164: apply (subgoal_tac "b*q' \ b'*q'") wenzelm@23164: prefer 2 apply (simp add: mult_right_mono_neg, arith) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zdiv_mono2_neg: wenzelm@23164: "[| a < (0::int); 0 < b'; b' \ b |] ==> a div b' \ a div b" wenzelm@23164: apply (cut_tac a = a and b = b in zmod_zdiv_equality) wenzelm@23164: apply (cut_tac a = a and b = b' in zmod_zdiv_equality) wenzelm@23164: apply (rule zdiv_mono2_neg_lemma) wenzelm@23164: apply (erule subst) wenzelm@23164: apply (erule subst, simp_all) wenzelm@23164: done wenzelm@23164: haftmann@25942: wenzelm@23164: subsection{*More Algebraic Laws for div and mod*} wenzelm@23164: wenzelm@23164: text{*proving (a*b) div c = a * (b div c) + a * (b mod c) *} wenzelm@23164: wenzelm@23164: lemma zmult1_lemma: haftmann@33340: "[| divmod_int_rel b c (q, r); c \ 0 |] haftmann@33340: ==> divmod_int_rel (a * b) c (a*q + a*r div c, a*r mod c)" haftmann@33340: by (auto simp add: split_ifs divmod_int_rel_def linorder_neq_iff right_distrib mult_ac) wenzelm@23164: wenzelm@23164: lemma zdiv_zmult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::int)" wenzelm@23164: apply (case_tac "c = 0", simp) haftmann@33340: apply (blast intro: divmod_int_rel_div_mod [THEN zmult1_lemma, THEN divmod_int_rel_div]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmod_zmult1_eq: "(a*b) mod c = a*(b mod c) mod (c::int)" wenzelm@23164: apply (case_tac "c = 0", simp) haftmann@33340: apply (blast intro: divmod_int_rel_div_mod [THEN zmult1_lemma, THEN divmod_int_rel_mod]) wenzelm@23164: done wenzelm@23164: huffman@29403: lemma zmod_zdiv_trivial: "(a mod b) div b = (0::int)" haftmann@27651: apply (case_tac "b = 0", simp) haftmann@27651: apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial) haftmann@27651: done haftmann@27651: haftmann@27651: text{*proving (a+b) div c = a div c + b div c + ((a mod c + b mod c) div c) *} haftmann@27651: haftmann@27651: lemma zadd1_lemma: haftmann@33340: "[| divmod_int_rel a c (aq, ar); divmod_int_rel b c (bq, br); c \ 0 |] haftmann@33340: ==> divmod_int_rel (a+b) c (aq + bq + (ar+br) div c, (ar+br) mod c)" haftmann@33340: by (force simp add: split_ifs divmod_int_rel_def linorder_neq_iff right_distrib) haftmann@27651: haftmann@27651: (*NOT suitable for rewriting: the RHS has an instance of the LHS*) haftmann@27651: lemma zdiv_zadd1_eq: haftmann@27651: "(a+b) div (c::int) = a div c + b div c + ((a mod c + b mod c) div c)" haftmann@27651: apply (case_tac "c = 0", simp) haftmann@33340: apply (blast intro: zadd1_lemma [OF divmod_int_rel_div_mod divmod_int_rel_div_mod] divmod_int_rel_div) haftmann@27651: done haftmann@27651: huffman@29405: instance int :: ring_div haftmann@27651: proof haftmann@27651: fix a b c :: int haftmann@27651: assume not0: "b \ 0" haftmann@27651: show "(a + c * b) div b = c + a div b" haftmann@27651: unfolding zdiv_zadd1_eq [of a "c * b"] using not0 nipkow@30181: by (simp add: zmod_zmult1_eq zmod_zdiv_trivial zdiv_zmult1_eq) haftmann@30930: next haftmann@30930: fix a b c :: int haftmann@30930: assume "a \ 0" haftmann@30930: then show "(a * b) div (a * c) = b div c" haftmann@30930: proof (cases "b \ 0 \ c \ 0") haftmann@30930: case False then show ?thesis by auto haftmann@30930: next haftmann@30930: case True then have "b \ 0" and "c \ 0" by auto haftmann@30930: with `a \ 0` haftmann@33340: have "\q r. divmod_int_rel b c (q, r) \ divmod_int_rel (a * b) (a * c) (q, a * r)" haftmann@33340: apply (auto simp add: divmod_int_rel_def) haftmann@30930: apply (auto simp add: algebra_simps) haftmann@33340: apply (auto simp add: zero_less_mult_iff zero_le_mult_iff mult_le_0_iff mult_commute [of a] mult_less_cancel_right) haftmann@30930: done haftmann@33340: moreover with `c \ 0` divmod_int_rel_div_mod have "divmod_int_rel b c (b div c, b mod c)" by auto haftmann@33340: ultimately have "divmod_int_rel (a * b) (a * c) (b div c, a * (b mod c))" . haftmann@30930: moreover from `a \ 0` `c \ 0` have "a * c \ 0" by simp haftmann@33340: ultimately show ?thesis by (rule divmod_int_rel_div) haftmann@30930: qed haftmann@27651: qed auto haftmann@25942: haftmann@29651: lemma posDivAlg_div_mod: haftmann@29651: assumes "k \ 0" haftmann@29651: and "l \ 0" haftmann@29651: shows "posDivAlg k l = (k div l, k mod l)" haftmann@29651: proof (cases "l = 0") haftmann@29651: case True then show ?thesis by (simp add: posDivAlg.simps) haftmann@29651: next haftmann@29651: case False with assms posDivAlg_correct haftmann@33340: have "divmod_int_rel k l (fst (posDivAlg k l), snd (posDivAlg k l))" haftmann@29651: by simp haftmann@33340: from divmod_int_rel_div [OF this `l \ 0`] divmod_int_rel_mod [OF this `l \ 0`] haftmann@29651: show ?thesis by simp haftmann@29651: qed haftmann@29651: haftmann@29651: lemma negDivAlg_div_mod: haftmann@29651: assumes "k < 0" haftmann@29651: and "l > 0" haftmann@29651: shows "negDivAlg k l = (k div l, k mod l)" haftmann@29651: proof - haftmann@29651: from assms have "l \ 0" by simp haftmann@29651: from assms negDivAlg_correct haftmann@33340: have "divmod_int_rel k l (fst (negDivAlg k l), snd (negDivAlg k l))" haftmann@29651: by simp haftmann@33340: from divmod_int_rel_div [OF this `l \ 0`] divmod_int_rel_mod [OF this `l \ 0`] haftmann@29651: show ?thesis by simp haftmann@29651: qed haftmann@29651: wenzelm@23164: lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)" huffman@29403: by (simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def) wenzelm@23164: huffman@29403: (* REVISIT: should this be generalized to all semiring_div types? *) wenzelm@23164: lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1] wenzelm@23164: nipkow@23983: wenzelm@23164: subsection{*Proving @{term "a div (b*c) = (a div b) div c"} *} wenzelm@23164: wenzelm@23164: (*The condition c>0 seems necessary. Consider that 7 div ~6 = ~2 but wenzelm@23164: 7 div 2 div ~3 = 3 div ~3 = ~1. The subcase (a div b) mod c = 0 seems wenzelm@23164: to cause particular problems.*) wenzelm@23164: wenzelm@23164: text{*first, four lemmas to bound the remainder for the cases b<0 and b>0 *} wenzelm@23164: wenzelm@23164: lemma zmult2_lemma_aux1: "[| (0::int) < c; b < r; r \ 0 |] ==> b*c < b*(q mod c) + r" wenzelm@23164: apply (subgoal_tac "b * (c - q mod c) < r * 1") nipkow@29667: apply (simp add: algebra_simps) wenzelm@23164: apply (rule order_le_less_trans) nipkow@29667: apply (erule_tac [2] mult_strict_right_mono) nipkow@29667: apply (rule mult_left_mono_neg) nipkow@29667: using add1_zle_eq[of "q mod c"]apply(simp add: algebra_simps pos_mod_bound) nipkow@29667: apply (simp) nipkow@29667: apply (simp) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmult2_lemma_aux2: wenzelm@23164: "[| (0::int) < c; b < r; r \ 0 |] ==> b * (q mod c) + r \ 0" wenzelm@23164: apply (subgoal_tac "b * (q mod c) \ 0") wenzelm@23164: apply arith wenzelm@23164: apply (simp add: mult_le_0_iff) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmult2_lemma_aux3: "[| (0::int) < c; 0 \ r; r < b |] ==> 0 \ b * (q mod c) + r" wenzelm@23164: apply (subgoal_tac "0 \ b * (q mod c) ") wenzelm@23164: apply arith wenzelm@23164: apply (simp add: zero_le_mult_iff) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmult2_lemma_aux4: "[| (0::int) < c; 0 \ r; r < b |] ==> b * (q mod c) + r < b * c" wenzelm@23164: apply (subgoal_tac "r * 1 < b * (c - q mod c) ") nipkow@29667: apply (simp add: right_diff_distrib) wenzelm@23164: apply (rule order_less_le_trans) nipkow@29667: apply (erule mult_strict_right_mono) nipkow@29667: apply (rule_tac [2] mult_left_mono) nipkow@29667: apply simp nipkow@29667: using add1_zle_eq[of "q mod c"] apply (simp add: algebra_simps pos_mod_bound) nipkow@29667: apply simp wenzelm@23164: done wenzelm@23164: haftmann@33340: lemma zmult2_lemma: "[| divmod_int_rel a b (q, r); b \ 0; 0 < c |] haftmann@33340: ==> divmod_int_rel a (b * c) (q div c, b*(q mod c) + r)" haftmann@33340: by (auto simp add: mult_ac divmod_int_rel_def linorder_neq_iff wenzelm@23164: zero_less_mult_iff right_distrib [symmetric] wenzelm@23164: zmult2_lemma_aux1 zmult2_lemma_aux2 zmult2_lemma_aux3 zmult2_lemma_aux4) wenzelm@23164: wenzelm@23164: lemma zdiv_zmult2_eq: "(0::int) < c ==> a div (b*c) = (a div b) div c" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_div]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmod_zmult2_eq: wenzelm@23164: "(0::int) < c ==> a mod (b*c) = b*(a div b mod c) + a mod b" wenzelm@23164: apply (case_tac "b = 0", simp) haftmann@33340: apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection {*Splitting Rules for div and mod*} wenzelm@23164: wenzelm@23164: text{*The proofs of the two lemmas below are essentially identical*} wenzelm@23164: wenzelm@23164: lemma split_pos_lemma: wenzelm@23164: "0 wenzelm@23164: P(n div k :: int)(n mod k) = (\i j. 0\j & j P i j)" wenzelm@23164: apply (rule iffI, clarify) wenzelm@23164: apply (erule_tac P="P ?x ?y" in rev_mp) nipkow@29948: apply (subst mod_add_eq) wenzelm@23164: apply (subst zdiv_zadd1_eq) wenzelm@23164: apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial) wenzelm@23164: txt{*converse direction*} wenzelm@23164: apply (drule_tac x = "n div k" in spec) wenzelm@23164: apply (drule_tac x = "n mod k" in spec, simp) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma split_neg_lemma: wenzelm@23164: "k<0 ==> wenzelm@23164: P(n div k :: int)(n mod k) = (\i j. k0 & n = k*i + j --> P i j)" wenzelm@23164: apply (rule iffI, clarify) wenzelm@23164: apply (erule_tac P="P ?x ?y" in rev_mp) nipkow@29948: apply (subst mod_add_eq) wenzelm@23164: apply (subst zdiv_zadd1_eq) wenzelm@23164: apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial) wenzelm@23164: txt{*converse direction*} wenzelm@23164: apply (drule_tac x = "n div k" in spec) wenzelm@23164: apply (drule_tac x = "n mod k" in spec, simp) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma split_zdiv: wenzelm@23164: "P(n div k :: int) = wenzelm@23164: ((k = 0 --> P 0) & wenzelm@23164: (0 (\i j. 0\j & j P i)) & wenzelm@23164: (k<0 --> (\i j. k0 & n = k*i + j --> P i)))" wenzelm@23164: apply (case_tac "k=0", simp) wenzelm@23164: apply (simp only: linorder_neq_iff) wenzelm@23164: apply (erule disjE) wenzelm@23164: apply (simp_all add: split_pos_lemma [of concl: "%x y. P x"] wenzelm@23164: split_neg_lemma [of concl: "%x y. P x"]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma split_zmod: wenzelm@23164: "P(n mod k :: int) = wenzelm@23164: ((k = 0 --> P n) & wenzelm@23164: (0 (\i j. 0\j & j P j)) & wenzelm@23164: (k<0 --> (\i j. k0 & n = k*i + j --> P j)))" wenzelm@23164: apply (case_tac "k=0", simp) wenzelm@23164: apply (simp only: linorder_neq_iff) wenzelm@23164: apply (erule disjE) wenzelm@23164: apply (simp_all add: split_pos_lemma [of concl: "%x y. P y"] wenzelm@23164: split_neg_lemma [of concl: "%x y. P y"]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: (* Enable arith to deal with div 2 and mod 2: *) wenzelm@23164: declare split_zdiv [of _ _ "number_of k", simplified, standard, arith_split] wenzelm@23164: declare split_zmod [of _ _ "number_of k", simplified, standard, arith_split] wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Speeding up the Division Algorithm with Shifting*} wenzelm@23164: wenzelm@23164: text{*computing div by shifting *} wenzelm@23164: wenzelm@23164: lemma pos_zdiv_mult_2: "(0::int) \ a ==> (1 + 2*b) div (2*a) = b div a" wenzelm@23164: proof cases wenzelm@23164: assume "a=0" wenzelm@23164: thus ?thesis by simp wenzelm@23164: next wenzelm@23164: assume "a\0" and le_a: "0\a" wenzelm@23164: hence a_pos: "1 \ a" by arith haftmann@30652: hence one_less_a2: "1 < 2 * a" by arith wenzelm@23164: hence le_2a: "2 * (1 + b mod a) \ 2 * a" haftmann@30652: unfolding mult_le_cancel_left haftmann@30652: by (simp add: add1_zle_eq add_commute [of 1]) wenzelm@23164: with a_pos have "0 \ b mod a" by simp wenzelm@23164: hence le_addm: "0 \ 1 mod (2*a) + 2*(b mod a)" wenzelm@23164: by (simp add: mod_pos_pos_trivial one_less_a2) wenzelm@23164: with le_2a wenzelm@23164: have "(1 mod (2*a) + 2*(b mod a)) div (2*a) = 0" wenzelm@23164: by (simp add: div_pos_pos_trivial le_addm mod_pos_pos_trivial one_less_a2 wenzelm@23164: right_distrib) wenzelm@23164: thus ?thesis wenzelm@23164: by (subst zdiv_zadd1_eq, haftmann@30930: simp add: mod_mult_mult1 one_less_a2 wenzelm@23164: div_pos_pos_trivial) wenzelm@23164: qed wenzelm@23164: wenzelm@23164: lemma neg_zdiv_mult_2: "a \ (0::int) ==> (1 + 2*b) div (2*a) = (b+1) div a" wenzelm@23164: apply (subgoal_tac " (1 + 2* (-b - 1)) div (2 * (-a)) = (-b - 1) div (-a) ") wenzelm@23164: apply (rule_tac [2] pos_zdiv_mult_2) haftmann@33340: apply (auto simp add: right_diff_distrib) wenzelm@23164: apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))") haftmann@33340: apply (simp only: zdiv_zminus_zminus diff_minus minus_add_distrib [symmetric]) haftmann@33340: apply (simp_all add: algebra_simps) haftmann@33340: apply (simp only: ab_diff_minus minus_add_distrib [symmetric] number_of_Min zdiv_zminus_zminus) wenzelm@23164: done wenzelm@23164: huffman@26086: lemma zdiv_number_of_Bit0 [simp]: huffman@26086: "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) = huffman@26086: number_of v div (number_of w :: int)" haftmann@33340: by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric]) huffman@26086: huffman@26086: lemma zdiv_number_of_Bit1 [simp]: huffman@26086: "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) = huffman@26086: (if (0::int) \ number_of w wenzelm@23164: then number_of v div (number_of w) wenzelm@23164: else (number_of v + (1::int)) div (number_of w))" wenzelm@23164: apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) haftmann@33340: apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Computing mod by Shifting (proofs resemble those for div)*} wenzelm@23164: wenzelm@23164: lemma pos_zmod_mult_2: haftmann@33340: fixes a b :: int haftmann@33340: assumes "0 \ a" haftmann@33340: shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)" haftmann@33340: proof (cases "0 < a") haftmann@33340: case False with assms show ?thesis by simp haftmann@33340: next haftmann@33340: case True haftmann@33340: then have "b mod a < a" by (rule pos_mod_bound) haftmann@33340: then have "1 + b mod a \ a" by simp haftmann@33340: then have A: "2 * (1 + b mod a) \ 2 * a" by simp haftmann@33340: from `0 < a` have "0 \ b mod a" by (rule pos_mod_sign) haftmann@33340: then have B: "0 \ 1 + 2 * (b mod a)" by simp haftmann@33340: have "((1\int) mod ((2\int) * a) + (2\int) * b mod ((2\int) * a)) mod ((2\int) * a) = (1\int) + (2\int) * (b mod a)" haftmann@33340: using `0 < a` and A haftmann@33340: by (auto simp add: mod_mult_mult1 mod_pos_pos_trivial ring_distribs intro!: mod_pos_pos_trivial B) haftmann@33340: then show ?thesis by (subst mod_add_eq) haftmann@33340: qed wenzelm@23164: wenzelm@23164: lemma neg_zmod_mult_2: haftmann@33340: fixes a b :: int haftmann@33340: assumes "a \ 0" haftmann@33340: shows "(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1" haftmann@33340: proof - haftmann@33340: from assms have "0 \ - a" by auto haftmann@33340: then have "(1 + 2 * (- b - 1)) mod (2 * (- a)) = 1 + 2 * ((- b - 1) mod (- a))" haftmann@33340: by (rule pos_zmod_mult_2) haftmann@33340: then show ?thesis by (simp add: zmod_zminus2 algebra_simps) haftmann@33340: (simp add: diff_minus add_ac) haftmann@33340: qed wenzelm@23164: huffman@26086: lemma zmod_number_of_Bit0 [simp]: huffman@26086: "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) = huffman@26086: (2::int) * (number_of v mod number_of w)" huffman@26086: apply (simp only: number_of_eq numeral_simps) haftmann@30930: apply (simp add: mod_mult_mult1 pos_zmod_mult_2 haftmann@33340: neg_zmod_mult_2 add_ac mult_2 [symmetric]) huffman@26086: done huffman@26086: huffman@26086: lemma zmod_number_of_Bit1 [simp]: huffman@26086: "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) = huffman@26086: (if (0::int) \ number_of w wenzelm@23164: then 2 * (number_of v mod number_of w) + 1 wenzelm@23164: else 2 * ((number_of v + (1::int)) mod number_of w) - 1)" huffman@26086: apply (simp only: number_of_eq numeral_simps) haftmann@30930: apply (simp add: mod_mult_mult1 pos_zmod_mult_2 haftmann@33340: neg_zmod_mult_2 add_ac mult_2 [symmetric]) wenzelm@23164: done wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection{*Quotients of Signs*} wenzelm@23164: wenzelm@23164: lemma div_neg_pos_less0: "[| a < (0::int); 0 < b |] ==> a div b < 0" wenzelm@23164: apply (subgoal_tac "a div b \ -1", force) wenzelm@23164: apply (rule order_trans) wenzelm@23164: apply (rule_tac a' = "-1" in zdiv_mono1) nipkow@29948: apply (auto simp add: div_eq_minus1) wenzelm@23164: done wenzelm@23164: nipkow@30323: lemma div_nonneg_neg_le0: "[| (0::int) \ a; b < 0 |] ==> a div b \ 0" wenzelm@23164: by (drule zdiv_mono1_neg, auto) wenzelm@23164: nipkow@30323: lemma div_nonpos_pos_le0: "[| (a::int) \ 0; b > 0 |] ==> a div b \ 0" nipkow@30323: by (drule zdiv_mono1, auto) nipkow@30323: wenzelm@23164: lemma pos_imp_zdiv_nonneg_iff: "(0::int) < b ==> (0 \ a div b) = (0 \ a)" wenzelm@23164: apply auto wenzelm@23164: apply (drule_tac [2] zdiv_mono1) wenzelm@23164: apply (auto simp add: linorder_neq_iff) wenzelm@23164: apply (simp (no_asm_use) add: linorder_not_less [symmetric]) wenzelm@23164: apply (blast intro: div_neg_pos_less0) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma neg_imp_zdiv_nonneg_iff: wenzelm@23164: "b < (0::int) ==> (0 \ a div b) = (a \ (0::int))" wenzelm@23164: apply (subst zdiv_zminus_zminus [symmetric]) wenzelm@23164: apply (subst pos_imp_zdiv_nonneg_iff, auto) wenzelm@23164: done wenzelm@23164: wenzelm@23164: (*But not (a div b \ 0 iff a\0); consider a=1, b=2 when a div b = 0.*) wenzelm@23164: lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)" wenzelm@23164: by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff) wenzelm@23164: wenzelm@23164: (*Again the law fails for \: consider a = -1, b = -2 when a div b = 0*) wenzelm@23164: lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)" wenzelm@23164: by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff) wenzelm@23164: wenzelm@23164: wenzelm@23164: subsection {* The Divides Relation *} wenzelm@23164: wenzelm@23164: lemmas zdvd_iff_zmod_eq_0_number_of [simp] = nipkow@30042: dvd_eq_mod_eq_0 [of "number_of x::int" "number_of y::int", standard] wenzelm@23164: wenzelm@23164: lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n" huffman@31662: by (rule dvd_mod) (* TODO: remove *) wenzelm@23164: wenzelm@23164: lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)" huffman@31662: by (rule dvd_mod_imp_dvd) (* TODO: remove *) wenzelm@23164: wenzelm@23164: lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)" wenzelm@23164: using zmod_zdiv_equality[where a="m" and b="n"] nipkow@29667: by (simp add: algebra_simps) wenzelm@23164: wenzelm@23164: lemma zpower_zmod: "((x::int) mod m)^y mod m = x^y mod m" wenzelm@23164: apply (induct "y", auto) wenzelm@23164: apply (rule zmod_zmult1_eq [THEN trans]) wenzelm@23164: apply (simp (no_asm_simp)) nipkow@29948: apply (rule mod_mult_eq [symmetric]) wenzelm@23164: done wenzelm@23164: huffman@23365: lemma zdiv_int: "int (a div b) = (int a) div (int b)" wenzelm@23164: apply (subst split_div, auto) wenzelm@23164: apply (subst split_zdiv, auto) huffman@23365: apply (rule_tac a="int (b * i) + int j" and b="int b" and r="int j" and r'=ja in IntDiv.unique_quotient) haftmann@33340: apply (auto simp add: IntDiv.divmod_int_rel_def of_nat_mult) wenzelm@23164: done wenzelm@23164: wenzelm@23164: lemma zmod_int: "int (a mod b) = (int a) mod (int b)" huffman@23365: apply (subst split_mod, auto) huffman@23365: apply (subst split_zmod, auto) huffman@23365: apply (rule_tac a="int (b * i) + int j" and b="int b" and q="int i" and q'=ia huffman@23365: in unique_remainder) haftmann@33340: apply (auto simp add: IntDiv.divmod_int_rel_def of_nat_mult) huffman@23365: done wenzelm@23164: nipkow@30180: lemma abs_div: "(y::int) dvd x \ abs (x div y) = abs x div abs y" nipkow@30180: by (unfold dvd_def, cases "y=0", auto simp add: abs_mult) nipkow@30180: haftmann@33318: lemma zdvd_mult_div_cancel:"(n::int) dvd m \ n * (m div n) = m" haftmann@33318: apply (subgoal_tac "m mod n = 0") haftmann@33318: apply (simp add: zmult_div_cancel) haftmann@33318: apply (simp only: dvd_eq_mod_eq_0) haftmann@33318: done haftmann@33318: wenzelm@23164: text{*Suggested by Matthias Daum*} wenzelm@23164: lemma int_power_div_base: wenzelm@23164: "\0 < m; 0 < k\ \ k ^ m div k = (k::int) ^ (m - Suc 0)" huffman@30079: apply (subgoal_tac "k ^ m = k ^ ((m - Suc 0) + Suc 0)") wenzelm@23164: apply (erule ssubst) wenzelm@23164: apply (simp only: power_add) wenzelm@23164: apply simp_all wenzelm@23164: done wenzelm@23164: haftmann@23853: text {* by Brian Huffman *} haftmann@23853: lemma zminus_zmod: "- ((x::int) mod m) mod m = - x mod m" huffman@29405: by (rule mod_minus_eq [symmetric]) haftmann@23853: haftmann@23853: lemma zdiff_zmod_left: "(x mod m - y) mod m = (x - y) mod (m::int)" huffman@29405: by (rule mod_diff_left_eq [symmetric]) haftmann@23853: haftmann@23853: lemma zdiff_zmod_right: "(x - y mod m) mod m = (x - y) mod (m::int)" huffman@29405: by (rule mod_diff_right_eq [symmetric]) haftmann@23853: haftmann@23853: lemmas zmod_simps = nipkow@30034: mod_add_left_eq [symmetric] nipkow@30034: mod_add_right_eq [symmetric] haftmann@30930: zmod_zmult1_eq [symmetric] haftmann@30930: mod_mult_left_eq [symmetric] haftmann@30930: zpower_zmod haftmann@23853: zminus_zmod zdiff_zmod_left zdiff_zmod_right haftmann@23853: huffman@29045: text {* Distributive laws for function @{text nat}. *} huffman@29045: huffman@29045: lemma nat_div_distrib: "0 \ x \ nat (x div y) = nat x div nat y" huffman@29045: apply (rule linorder_cases [of y 0]) huffman@29045: apply (simp add: div_nonneg_neg_le0) huffman@29045: apply simp huffman@29045: apply (simp add: nat_eq_iff pos_imp_zdiv_nonneg_iff zdiv_int) huffman@29045: done huffman@29045: huffman@29045: (*Fails if y<0: the LHS collapses to (nat z) but the RHS doesn't*) huffman@29045: lemma nat_mod_distrib: huffman@29045: "\0 \ x; 0 \ y\ \ nat (x mod y) = nat x mod nat y" huffman@29045: apply (case_tac "y = 0", simp add: DIVISION_BY_ZERO) huffman@29045: apply (simp add: nat_eq_iff zmod_int) huffman@29045: done huffman@29045: huffman@29045: text{*Suggested by Matthias Daum*} huffman@29045: lemma int_div_less_self: "\0 < x; 1 < k\ \ x div k < (x::int)" huffman@29045: apply (subgoal_tac "nat x div nat k < nat x") huffman@29045: apply (simp (asm_lr) add: nat_div_distrib [symmetric]) huffman@29045: apply (rule Divides.div_less_dividend, simp_all) huffman@29045: done huffman@29045: haftmann@23853: text {* code generator setup *} wenzelm@23164: haftmann@26507: context ring_1 haftmann@26507: begin haftmann@26507: haftmann@28562: lemma of_int_num [code]: haftmann@26507: "of_int k = (if k = 0 then 0 else if k < 0 then haftmann@26507: - of_int (- k) else let haftmann@33340: (l, m) = divmod_int k 2; haftmann@26507: l' = of_int l haftmann@26507: in if m = 0 then l' + l' else l' + l' + 1)" haftmann@26507: proof - haftmann@26507: have aux1: "k mod (2\int) \ (0\int) \ haftmann@26507: of_int k = of_int (k div 2 * 2 + 1)" haftmann@26507: proof - haftmann@26507: have "k mod 2 < 2" by (auto intro: pos_mod_bound) haftmann@26507: moreover have "0 \ k mod 2" by (auto intro: pos_mod_sign) haftmann@26507: moreover assume "k mod 2 \ 0" haftmann@26507: ultimately have "k mod 2 = 1" by arith haftmann@26507: moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp haftmann@26507: ultimately show ?thesis by auto haftmann@26507: qed haftmann@26507: have aux2: "\x. of_int 2 * x = x + x" haftmann@26507: proof - haftmann@26507: fix x haftmann@26507: have int2: "(2::int) = 1 + 1" by arith haftmann@26507: show "of_int 2 * x = x + x" haftmann@26507: unfolding int2 of_int_add left_distrib by simp haftmann@26507: qed haftmann@26507: have aux3: "\x. x * of_int 2 = x + x" haftmann@26507: proof - haftmann@26507: fix x haftmann@26507: have int2: "(2::int) = 1 + 1" by arith haftmann@26507: show "x * of_int 2 = x + x" haftmann@26507: unfolding int2 of_int_add right_distrib by simp haftmann@26507: qed haftmann@33340: from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3) haftmann@26507: qed haftmann@26507: haftmann@26507: end haftmann@26507: chaieb@27667: lemma zmod_eq_dvd_iff: "(x::int) mod n = y mod n \ n dvd x - y" chaieb@27667: proof chaieb@27667: assume H: "x mod n = y mod n" chaieb@27667: hence "x mod n - y mod n = 0" by simp chaieb@27667: hence "(x mod n - y mod n) mod n = 0" by simp nipkow@30034: hence "(x - y) mod n = 0" by (simp add: mod_diff_eq[symmetric]) nipkow@30042: thus "n dvd x - y" by (simp add: dvd_eq_mod_eq_0) chaieb@27667: next chaieb@27667: assume H: "n dvd x - y" chaieb@27667: then obtain k where k: "x-y = n*k" unfolding dvd_def by blast chaieb@27667: hence "x = n*k + y" by simp chaieb@27667: hence "x mod n = (n*k + y) mod n" by simp nipkow@30034: thus "x mod n = y mod n" by (simp add: mod_add_left_eq) chaieb@27667: qed chaieb@27667: chaieb@27667: lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y mod n" and xy:"y \ x" chaieb@27667: shows "\q. x = y + n * q" chaieb@27667: proof- chaieb@27667: from xy have th: "int x - int y = int (x - y)" by simp chaieb@27667: from xyn have "int x mod int n = int y mod int n" chaieb@27667: by (simp add: zmod_int[symmetric]) chaieb@27667: hence "int n dvd int x - int y" by (simp only: zmod_eq_dvd_iff[symmetric]) chaieb@27667: hence "n dvd x - y" by (simp add: th zdvd_int) chaieb@27667: then show ?thesis using xy unfolding dvd_def apply clarsimp apply (rule_tac x="k" in exI) by arith chaieb@27667: qed chaieb@27667: chaieb@27667: lemma nat_mod_eq_iff: "(x::nat) mod n = y mod n \ (\q1 q2. x + n * q1 = y + n * q2)" chaieb@27667: (is "?lhs = ?rhs") chaieb@27667: proof chaieb@27667: assume H: "x mod n = y mod n" chaieb@27667: {assume xy: "x \ y" chaieb@27667: from H have th: "y mod n = x mod n" by simp chaieb@27667: from nat_mod_eq_lemma[OF th xy] have ?rhs chaieb@27667: apply clarify apply (rule_tac x="q" in exI) by (rule exI[where x="0"], simp)} chaieb@27667: moreover chaieb@27667: {assume xy: "y \ x" chaieb@27667: from nat_mod_eq_lemma[OF H xy] have ?rhs chaieb@27667: apply clarify apply (rule_tac x="0" in exI) by (rule_tac x="q" in exI, simp)} chaieb@27667: ultimately show ?rhs using linear[of x y] by blast chaieb@27667: next chaieb@27667: assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast chaieb@27667: hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp chaieb@27667: thus ?lhs by simp chaieb@27667: qed chaieb@27667: haftmann@33296: lemma div_nat_number_of [simp]: haftmann@33296: "(number_of v :: nat) div number_of v' = haftmann@33296: (if neg (number_of v :: int) then 0 haftmann@33296: else nat (number_of v div number_of v'))" haftmann@33296: unfolding nat_number_of_def number_of_is_id neg_def haftmann@33296: by (simp add: nat_div_distrib) haftmann@33296: haftmann@33296: lemma one_div_nat_number_of [simp]: haftmann@33296: "Suc 0 div number_of v' = nat (1 div number_of v')" haftmann@33296: by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) haftmann@33296: haftmann@33296: lemma mod_nat_number_of [simp]: haftmann@33296: "(number_of v :: nat) mod number_of v' = haftmann@33296: (if neg (number_of v :: int) then 0 haftmann@33296: else if neg (number_of v' :: int) then number_of v haftmann@33296: else nat (number_of v mod number_of v'))" haftmann@33296: unfolding nat_number_of_def number_of_is_id neg_def haftmann@33296: by (simp add: nat_mod_distrib) haftmann@33296: haftmann@33296: lemma one_mod_nat_number_of [simp]: haftmann@33296: "Suc 0 mod number_of v' = haftmann@33296: (if neg (number_of v' :: int) then Suc 0 haftmann@33296: else nat (1 mod number_of v'))" haftmann@33296: by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) haftmann@33296: haftmann@33296: lemmas dvd_eq_mod_eq_0_number_of = haftmann@33296: dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard] haftmann@33296: haftmann@33296: declare dvd_eq_mod_eq_0_number_of [simp] haftmann@33296: haftmann@29936: haftmann@33318: subsection {* Transfer setup *} haftmann@33318: haftmann@33318: lemma transfer_nat_int_functions: haftmann@33318: "(x::int) >= 0 \ y >= 0 \ (nat x) div (nat y) = nat (x div y)" haftmann@33318: "(x::int) >= 0 \ y >= 0 \ (nat x) mod (nat y) = nat (x mod y)" haftmann@33318: by (auto simp add: nat_div_distrib nat_mod_distrib) haftmann@33318: haftmann@33318: lemma transfer_nat_int_function_closures: haftmann@33318: "(x::int) >= 0 \ y >= 0 \ x div y >= 0" haftmann@33318: "(x::int) >= 0 \ y >= 0 \ x mod y >= 0" haftmann@33318: apply (cases "y = 0") haftmann@33318: apply (auto simp add: pos_imp_zdiv_nonneg_iff) haftmann@33318: apply (cases "y = 0") haftmann@33318: apply auto haftmann@33318: done haftmann@33318: haftmann@33318: declare TransferMorphism_nat_int[transfer add return: haftmann@33318: transfer_nat_int_functions haftmann@33318: transfer_nat_int_function_closures haftmann@33318: ] haftmann@33318: haftmann@33318: lemma transfer_int_nat_functions: haftmann@33318: "(int x) div (int y) = int (x div y)" haftmann@33318: "(int x) mod (int y) = int (x mod y)" haftmann@33318: by (auto simp add: zdiv_int zmod_int) haftmann@33318: haftmann@33318: lemma transfer_int_nat_function_closures: haftmann@33318: "is_nat x \ is_nat y \ is_nat (x div y)" haftmann@33318: "is_nat x \ is_nat y \ is_nat (x mod y)" haftmann@33318: by (simp_all only: is_nat_def transfer_nat_int_function_closures) haftmann@33318: haftmann@33318: declare TransferMorphism_int_nat[transfer add return: haftmann@33318: transfer_int_nat_functions haftmann@33318: transfer_int_nat_function_closures haftmann@33318: ] haftmann@33318: haftmann@33318: haftmann@29936: subsection {* Code generation *} haftmann@29936: haftmann@29936: definition pdivmod :: "int \ int \ int \ int" where haftmann@29936: "pdivmod k l = (\k\ div \l\, \k\ mod \l\)" haftmann@29936: haftmann@29936: lemma pdivmod_posDivAlg [code]: haftmann@29936: "pdivmod k l = (if l = 0 then (0, \k\) else posDivAlg \k\ \l\)" haftmann@29936: by (subst posDivAlg_div_mod) (simp_all add: pdivmod_def) haftmann@29936: haftmann@33340: lemma divmod_int_pdivmod: "divmod_int k l = (if k = 0 then (0, 0) else if l = 0 then (0, k) else haftmann@29936: apsnd ((op *) (sgn l)) (if 0 < l \ 0 \ k \ l < 0 \ k < 0 haftmann@29936: then pdivmod k l haftmann@29936: else (let (r, s) = pdivmod k l in haftmann@29936: if s = 0 then (- r, 0) else (- r - 1, \l\ - s))))" haftmann@29936: proof - haftmann@29936: have aux: "\q::int. - k = l * q \ k = l * - q" by auto haftmann@29936: show ?thesis haftmann@33340: by (simp add: divmod_int_mod_div pdivmod_def) haftmann@29936: (auto simp add: aux not_less not_le zdiv_zminus1_eq_if haftmann@29936: zmod_zminus1_eq_if zdiv_zminus2_eq_if zmod_zminus2_eq_if) haftmann@29936: qed haftmann@29936: haftmann@33340: lemma divmod_int_code [code]: "divmod_int k l = (if k = 0 then (0, 0) else if l = 0 then (0, k) else haftmann@29936: apsnd ((op *) (sgn l)) (if sgn k = sgn l haftmann@29936: then pdivmod k l haftmann@29936: else (let (r, s) = pdivmod k l in haftmann@29936: if s = 0 then (- r, 0) else (- r - 1, \l\ - s))))" haftmann@29936: proof - haftmann@29936: have "k \ 0 \ l \ 0 \ 0 < l \ 0 \ k \ l < 0 \ k < 0 \ sgn k = sgn l" haftmann@29936: by (auto simp add: not_less sgn_if) haftmann@33340: then show ?thesis by (simp add: divmod_int_pdivmod) haftmann@29936: qed haftmann@29936: wenzelm@23164: code_modulename SML wenzelm@23164: IntDiv Integer wenzelm@23164: wenzelm@23164: code_modulename OCaml wenzelm@23164: IntDiv Integer wenzelm@23164: wenzelm@23164: code_modulename Haskell haftmann@24195: IntDiv Integer wenzelm@23164: haftmann@33340: haftmann@33340: haftmann@33340: subsection {* Proof Tools setup; Combination and Cancellation Simprocs *} haftmann@33340: haftmann@33340: declare split_div[of _ _ "number_of k", standard, arith_split] haftmann@33340: declare split_mod[of _ _ "number_of k", standard, arith_split] haftmann@33340: haftmann@33340: haftmann@33340: subsubsection{*For @{text combine_numerals}*} haftmann@33340: haftmann@33340: lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)" haftmann@33340: by (simp add: add_mult_distrib) haftmann@33340: haftmann@33340: haftmann@33340: subsubsection{*For @{text cancel_numerals}*} haftmann@33340: haftmann@33340: lemma nat_diff_add_eq1: haftmann@33340: "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)" haftmann@33340: by (simp split add: nat_diff_split add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_diff_add_eq2: haftmann@33340: "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))" haftmann@33340: by (simp split add: nat_diff_split add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_eq_add_iff1: haftmann@33340: "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_eq_add_iff2: haftmann@33340: "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_less_add_iff1: haftmann@33340: "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_less_add_iff2: haftmann@33340: "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_le_add_iff1: haftmann@33340: "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: lemma nat_le_add_iff2: haftmann@33340: "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)" haftmann@33340: by (auto split add: nat_diff_split simp add: add_mult_distrib) haftmann@33340: haftmann@33340: haftmann@33340: subsubsection{*For @{text cancel_numeral_factors} *} haftmann@33340: haftmann@33340: lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)" haftmann@33340: by auto haftmann@33340: haftmann@33340: lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m (k*m = k*n) = (m=n)" haftmann@33340: by auto haftmann@33340: haftmann@33340: lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)" haftmann@33340: by auto haftmann@33340: haftmann@33340: lemma nat_mult_dvd_cancel_disj[simp]: haftmann@33340: "(k*m) dvd (k*n) = (k=0 | m dvd (n::nat))" haftmann@33340: by(auto simp: dvd_eq_mod_eq_0 mod_mult_distrib2[symmetric]) haftmann@33340: haftmann@33340: lemma nat_mult_dvd_cancel1: "0 < k \ (k*m) dvd (k*n::nat) = (m dvd n)" haftmann@33340: by(auto) haftmann@33340: haftmann@33340: haftmann@33340: subsubsection{*For @{text cancel_factor} *} haftmann@33340: haftmann@33340: lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)" haftmann@33340: by auto haftmann@33340: haftmann@33340: lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1}, haftmann@33340: @{thm nat_0}, @{thm nat_1}, haftmann@33340: @{thm add_nat_number_of}, @{thm diff_nat_number_of}, @{thm mult_nat_number_of}, haftmann@33340: @{thm eq_nat_number_of}, @{thm less_nat_number_of}, @{thm le_number_of_eq_not_less}, haftmann@33340: @{thm le_Suc_number_of}, @{thm le_number_of_Suc}, haftmann@33340: @{thm less_Suc_number_of}, @{thm less_number_of_Suc}, haftmann@33340: @{thm Suc_eq_number_of}, @{thm eq_number_of_Suc}, haftmann@33340: @{thm mult_Suc}, @{thm mult_Suc_right}, haftmann@33340: @{thm add_Suc}, @{thm add_Suc_right}, haftmann@33340: @{thm eq_number_of_0}, @{thm eq_0_number_of}, @{thm less_0_number_of}, haftmann@33340: @{thm of_int_number_of_eq}, @{thm of_nat_number_of_eq}, @{thm nat_number_of}, haftmann@33340: @{thm if_True}, @{thm if_False}]) haftmann@33340: #> Lin_Arith.add_simprocs (Numeral_Simprocs.assoc_fold_simproc haftmann@33340: :: Numeral_Simprocs.combine_numerals haftmann@33340: :: Numeral_Simprocs.cancel_numerals) haftmann@33340: #> Lin_Arith.add_simprocs (Nat_Numeral_Simprocs.combine_numerals :: Nat_Numeral_Simprocs.cancel_numerals)) haftmann@33340: *} haftmann@33340: wenzelm@23164: end