author | haftmann |
Sun, 08 Oct 2017 22:28:22 +0200 | |
changeset 66814 | a24cde9588bb |
parent 66810 | cc2b490f9dc4 |
child 66815 | 93c6632ddf44 |
permissions | -rw-r--r-- |
3366 | 1 |
(* Title: HOL/Divides.thy |
2 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
6865
5577ffe4c2f1
now div and mod are overloaded; dvd is polymorphic
paulson
parents:
3366
diff
changeset
|
3 |
Copyright 1999 University of Cambridge |
18154 | 4 |
*) |
3366 | 5 |
|
64785 | 6 |
section \<open>More on quotient and remainder\<close> |
3366 | 7 |
|
15131 | 8 |
theory Divides |
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
9 |
imports Parity |
15131 | 10 |
begin |
3366 | 11 |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
12 |
subsection \<open>Numeral division with a pragmatic type class\<close> |
60758 | 13 |
|
14 |
text \<open> |
|
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
15 |
The following type class contains everything necessary to formulate |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
16 |
a division algorithm in ring structures with numerals, restricted |
66800 | 17 |
to its positive segments. This is its primary motivation, and it |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
18 |
could surely be formulated using a more fine-grained, more algebraic |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
19 |
and less technical class hierarchy. |
60758 | 20 |
\<close> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
21 |
|
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
22 |
class unique_euclidean_semiring_numeral = unique_euclidean_semiring + linordered_semidom + |
59816
034b13f4efae
distributivity of partial minus establishes desired properties of dvd in semirings
haftmann
parents:
59807
diff
changeset
|
23 |
assumes div_less: "0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a div b = 0" |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
24 |
and mod_less: " 0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a mod b = a" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
25 |
and div_positive: "0 < b \<Longrightarrow> b \<le> a \<Longrightarrow> a div b > 0" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
26 |
and mod_less_eq_dividend: "0 \<le> a \<Longrightarrow> a mod b \<le> a" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
27 |
and pos_mod_bound: "0 < b \<Longrightarrow> a mod b < b" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
28 |
and pos_mod_sign: "0 < b \<Longrightarrow> 0 \<le> a mod b" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
29 |
and mod_mult2_eq: "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
30 |
and div_mult2_eq: "0 \<le> c \<Longrightarrow> a div (b * c) = a div b div c" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
31 |
assumes discrete: "a < b \<longleftrightarrow> a + 1 \<le> b" |
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
32 |
fixes divmod :: "num \<Rightarrow> num \<Rightarrow> 'a \<times> 'a" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
33 |
and divmod_step :: "num \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
34 |
assumes divmod_def: "divmod m n = (numeral m div numeral n, numeral m mod numeral n)" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
35 |
and divmod_step_def: "divmod_step l qr = (let (q, r) = qr |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
36 |
in if r \<ge> numeral l then (2 * q + 1, r - numeral l) |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
37 |
else (2 * q, r))" |
61799 | 38 |
\<comment> \<open>These are conceptually definitions but force generated code |
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
39 |
to be monomorphic wrt. particular instances of this class which |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
40 |
yields a significant speedup.\<close> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
41 |
begin |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
42 |
|
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
43 |
subclass unique_euclidean_semiring_parity |
54226
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
44 |
proof |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
45 |
fix a |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
46 |
show "a mod 2 = 0 \<or> a mod 2 = 1" |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
47 |
proof (rule ccontr) |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
48 |
assume "\<not> (a mod 2 = 0 \<or> a mod 2 = 1)" |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
49 |
then have "a mod 2 \<noteq> 0" and "a mod 2 \<noteq> 1" by simp_all |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
50 |
have "0 < 2" by simp |
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
51 |
with pos_mod_bound pos_mod_sign have "0 \<le> a mod 2" "a mod 2 < 2" by simp_all |
60758 | 52 |
with \<open>a mod 2 \<noteq> 0\<close> have "0 < a mod 2" by simp |
54226
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
53 |
with discrete have "1 \<le> a mod 2" by simp |
60758 | 54 |
with \<open>a mod 2 \<noteq> 1\<close> have "1 < a mod 2" by simp |
54226
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
55 |
with discrete have "2 \<le> a mod 2" by simp |
60758 | 56 |
with \<open>a mod 2 < 2\<close> show False by simp |
54226
e3df2a4e02fc
explicit type class for modelling even/odd parity
haftmann
parents:
54221
diff
changeset
|
57 |
qed |
58646
cd63a4b12a33
specialized specification: avoid trivial instances
haftmann
parents:
58511
diff
changeset
|
58 |
next |
cd63a4b12a33
specialized specification: avoid trivial instances
haftmann
parents:
58511
diff
changeset
|
59 |
show "1 mod 2 = 1" |
cd63a4b12a33
specialized specification: avoid trivial instances
haftmann
parents:
58511
diff
changeset
|
60 |
by (rule mod_less) simp_all |
58710
7216a10d69ba
augmented and tuned facts on even/odd and division
haftmann
parents:
58646
diff
changeset
|
61 |
next |
7216a10d69ba
augmented and tuned facts on even/odd and division
haftmann
parents:
58646
diff
changeset
|
62 |
show "0 \<noteq> 2" |
7216a10d69ba
augmented and tuned facts on even/odd and division
haftmann
parents:
58646
diff
changeset
|
63 |
by simp |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
64 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
65 |
|
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
66 |
lemma divmod_digit_1: |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
67 |
assumes "0 \<le> a" "0 < b" and "b \<le> a mod (2 * b)" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
68 |
shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
69 |
and "a mod (2 * b) - b = a mod b" (is "?Q") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
70 |
proof - |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
71 |
from assms mod_less_eq_dividend [of a "2 * b"] have "b \<le> a" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
72 |
by (auto intro: trans) |
60758 | 73 |
with \<open>0 < b\<close> have "0 < a div b" by (auto intro: div_positive) |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
74 |
then have [simp]: "1 \<le> a div b" by (simp add: discrete) |
60758 | 75 |
with \<open>0 < b\<close> have mod_less: "a mod b < b" by (simp add: pos_mod_bound) |
63040 | 76 |
define w where "w = a div b mod 2" |
77 |
with parity have w_exhaust: "w = 0 \<or> w = 1" by auto |
|
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
78 |
have mod_w: "a mod (2 * b) = a mod b + b * w" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
79 |
by (simp add: w_def mod_mult2_eq ac_simps) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
80 |
from assms w_exhaust have "w = 1" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
81 |
by (auto simp add: mod_w) (insert mod_less, auto) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
82 |
with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
83 |
have "2 * (a div (2 * b)) = a div b - w" |
64246 | 84 |
by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) |
60758 | 85 |
with \<open>w = 1\<close> have div: "2 * (a div (2 * b)) = a div b - 1" by simp |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
86 |
then show ?P and ?Q |
60867 | 87 |
by (simp_all add: div mod add_implies_diff [symmetric]) |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
88 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
89 |
|
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
90 |
lemma divmod_digit_0: |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
91 |
assumes "0 < b" and "a mod (2 * b) < b" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
92 |
shows "2 * (a div (2 * b)) = a div b" (is "?P") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
93 |
and "a mod (2 * b) = a mod b" (is "?Q") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
94 |
proof - |
63040 | 95 |
define w where "w = a div b mod 2" |
96 |
with parity have w_exhaust: "w = 0 \<or> w = 1" by auto |
|
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
97 |
have mod_w: "a mod (2 * b) = a mod b + b * w" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
98 |
by (simp add: w_def mod_mult2_eq ac_simps) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
99 |
moreover have "b \<le> a mod b + b" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
100 |
proof - |
60758 | 101 |
from \<open>0 < b\<close> pos_mod_sign have "0 \<le> a mod b" by blast |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
102 |
then have "0 + b \<le> a mod b + b" by (rule add_right_mono) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
103 |
then show ?thesis by simp |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
104 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
105 |
moreover note assms w_exhaust |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
106 |
ultimately have "w = 0" by auto |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
107 |
with mod_w have mod: "a mod (2 * b) = a mod b" by simp |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
108 |
have "2 * (a div (2 * b)) = a div b - w" |
64246 | 109 |
by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) |
60758 | 110 |
with \<open>w = 0\<close> have div: "2 * (a div (2 * b)) = a div b" by simp |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
111 |
then show ?P and ?Q |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
112 |
by (simp_all add: div mod) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
113 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
114 |
|
60867 | 115 |
lemma fst_divmod: |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
116 |
"fst (divmod m n) = numeral m div numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
117 |
by (simp add: divmod_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
118 |
|
60867 | 119 |
lemma snd_divmod: |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
120 |
"snd (divmod m n) = numeral m mod numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
121 |
by (simp add: divmod_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
122 |
|
60758 | 123 |
text \<open> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
124 |
This is a formulation of one step (referring to one digit position) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
125 |
in school-method division: compare the dividend at the current |
53070 | 126 |
digit position with the remainder from previous division steps |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
127 |
and evaluate accordingly. |
60758 | 128 |
\<close> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
129 |
|
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
130 |
lemma divmod_step_eq [simp]: |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
131 |
"divmod_step l (q, r) = (if numeral l \<le> r |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
132 |
then (2 * q + 1, r - numeral l) else (2 * q, r))" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
133 |
by (simp add: divmod_step_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
134 |
|
60758 | 135 |
text \<open> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
136 |
This is a formulation of school-method division. |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
137 |
If the divisor is smaller than the dividend, terminate. |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
138 |
If not, shift the dividend to the right until termination |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
139 |
occurs and then reiterate single division steps in the |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
140 |
opposite direction. |
60758 | 141 |
\<close> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
142 |
|
60867 | 143 |
lemma divmod_divmod_step: |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
144 |
"divmod m n = (if m < n then (0, numeral m) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
145 |
else divmod_step n (divmod m (Num.Bit0 n)))" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
146 |
proof (cases "m < n") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
147 |
case True then have "numeral m < numeral n" by simp |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
148 |
then show ?thesis |
60867 | 149 |
by (simp add: prod_eq_iff div_less mod_less fst_divmod snd_divmod) |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
150 |
next |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
151 |
case False |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
152 |
have "divmod m n = |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
153 |
divmod_step n (numeral m div (2 * numeral n), |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
154 |
numeral m mod (2 * numeral n))" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
155 |
proof (cases "numeral n \<le> numeral m mod (2 * numeral n)") |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
156 |
case True |
60867 | 157 |
with divmod_step_eq |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
158 |
have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) = |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
159 |
(2 * (numeral m div (2 * numeral n)) + 1, numeral m mod (2 * numeral n) - numeral n)" |
60867 | 160 |
by simp |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
161 |
moreover from True divmod_digit_1 [of "numeral m" "numeral n"] |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
162 |
have "2 * (numeral m div (2 * numeral n)) + 1 = numeral m div numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
163 |
and "numeral m mod (2 * numeral n) - numeral n = numeral m mod numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
164 |
by simp_all |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
165 |
ultimately show ?thesis by (simp only: divmod_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
166 |
next |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
167 |
case False then have *: "numeral m mod (2 * numeral n) < numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
168 |
by (simp add: not_le) |
60867 | 169 |
with divmod_step_eq |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
170 |
have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) = |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
171 |
(2 * (numeral m div (2 * numeral n)), numeral m mod (2 * numeral n))" |
60867 | 172 |
by auto |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
173 |
moreover from * divmod_digit_0 [of "numeral n" "numeral m"] |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
174 |
have "2 * (numeral m div (2 * numeral n)) = numeral m div numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
175 |
and "numeral m mod (2 * numeral n) = numeral m mod numeral n" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
176 |
by (simp_all only: zero_less_numeral) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
177 |
ultimately show ?thesis by (simp only: divmod_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
178 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
179 |
then have "divmod m n = |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
180 |
divmod_step n (numeral m div numeral (Num.Bit0 n), |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
181 |
numeral m mod numeral (Num.Bit0 n))" |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
182 |
by (simp only: numeral.simps distrib mult_1) |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
183 |
then have "divmod m n = divmod_step n (divmod m (Num.Bit0 n))" |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
184 |
by (simp add: divmod_def) |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
185 |
with False show ?thesis by simp |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
186 |
qed |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
187 |
|
61799 | 188 |
text \<open>The division rewrite proper -- first, trivial results involving \<open>1\<close>\<close> |
60867 | 189 |
|
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
190 |
lemma divmod_trivial [simp]: |
60867 | 191 |
"divmod Num.One Num.One = (numeral Num.One, 0)" |
192 |
"divmod (Num.Bit0 m) Num.One = (numeral (Num.Bit0 m), 0)" |
|
193 |
"divmod (Num.Bit1 m) Num.One = (numeral (Num.Bit1 m), 0)" |
|
194 |
"divmod num.One (num.Bit0 n) = (0, Numeral1)" |
|
195 |
"divmod num.One (num.Bit1 n) = (0, Numeral1)" |
|
196 |
using divmod_divmod_step [of "Num.One"] by (simp_all add: divmod_def) |
|
197 |
||
198 |
text \<open>Division by an even number is a right-shift\<close> |
|
58953 | 199 |
|
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
200 |
lemma divmod_cancel [simp]: |
53069
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
201 |
"divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r))" (is ?P) |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
202 |
"divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r + 1))" (is ?Q) |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
203 |
proof - |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
204 |
have *: "\<And>q. numeral (Num.Bit0 q) = 2 * numeral q" |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
205 |
"\<And>q. numeral (Num.Bit1 q) = 2 * numeral q + 1" |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
206 |
by (simp_all only: numeral_mult numeral.simps distrib) simp_all |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
207 |
have "1 div 2 = 0" "1 mod 2 = 1" by (auto intro: div_less mod_less) |
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
208 |
then show ?P and ?Q |
60867 | 209 |
by (simp_all add: fst_divmod snd_divmod prod_eq_iff split_def * [of m] * [of n] mod_mult_mult1 |
210 |
div_mult2_eq [of _ _ 2] mod_mult2_eq [of _ _ 2] |
|
211 |
add.commute del: numeral_times_numeral) |
|
58953 | 212 |
qed |
213 |
||
60867 | 214 |
text \<open>The really hard work\<close> |
215 |
||
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
216 |
lemma divmod_steps [simp]: |
60867 | 217 |
"divmod (num.Bit0 m) (num.Bit1 n) = |
218 |
(if m \<le> n then (0, numeral (num.Bit0 m)) |
|
219 |
else divmod_step (num.Bit1 n) |
|
220 |
(divmod (num.Bit0 m) |
|
221 |
(num.Bit0 (num.Bit1 n))))" |
|
222 |
"divmod (num.Bit1 m) (num.Bit1 n) = |
|
223 |
(if m < n then (0, numeral (num.Bit1 m)) |
|
224 |
else divmod_step (num.Bit1 n) |
|
225 |
(divmod (num.Bit1 m) |
|
226 |
(num.Bit0 (num.Bit1 n))))" |
|
227 |
by (simp_all add: divmod_divmod_step) |
|
228 |
||
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
229 |
lemmas divmod_algorithm_code = divmod_step_eq divmod_trivial divmod_cancel divmod_steps |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
230 |
|
60758 | 231 |
text \<open>Special case: divisibility\<close> |
58953 | 232 |
|
233 |
definition divides_aux :: "'a \<times> 'a \<Rightarrow> bool" |
|
234 |
where |
|
235 |
"divides_aux qr \<longleftrightarrow> snd qr = 0" |
|
236 |
||
237 |
lemma divides_aux_eq [simp]: |
|
238 |
"divides_aux (q, r) \<longleftrightarrow> r = 0" |
|
239 |
by (simp add: divides_aux_def) |
|
240 |
||
241 |
lemma dvd_numeral_simp [simp]: |
|
242 |
"numeral m dvd numeral n \<longleftrightarrow> divides_aux (divmod n m)" |
|
243 |
by (simp add: divmod_def mod_eq_0_iff_dvd) |
|
53069
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
244 |
|
60867 | 245 |
text \<open>Generic computation of quotient and remainder\<close> |
246 |
||
247 |
lemma numeral_div_numeral [simp]: |
|
248 |
"numeral k div numeral l = fst (divmod k l)" |
|
249 |
by (simp add: fst_divmod) |
|
250 |
||
251 |
lemma numeral_mod_numeral [simp]: |
|
252 |
"numeral k mod numeral l = snd (divmod k l)" |
|
253 |
by (simp add: snd_divmod) |
|
254 |
||
255 |
lemma one_div_numeral [simp]: |
|
256 |
"1 div numeral n = fst (divmod num.One n)" |
|
257 |
by (simp add: fst_divmod) |
|
258 |
||
259 |
lemma one_mod_numeral [simp]: |
|
260 |
"1 mod numeral n = snd (divmod num.One n)" |
|
261 |
by (simp add: snd_divmod) |
|
64630
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
262 |
|
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
263 |
text \<open>Computing congruences modulo \<open>2 ^ q\<close>\<close> |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
264 |
|
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
265 |
lemma cong_exp_iff_simps: |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
266 |
"numeral n mod numeral Num.One = 0 |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
267 |
\<longleftrightarrow> True" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
268 |
"numeral (Num.Bit0 n) mod numeral (Num.Bit0 q) = 0 |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
269 |
\<longleftrightarrow> numeral n mod numeral q = 0" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
270 |
"numeral (Num.Bit1 n) mod numeral (Num.Bit0 q) = 0 |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
271 |
\<longleftrightarrow> False" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
272 |
"numeral m mod numeral Num.One = (numeral n mod numeral Num.One) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
273 |
\<longleftrightarrow> True" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
274 |
"numeral Num.One mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
275 |
\<longleftrightarrow> True" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
276 |
"numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
277 |
\<longleftrightarrow> False" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
278 |
"numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
279 |
\<longleftrightarrow> (numeral n mod numeral q) = 0" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
280 |
"numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
281 |
\<longleftrightarrow> False" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
282 |
"numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
283 |
\<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
284 |
"numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
285 |
\<longleftrightarrow> False" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
286 |
"numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
287 |
\<longleftrightarrow> (numeral m mod numeral q) = 0" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
288 |
"numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
289 |
\<longleftrightarrow> False" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
290 |
"numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
291 |
\<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)" |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
292 |
by (auto simp add: case_prod_beta dest: arg_cong [of _ _ even]) |
96015aecfeba
emphasize dedicated rewrite rules for congruences
haftmann
parents:
64593
diff
changeset
|
293 |
|
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
294 |
end |
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
295 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
296 |
hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
297 |
|
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
298 |
|
60758 | 299 |
subsection \<open>Division on @{typ nat}\<close> |
300 |
||
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
301 |
instantiation nat :: unique_euclidean_semiring_numeral |
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
302 |
begin |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
303 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
304 |
definition divmod_nat :: "num \<Rightarrow> num \<Rightarrow> nat \<times> nat" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
305 |
where |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
306 |
divmod'_nat_def: "divmod_nat m n = (numeral m div numeral n, numeral m mod numeral n)" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
307 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
308 |
definition divmod_step_nat :: "num \<Rightarrow> nat \<times> nat \<Rightarrow> nat \<times> nat" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
309 |
where |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
310 |
"divmod_step_nat l qr = (let (q, r) = qr |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
311 |
in if r \<ge> numeral l then (2 * q + 1, r - numeral l) |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
312 |
else (2 * q, r))" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
313 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
314 |
instance by standard |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
315 |
(auto simp add: divmod'_nat_def divmod_step_nat_def div_greater_zero_iff div_mult2_eq mod_mult2_eq) |
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
316 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
317 |
end |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
318 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
319 |
declare divmod_algorithm_code [where ?'a = nat, code] |
14267
b963e9cee2a0
More refinements to Ring_and_Field and numerics. Conversion of Divides_lemmas
paulson
parents:
14208
diff
changeset
|
320 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
321 |
lemma odd_Suc_minus_one [simp]: "odd n \<Longrightarrow> Suc (n - Suc 0) = n" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
322 |
by (auto elim: oddE) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
323 |
|
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
324 |
lemma even_Suc_div_two [simp]: |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
325 |
"even n \<Longrightarrow> Suc n div 2 = n div 2" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
326 |
using even_succ_div_two [of n] by simp |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
327 |
|
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
328 |
lemma odd_Suc_div_two [simp]: |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
329 |
"odd n \<Longrightarrow> Suc n div 2 = Suc (n div 2)" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
330 |
using odd_succ_div_two [of n] by simp |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
331 |
|
58834 | 332 |
lemma odd_two_times_div_two_nat [simp]: |
60352
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
333 |
assumes "odd n" |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
334 |
shows "2 * (n div 2) = n - (1 :: nat)" |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
335 |
proof - |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
336 |
from assms have "2 * (n div 2) + 1 = n" |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
337 |
by (rule odd_two_times_div_two_succ) |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
338 |
then have "Suc (2 * (n div 2)) - 1 = n - 1" |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
339 |
by simp |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
340 |
then show ?thesis |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
341 |
by simp |
d46de31a50c4
separate class for division operator, with particular syntax added in more specific classes
haftmann
parents:
59833
diff
changeset
|
342 |
qed |
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
343 |
|
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
344 |
lemma parity_induct [case_names zero even odd]: |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
345 |
assumes zero: "P 0" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
346 |
assumes even: "\<And>n. P n \<Longrightarrow> P (2 * n)" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
347 |
assumes odd: "\<And>n. P n \<Longrightarrow> P (Suc (2 * n))" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
348 |
shows "P n" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
349 |
proof (induct n rule: less_induct) |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
350 |
case (less n) |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
351 |
show "P n" |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
352 |
proof (cases "n = 0") |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
353 |
case True with zero show ?thesis by simp |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
354 |
next |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
355 |
case False |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
356 |
with less have hyp: "P (n div 2)" by simp |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
357 |
show ?thesis |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
358 |
proof (cases "even n") |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
359 |
case True |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
360 |
with hyp even [of "n div 2"] show ?thesis |
58834 | 361 |
by simp |
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
362 |
next |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
363 |
case False |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
364 |
with hyp odd [of "n div 2"] show ?thesis |
58834 | 365 |
by simp |
58778
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
366 |
qed |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
367 |
qed |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
368 |
qed |
e29cae8eab1f
even further downshift of theory Parity in the hierarchy
haftmann
parents:
58710
diff
changeset
|
369 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
370 |
lemma mod_2_not_eq_zero_eq_one_nat: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
371 |
fixes n :: nat |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
372 |
shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
373 |
by (fact not_mod_2_eq_0_eq_1) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
374 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
375 |
lemma Suc_0_div_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
376 |
fixes k l :: num |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
377 |
shows "Suc 0 div numeral k = fst (divmod Num.One k)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
378 |
by (simp_all add: fst_divmod) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
379 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
380 |
lemma Suc_0_mod_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
381 |
fixes k l :: num |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
382 |
shows "Suc 0 mod numeral k = snd (divmod Num.One k)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
383 |
by (simp_all add: snd_divmod) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
384 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
385 |
definition divmod_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
386 |
where "divmod_nat m n = (m div n, m mod n)" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
387 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
388 |
lemma fst_divmod_nat [simp]: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
389 |
"fst (divmod_nat m n) = m div n" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
390 |
by (simp add: divmod_nat_def) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
391 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
392 |
lemma snd_divmod_nat [simp]: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
393 |
"snd (divmod_nat m n) = m mod n" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
394 |
by (simp add: divmod_nat_def) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
395 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
396 |
lemma divmod_nat_if [code]: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
397 |
"Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
398 |
let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
399 |
by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
400 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
401 |
lemma [code]: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
402 |
"m div n = fst (divmod_nat m n)" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
403 |
"m mod n = snd (divmod_nat m n)" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
404 |
by simp_all |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
405 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
406 |
|
60758 | 407 |
subsection \<open>Division on @{typ int}\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
408 |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
409 |
context |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
410 |
begin |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
411 |
|
64635 | 412 |
inductive eucl_rel_int :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" |
413 |
where eucl_rel_int_by0: "eucl_rel_int k 0 (0, k)" |
|
414 |
| eucl_rel_int_dividesI: "l \<noteq> 0 \<Longrightarrow> k = q * l \<Longrightarrow> eucl_rel_int k l (q, 0)" |
|
415 |
| eucl_rel_int_remainderI: "sgn r = sgn l \<Longrightarrow> \<bar>r\<bar> < \<bar>l\<bar> |
|
416 |
\<Longrightarrow> k = q * l + r \<Longrightarrow> eucl_rel_int k l (q, r)" |
|
417 |
||
418 |
lemma eucl_rel_int_iff: |
|
419 |
"eucl_rel_int k l (q, r) \<longleftrightarrow> |
|
420 |
k = l * q + r \<and> |
|
421 |
(if 0 < l then 0 \<le> r \<and> r < l else if l < 0 then l < r \<and> r \<le> 0 else q = 0)" |
|
422 |
by (cases "r = 0") |
|
423 |
(auto elim!: eucl_rel_int.cases intro: eucl_rel_int_by0 eucl_rel_int_dividesI eucl_rel_int_remainderI |
|
424 |
simp add: ac_simps sgn_1_pos sgn_1_neg) |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
425 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
426 |
lemma unique_quotient_lemma: |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
427 |
"b * q' + r' \<le> b * q + r \<Longrightarrow> 0 \<le> r' \<Longrightarrow> r' < b \<Longrightarrow> r < b \<Longrightarrow> q' \<le> (q::int)" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
428 |
apply (subgoal_tac "r' + b * (q'-q) \<le> r") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
429 |
prefer 2 apply (simp add: right_diff_distrib) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
430 |
apply (subgoal_tac "0 < b * (1 + q - q') ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
431 |
apply (erule_tac [2] order_le_less_trans) |
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
48891
diff
changeset
|
432 |
prefer 2 apply (simp add: right_diff_distrib distrib_left) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
433 |
apply (subgoal_tac "b * q' < b * (1 + q) ") |
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
48891
diff
changeset
|
434 |
prefer 2 apply (simp add: right_diff_distrib distrib_left) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
435 |
apply (simp add: mult_less_cancel_left) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
436 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
437 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
438 |
lemma unique_quotient_lemma_neg: |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
439 |
"b * q' + r' \<le> b*q + r \<Longrightarrow> r \<le> 0 \<Longrightarrow> b < r \<Longrightarrow> b < r' \<Longrightarrow> q \<le> (q'::int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
440 |
by (rule_tac b = "-b" and r = "-r'" and r' = "-r" in unique_quotient_lemma) auto |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
441 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
442 |
lemma unique_quotient: |
64635 | 443 |
"eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> q = q'" |
444 |
apply (simp add: eucl_rel_int_iff linorder_neq_iff split: if_split_asm) |
|
445 |
apply (blast intro: order_antisym |
|
446 |
dest: order_eq_refl [THEN unique_quotient_lemma] |
|
447 |
order_eq_refl [THEN unique_quotient_lemma_neg] sym)+ |
|
448 |
done |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
449 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
450 |
lemma unique_remainder: |
64635 | 451 |
"eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> r = r'" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
452 |
apply (subgoal_tac "q = q'") |
64635 | 453 |
apply (simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
454 |
apply (blast intro: unique_quotient) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
455 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
456 |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
457 |
end |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
458 |
|
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
459 |
instantiation int :: "{idom_modulo, normalization_semidom}" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
460 |
begin |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
461 |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
462 |
definition normalize_int :: "int \<Rightarrow> int" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
463 |
where [simp]: "normalize = (abs :: int \<Rightarrow> int)" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
464 |
|
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
465 |
definition unit_factor_int :: "int \<Rightarrow> int" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
466 |
where [simp]: "unit_factor = (sgn :: int \<Rightarrow> int)" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
467 |
|
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
468 |
definition divide_int :: "int \<Rightarrow> int \<Rightarrow> int" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
469 |
where "k div l = (if l = 0 \<or> k = 0 then 0 |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
470 |
else if k > 0 \<and> l > 0 \<or> k < 0 \<and> l < 0 |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
471 |
then int (nat \<bar>k\<bar> div nat \<bar>l\<bar>) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
472 |
else |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
473 |
if l dvd k then - int (nat \<bar>k\<bar> div nat \<bar>l\<bar>) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
474 |
else - int (Suc (nat \<bar>k\<bar> div nat \<bar>l\<bar>)))" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
475 |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
476 |
definition modulo_int :: "int \<Rightarrow> int \<Rightarrow> int" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
477 |
where "k mod l = (if l = 0 then k else if l dvd k then 0 |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
478 |
else if k > 0 \<and> l > 0 \<or> k < 0 \<and> l < 0 |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
479 |
then sgn l * int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
480 |
else sgn l * (\<bar>l\<bar> - int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)))" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
481 |
|
64635 | 482 |
lemma eucl_rel_int: |
483 |
"eucl_rel_int k l (k div l, k mod l)" |
|
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
484 |
proof (cases k rule: int_cases3) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
485 |
case zero |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
486 |
then show ?thesis |
64635 | 487 |
by (simp add: eucl_rel_int_iff divide_int_def modulo_int_def) |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
488 |
next |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
489 |
case (pos n) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
490 |
then show ?thesis |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
491 |
using div_mult_mod_eq [of n] |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
492 |
by (cases l rule: int_cases3) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
493 |
(auto simp del: of_nat_mult of_nat_add |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
494 |
simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps |
64635 | 495 |
eucl_rel_int_iff divide_int_def modulo_int_def int_dvd_iff) |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
496 |
next |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
497 |
case (neg n) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
498 |
then show ?thesis |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
499 |
using div_mult_mod_eq [of n] |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
500 |
by (cases l rule: int_cases3) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
501 |
(auto simp del: of_nat_mult of_nat_add |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
502 |
simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps |
64635 | 503 |
eucl_rel_int_iff divide_int_def modulo_int_def int_dvd_iff) |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
504 |
qed |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
505 |
|
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
506 |
lemma divmod_int_unique: |
64635 | 507 |
assumes "eucl_rel_int k l (q, r)" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
508 |
shows div_int_unique: "k div l = q" and mod_int_unique: "k mod l = r" |
64635 | 509 |
using assms eucl_rel_int [of k l] |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
510 |
using unique_quotient [of k l] unique_remainder [of k l] |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
511 |
by auto |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
512 |
|
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
513 |
instance proof |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
514 |
fix k l :: int |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
515 |
show "k div l * l + k mod l = k" |
64635 | 516 |
using eucl_rel_int [of k l] |
517 |
unfolding eucl_rel_int_iff by (simp add: ac_simps) |
|
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
518 |
next |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
519 |
fix k :: int show "k div 0 = 0" |
64635 | 520 |
by (rule div_int_unique, simp add: eucl_rel_int_iff) |
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
521 |
next |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
522 |
fix k l :: int |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
523 |
assume "l \<noteq> 0" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
524 |
then show "k * l div l = k" |
64635 | 525 |
by (auto simp add: eucl_rel_int_iff ac_simps intro: div_int_unique [of _ _ _ 0]) |
64848
c50db2128048
slightly generalized type class hierarchy concerning unit factors, to allow for lean polynomial normalization
haftmann
parents:
64785
diff
changeset
|
526 |
qed (auto simp add: sgn_mult mult_sgn_abs abs_eq_iff') |
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
527 |
|
60429
d3d1e185cd63
uniform _ div _ as infix syntax for ring division
haftmann
parents:
60353
diff
changeset
|
528 |
end |
d3d1e185cd63
uniform _ div _ as infix syntax for ring division
haftmann
parents:
60353
diff
changeset
|
529 |
|
60517
f16e4fb20652
separate class for notions specific for integral (semi)domains, in contrast to fields where these are trivial
haftmann
parents:
60516
diff
changeset
|
530 |
lemma is_unit_int: |
f16e4fb20652
separate class for notions specific for integral (semi)domains, in contrast to fields where these are trivial
haftmann
parents:
60516
diff
changeset
|
531 |
"is_unit (k::int) \<longleftrightarrow> k = 1 \<or> k = - 1" |
f16e4fb20652
separate class for notions specific for integral (semi)domains, in contrast to fields where these are trivial
haftmann
parents:
60516
diff
changeset
|
532 |
by auto |
f16e4fb20652
separate class for notions specific for integral (semi)domains, in contrast to fields where these are trivial
haftmann
parents:
60516
diff
changeset
|
533 |
|
64715 | 534 |
lemma zdiv_int: |
535 |
"int (a div b) = int a div int b" |
|
536 |
by (simp add: divide_int_def) |
|
537 |
||
538 |
lemma zmod_int: |
|
539 |
"int (a mod b) = int a mod int b" |
|
540 |
by (simp add: modulo_int_def int_dvd_iff) |
|
541 |
||
542 |
lemma div_abs_eq_div_nat: |
|
543 |
"\<bar>k\<bar> div \<bar>l\<bar> = int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)" |
|
544 |
by (simp add: divide_int_def) |
|
545 |
||
546 |
lemma mod_abs_eq_div_nat: |
|
547 |
"\<bar>k\<bar> mod \<bar>l\<bar> = int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)" |
|
548 |
by (simp add: modulo_int_def dvd_int_unfold_dvd_nat) |
|
549 |
||
550 |
lemma div_sgn_abs_cancel: |
|
551 |
fixes k l v :: int |
|
552 |
assumes "v \<noteq> 0" |
|
553 |
shows "(sgn v * \<bar>k\<bar>) div (sgn v * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>" |
|
554 |
proof - |
|
555 |
from assms have "sgn v = - 1 \<or> sgn v = 1" |
|
556 |
by (cases "v \<ge> 0") auto |
|
557 |
then show ?thesis |
|
66630 | 558 |
using assms unfolding divide_int_def [of "sgn v * \<bar>k\<bar>" "sgn v * \<bar>l\<bar>"] |
559 |
by (fastforce simp add: not_less div_abs_eq_div_nat) |
|
64715 | 560 |
qed |
561 |
||
562 |
lemma div_eq_sgn_abs: |
|
563 |
fixes k l v :: int |
|
564 |
assumes "sgn k = sgn l" |
|
565 |
shows "k div l = \<bar>k\<bar> div \<bar>l\<bar>" |
|
566 |
proof (cases "l = 0") |
|
567 |
case True |
|
568 |
then show ?thesis |
|
569 |
by simp |
|
570 |
next |
|
571 |
case False |
|
572 |
with assms have "(sgn k * \<bar>k\<bar>) div (sgn l * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>" |
|
573 |
by (simp add: div_sgn_abs_cancel) |
|
574 |
then show ?thesis |
|
575 |
by (simp add: sgn_mult_abs) |
|
576 |
qed |
|
577 |
||
578 |
lemma div_dvd_sgn_abs: |
|
579 |
fixes k l :: int |
|
580 |
assumes "l dvd k" |
|
581 |
shows "k div l = (sgn k * sgn l) * (\<bar>k\<bar> div \<bar>l\<bar>)" |
|
582 |
proof (cases "k = 0") |
|
583 |
case True |
|
584 |
then show ?thesis |
|
585 |
by simp |
|
586 |
next |
|
587 |
case False |
|
588 |
show ?thesis |
|
589 |
proof (cases "sgn l = sgn k") |
|
590 |
case True |
|
591 |
then show ?thesis |
|
592 |
by (simp add: div_eq_sgn_abs) |
|
593 |
next |
|
594 |
case False |
|
595 |
with \<open>k \<noteq> 0\<close> assms show ?thesis |
|
596 |
unfolding divide_int_def [of k l] |
|
597 |
by (auto simp add: zdiv_int) |
|
598 |
qed |
|
599 |
qed |
|
600 |
||
601 |
lemma div_noneq_sgn_abs: |
|
602 |
fixes k l :: int |
|
603 |
assumes "l \<noteq> 0" |
|
604 |
assumes "sgn k \<noteq> sgn l" |
|
605 |
shows "k div l = - (\<bar>k\<bar> div \<bar>l\<bar>) - of_bool (\<not> l dvd k)" |
|
606 |
using assms |
|
607 |
by (simp only: divide_int_def [of k l], auto simp add: not_less zdiv_int) |
|
608 |
||
609 |
lemma sgn_mod: |
|
610 |
fixes k l :: int |
|
611 |
assumes "l \<noteq> 0" "\<not> l dvd k" |
|
612 |
shows "sgn (k mod l) = sgn l" |
|
613 |
proof - |
|
614 |
from \<open>\<not> l dvd k\<close> |
|
615 |
have "k mod l \<noteq> 0" |
|
616 |
by (simp add: dvd_eq_mod_eq_0) |
|
617 |
show ?thesis |
|
618 |
using \<open>l \<noteq> 0\<close> \<open>\<not> l dvd k\<close> |
|
619 |
unfolding modulo_int_def [of k l] |
|
620 |
by (auto simp add: sgn_1_pos sgn_1_neg mod_greater_zero_iff_not_dvd nat_dvd_iff not_less |
|
621 |
zless_nat_eq_int_zless [symmetric] elim: nonpos_int_cases) |
|
622 |
qed |
|
623 |
||
624 |
lemma abs_mod_less: |
|
625 |
fixes k l :: int |
|
626 |
assumes "l \<noteq> 0" |
|
627 |
shows "\<bar>k mod l\<bar> < \<bar>l\<bar>" |
|
628 |
using assms unfolding modulo_int_def [of k l] |
|
629 |
by (auto simp add: not_less int_dvd_iff mod_greater_zero_iff_not_dvd elim: pos_int_cases neg_int_cases nonneg_int_cases nonpos_int_cases) |
|
630 |
||
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
631 |
instantiation int :: unique_euclidean_ring |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
632 |
begin |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
633 |
|
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
634 |
definition [simp]: |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
635 |
"euclidean_size_int = (nat \<circ> abs :: int \<Rightarrow> nat)" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
636 |
|
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
637 |
definition [simp]: |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
638 |
"uniqueness_constraint_int (k :: int) l \<longleftrightarrow> unit_factor k = unit_factor l" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
639 |
|
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
640 |
instance proof |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
641 |
fix l q r:: int |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
642 |
assume "uniqueness_constraint r l" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
643 |
and "euclidean_size r < euclidean_size l" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
644 |
then have "sgn r = sgn l" and "\<bar>r\<bar> < \<bar>l\<bar>" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
645 |
by simp_all |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
646 |
then have "eucl_rel_int (q * l + r) l (q, r)" |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
647 |
by (rule eucl_rel_int_remainderI) simp |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
648 |
then show "(q * l + r) div l = q" |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
649 |
by (rule div_int_unique) |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
650 |
qed (use mult_le_mono2 [of 1] in \<open>auto simp add: abs_mult sgn_mult abs_mod_less sgn_mod nat_mult_distrib\<close>) |
60758 | 651 |
|
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
652 |
end |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
653 |
|
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
654 |
text\<open>Basic laws about division and remainder\<close> |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
655 |
|
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
656 |
lemma pos_mod_conj: "(0::int) < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b" |
64635 | 657 |
using eucl_rel_int [of a b] |
658 |
by (auto simp add: eucl_rel_int_iff prod_eq_iff) |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
659 |
|
45607 | 660 |
lemmas pos_mod_sign [simp] = pos_mod_conj [THEN conjunct1] |
661 |
and pos_mod_bound [simp] = pos_mod_conj [THEN conjunct2] |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
662 |
|
47141
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
huffman
parents:
47140
diff
changeset
|
663 |
lemma neg_mod_conj: "b < (0::int) \<Longrightarrow> a mod b \<le> 0 \<and> b < a mod b" |
64635 | 664 |
using eucl_rel_int [of a b] |
665 |
by (auto simp add: eucl_rel_int_iff prod_eq_iff) |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
666 |
|
45607 | 667 |
lemmas neg_mod_sign [simp] = neg_mod_conj [THEN conjunct1] |
668 |
and neg_mod_bound [simp] = neg_mod_conj [THEN conjunct2] |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
669 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
670 |
|
60758 | 671 |
subsubsection \<open>General Properties of div and mod\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
672 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
673 |
lemma div_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a div b = 0" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
674 |
apply (rule div_int_unique) |
64635 | 675 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
676 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
677 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
678 |
lemma div_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a div b = 0" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
679 |
apply (rule div_int_unique) |
64635 | 680 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
681 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
682 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
683 |
lemma div_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a div b = -1" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
684 |
apply (rule div_int_unique) |
64635 | 685 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
686 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
687 |
|
66801 | 688 |
lemma div_positive_int: |
689 |
"k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int |
|
690 |
using that by (simp add: divide_int_def div_positive) |
|
691 |
||
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
692 |
(*There is no div_neg_pos_trivial because 0 div b = 0 would supersede it*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
693 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
694 |
lemma mod_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a mod b = a" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
695 |
apply (rule_tac q = 0 in mod_int_unique) |
64635 | 696 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
697 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
698 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
699 |
lemma mod_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a mod b = a" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
700 |
apply (rule_tac q = 0 in mod_int_unique) |
64635 | 701 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
702 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
703 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
704 |
lemma mod_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a mod b = a+b" |
47140
97c3676c5c94
rename lemmas {divmod_int_rel_{div,mod} -> {div,mod}_int_unique, for consistency with nat lemma names
huffman
parents:
47139
diff
changeset
|
705 |
apply (rule_tac q = "-1" in mod_int_unique) |
64635 | 706 |
apply (auto simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
707 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
708 |
|
61799 | 709 |
text\<open>There is no \<open>mod_neg_pos_trivial\<close>.\<close> |
60758 | 710 |
|
711 |
||
712 |
subsubsection \<open>Laws for div and mod with Unary Minus\<close> |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
713 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
714 |
lemma zminus1_lemma: |
64635 | 715 |
"eucl_rel_int a b (q, r) ==> b \<noteq> 0 |
716 |
==> eucl_rel_int (-a) b (if r=0 then -q else -q - 1, |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
717 |
if r=0 then 0 else b-r)" |
66630 | 718 |
by (force simp add: eucl_rel_int_iff right_diff_distrib) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
719 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
720 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
721 |
lemma zdiv_zminus1_eq_if: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
722 |
"b \<noteq> (0::int) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
723 |
==> (-a) div b = |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
724 |
(if a mod b = 0 then - (a div b) else - (a div b) - 1)" |
64635 | 725 |
by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN div_int_unique]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
726 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
727 |
lemma zmod_zminus1_eq_if: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
728 |
"(-a::int) mod b = (if a mod b = 0 then 0 else b - (a mod b))" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
729 |
apply (case_tac "b = 0", simp) |
64635 | 730 |
apply (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN mod_int_unique]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
731 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
732 |
|
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
733 |
lemma zmod_zminus1_not_zero: |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
734 |
fixes k l :: int |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
735 |
shows "- k mod l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0" |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
736 |
by (simp add: mod_eq_0_iff_dvd) |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
737 |
|
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
738 |
lemma zmod_zminus2_not_zero: |
64592
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
739 |
fixes k l :: int |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
740 |
shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0" |
7759f1766189
more fine-grained type class hierarchy for div and mod
haftmann
parents:
64250
diff
changeset
|
741 |
by (simp add: mod_eq_0_iff_dvd) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
742 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
743 |
lemma zdiv_zminus2_eq_if: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
744 |
"b \<noteq> (0::int) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
745 |
==> a div (-b) = |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
746 |
(if a mod b = 0 then - (a div b) else - (a div b) - 1)" |
47159 | 747 |
by (simp add: zdiv_zminus1_eq_if div_minus_right) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
748 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
749 |
lemma zmod_zminus2_eq_if: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
750 |
"a mod (-b::int) = (if a mod b = 0 then 0 else (a mod b) - b)" |
47159 | 751 |
by (simp add: zmod_zminus1_eq_if mod_minus_right) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
752 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
753 |
|
60758 | 754 |
subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
755 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
756 |
lemma zdiv_mono1: "[| a \<le> a'; 0 < (b::int) |] ==> a div b \<le> a' div b" |
64246 | 757 |
using mult_div_mod_eq [symmetric, of a b] |
758 |
using mult_div_mod_eq [symmetric, of a' b] |
|
759 |
apply - |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
760 |
apply (rule unique_quotient_lemma) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
761 |
apply (erule subst) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
762 |
apply (erule subst, simp_all) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
763 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
764 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
765 |
lemma zdiv_mono1_neg: "[| a \<le> a'; (b::int) < 0 |] ==> a' div b \<le> a div b" |
64246 | 766 |
using mult_div_mod_eq [symmetric, of a b] |
767 |
using mult_div_mod_eq [symmetric, of a' b] |
|
768 |
apply - |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
769 |
apply (rule unique_quotient_lemma_neg) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
770 |
apply (erule subst) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
771 |
apply (erule subst, simp_all) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
772 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
773 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
774 |
|
60758 | 775 |
subsubsection \<open>Monotonicity in the Second Argument (Divisor)\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
776 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
777 |
lemma q_pos_lemma: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
778 |
"[| 0 \<le> b'*q' + r'; r' < b'; 0 < b' |] ==> 0 \<le> (q'::int)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
779 |
apply (subgoal_tac "0 < b'* (q' + 1) ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
780 |
apply (simp add: zero_less_mult_iff) |
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
48891
diff
changeset
|
781 |
apply (simp add: distrib_left) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
782 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
783 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
784 |
lemma zdiv_mono2_lemma: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
785 |
"[| b*q + r = b'*q' + r'; 0 \<le> b'*q' + r'; |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
786 |
r' < b'; 0 \<le> r; 0 < b'; b' \<le> b |] |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
787 |
==> q \<le> (q'::int)" |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
788 |
apply (frule q_pos_lemma, assumption+) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
789 |
apply (subgoal_tac "b*q < b* (q' + 1) ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
790 |
apply (simp add: mult_less_cancel_left) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
791 |
apply (subgoal_tac "b*q = r' - r + b'*q'") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
792 |
prefer 2 apply simp |
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
48891
diff
changeset
|
793 |
apply (simp (no_asm_simp) add: distrib_left) |
57512
cc97b347b301
reduced name variants for assoc and commute on plus and mult
haftmann
parents:
57492
diff
changeset
|
794 |
apply (subst add.commute, rule add_less_le_mono, arith) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
795 |
apply (rule mult_right_mono, auto) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
796 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
797 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
798 |
lemma zdiv_mono2: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
799 |
"[| (0::int) \<le> a; 0 < b'; b' \<le> b |] ==> a div b \<le> a div b'" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
800 |
apply (subgoal_tac "b \<noteq> 0") |
64246 | 801 |
prefer 2 apply arith |
802 |
using mult_div_mod_eq [symmetric, of a b] |
|
803 |
using mult_div_mod_eq [symmetric, of a b'] |
|
804 |
apply - |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
805 |
apply (rule zdiv_mono2_lemma) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
806 |
apply (erule subst) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
807 |
apply (erule subst, simp_all) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
808 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
809 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
810 |
lemma q_neg_lemma: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
811 |
"[| b'*q' + r' < 0; 0 \<le> r'; 0 < b' |] ==> q' \<le> (0::int)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
812 |
apply (subgoal_tac "b'*q' < 0") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
813 |
apply (simp add: mult_less_0_iff, arith) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
814 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
815 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
816 |
lemma zdiv_mono2_neg_lemma: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
817 |
"[| b*q + r = b'*q' + r'; b'*q' + r' < 0; |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
818 |
r < b; 0 \<le> r'; 0 < b'; b' \<le> b |] |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
819 |
==> q' \<le> (q::int)" |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
820 |
apply (frule q_neg_lemma, assumption+) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
821 |
apply (subgoal_tac "b*q' < b* (q + 1) ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
822 |
apply (simp add: mult_less_cancel_left) |
49962
a8cc904a6820
Renamed {left,right}_distrib to distrib_{right,left}.
webertj
parents:
48891
diff
changeset
|
823 |
apply (simp add: distrib_left) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
824 |
apply (subgoal_tac "b*q' \<le> b'*q'") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
825 |
prefer 2 apply (simp add: mult_right_mono_neg, arith) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
826 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
827 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
828 |
lemma zdiv_mono2_neg: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
829 |
"[| a < (0::int); 0 < b'; b' \<le> b |] ==> a div b' \<le> a div b" |
64246 | 830 |
using mult_div_mod_eq [symmetric, of a b] |
831 |
using mult_div_mod_eq [symmetric, of a b'] |
|
832 |
apply - |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
833 |
apply (rule zdiv_mono2_neg_lemma) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
834 |
apply (erule subst) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
835 |
apply (erule subst, simp_all) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
836 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
837 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
838 |
|
60758 | 839 |
subsubsection \<open>More Algebraic Laws for div and mod\<close> |
840 |
||
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
841 |
lemma zdiv_zmult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::int)" |
66814 | 842 |
by (fact div_mult1_eq) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
843 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
844 |
(*NOT suitable for rewriting: the RHS has an instance of the LHS*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
845 |
lemma zdiv_zadd1_eq: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
846 |
"(a+b) div (c::int) = a div c + b div c + ((a mod c + b mod c) div c)" |
66814 | 847 |
by (fact div_add1_eq) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
848 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
849 |
lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
850 |
by (simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
851 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
852 |
(* REVISIT: should this be generalized to all semiring_div types? *) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
853 |
lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1] |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
854 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
855 |
|
60758 | 856 |
subsubsection \<open>Proving @{term "a div (b * c) = (a div b) div c"}\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
857 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
858 |
(*The condition c>0 seems necessary. Consider that 7 div ~6 = ~2 but |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
859 |
7 div 2 div ~3 = 3 div ~3 = ~1. The subcase (a div b) mod c = 0 seems |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
860 |
to cause particular problems.*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
861 |
|
60758 | 862 |
text\<open>first, four lemmas to bound the remainder for the cases b<0 and b>0\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
863 |
|
55085
0e8e4dc55866
moved 'fundef_cong' attribute (and other basic 'fun' stuff) up the dependency chain
blanchet
parents:
54489
diff
changeset
|
864 |
lemma zmult2_lemma_aux1: "[| (0::int) < c; b < r; r \<le> 0 |] ==> b * c < b * (q mod c) + r" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
865 |
apply (subgoal_tac "b * (c - q mod c) < r * 1") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
866 |
apply (simp add: algebra_simps) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
867 |
apply (rule order_le_less_trans) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
868 |
apply (erule_tac [2] mult_strict_right_mono) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
869 |
apply (rule mult_left_mono_neg) |
35216 | 870 |
using add1_zle_eq[of "q mod c"]apply(simp add: algebra_simps) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
871 |
apply (simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
872 |
apply (simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
873 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
874 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
875 |
lemma zmult2_lemma_aux2: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
876 |
"[| (0::int) < c; b < r; r \<le> 0 |] ==> b * (q mod c) + r \<le> 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
877 |
apply (subgoal_tac "b * (q mod c) \<le> 0") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
878 |
apply arith |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
879 |
apply (simp add: mult_le_0_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
880 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
881 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
882 |
lemma zmult2_lemma_aux3: "[| (0::int) < c; 0 \<le> r; r < b |] ==> 0 \<le> b * (q mod c) + r" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
883 |
apply (subgoal_tac "0 \<le> b * (q mod c) ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
884 |
apply arith |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
885 |
apply (simp add: zero_le_mult_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
886 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
887 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
888 |
lemma zmult2_lemma_aux4: "[| (0::int) < c; 0 \<le> r; r < b |] ==> b * (q mod c) + r < b * c" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
889 |
apply (subgoal_tac "r * 1 < b * (c - q mod c) ") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
890 |
apply (simp add: right_diff_distrib) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
891 |
apply (rule order_less_le_trans) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
892 |
apply (erule mult_strict_right_mono) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
893 |
apply (rule_tac [2] mult_left_mono) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
894 |
apply simp |
35216 | 895 |
using add1_zle_eq[of "q mod c"] apply (simp add: algebra_simps) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
896 |
apply simp |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
897 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
898 |
|
64635 | 899 |
lemma zmult2_lemma: "[| eucl_rel_int a b (q, r); 0 < c |] |
900 |
==> eucl_rel_int a (b * c) (q div c, b*(q mod c) + r)" |
|
901 |
by (auto simp add: mult.assoc eucl_rel_int_iff linorder_neq_iff |
|
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
902 |
zero_less_mult_iff distrib_left [symmetric] |
62390 | 903 |
zmult2_lemma_aux1 zmult2_lemma_aux2 zmult2_lemma_aux3 zmult2_lemma_aux4 mult_less_0_iff split: if_split_asm) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
904 |
|
53068 | 905 |
lemma zdiv_zmult2_eq: |
906 |
fixes a b c :: int |
|
907 |
shows "0 \<le> c \<Longrightarrow> a div (b * c) = (a div b) div c" |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
908 |
apply (case_tac "b = 0", simp) |
64635 | 909 |
apply (force simp add: le_less eucl_rel_int [THEN zmult2_lemma, THEN div_int_unique]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
910 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
911 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
912 |
lemma zmod_zmult2_eq: |
53068 | 913 |
fixes a b c :: int |
914 |
shows "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b" |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
915 |
apply (case_tac "b = 0", simp) |
64635 | 916 |
apply (force simp add: le_less eucl_rel_int [THEN zmult2_lemma, THEN mod_int_unique]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
917 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
918 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
919 |
lemma div_pos_geq: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
920 |
fixes k l :: int |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
921 |
assumes "0 < l" and "l \<le> k" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
922 |
shows "k div l = (k - l) div l + 1" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
923 |
proof - |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
924 |
have "k = (k - l) + l" by simp |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
925 |
then obtain j where k: "k = j + l" .. |
63499
9c9a59949887
Tuned looping simp rules in semiring_div
eberlm <eberlm@in.tum.de>
parents:
63417
diff
changeset
|
926 |
with assms show ?thesis by (simp add: div_add_self2) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
927 |
qed |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
928 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
929 |
lemma mod_pos_geq: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
930 |
fixes k l :: int |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
931 |
assumes "0 < l" and "l \<le> k" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
932 |
shows "k mod l = (k - l) mod l" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
933 |
proof - |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
934 |
have "k = (k - l) + l" by simp |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
935 |
then obtain j where k: "k = j + l" .. |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
936 |
with assms show ?thesis by simp |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
937 |
qed |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
938 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
939 |
|
60758 | 940 |
subsubsection \<open>Splitting Rules for div and mod\<close> |
941 |
||
942 |
text\<open>The proofs of the two lemmas below are essentially identical\<close> |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
943 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
944 |
lemma split_pos_lemma: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
945 |
"0<k ==> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
946 |
P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i j)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
947 |
apply (rule iffI, clarify) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
948 |
apply (erule_tac P="P x y" for x y in rev_mp) |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
949 |
apply (subst mod_add_eq [symmetric]) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
950 |
apply (subst zdiv_zadd1_eq) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
951 |
apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial) |
60758 | 952 |
txt\<open>converse direction\<close> |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
953 |
apply (drule_tac x = "n div k" in spec) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
954 |
apply (drule_tac x = "n mod k" in spec, simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
955 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
956 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
957 |
lemma split_neg_lemma: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
958 |
"k<0 ==> |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
959 |
P(n div k :: int)(n mod k) = (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i j)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
960 |
apply (rule iffI, clarify) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
961 |
apply (erule_tac P="P x y" for x y in rev_mp) |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
962 |
apply (subst mod_add_eq [symmetric]) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
963 |
apply (subst zdiv_zadd1_eq) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
964 |
apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial) |
60758 | 965 |
txt\<open>converse direction\<close> |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
966 |
apply (drule_tac x = "n div k" in spec) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
967 |
apply (drule_tac x = "n mod k" in spec, simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
968 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
969 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
970 |
lemma split_zdiv: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
971 |
"P(n div k :: int) = |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
972 |
((k = 0 --> P 0) & |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
973 |
(0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i)) & |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
974 |
(k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i)))" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
975 |
apply (case_tac "k=0", simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
976 |
apply (simp only: linorder_neq_iff) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
977 |
apply (erule disjE) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
978 |
apply (simp_all add: split_pos_lemma [of concl: "%x y. P x"] |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
979 |
split_neg_lemma [of concl: "%x y. P x"]) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
980 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
981 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
982 |
lemma split_zmod: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
983 |
"P(n mod k :: int) = |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
984 |
((k = 0 --> P n) & |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
985 |
(0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P j)) & |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
986 |
(k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P j)))" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
987 |
apply (case_tac "k=0", simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
988 |
apply (simp only: linorder_neq_iff) |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
989 |
apply (erule disjE) |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
990 |
apply (simp_all add: split_pos_lemma [of concl: "%x y. P y"] |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
991 |
split_neg_lemma [of concl: "%x y. P y"]) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
992 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
993 |
|
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
994 |
text \<open>Enable (lin)arith to deal with @{const divide} and @{const modulo} |
33730
1755ca4ec022
Fixed splitting of div and mod on integers (split theorem differed from implementation).
webertj
parents:
33728
diff
changeset
|
995 |
when these are applied to some constant that is of the form |
60758 | 996 |
@{term "numeral k"}:\<close> |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
997 |
declare split_zdiv [of _ _ "numeral k", arith_split] for k |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
998 |
declare split_zmod [of _ _ "numeral k", arith_split] for k |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
999 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1000 |
|
61799 | 1001 |
subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> with shifting\<close> |
47166 | 1002 |
|
64635 | 1003 |
lemma pos_eucl_rel_int_mult_2: |
47166 | 1004 |
assumes "0 \<le> b" |
64635 | 1005 |
assumes "eucl_rel_int a b (q, r)" |
1006 |
shows "eucl_rel_int (1 + 2*a) (2*b) (q, 1 + 2*r)" |
|
1007 |
using assms unfolding eucl_rel_int_iff by auto |
|
1008 |
||
1009 |
lemma neg_eucl_rel_int_mult_2: |
|
47166 | 1010 |
assumes "b \<le> 0" |
64635 | 1011 |
assumes "eucl_rel_int (a + 1) b (q, r)" |
1012 |
shows "eucl_rel_int (1 + 2*a) (2*b) (q, 2*r - 1)" |
|
1013 |
using assms unfolding eucl_rel_int_iff by auto |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1014 |
|
60758 | 1015 |
text\<open>computing div by shifting\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1016 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1017 |
lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a" |
64635 | 1018 |
using pos_eucl_rel_int_mult_2 [OF _ eucl_rel_int] |
47166 | 1019 |
by (rule div_int_unique) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1020 |
|
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1021 |
lemma neg_zdiv_mult_2: |
35815
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
boehmes
parents:
35673
diff
changeset
|
1022 |
assumes A: "a \<le> (0::int)" shows "(1 + 2*b) div (2*a) = (b+1) div a" |
64635 | 1023 |
using neg_eucl_rel_int_mult_2 [OF A eucl_rel_int] |
47166 | 1024 |
by (rule div_int_unique) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1025 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1026 |
(* FIXME: add rules for negative numerals *) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1027 |
lemma zdiv_numeral_Bit0 [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1028 |
"numeral (Num.Bit0 v) div numeral (Num.Bit0 w) = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1029 |
numeral v div (numeral w :: int)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1030 |
unfolding numeral.simps unfolding mult_2 [symmetric] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1031 |
by (rule div_mult_mult1, simp) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1032 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1033 |
lemma zdiv_numeral_Bit1 [simp]: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1034 |
"numeral (Num.Bit1 v) div numeral (Num.Bit0 w) = |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1035 |
(numeral v div (numeral w :: int))" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1036 |
unfolding numeral.simps |
57512
cc97b347b301
reduced name variants for assoc and commute on plus and mult
haftmann
parents:
57492
diff
changeset
|
1037 |
unfolding mult_2 [symmetric] add.commute [of _ 1] |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1038 |
by (rule pos_zdiv_mult_2, simp) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1039 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1040 |
lemma pos_zmod_mult_2: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1041 |
fixes a b :: int |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1042 |
assumes "0 \<le> a" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1043 |
shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)" |
64635 | 1044 |
using pos_eucl_rel_int_mult_2 [OF assms eucl_rel_int] |
47166 | 1045 |
by (rule mod_int_unique) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1046 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1047 |
lemma neg_zmod_mult_2: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1048 |
fixes a b :: int |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1049 |
assumes "a \<le> 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1050 |
shows "(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1" |
64635 | 1051 |
using neg_eucl_rel_int_mult_2 [OF assms eucl_rel_int] |
47166 | 1052 |
by (rule mod_int_unique) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1053 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1054 |
(* FIXME: add rules for negative numerals *) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1055 |
lemma zmod_numeral_Bit0 [simp]: |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1056 |
"numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) = |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1057 |
(2::int) * (numeral v mod numeral w)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1058 |
unfolding numeral_Bit0 [of v] numeral_Bit0 [of w] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1059 |
unfolding mult_2 [symmetric] by (rule mod_mult_mult1) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1060 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1061 |
lemma zmod_numeral_Bit1 [simp]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1062 |
"numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1063 |
2 * (numeral v mod numeral w) + (1::int)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1064 |
unfolding numeral_Bit1 [of v] numeral_Bit0 [of w] |
57512
cc97b347b301
reduced name variants for assoc and commute on plus and mult
haftmann
parents:
57492
diff
changeset
|
1065 |
unfolding mult_2 [symmetric] add.commute [of _ 1] |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46560
diff
changeset
|
1066 |
by (rule pos_zmod_mult_2, simp) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1067 |
|
39489 | 1068 |
lemma zdiv_eq_0_iff: |
1069 |
"(i::int) div k = 0 \<longleftrightarrow> k=0 \<or> 0\<le>i \<and> i<k \<or> i\<le>0 \<and> k<i" (is "?L = ?R") |
|
1070 |
proof |
|
1071 |
assume ?L |
|
1072 |
have "?L \<longrightarrow> ?R" by (rule split_zdiv[THEN iffD2]) simp |
|
60758 | 1073 |
with \<open>?L\<close> show ?R by blast |
39489 | 1074 |
next |
1075 |
assume ?R thus ?L |
|
1076 |
by(auto simp: div_pos_pos_trivial div_neg_neg_trivial) |
|
1077 |
qed |
|
1078 |
||
63947 | 1079 |
lemma zmod_trival_iff: |
1080 |
fixes i k :: int |
|
1081 |
shows "i mod k = i \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i" |
|
1082 |
proof - |
|
1083 |
have "i mod k = i \<longleftrightarrow> i div k = 0" |
|
64242
93c6f0da5c70
more standardized theorem names for facts involving the div and mod identity
haftmann
parents:
64240
diff
changeset
|
1084 |
by safe (insert div_mult_mod_eq [of i k], auto) |
63947 | 1085 |
with zdiv_eq_0_iff |
1086 |
show ?thesis |
|
1087 |
by simp |
|
1088 |
qed |
|
39489 | 1089 |
|
64785 | 1090 |
|
60758 | 1091 |
subsubsection \<open>Quotients of Signs\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1092 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1093 |
lemma div_eq_minus1: "(0::int) < b ==> -1 div b = -1" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1094 |
by (simp add: divide_int_def) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1095 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1096 |
lemma zmod_minus1: "(0::int) < b ==> -1 mod b = b - 1" |
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
1097 |
by (simp add: modulo_int_def) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1098 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1099 |
lemma div_neg_pos_less0: "[| a < (0::int); 0 < b |] ==> a div b < 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1100 |
apply (subgoal_tac "a div b \<le> -1", force) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1101 |
apply (rule order_trans) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1102 |
apply (rule_tac a' = "-1" in zdiv_mono1) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1103 |
apply (auto simp add: div_eq_minus1) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1104 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1105 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1106 |
lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1107 |
by (drule zdiv_mono1_neg, auto) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1108 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1109 |
lemma div_nonpos_pos_le0: "[| (a::int) \<le> 0; b > 0 |] ==> a div b \<le> 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1110 |
by (drule zdiv_mono1, auto) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1111 |
|
61799 | 1112 |
text\<open>Now for some equivalences of the form \<open>a div b >=< 0 \<longleftrightarrow> \<dots>\<close> |
1113 |
conditional upon the sign of \<open>a\<close> or \<open>b\<close>. There are many more. |
|
60758 | 1114 |
They should all be simp rules unless that causes too much search.\<close> |
33804 | 1115 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1116 |
lemma pos_imp_zdiv_nonneg_iff: "(0::int) < b ==> (0 \<le> a div b) = (0 \<le> a)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1117 |
apply auto |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1118 |
apply (drule_tac [2] zdiv_mono1) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1119 |
apply (auto simp add: linorder_neq_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1120 |
apply (simp (no_asm_use) add: linorder_not_less [symmetric]) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1121 |
apply (blast intro: div_neg_pos_less0) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1122 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1123 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1124 |
lemma pos_imp_zdiv_pos_iff: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1125 |
"0<k \<Longrightarrow> 0 < (i::int) div k \<longleftrightarrow> k \<le> i" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1126 |
using pos_imp_zdiv_nonneg_iff[of k i] zdiv_eq_0_iff[of i k] |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1127 |
by arith |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1128 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1129 |
lemma neg_imp_zdiv_nonneg_iff: |
33804 | 1130 |
"b < (0::int) ==> (0 \<le> a div b) = (a \<le> (0::int))" |
47159 | 1131 |
apply (subst div_minus_minus [symmetric]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1132 |
apply (subst pos_imp_zdiv_nonneg_iff, auto) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1133 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1134 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1135 |
(*But not (a div b \<le> 0 iff a\<le>0); consider a=1, b=2 when a div b = 0.*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1136 |
lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1137 |
by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1138 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1139 |
(*Again the law fails for \<le>: consider a = -1, b = -2 when a div b = 0*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1140 |
lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1141 |
by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1142 |
|
33804 | 1143 |
lemma nonneg1_imp_zdiv_pos_iff: |
1144 |
"(0::int) <= a \<Longrightarrow> (a div b > 0) = (a >= b & b>0)" |
|
1145 |
apply rule |
|
1146 |
apply rule |
|
1147 |
using div_pos_pos_trivial[of a b]apply arith |
|
1148 |
apply(cases "b=0")apply simp |
|
1149 |
using div_nonneg_neg_le0[of a b]apply arith |
|
1150 |
using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b]apply simp |
|
1151 |
done |
|
1152 |
||
39489 | 1153 |
lemma zmod_le_nonneg_dividend: "(m::int) \<ge> 0 ==> m mod k \<le> m" |
1154 |
apply (rule split_zmod[THEN iffD2]) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44766
diff
changeset
|
1155 |
apply(fastforce dest: q_pos_lemma intro: split_mult_pos_le) |
39489 | 1156 |
done |
1157 |
||
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1158 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1159 |
subsubsection \<open>Computation of Division and Remainder\<close> |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1160 |
|
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1161 |
instantiation int :: unique_euclidean_semiring_numeral |
61275
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1162 |
begin |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1163 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1164 |
definition divmod_int :: "num \<Rightarrow> num \<Rightarrow> int \<times> int" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1165 |
where |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1166 |
"divmod_int m n = (numeral m div numeral n, numeral m mod numeral n)" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1167 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1168 |
definition divmod_step_int :: "num \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1169 |
where |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1170 |
"divmod_step_int l qr = (let (q, r) = qr |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1171 |
in if r \<ge> numeral l then (2 * q + 1, r - numeral l) |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1172 |
else (2 * q, r))" |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1173 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1174 |
instance |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1175 |
by standard (auto intro: zmod_le_nonneg_dividend simp add: divmod_int_def divmod_step_int_def |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1176 |
pos_imp_zdiv_pos_iff div_pos_pos_trivial mod_pos_pos_trivial zmod_zmult2_eq zdiv_zmult2_eq) |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1177 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1178 |
end |
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1179 |
|
053ec04ea866
monomorphization of divmod wrt. code generation avoids costly dictionary unpacking at runtime
haftmann
parents:
61201
diff
changeset
|
1180 |
declare divmod_algorithm_code [where ?'a = int, code] |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1181 |
|
60930 | 1182 |
context |
1183 |
begin |
|
1184 |
||
1185 |
qualified definition adjust_div :: "int \<times> int \<Rightarrow> int" |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1186 |
where |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1187 |
"adjust_div qr = (let (q, r) = qr in q + of_bool (r \<noteq> 0))" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1188 |
|
60930 | 1189 |
qualified lemma adjust_div_eq [simp, code]: |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1190 |
"adjust_div (q, r) = q + of_bool (r \<noteq> 0)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1191 |
by (simp add: adjust_div_def) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1192 |
|
60930 | 1193 |
qualified definition adjust_mod :: "int \<Rightarrow> int \<Rightarrow> int" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1194 |
where |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1195 |
[simp]: "adjust_mod l r = (if r = 0 then 0 else l - r)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1196 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1197 |
lemma minus_numeral_div_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1198 |
"- numeral m div numeral n = - (adjust_div (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1199 |
proof - |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1200 |
have "int (fst (divmod m n)) = fst (divmod m n)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1201 |
by (simp only: fst_divmod divide_int_def) auto |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1202 |
then show ?thesis |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1203 |
by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1204 |
qed |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1205 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1206 |
lemma minus_numeral_mod_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1207 |
"- numeral m mod numeral n = adjust_mod (numeral n) (snd (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1208 |
proof - |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1209 |
have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)" |
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
1210 |
using that by (simp only: snd_divmod modulo_int_def) auto |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1211 |
then show ?thesis |
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
1212 |
by (auto simp add: split_def Let_def adjust_div_def divides_aux_def modulo_int_def) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1213 |
qed |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1214 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1215 |
lemma numeral_div_minus_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1216 |
"numeral m div - numeral n = - (adjust_div (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1217 |
proof - |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1218 |
have "int (fst (divmod m n)) = fst (divmod m n)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1219 |
by (simp only: fst_divmod divide_int_def) auto |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1220 |
then show ?thesis |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1221 |
by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1222 |
qed |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1223 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1224 |
lemma numeral_mod_minus_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1225 |
"numeral m mod - numeral n = - adjust_mod (numeral n) (snd (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1226 |
proof - |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1227 |
have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)" |
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
1228 |
using that by (simp only: snd_divmod modulo_int_def) auto |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1229 |
then show ?thesis |
63950
cdc1e59aa513
syntactic type class for operation mod named after mod;
haftmann
parents:
63947
diff
changeset
|
1230 |
by (auto simp add: split_def Let_def adjust_div_def divides_aux_def modulo_int_def) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1231 |
qed |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1232 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1233 |
lemma minus_one_div_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1234 |
"- 1 div numeral n = - (adjust_div (divmod Num.One n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1235 |
using minus_numeral_div_numeral [of Num.One n] by simp |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1236 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1237 |
lemma minus_one_mod_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1238 |
"- 1 mod numeral n = adjust_mod (numeral n) (snd (divmod Num.One n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1239 |
using minus_numeral_mod_numeral [of Num.One n] by simp |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1240 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1241 |
lemma one_div_minus_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1242 |
"1 div - numeral n = - (adjust_div (divmod Num.One n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1243 |
using numeral_div_minus_numeral [of Num.One n] by simp |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1244 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1245 |
lemma one_mod_minus_numeral [simp]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1246 |
"1 mod - numeral n = - adjust_mod (numeral n) (snd (divmod Num.One n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1247 |
using numeral_mod_minus_numeral [of Num.One n] by simp |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1248 |
|
60930 | 1249 |
end |
1250 |
||
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1251 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1252 |
subsubsection \<open>Further properties\<close> |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1253 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1254 |
text \<open>Simplify expresions in which div and mod combine numerical constants\<close> |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1255 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1256 |
lemma int_div_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a div b = q" |
64635 | 1257 |
by (rule div_int_unique [of a b q r]) (simp add: eucl_rel_int_iff) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1258 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1259 |
lemma int_div_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a div b = q" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1260 |
by (rule div_int_unique [of a b q r], |
64635 | 1261 |
simp add: eucl_rel_int_iff) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1262 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1263 |
lemma int_mod_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a mod b = r" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1264 |
by (rule mod_int_unique [of a b q r], |
64635 | 1265 |
simp add: eucl_rel_int_iff) |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1266 |
|
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1267 |
lemma int_mod_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a mod b = r" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1268 |
by (rule mod_int_unique [of a b q r], |
64635 | 1269 |
simp add: eucl_rel_int_iff) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1270 |
|
61944 | 1271 |
lemma abs_div: "(y::int) dvd x \<Longrightarrow> \<bar>x div y\<bar> = \<bar>x\<bar> div \<bar>y\<bar>" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1272 |
by (unfold dvd_def, cases "y=0", auto simp add: abs_mult) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1273 |
|
60758 | 1274 |
text\<open>Suggested by Matthias Daum\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1275 |
lemma int_power_div_base: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1276 |
"\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1277 |
apply (subgoal_tac "k ^ m = k ^ ((m - Suc 0) + Suc 0)") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1278 |
apply (erule ssubst) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1279 |
apply (simp only: power_add) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1280 |
apply simp_all |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1281 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1282 |
|
61799 | 1283 |
text \<open>Distributive laws for function \<open>nat\<close>.\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1284 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1285 |
lemma nat_div_distrib: "0 \<le> x \<Longrightarrow> nat (x div y) = nat x div nat y" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1286 |
apply (rule linorder_cases [of y 0]) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1287 |
apply (simp add: div_nonneg_neg_le0) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1288 |
apply simp |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1289 |
apply (simp add: nat_eq_iff pos_imp_zdiv_nonneg_iff zdiv_int) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1290 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1291 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1292 |
(*Fails if y<0: the LHS collapses to (nat z) but the RHS doesn't*) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1293 |
lemma nat_mod_distrib: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1294 |
"\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x mod y) = nat x mod nat y" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1295 |
apply (case_tac "y = 0", simp) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1296 |
apply (simp add: nat_eq_iff zmod_int) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1297 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1298 |
|
60758 | 1299 |
text \<open>transfer setup\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1300 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1301 |
lemma transfer_nat_int_functions: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1302 |
"(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> (nat x) div (nat y) = nat (x div y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1303 |
"(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> (nat x) mod (nat y) = nat (x mod y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1304 |
by (auto simp add: nat_div_distrib nat_mod_distrib) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1305 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1306 |
lemma transfer_nat_int_function_closures: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1307 |
"(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> x div y >= 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1308 |
"(x::int) >= 0 \<Longrightarrow> y >= 0 \<Longrightarrow> x mod y >= 0" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1309 |
apply (cases "y = 0") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1310 |
apply (auto simp add: pos_imp_zdiv_nonneg_iff) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1311 |
apply (cases "y = 0") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1312 |
apply auto |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1313 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1314 |
|
35644 | 1315 |
declare transfer_morphism_nat_int [transfer add return: |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1316 |
transfer_nat_int_functions |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1317 |
transfer_nat_int_function_closures |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1318 |
] |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1319 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1320 |
lemma transfer_int_nat_functions: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1321 |
"(int x) div (int y) = int (x div y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1322 |
"(int x) mod (int y) = int (x mod y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1323 |
by (auto simp add: zdiv_int zmod_int) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1324 |
|
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1325 |
lemma transfer_int_nat_function_closures: |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1326 |
"is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> is_nat (x div y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1327 |
"is_nat x \<Longrightarrow> is_nat y \<Longrightarrow> is_nat (x mod y)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1328 |
by (simp_all only: is_nat_def transfer_nat_int_function_closures) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1329 |
|
35644 | 1330 |
declare transfer_morphism_int_nat [transfer add return: |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1331 |
transfer_int_nat_functions |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1332 |
transfer_int_nat_function_closures |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1333 |
] |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1334 |
|
60758 | 1335 |
text\<open>Suggested by Matthias Daum\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1336 |
lemma int_div_less_self: "\<lbrakk>0 < x; 1 < k\<rbrakk> \<Longrightarrow> x div k < (x::int)" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1337 |
apply (subgoal_tac "nat x div nat k < nat x") |
34225 | 1338 |
apply (simp add: nat_div_distrib [symmetric]) |
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1339 |
apply (rule div_less_dividend, simp_all) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1340 |
done |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1341 |
|
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
1342 |
lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y mod n" and xy:"y \<le> x" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1343 |
shows "\<exists>q. x = y + n * q" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1344 |
proof- |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1345 |
from xy have th: "int x - int y = int (x - y)" by simp |
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1346 |
from xyn have "int x mod int n = int y mod int n" |
46551
866bce5442a3
simplify projections on simultaneous computations of div and mod; tuned structure (from Florian Haftmann)
huffman
parents:
46026
diff
changeset
|
1347 |
by (simp add: zmod_int [symmetric]) |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64592
diff
changeset
|
1348 |
hence "int n dvd int x - int y" by (simp only: mod_eq_dvd_iff [symmetric]) |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1349 |
hence "n dvd x - y" by (simp add: th zdvd_int) |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1350 |
then show ?thesis using xy unfolding dvd_def apply clarsimp apply (rule_tac x="k" in exI) by arith |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1351 |
qed |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1352 |
|
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1353 |
lemma nat_mod_eq_iff: "(x::nat) mod n = y mod n \<longleftrightarrow> (\<exists>q1 q2. x + n * q1 = y + n * q2)" |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1354 |
(is "?lhs = ?rhs") |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1355 |
proof |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1356 |
assume H: "x mod n = y mod n" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1357 |
{assume xy: "x \<le> y" |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1358 |
from H have th: "y mod n = x mod n" by simp |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1359 |
from nat_mod_eq_lemma[OF th xy] have ?rhs |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1360 |
apply clarify apply (rule_tac x="q" in exI) by (rule exI[where x="0"], simp)} |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1361 |
moreover |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1362 |
{assume xy: "y \<le> x" |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1363 |
from nat_mod_eq_lemma[OF H xy] have ?rhs |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1364 |
apply clarify apply (rule_tac x="0" in exI) by (rule_tac x="q" in exI, simp)} |
60562
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
paulson <lp15@cam.ac.uk>
parents:
60517
diff
changeset
|
1365 |
ultimately show ?rhs using linear[of x y] by blast |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1366 |
next |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1367 |
assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1368 |
hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1369 |
thus ?lhs by simp |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1370 |
qed |
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1371 |
|
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1372 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1373 |
subsubsection \<open>Dedicated simproc for calculation\<close> |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1374 |
|
60758 | 1375 |
text \<open> |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1376 |
There is space for improvement here: the calculation itself |
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1377 |
could be carried out outside the logic, and a generic simproc |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1378 |
(simplifier setup) for generic calculation would be helpful. |
60758 | 1379 |
\<close> |
53067
ee0b7c2315d2
type class for generic division algorithm on numerals
haftmann
parents:
53066
diff
changeset
|
1380 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1381 |
simproc_setup numeral_divmod |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1382 |
("0 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 0 :: 'a :: unique_euclidean_semiring_numeral" | |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1383 |
"0 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 1 :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1384 |
"0 div - 1 :: int" | "0 mod - 1 :: int" | |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1385 |
"0 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "0 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1386 |
"0 div - numeral b :: int" | "0 mod - numeral b :: int" | |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1387 |
"1 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 0 :: 'a :: unique_euclidean_semiring_numeral" | |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1388 |
"1 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 1 :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1389 |
"1 div - 1 :: int" | "1 mod - 1 :: int" | |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1390 |
"1 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "1 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1391 |
"1 div - numeral b :: int" |"1 mod - numeral b :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1392 |
"- 1 div 0 :: int" | "- 1 mod 0 :: int" | "- 1 div 1 :: int" | "- 1 mod 1 :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1393 |
"- 1 div - 1 :: int" | "- 1 mod - 1 :: int" | "- 1 div numeral b :: int" | "- 1 mod numeral b :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1394 |
"- 1 div - numeral b :: int" | "- 1 mod - numeral b :: int" | |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1395 |
"numeral a div 0 :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod 0 :: 'a :: unique_euclidean_semiring_numeral" | |
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1396 |
"numeral a div 1 :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod 1 :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1397 |
"numeral a div - 1 :: int" | "numeral a mod - 1 :: int" | |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1398 |
"numeral a div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1399 |
"numeral a div - numeral b :: int" | "numeral a mod - numeral b :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1400 |
"- numeral a div 0 :: int" | "- numeral a mod 0 :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1401 |
"- numeral a div 1 :: int" | "- numeral a mod 1 :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1402 |
"- numeral a div - 1 :: int" | "- numeral a mod - 1 :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1403 |
"- numeral a div numeral b :: int" | "- numeral a mod numeral b :: int" | |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1404 |
"- numeral a div - numeral b :: int" | "- numeral a mod - numeral b :: int") = |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1405 |
\<open> let |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1406 |
val if_cong = the (Code.get_case_cong @{theory} @{const_name If}); |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1407 |
fun successful_rewrite ctxt ct = |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1408 |
let |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1409 |
val thm = Simplifier.rewrite ctxt ct |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1410 |
in if Thm.is_reflexive thm then NONE else SOME thm end; |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1411 |
in fn phi => |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1412 |
let |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1413 |
val simps = Morphism.fact phi (@{thms div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1 |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1414 |
one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1415 |
one_div_minus_numeral one_mod_minus_numeral |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1416 |
numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1417 |
numeral_div_minus_numeral numeral_mod_minus_numeral |
60930 | 1418 |
div_minus_minus mod_minus_minus Divides.adjust_div_eq of_bool_eq one_neq_zero |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1419 |
numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1420 |
divmod_cancel divmod_steps divmod_step_eq fst_conv snd_conv numeral_One |
60930 | 1421 |
case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1422 |
minus_minus numeral_times_numeral mult_zero_right mult_1_right} |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1423 |
@ [@{lemma "0 = 0 \<longleftrightarrow> True" by simp}]); |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1424 |
fun prepare_simpset ctxt = HOL_ss |> Simplifier.simpset_map ctxt |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1425 |
(Simplifier.add_cong if_cong #> fold Simplifier.add_simp simps) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1426 |
in fn ctxt => successful_rewrite (Simplifier.put_simpset (prepare_simpset ctxt) ctxt) end |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1427 |
end; |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1428 |
\<close> |
34126 | 1429 |
|
35673 | 1430 |
|
60758 | 1431 |
subsubsection \<open>Code generation\<close> |
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1432 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1433 |
lemma [code]: |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1434 |
fixes k :: int |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1435 |
shows |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1436 |
"k div 0 = 0" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1437 |
"k mod 0 = k" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1438 |
"0 div k = 0" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1439 |
"0 mod k = 0" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1440 |
"k div Int.Pos Num.One = k" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1441 |
"k mod Int.Pos Num.One = 0" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1442 |
"k div Int.Neg Num.One = - k" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1443 |
"k mod Int.Neg Num.One = 0" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1444 |
"Int.Pos m div Int.Pos n = (fst (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1445 |
"Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)" |
60930 | 1446 |
"Int.Neg m div Int.Pos n = - (Divides.adjust_div (divmod m n) :: int)" |
1447 |
"Int.Neg m mod Int.Pos n = Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)" |
|
1448 |
"Int.Pos m div Int.Neg n = - (Divides.adjust_div (divmod m n) :: int)" |
|
1449 |
"Int.Pos m mod Int.Neg n = - Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)" |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1450 |
"Int.Neg m div Int.Neg n = (fst (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1451 |
"Int.Neg m mod Int.Neg n = - (snd (divmod m n) :: int)" |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1452 |
by simp_all |
53069
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents:
53068
diff
changeset
|
1453 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52398
diff
changeset
|
1454 |
code_identifier |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
52398
diff
changeset
|
1455 |
code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith |
33364 | 1456 |
|
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1457 |
lemma dvd_eq_mod_eq_0_numeral: |
66806
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents:
66801
diff
changeset
|
1458 |
"numeral x dvd (numeral y :: 'a) \<longleftrightarrow> numeral y mod numeral x = (0 :: 'a::semidom_modulo)" |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1459 |
by (fact dvd_eq_mod_eq_0) |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60867
diff
changeset
|
1460 |
|
64246 | 1461 |
declare minus_div_mult_eq_mod [symmetric, nitpick_unfold] |
1462 |
||
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1463 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1464 |
subsubsection \<open>Lemmas of doubtful value\<close> |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1465 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1466 |
lemma mod_mult_self3': |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1467 |
"Suc (k * n + m) mod n = Suc m mod n" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1468 |
by (fact Suc_mod_mult_self3) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1469 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1470 |
lemma mod_Suc_eq_Suc_mod: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1471 |
"Suc m mod n = Suc (m mod n) mod n" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1472 |
by (simp add: mod_simps) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1473 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1474 |
lemma div_geq: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1475 |
"m div n = Suc ((m - n) div n)" if "0 < n" and " \<not> m < n" for m n :: nat |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1476 |
by (rule le_div_geq) (use that in \<open>simp_all add: not_less\<close>) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1477 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1478 |
lemma mod_geq: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1479 |
"m mod n = (m - n) mod n" if "\<not> m < n" for m n :: nat |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1480 |
by (rule le_mod_geq) (use that in \<open>simp add: not_less\<close>) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1481 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1482 |
lemma mod_eq_0_iff: "(m mod d = 0) = (\<exists>q::nat. m = d*q)" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1483 |
by (auto simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1484 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1485 |
lemmas mod_eq_0D [dest!] = mod_eq_0_iff [THEN iffD1] |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1486 |
|
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1487 |
(*Loses information, namely we also have r<d provided d is nonzero*) |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1488 |
lemma mod_eqD: |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1489 |
fixes m d r q :: nat |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1490 |
assumes "m mod d = r" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1491 |
shows "\<exists>q. m = r + q * d" |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1492 |
proof - |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1493 |
from div_mult_mod_eq obtain q where "q * d + m mod d = m" by blast |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1494 |
with assms have "m = r + q * d" by simp |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1495 |
then show ?thesis .. |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1496 |
qed |
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66806
diff
changeset
|
1497 |
|
33361
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
haftmann
parents:
33340
diff
changeset
|
1498 |
end |