src/HOL/Divides.thy
author paulson <lp15@cam.ac.uk>
Tue, 30 May 2023 12:33:06 +0100
changeset 78127 24b70433c2e8
parent 76231 8a48e18f081e
child 78668 d52934f126d4
permissions -rw-r--r--
New HOL Light material on metric spaces and topological spaces
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     1
(*  Title:      HOL/Divides.thy
18154
0c05abaf6244 add header
huffman
parents: 17609
diff changeset
     2
*)
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     3
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
     4
section \<open>Misc lemmas on division, to be sorted out finally\<close>
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     5
15131
c69542757a4d New theory header syntax.
nipkow
parents: 14640
diff changeset
     6
theory Divides
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
     7
imports Parity
15131
c69542757a4d New theory header syntax.
nipkow
parents: 14640
diff changeset
     8
begin
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     9
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    10
class unique_euclidean_semiring_numeral = unique_euclidean_semiring_with_nat + linordered_semidom +
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    11
  assumes div_less [no_atp]: "0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a div b = 0"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    12
    and mod_less [no_atp]: " 0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a mod b = a"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    13
    and div_positive [no_atp]: "0 < b \<Longrightarrow> b \<le> a \<Longrightarrow> a div b > 0"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    14
    and mod_less_eq_dividend [no_atp]: "0 \<le> a \<Longrightarrow> a mod b \<le> a"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    15
    and pos_mod_bound [no_atp]: "0 < b \<Longrightarrow> a mod b < b"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    16
    and pos_mod_sign [no_atp]: "0 < b \<Longrightarrow> 0 \<le> a mod b"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    17
    and mod_mult2_eq [no_atp]: "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    18
    and div_mult2_eq [no_atp]: "0 \<le> c \<Longrightarrow> a div (b * c) = a div b div c"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    19
  assumes discrete [no_atp]: "a < b \<longleftrightarrow> a + 1 \<le> b"
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    20
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    21
hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    22
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    23
context unique_euclidean_semiring_numeral
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    24
begin
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    25
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    26
context
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    27
begin
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    28
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    29
lemma divmod_digit_1 [no_atp]:
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    30
  assumes "0 \<le> a" "0 < b" and "b \<le> a mod (2 * b)"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    31
  shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P")
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    32
    and "a mod (2 * b) - b = a mod b" (is "?Q")
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    33
proof -
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    34
  from assms mod_less_eq_dividend [of a "2 * b"] have "b \<le> a"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    35
    by (auto intro: trans)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    36
  with \<open>0 < b\<close> have "0 < a div b" by (auto intro: div_positive)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    37
  then have [simp]: "1 \<le> a div b" by (simp add: discrete)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    38
  with \<open>0 < b\<close> have mod_less: "a mod b < b" by (simp add: pos_mod_bound)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    39
  define w where "w = a div b mod 2"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    40
  then have w_exhaust: "w = 0 \<or> w = 1" by auto
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    41
  have mod_w: "a mod (2 * b) = a mod b + b * w"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    42
    by (simp add: w_def mod_mult2_eq ac_simps)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    43
  from assms w_exhaust have "w = 1"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    44
    using mod_less by (auto simp add: mod_w)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    45
  with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    46
  have "2 * (a div (2 * b)) = a div b - w"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    47
    by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    48
  with \<open>w = 1\<close> have div: "2 * (a div (2 * b)) = a div b - 1" by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    49
  then show ?P and ?Q
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    50
    by (simp_all add: div mod add_implies_diff [symmetric])
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    51
qed
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    52
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    53
lemma divmod_digit_0 [no_atp]:
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    54
  assumes "0 < b" and "a mod (2 * b) < b"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    55
  shows "2 * (a div (2 * b)) = a div b" (is "?P")
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    56
    and "a mod (2 * b) = a mod b" (is "?Q")
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    57
proof -
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    58
  define w where "w = a div b mod 2"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    59
  then have w_exhaust: "w = 0 \<or> w = 1" by auto
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    60
  have mod_w: "a mod (2 * b) = a mod b + b * w"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    61
    by (simp add: w_def mod_mult2_eq ac_simps)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    62
  moreover have "b \<le> a mod b + b"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    63
  proof -
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    64
    from \<open>0 < b\<close> pos_mod_sign have "0 \<le> a mod b" by blast
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    65
    then have "0 + b \<le> a mod b + b" by (rule add_right_mono)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    66
    then show ?thesis by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    67
  qed
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    68
  moreover note assms w_exhaust
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    69
  ultimately have "w = 0" by auto
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    70
  with mod_w have mod: "a mod (2 * b) = a mod b" by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    71
  have "2 * (a div (2 * b)) = a div b - w"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    72
    by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    73
  with \<open>w = 0\<close> have div: "2 * (a div (2 * b)) = a div b" by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    74
  then show ?P and ?Q
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    75
    by (simp_all add: div mod)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    76
qed
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    77
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    78
lemma mod_double_modulus: \<comment>\<open>This is actually useful and should be transferred to a suitable type class\<close>
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    79
  assumes "m > 0" "x \<ge> 0"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    80
  shows   "x mod (2 * m) = x mod m \<or> x mod (2 * m) = x mod m + m"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    81
proof (cases "x mod (2 * m) < m")
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    82
  case True
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    83
  thus ?thesis using assms using divmod_digit_0(2)[of m x] by auto
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    84
next
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    85
  case False
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    86
  hence *: "x mod (2 * m) - m = x mod m"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    87
    using assms by (intro divmod_digit_1) auto
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    88
  hence "x mod (2 * m) = x mod m + m"
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    89
    by (subst * [symmetric], subst le_add_diff_inverse2) (use False in auto)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    90
  thus ?thesis by simp
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    91
qed
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    92
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    93
end
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    94
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
    95
end
75936
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    96
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    97
instance nat :: unique_euclidean_semiring_numeral
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    98
  by standard
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
    99
    (auto simp add: div_greater_zero_iff div_mult2_eq mod_mult2_eq)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
   100
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
   101
instance int :: unique_euclidean_semiring_numeral
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
   102
  by standard (auto intro: zmod_le_nonneg_dividend simp add:
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
   103
    pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq)
d2e6a1342c90 simplified computation algorithm construction
haftmann
parents: 75883
diff changeset
   104
69695
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   105
(* REVISIT: should this be generalized to all semiring_div types? *)
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   106
lemma zmod_eq_0D [dest!]: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: int
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   107
  using that by auto
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   108
76231
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   109
lemma div_geq [no_atp]: "m div n = Suc ((m - n) div n)" if "0 < n" and " \<not> m < n" for m n :: nat
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   110
  by (rule le_div_geq) (use that in \<open>simp_all add: not_less\<close>)
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   111
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   112
lemma mod_geq [no_atp]: "m mod n = (m - n) mod n" if "\<not> m < n" for m n :: nat
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   113
  by (rule le_mod_geq) (use that in \<open>simp add: not_less\<close>)
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   114
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   115
lemma mod_eq_0D [no_atp]: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: nat
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   116
  using that by (auto simp add: mod_eq_0_iff_dvd)
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   117
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   118
lemma pos_mod_conj [no_atp]: "0 < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b" for a b :: int
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   119
  by simp
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   120
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   121
lemma neg_mod_conj [no_atp]: "b < 0 \<Longrightarrow> a mod b \<le> 0 \<and> b < a mod b" for a b :: int
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   122
  by simp
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   123
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   124
lemma zmod_eq_0_iff [no_atp]: "m mod d = 0 \<longleftrightarrow> (\<exists>q. m = d * q)" for m d :: int
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   125
  by (auto simp add: mod_eq_0_iff_dvd)
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   126
8a48e18f081e reduce prominence of facts
haftmann
parents: 76224
diff changeset
   127
lemma div_positive_int [no_atp]:
75937
02b18f59f903 streamlined
haftmann
parents: 75936
diff changeset
   128
  "k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int
02b18f59f903 streamlined
haftmann
parents: 75936
diff changeset
   129
  using that by (simp add: nonneg1_imp_zdiv_pos_iff)
02b18f59f903 streamlined
haftmann
parents: 75936
diff changeset
   130
76224
64e8d4afcf10 moved relevant theorems from theory Divides to theory Euclidean_Division
haftmann
parents: 76141
diff changeset
   131
code_identifier
64e8d4afcf10 moved relevant theorems from theory Divides to theory Euclidean_Division
haftmann
parents: 76141
diff changeset
   132
  code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
64e8d4afcf10 moved relevant theorems from theory Divides to theory Euclidean_Division
haftmann
parents: 76141
diff changeset
   133
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   134
end