src/HOL/Divides.thy
author haftmann
Thu, 17 Sep 2020 09:57:30 +0000
changeset 72261 5193570b739a
parent 72187 e4aecb0c7296
child 72262 a282abb07642
permissions -rw-r--r--
more lemmas
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
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     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
0c05abaf6244 add header
huffman
parents: 17609
diff changeset
     4
*)
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     5
64785
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents: 64715
diff changeset
     6
section \<open>More on quotient and remainder\<close>
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
     7
15131
c69542757a4d New theory header syntax.
nipkow
parents: 14640
diff changeset
     8
theory Divides
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
     9
imports Parity
15131
c69542757a4d New theory header syntax.
nipkow
parents: 14640
diff changeset
    10
begin
3366
2402c6ab1561 Moving div and mod from Arith to Divides
paulson
parents:
diff changeset
    11
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
    12
subsection \<open>More on division\<close>
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
    13
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    14
inductive eucl_rel_int :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    15
  where eucl_rel_int_by0: "eucl_rel_int k 0 (0, k)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    16
  | eucl_rel_int_dividesI: "l \<noteq> 0 \<Longrightarrow> k = q * l \<Longrightarrow> eucl_rel_int k l (q, 0)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    17
  | eucl_rel_int_remainderI: "sgn r = sgn l \<Longrightarrow> \<bar>r\<bar> < \<bar>l\<bar>
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    18
      \<Longrightarrow> k = q * l + r \<Longrightarrow> eucl_rel_int k l (q, r)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    19
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    20
lemma eucl_rel_int_iff:    
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    21
  "eucl_rel_int k l (q, r) \<longleftrightarrow> 
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    22
    k = l * q + r \<and>
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    23
     (if 0 < l then 0 \<le> r \<and> r < l else if l < 0 then l < r \<and> r \<le> 0 else q = 0)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    24
  by (cases "r = 0")
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    25
    (auto elim!: eucl_rel_int.cases intro: eucl_rel_int_by0 eucl_rel_int_dividesI eucl_rel_int_remainderI
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    26
    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
    27
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    28
lemma unique_quotient_lemma:
68626
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    29
  assumes "b * q' + r' \<le> b * q + r" "0 \<le> r'" "r' < b" "r < b" shows "q' \<le> (q::int)"
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    30
proof -
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    31
  have "r' + b * (q'-q) \<le> r"
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    32
    using assms by (simp add: right_diff_distrib)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    33
  moreover have "0 < b * (1 + q - q') "
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    34
    using assms by (simp add: right_diff_distrib distrib_left)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    35
  moreover have "b * q' < b * (1 + q)"
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    36
    using assms by (simp add: right_diff_distrib distrib_left)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    37
  ultimately show ?thesis
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    38
    using assms by (simp add: mult_less_cancel_left)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    39
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    40
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    41
lemma unique_quotient_lemma_neg:
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
    42
  "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
    43
  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
    44
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    45
lemma unique_quotient:
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    46
  "eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> q = q'"
68626
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    47
  apply (rule order_antisym)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    48
   apply (simp_all add: eucl_rel_int_iff linorder_neq_iff split: if_split_asm)
330c0ec897a4 de-applying
paulson <lp15@cam.ac.uk>
parents: 68260
diff changeset
    49
     apply (blast intro: order_eq_refl [THEN unique_quotient_lemma] order_eq_refl [THEN unique_quotient_lemma_neg] sym)+
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    50
  done
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    51
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    52
lemma unique_remainder:
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    53
  "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
    54
apply (subgoal_tac "q = q'")
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    55
 apply (simp add: eucl_rel_int_iff)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    56
apply (blast intro: unique_quotient)
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    57
done
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    58
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    59
lemma eucl_rel_int:
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    60
  "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
    61
proof (cases k rule: int_cases3)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    62
  case zero
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    63
  then show ?thesis
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    64
    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
    65
next
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    66
  case (pos n)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    67
  then show ?thesis
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    68
    using div_mult_mod_eq [of n]
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    69
    by (cases l rule: int_cases3)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    70
      (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
    71
        simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
67118
ccab07d1196c more simplification rules
haftmann
parents: 67091
diff changeset
    72
        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
    73
next
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    74
  case (neg n)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    75
  then show ?thesis
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    76
    using div_mult_mod_eq [of n]
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    77
    by (cases l rule: int_cases3)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    78
      (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
    79
        simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
67118
ccab07d1196c more simplification rules
haftmann
parents: 67091
diff changeset
    80
        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
    81
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
    82
47141
02d6b816e4b3 move int::ring_div instance upward, simplify several proofs
huffman
parents: 47140
diff changeset
    83
lemma divmod_int_unique:
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    84
  assumes "eucl_rel_int k l (q, r)"
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
    85
  shows div_int_unique: "k div l = q" and mod_int_unique: "k mod l = r"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
    86
  using assms eucl_rel_int [of k l]
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
    87
  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
    88
  by auto
64592
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
    89
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    90
lemma div_abs_eq_div_nat:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    91
  "\<bar>k\<bar> div \<bar>l\<bar> = int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    92
  by (simp add: divide_int_def)
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    93
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    94
lemma mod_abs_eq_div_nat:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
    95
  "\<bar>k\<bar> mod \<bar>l\<bar> = int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)"
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
    96
  by (simp add: modulo_int_def)
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
    97
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
    98
lemma zdiv_int:
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
    99
  "int (a div b) = int a div int b"
69695
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   100
  by (simp add: divide_int_def)
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   101
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   102
lemma zmod_int:
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   103
  "int (a mod b) = int a mod int b"
69695
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   104
  by (simp add: modulo_int_def)
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   105
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   106
lemma div_sgn_abs_cancel:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   107
  fixes k l v :: int
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   108
  assumes "v \<noteq> 0"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   109
  shows "(sgn v * \<bar>k\<bar>) div (sgn v * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   110
proof -
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   111
  from assms have "sgn v = - 1 \<or> sgn v = 1"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   112
    by (cases "v \<ge> 0") auto
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   113
  then show ?thesis
66630
034cabc4fda5 speed up proofs slightly
blanchet
parents: 65556
diff changeset
   114
    using assms unfolding divide_int_def [of "sgn v * \<bar>k\<bar>" "sgn v * \<bar>l\<bar>"]
034cabc4fda5 speed up proofs slightly
blanchet
parents: 65556
diff changeset
   115
    by (fastforce simp add: not_less div_abs_eq_div_nat)
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   116
qed
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   117
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   118
lemma div_eq_sgn_abs:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   119
  fixes k l v :: int
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   120
  assumes "sgn k = sgn l"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   121
  shows "k div l = \<bar>k\<bar> div \<bar>l\<bar>"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   122
proof (cases "l = 0")
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   123
  case True
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   124
  then show ?thesis
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   125
    by simp
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   126
next
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   127
  case False
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   128
  with assms have "(sgn k * \<bar>k\<bar>) div (sgn l * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>"
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   129
    using div_sgn_abs_cancel [of l k l] by simp
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   130
  then show ?thesis
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   131
    by (simp add: sgn_mult_abs)
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   132
qed
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   133
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   134
lemma div_dvd_sgn_abs:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   135
  fixes k l :: int
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   136
  assumes "l dvd k"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   137
  shows "k div l = (sgn k * sgn l) * (\<bar>k\<bar> div \<bar>l\<bar>)"
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   138
proof (cases "k = 0 \<or> l = 0")
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   139
  case True
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   140
  then show ?thesis
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   141
    by auto
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   142
next
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   143
  case False
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   144
  then have "k \<noteq> 0" and "l \<noteq> 0"
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   145
    by auto
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   146
  show ?thesis
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   147
  proof (cases "sgn l = sgn k")
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   148
    case True
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   149
    then show ?thesis
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   150
      by (simp add: div_eq_sgn_abs)
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   151
  next
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   152
    case False
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   153
    with \<open>k \<noteq> 0\<close> \<open>l \<noteq> 0\<close>
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   154
    have "sgn l * sgn k = - 1"
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   155
      by (simp add: sgn_if split: if_splits)
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   156
    with assms show ?thesis
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   157
      unfolding divide_int_def [of k l]
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   158
      by (auto simp add: zdiv_int ac_simps)
64715
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   159
  qed
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   160
qed
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   161
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   162
lemma div_noneq_sgn_abs:
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   163
  fixes k l :: int
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   164
  assumes "l \<noteq> 0"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   165
  assumes "sgn k \<noteq> sgn l"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   166
  shows "k div l = - (\<bar>k\<bar> div \<bar>l\<bar>) - of_bool (\<not> l dvd k)"
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   167
  using assms
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   168
  by (simp only: divide_int_def [of k l], auto simp add: not_less zdiv_int)
33d5fa0ce6e5 more elementary rules about div / mod on int
haftmann
parents: 64635
diff changeset
   169
  
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   170
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   171
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
   172
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   173
lemma zminus1_lemma:
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   174
     "eucl_rel_int a b (q, r) ==> b \<noteq> 0
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   175
      ==> 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
   176
                          if r=0 then 0 else b-r)"
66630
034cabc4fda5 speed up proofs slightly
blanchet
parents: 65556
diff changeset
   177
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
   178
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   179
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   180
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
   181
     "b \<noteq> (0::int)
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   182
      \<Longrightarrow> (-a) div b = (if a mod b = 0 then - (a div b) else  - (a div b) - 1)"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   183
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
   184
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   185
lemma zmod_zminus1_eq_if:
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   186
     "(-a::int) mod b = (if a mod b = 0 then 0 else  b - (a mod b))"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   187
proof (cases "b = 0")
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   188
  case False
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   189
  then show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   190
    by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN mod_int_unique])
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   191
qed auto
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   192
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64592
diff changeset
   193
lemma zmod_zminus1_not_zero:
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   194
  fixes k l :: int
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   195
  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
   196
  by (simp add: mod_eq_0_iff_dvd)
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
   197
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64592
diff changeset
   198
lemma zmod_zminus2_not_zero:
64592
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
   199
  fixes k l :: int
7759f1766189 more fine-grained type class hierarchy for div and mod
haftmann
parents: 64250
diff changeset
   200
  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
   201
  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
   202
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   203
lemma zdiv_zminus2_eq_if:
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   204
  "b \<noteq> (0::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
   205
      ==> a div (-b) =
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   206
          (if a mod b = 0 then - (a div b) else  - (a div b) - 1)"
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   207
  by (auto 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
   208
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   209
lemma zmod_zminus2_eq_if:
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   210
  "a mod (-b::int) = (if a mod b = 0 then 0 else  (a mod b) - b)"
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
   211
  by (auto 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
   212
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   213
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   214
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
   215
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   216
lemma zdiv_mono1:
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   217
  fixes b::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   218
  assumes "a \<le> a'" "0 < b" shows "a div b \<le> a' div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   219
proof (rule unique_quotient_lemma)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   220
  show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   221
    using assms(1) by auto
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   222
qed (use assms in auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   223
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   224
lemma zdiv_mono1_neg:
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   225
  fixes b::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   226
  assumes "a \<le> a'" "b < 0" shows "a' div b \<le> a div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   227
proof (rule unique_quotient_lemma_neg)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   228
  show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   229
    using assms(1) by auto
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   230
qed (use assms in auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   231
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   232
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   233
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
   234
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   235
lemma q_pos_lemma:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   236
  fixes q'::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   237
  assumes "0 \<le> b'*q' + r'" "r' < b'" "0 < b'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   238
  shows "0 \<le> q'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   239
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   240
  have "0 < b'* (q' + 1)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   241
    using assms by (simp add: distrib_left)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   242
  with assms show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   243
    by (simp add: zero_less_mult_iff)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   244
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   245
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   246
lemma zdiv_mono2_lemma:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   247
  fixes q'::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   248
  assumes eq: "b*q + r = b'*q' + r'" and le: "0 \<le> b'*q' + r'" and "r' < b'" "0 \<le> r" "0 < b'" "b' \<le> b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   249
  shows "q \<le> q'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   250
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   251
  have "0 \<le> q'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   252
    using q_pos_lemma le \<open>r' < b'\<close> \<open>0 < b'\<close> by blast
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   253
  moreover have "b*q = r' - r + b'*q'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   254
    using eq by linarith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   255
  ultimately have "b*q < b* (q' + 1)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   256
    using mult_right_mono assms unfolding distrib_left by fastforce
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   257
  with assms show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   258
    by (simp add: mult_less_cancel_left_pos)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   259
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   260
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   261
lemma zdiv_mono2:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   262
  fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   263
  assumes "0 \<le> a" "0 < b'" "b' \<le> b" shows "a div b \<le> a div b'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   264
proof (rule zdiv_mono2_lemma)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   265
  have "b \<noteq> 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   266
    using assms by linarith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   267
  show "b * (a div b) + a mod b = b' * (a div b') + a mod b'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   268
    by simp
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   269
qed (use assms in auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   270
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   271
lemma zdiv_mono2_neg_lemma:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   272
    fixes q'::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   273
    assumes "b*q + r = b'*q' + r'" "b'*q' + r' < 0" "r < b" "0 \<le> r'" "0 < b'" "b' \<le> b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   274
    shows "q' \<le> q"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   275
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   276
  have "b'*q' < 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   277
    using assms by linarith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   278
  with assms have "q' \<le> 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   279
    by (simp add: mult_less_0_iff)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   280
  have "b*q' \<le> b'*q'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   281
    by (simp add: \<open>q' \<le> 0\<close> assms(6) mult_right_mono_neg)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   282
  then have "b*q' < b* (q + 1)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   283
    using assms by (simp add: distrib_left)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   284
  then show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   285
    using assms by (simp add: mult_less_cancel_left)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   286
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   287
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   288
lemma zdiv_mono2_neg:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   289
  fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   290
  assumes "a < 0" "0 < b'" "b' \<le> b" shows "a div b' \<le> a div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   291
proof (rule zdiv_mono2_neg_lemma)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   292
  have "b \<noteq> 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   293
    using assms by linarith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   294
  show "b * (a div b) + a mod b = b' * (a div b') + a mod b'"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   295
    by simp
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   296
qed (use assms in auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   297
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   298
lemma div_pos_geq:
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   299
  fixes k l :: int
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   300
  assumes "0 < l" and "l \<le> k"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   301
  shows "k div l = (k - l) div l + 1"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   302
proof -
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   303
  have "k = (k - l) + l" by simp
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   304
  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
   305
  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
   306
qed
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   307
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   308
lemma mod_pos_geq:
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   309
  fixes k l :: int
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   310
  assumes "0 < l" and "l \<le> k"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   311
  shows "k mod l = (k - l) mod l"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   312
proof -
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   313
  have "k = (k - l) + l" by simp
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   314
  then obtain j where k: "k = j + l" ..
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   315
  with assms show ?thesis by simp
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   316
qed
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   317
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   318
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   319
subsubsection \<open>Splitting Rules for div and mod\<close>
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   320
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   321
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
   322
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   323
lemma split_pos_lemma:
67091
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   324
 "0<k \<Longrightarrow>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   325
    P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P i j)"
66886
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   326
  by auto
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   327
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   328
lemma split_neg_lemma:
67091
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   329
 "k<0 \<Longrightarrow>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   330
    P(n div k :: int)(n mod k) = (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P i j)"
66886
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   331
  by auto
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   332
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   333
lemma split_zdiv:
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   334
 "P(n div k :: int) =
67091
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   335
  ((k = 0 \<longrightarrow> P 0) \<and>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   336
   (0<k \<longrightarrow> (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P i)) \<and>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   337
   (k<0 \<longrightarrow> (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P i)))"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   338
proof (cases "k = 0")
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   339
  case False
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   340
  then show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   341
    unfolding linorder_neq_iff
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   342
    by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P x"] split_neg_lemma [of concl: "\<lambda>x y. P x"])
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   343
qed auto
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   344
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   345
lemma split_zmod:
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   346
 "P(n mod k :: int) =
67091
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   347
  ((k = 0 \<longrightarrow> P n) \<and>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   348
   (0<k \<longrightarrow> (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P j)) \<and>
1393c2340eec more symbols;
wenzelm
parents: 67083
diff changeset
   349
   (k<0 \<longrightarrow> (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P j)))"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   350
proof (cases "k = 0")
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   351
  case False
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   352
  then show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   353
    unfolding linorder_neq_iff
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   354
    by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P y"] split_neg_lemma [of concl: "\<lambda>x y. P y"])
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   355
qed auto
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   356
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69216
diff changeset
   357
text \<open>Enable (lin)arith to deal with \<^const>\<open>divide\<close> and \<^const>\<open>modulo\<close>
33730
1755ca4ec022 Fixed splitting of div and mod on integers (split theorem differed from implementation).
webertj
parents: 33728
diff changeset
   358
  when these are applied to some constant that is of the form
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69216
diff changeset
   359
  \<^term>\<open>numeral k\<close>:\<close>
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   360
declare split_zdiv [of _ _ "numeral k", arith_split] for k
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   361
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
   362
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   363
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
   364
subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> with shifting\<close>
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   365
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   366
lemma pos_eucl_rel_int_mult_2:
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   367
  assumes "0 \<le> b"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   368
  assumes "eucl_rel_int a b (q, r)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   369
  shows "eucl_rel_int (1 + 2*a) (2*b) (q, 1 + 2*r)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   370
  using assms unfolding eucl_rel_int_iff by auto
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   371
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   372
lemma neg_eucl_rel_int_mult_2:
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   373
  assumes "b \<le> 0"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   374
  assumes "eucl_rel_int (a + 1) b (q, r)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   375
  shows "eucl_rel_int (1 + 2*a) (2*b) (q, 2*r - 1)"
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   376
  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
   377
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   378
text\<open>computing div by shifting\<close>
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   379
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   380
lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   381
  using pos_eucl_rel_int_mult_2 [OF _ eucl_rel_int]
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   382
  by (rule div_int_unique)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   383
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
   384
lemma neg_zdiv_mult_2:
35815
10e723e54076 tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
boehmes
parents: 35673
diff changeset
   385
  assumes A: "a \<le> (0::int)" shows "(1 + 2*b) div (2*a) = (b+1) div a"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   386
  using neg_eucl_rel_int_mult_2 [OF A eucl_rel_int]
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   387
  by (rule div_int_unique)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   388
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   389
lemma zdiv_numeral_Bit0 [simp]:
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   390
  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   391
    numeral v div (numeral w :: int)"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   392
  unfolding numeral.simps unfolding mult_2 [symmetric]
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   393
  by (rule div_mult_mult1, simp)
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   394
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   395
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
   396
  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   397
    (numeral v div (numeral w :: int))"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   398
  unfolding numeral.simps
57512
cc97b347b301 reduced name variants for assoc and commute on plus and mult
haftmann
parents: 57492
diff changeset
   399
  unfolding mult_2 [symmetric] add.commute [of _ 1]
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   400
  by (rule pos_zdiv_mult_2, simp)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   401
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   402
lemma pos_zmod_mult_2:
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   403
  fixes a b :: int
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   404
  assumes "0 \<le> a"
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   405
  shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   406
  using pos_eucl_rel_int_mult_2 [OF assms eucl_rel_int]
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   407
  by (rule mod_int_unique)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   408
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   409
lemma neg_zmod_mult_2:
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   410
  fixes a b :: int
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   411
  assumes "a \<le> 0"
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   412
  shows "(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   413
  using neg_eucl_rel_int_mult_2 [OF assms eucl_rel_int]
47166
108bf76ca00c tuned proofs
huffman
parents: 47165
diff changeset
   414
  by (rule mod_int_unique)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   415
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   416
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
   417
  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   418
    (2::int) * (numeral v mod numeral w)"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   419
  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   420
  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   421
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   422
lemma zmod_numeral_Bit1 [simp]:
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   423
  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   424
    2 * (numeral v mod numeral w) + (1::int)"
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   425
  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
   426
  unfolding mult_2 [symmetric] add.commute [of _ 1]
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46560
diff changeset
   427
  by (rule pos_zmod_mult_2, simp)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   428
39489
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   429
lemma zdiv_eq_0_iff:
66886
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   430
  "i div k = 0 \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i" (is "?L = ?R")
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   431
  for i k :: int
39489
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   432
proof
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   433
  assume ?L
66886
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   434
  moreover have "?L \<longrightarrow> ?R"
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   435
    by (rule split_zdiv [THEN iffD2]) simp
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   436
  ultimately show ?R
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   437
    by blast
39489
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   438
next
66886
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   439
  assume ?R then show ?L
960509bfd47e added lemmas and tuned proofs
haftmann
parents: 66837
diff changeset
   440
    by auto
39489
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   441
qed
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   442
63947
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   443
lemma zmod_trival_iff:
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   444
  fixes i k :: int
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   445
  shows "i mod k = i \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i"
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   446
proof -
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   447
  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
   448
    by safe (insert div_mult_mod_eq [of i k], auto)
63947
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   449
  with zdiv_eq_0_iff
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   450
  show ?thesis
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   451
    by simp
559f0882d6a6 more lemmas
haftmann
parents: 63834
diff changeset
   452
qed
39489
8bb7f32a3a08 added lemmas
nipkow
parents: 38715
diff changeset
   453
64785
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents: 64715
diff changeset
   454
  
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   455
subsubsection \<open>Quotients of Signs\<close>
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   456
67083
6b2c0681ef28 new simp rule
haftmann
parents: 66886
diff changeset
   457
lemma div_eq_minus1: "0 < b \<Longrightarrow> - 1 div b = - 1" for b :: int
6b2c0681ef28 new simp rule
haftmann
parents: 66886
diff changeset
   458
  by (simp add: divide_int_def)
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   459
67083
6b2c0681ef28 new simp rule
haftmann
parents: 66886
diff changeset
   460
lemma zmod_minus1: "0 < b \<Longrightarrow> - 1 mod b = b - 1" for b :: int
6b2c0681ef28 new simp rule
haftmann
parents: 66886
diff changeset
   461
  by (auto simp add: modulo_int_def)
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   462
71991
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   463
lemma minus_mod_int_eq:
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   464
  \<open>- k mod l = l - 1 - (k - 1) mod l\<close> if \<open>l \<ge> 0\<close> for k l :: int
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   465
proof (cases \<open>l = 0\<close>)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   466
  case True
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   467
  then show ?thesis
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   468
    by simp
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   469
next
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   470
  case False
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   471
  with that have \<open>l > 0\<close>
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   472
    by simp
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   473
  then show ?thesis
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   474
  proof (cases \<open>l dvd k\<close>)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   475
    case True
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   476
    then obtain j where \<open>k = l * j\<close> ..
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   477
    moreover have \<open>(l * j mod l - 1) mod l = l - 1\<close>
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   478
      using \<open>l > 0\<close> by (simp add: zmod_minus1)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   479
    then have \<open>(l * j - 1) mod l = l - 1\<close>
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   480
      by (simp only: mod_simps)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   481
    ultimately show ?thesis
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   482
      by simp
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   483
  next
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   484
    case False
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   485
    moreover have \<open>0 < k mod l\<close> \<open>k mod l < 1 + l\<close>
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   486
      using \<open>0 < l\<close> le_imp_0_less False apply auto
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   487
      using le_less apply fastforce
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   488
      using pos_mod_bound [of l k] apply linarith 
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   489
      done
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   490
    with \<open>l > 0\<close> have \<open>(k mod l - 1) mod l = k mod l - 1\<close>
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   491
      by (simp add: zmod_trival_iff)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   492
    ultimately show ?thesis
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   493
      apply (simp only: zmod_zminus1_eq_if)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   494
      apply (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps)
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   495
      done
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   496
  qed
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   497
qed
8bff286878bf misc lemma tuning
haftmann
parents: 71757
diff changeset
   498
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   499
lemma div_neg_pos_less0:
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   500
  fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   501
  assumes "a < 0" "0 < b" 
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   502
  shows "a div b < 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   503
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   504
  have "a div b \<le> - 1 div b"
68644
242d298526a3 de-applying and simplifying proofs
paulson <lp15@cam.ac.uk>
parents: 68631
diff changeset
   505
    using zdiv_mono1 assms by auto
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   506
  also have "... \<le> -1"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   507
    by (simp add: assms(2) div_eq_minus1)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   508
  finally show ?thesis 
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   509
    by force
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   510
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   511
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   512
lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   513
  by (drule zdiv_mono1_neg, auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   514
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   515
lemma div_nonpos_pos_le0: "[| (a::int) \<le> 0; b > 0 |] ==> a div b \<le> 0"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   516
  by (drule zdiv_mono1, auto)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   517
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
   518
text\<open>Now for some equivalences of the form \<open>a div b >=< 0 \<longleftrightarrow> \<dots>\<close>
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
   519
conditional upon the sign of \<open>a\<close> or \<open>b\<close>. There are many more.
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   520
They should all be simp rules unless that causes too much search.\<close>
33804
39b494e8c055 added lemma
nipkow
parents: 33730
diff changeset
   521
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   522
lemma pos_imp_zdiv_nonneg_iff:
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   523
      fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   524
      assumes "0 < b" 
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   525
      shows "(0 \<le> a div b) = (0 \<le> a)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   526
proof
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   527
  show "0 \<le> a div b \<Longrightarrow> 0 \<le> a"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   528
    using assms
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   529
    by (simp add: linorder_not_less [symmetric]) (blast intro: div_neg_pos_less0)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   530
next
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   531
  assume "0 \<le> a"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   532
  then have "0 div b \<le> a div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   533
    using zdiv_mono1 assms by blast
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   534
  then show "0 \<le> a div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   535
    by auto
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   536
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   537
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   538
lemma pos_imp_zdiv_pos_iff:
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   539
  "0<k \<Longrightarrow> 0 < (i::int) div k \<longleftrightarrow> k \<le> i"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   540
  using pos_imp_zdiv_nonneg_iff[of k i] zdiv_eq_0_iff[of i k] by arith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   541
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   542
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   543
lemma neg_imp_zdiv_nonneg_iff:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   544
  fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   545
  assumes "b < 0" 
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   546
  shows "(0 \<le> a div b) = (a \<le> 0)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   547
  using assms by (simp add: div_minus_minus [of a, symmetric] pos_imp_zdiv_nonneg_iff del: div_minus_minus)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   548
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   549
(*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
   550
lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   551
  by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   552
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   553
(*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
   554
lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   555
  by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   556
33804
39b494e8c055 added lemma
nipkow
parents: 33730
diff changeset
   557
lemma nonneg1_imp_zdiv_pos_iff:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   558
  fixes a::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   559
  assumes "0 \<le> a" 
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   560
  shows "a div b > 0 \<longleftrightarrow> a \<ge> b \<and> b>0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   561
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   562
  have "0 < a div b \<Longrightarrow> b \<le> a"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   563
    using div_pos_pos_trivial[of a b] assms by arith
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   564
  moreover have "0 < a div b \<Longrightarrow> b > 0"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   565
    using assms div_nonneg_neg_le0[of a b]  by(cases "b=0"; force)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   566
  moreover have "b \<le> a \<and> 0 < b \<Longrightarrow> 0 < a div b"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   567
    using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b] by simp
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   568
  ultimately show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   569
    by blast
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   570
qed
33804
39b494e8c055 added lemma
nipkow
parents: 33730
diff changeset
   571
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   572
lemma zmod_le_nonneg_dividend: "(m::int) \<ge> 0 \<Longrightarrow> m mod k \<le> m"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   573
  by (rule split_zmod[THEN iffD2]) (fastforce dest: q_pos_lemma intro: split_mult_pos_le)
60930
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
   574
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   575
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   576
subsubsection \<open>Further properties\<close>
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   577
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   578
lemma div_int_pos_iff:
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   579
  "k div l \<ge> 0 \<longleftrightarrow> k = 0 \<or> l = 0 \<or> k \<ge> 0 \<and> l \<ge> 0
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   580
    \<or> k < 0 \<and> l < 0"
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   581
  for k l :: int
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   582
proof (cases "k = 0 \<or> l = 0")
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   583
  case False
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   584
  then show ?thesis
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   585
   apply (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff)
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   586
    by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   587
qed auto
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   588
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   589
lemma mod_int_pos_iff:
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   590
  "k mod l \<ge> 0 \<longleftrightarrow> l dvd k \<or> l = 0 \<and> k \<ge> 0 \<or> l > 0"
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   591
  for k l :: int
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   592
proof (cases "l > 0")
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   593
  case False
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   594
  then show ?thesis 
69695
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
   595
    by (simp add: dvd_eq_mod_eq_0) (use neg_mod_sign [of l k] in \<open>auto simp add: le_less not_less\<close>)
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   596
qed auto
66817
0b12755ccbb2 euclidean rings need no normalization
haftmann
parents: 66816
diff changeset
   597
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   598
text \<open>Simplify expressions in which div and mod combine numerical constants\<close>
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   599
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   600
lemma int_div_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a div b = q"
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   601
  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
   602
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   603
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
   604
  by (rule div_int_unique [of a b q r],
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   605
    simp add: eucl_rel_int_iff)
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   606
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   607
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
   608
  by (rule mod_int_unique [of a b q r],
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   609
    simp add: eucl_rel_int_iff)
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   610
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
   611
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
   612
  by (rule mod_int_unique [of a b q r],
64635
255741c5f862 more uniform div/mod relations
haftmann
parents: 64630
diff changeset
   613
    simp add: eucl_rel_int_iff)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   614
61944
5d06ecfdb472 prefer symbols for "abs";
wenzelm
parents: 61799
diff changeset
   615
lemma abs_div: "(y::int) dvd x \<Longrightarrow> \<bar>x div y\<bar> = \<bar>x\<bar> div \<bar>y\<bar>"
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   616
  unfolding dvd_def by (cases "y=0") (auto simp add: abs_mult)
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   617
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   618
text\<open>Suggested by Matthias Daum\<close>
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   619
lemma int_power_div_base:
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   620
  fixes k :: int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   621
  assumes "0 < m" "0 < k"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   622
  shows "k ^ m div k = (k::int) ^ (m - Suc 0)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   623
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   624
  have eq: "k ^ m = k ^ ((m - Suc 0) + Suc 0)"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   625
    by (simp add: assms)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   626
  show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   627
    using assms by (simp only: power_add eq) auto
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   628
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   629
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
   630
text\<open>Suggested by Matthias Daum\<close>
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   631
lemma int_div_less_self:
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   632
  fixes x::int
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   633
  assumes "0 < x" "1 < k"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   634
  shows  "x div k < x"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   635
proof -
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   636
  have "nat x div nat k < nat x"
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   637
    by (simp add: assms)
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   638
  with assms show ?thesis
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   639
    by (simp add: nat_div_distrib [symmetric])
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
   640
qed
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   641
66837
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   642
lemma mod_eq_dvd_iff_nat:
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   643
  "m mod q = n mod q \<longleftrightarrow> q dvd m - n" if "m \<ge> n" for m n q :: nat
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   644
proof -
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   645
  have "int m mod int q = int n mod int q \<longleftrightarrow> int q dvd int m - int n"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   646
    by (simp add: mod_eq_dvd_iff)
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   647
  with that have "int (m mod q) = int (n mod q) \<longleftrightarrow> int q dvd int (m - n)"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   648
    by (simp only: of_nat_mod of_nat_diff)
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   649
  then show ?thesis
67118
ccab07d1196c more simplification rules
haftmann
parents: 67091
diff changeset
   650
    by simp
66837
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   651
qed
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   652
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   653
lemma mod_eq_nat1E:
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   654
  fixes m n q :: nat
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   655
  assumes "m mod q = n mod q" and "m \<ge> n"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   656
  obtains s where "m = n + q * s"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   657
proof -
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   658
  from assms have "q dvd m - n"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   659
    by (simp add: mod_eq_dvd_iff_nat)
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   660
  then obtain s where "m - n = q * s" ..
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   661
  with \<open>m \<ge> n\<close> have "m = n + q * s"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   662
    by simp
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   663
  with that show thesis .
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   664
qed
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   665
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   666
lemma mod_eq_nat2E:
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   667
  fixes m n q :: nat
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   668
  assumes "m mod q = n mod q" and "n \<ge> m"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   669
  obtains s where "n = m + q * s"
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   670
  using assms mod_eq_nat1E [of n q m] by (auto simp add: ac_simps)
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   671
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   672
lemma nat_mod_eq_lemma:
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   673
  assumes "(x::nat) mod n = y mod n" and "y \<le> x"
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   674
  shows "\<exists>q. x = y + n * q"
66837
6ba663ff2b1c tuned proofs
haftmann
parents: 66817
diff changeset
   675
  using assms by (rule mod_eq_nat1E) rule
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   676
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
   677
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
   678
  (is "?lhs = ?rhs")
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   679
proof
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   680
  assume H: "x mod n = y mod n"
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   681
  {assume xy: "x \<le> y"
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   682
    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
   683
    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
   684
      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
   685
  moreover
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   686
  {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
   687
    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
   688
      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
   689
  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
   690
next
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   691
  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
   692
  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
   693
  thus  ?lhs by simp
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   694
qed
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
   695
72023
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   696
lemma take_bit_greater_eq:
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   697
  \<open>k + 2 ^ n \<le> take_bit n k\<close> if \<open>k < 0\<close> for k :: int
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   698
proof -
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   699
  have \<open>k + 2 ^ n \<le> take_bit n (k + 2 ^ n)\<close>
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   700
  proof (cases \<open>k > - (2 ^ n)\<close>)
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   701
    case False
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   702
    then have \<open>k + 2 ^ n \<le> 0\<close>
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   703
      by simp
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   704
    also note take_bit_nonnegative
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   705
    finally show ?thesis .
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   706
  next
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   707
    case True
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   708
    with that have \<open>0 \<le> k + 2 ^ n\<close> and \<open>k + 2 ^ n < 2 ^ n\<close>
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   709
      by simp_all
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   710
    then show ?thesis
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   711
      by (simp only: take_bit_eq_mod mod_pos_pos_trivial)
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   712
  qed
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   713
  then show ?thesis
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   714
    by (simp add: take_bit_eq_mod)
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   715
qed
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   716
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   717
lemma take_bit_less_eq:
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   718
  \<open>take_bit n k \<le> k - 2 ^ n\<close> if \<open>2 ^ n \<le> k\<close> and \<open>n > 0\<close> for k :: int
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   719
  using that zmod_le_nonneg_dividend [of \<open>k - 2 ^ n\<close> \<open>2 ^ n\<close>]
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   720
  by (simp add: take_bit_eq_mod)
08348e364739 more thms
haftmann
parents: 71991
diff changeset
   721
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66806
diff changeset
   722
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   723
subsection \<open>Numeral division with a pragmatic type class\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   724
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   725
text \<open>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   726
  The following type class contains everything necessary to formulate
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   727
  a division algorithm in ring structures with numerals, restricted
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   728
  to its positive segments.  This is its primary motivation, and it
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   729
  could surely be formulated using a more fine-grained, more algebraic
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   730
  and less technical class hierarchy.
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   731
\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   732
70340
7383930fc946 slightly more specialized name for type class
haftmann
parents: 69785
diff changeset
   733
class unique_euclidean_semiring_numeral = unique_euclidean_semiring_with_nat + linordered_semidom +
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   734
  assumes div_less: "0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a div b = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   735
    and mod_less: " 0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a mod b = a"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   736
    and div_positive: "0 < b \<Longrightarrow> b \<le> a \<Longrightarrow> a div b > 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   737
    and mod_less_eq_dividend: "0 \<le> a \<Longrightarrow> a mod b \<le> a"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   738
    and pos_mod_bound: "0 < b \<Longrightarrow> a mod b < b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   739
    and pos_mod_sign: "0 < b \<Longrightarrow> 0 \<le> a mod b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   740
    and mod_mult2_eq: "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   741
    and div_mult2_eq: "0 \<le> c \<Longrightarrow> a div (b * c) = a div b div c"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   742
  assumes discrete: "a < b \<longleftrightarrow> a + 1 \<le> b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   743
  fixes divmod :: "num \<Rightarrow> num \<Rightarrow> 'a \<times> 'a"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   744
    and divmod_step :: "num \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   745
  assumes divmod_def: "divmod m n = (numeral m div numeral n, numeral m mod numeral n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   746
    and divmod_step_def: "divmod_step l qr = (let (q, r) = qr
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   747
    in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   748
    else (2 * q, r))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   749
    \<comment> \<open>These are conceptually definitions but force generated code
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   750
    to be monomorphic wrt. particular instances of this class which
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   751
    yields a significant speedup.\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   752
begin
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   753
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   754
lemma divmod_digit_1:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   755
  assumes "0 \<le> a" "0 < b" and "b \<le> a mod (2 * b)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   756
  shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   757
    and "a mod (2 * b) - b = a mod b" (is "?Q")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   758
proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   759
  from assms mod_less_eq_dividend [of a "2 * b"] have "b \<le> a"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   760
    by (auto intro: trans)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   761
  with \<open>0 < b\<close> have "0 < a div b" by (auto intro: div_positive)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   762
  then have [simp]: "1 \<le> a div b" by (simp add: discrete)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   763
  with \<open>0 < b\<close> have mod_less: "a mod b < b" by (simp add: pos_mod_bound)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   764
  define w where "w = a div b mod 2"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   765
  then have w_exhaust: "w = 0 \<or> w = 1" by auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   766
  have mod_w: "a mod (2 * b) = a mod b + b * w"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   767
    by (simp add: w_def mod_mult2_eq ac_simps)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   768
  from assms w_exhaust have "w = 1"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   769
    by (auto simp add: mod_w) (insert mod_less, auto)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   770
  with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   771
  have "2 * (a div (2 * b)) = a div b - w"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   772
    by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   773
  with \<open>w = 1\<close> have div: "2 * (a div (2 * b)) = a div b - 1" by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   774
  then show ?P and ?Q
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   775
    by (simp_all add: div mod add_implies_diff [symmetric])
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   776
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   777
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   778
lemma divmod_digit_0:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   779
  assumes "0 < b" and "a mod (2 * b) < b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   780
  shows "2 * (a div (2 * b)) = a div b" (is "?P")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   781
    and "a mod (2 * b) = a mod b" (is "?Q")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   782
proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   783
  define w where "w = a div b mod 2"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   784
  then have w_exhaust: "w = 0 \<or> w = 1" by auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   785
  have mod_w: "a mod (2 * b) = a mod b + b * w"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   786
    by (simp add: w_def mod_mult2_eq ac_simps)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   787
  moreover have "b \<le> a mod b + b"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   788
  proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   789
    from \<open>0 < b\<close> pos_mod_sign have "0 \<le> a mod b" by blast
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   790
    then have "0 + b \<le> a mod b + b" by (rule add_right_mono)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   791
    then show ?thesis by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   792
  qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   793
  moreover note assms w_exhaust
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   794
  ultimately have "w = 0" by auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   795
  with mod_w have mod: "a mod (2 * b) = a mod b" by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   796
  have "2 * (a div (2 * b)) = a div b - w"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   797
    by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   798
  with \<open>w = 0\<close> have div: "2 * (a div (2 * b)) = a div b" by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   799
  then show ?P and ?Q
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   800
    by (simp_all add: div mod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   801
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   802
69785
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   803
lemma mod_double_modulus:
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   804
  assumes "m > 0" "x \<ge> 0"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   805
  shows   "x mod (2 * m) = x mod m \<or> x mod (2 * m) = x mod m + m"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   806
proof (cases "x mod (2 * m) < m")
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   807
  case True
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   808
  thus ?thesis using assms using divmod_digit_0(2)[of m x] by auto
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   809
next
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   810
  case False
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   811
  hence *: "x mod (2 * m) - m = x mod m"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   812
    using assms by (intro divmod_digit_1) auto
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   813
  hence "x mod (2 * m) = x mod m + m"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   814
    by (subst * [symmetric], subst le_add_diff_inverse2) (use False in auto)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   815
  thus ?thesis by simp
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   816
qed
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69695
diff changeset
   817
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   818
lemma fst_divmod:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   819
  "fst (divmod m n) = numeral m div numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   820
  by (simp add: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   821
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   822
lemma snd_divmod:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   823
  "snd (divmod m n) = numeral m mod numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   824
  by (simp add: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   825
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   826
text \<open>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   827
  This is a formulation of one step (referring to one digit position)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   828
  in school-method division: compare the dividend at the current
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   829
  digit position with the remainder from previous division steps
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   830
  and evaluate accordingly.
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   831
\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   832
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   833
lemma divmod_step_eq [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   834
  "divmod_step l (q, r) = (if numeral l \<le> r
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   835
    then (2 * q + 1, r - numeral l) else (2 * q, r))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   836
  by (simp add: divmod_step_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   837
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   838
text \<open>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   839
  This is a formulation of school-method division.
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   840
  If the divisor is smaller than the dividend, terminate.
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   841
  If not, shift the dividend to the right until termination
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   842
  occurs and then reiterate single division steps in the
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   843
  opposite direction.
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   844
\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   845
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   846
lemma divmod_divmod_step:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   847
  "divmod m n = (if m < n then (0, numeral m)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   848
    else divmod_step n (divmod m (Num.Bit0 n)))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   849
proof (cases "m < n")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   850
  case True then have "numeral m < numeral n" by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   851
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   852
    by (simp add: prod_eq_iff div_less mod_less fst_divmod snd_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   853
next
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   854
  case False
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   855
  have "divmod m n =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   856
    divmod_step n (numeral m div (2 * numeral n),
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   857
      numeral m mod (2 * numeral n))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   858
  proof (cases "numeral n \<le> numeral m mod (2 * numeral n)")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   859
    case True
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   860
    with divmod_step_eq
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   861
      have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   862
        (2 * (numeral m div (2 * numeral n)) + 1, numeral m mod (2 * numeral n) - numeral n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   863
        by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   864
    moreover from True divmod_digit_1 [of "numeral m" "numeral n"]
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   865
      have "2 * (numeral m div (2 * numeral n)) + 1 = numeral m div numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   866
      and "numeral m mod (2 * numeral n) - numeral n = numeral m mod numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   867
      by simp_all
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   868
    ultimately show ?thesis by (simp only: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   869
  next
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   870
    case False then have *: "numeral m mod (2 * numeral n) < numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   871
      by (simp add: not_le)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   872
    with divmod_step_eq
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   873
      have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   874
        (2 * (numeral m div (2 * numeral n)), numeral m mod (2 * numeral n))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   875
        by auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   876
    moreover from * divmod_digit_0 [of "numeral n" "numeral m"]
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   877
      have "2 * (numeral m div (2 * numeral n)) = numeral m div numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   878
      and "numeral m mod (2 * numeral n) = numeral m mod numeral n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   879
      by (simp_all only: zero_less_numeral)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   880
    ultimately show ?thesis by (simp only: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   881
  qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   882
  then have "divmod m n =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   883
    divmod_step n (numeral m div numeral (Num.Bit0 n),
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   884
      numeral m mod numeral (Num.Bit0 n))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   885
    by (simp only: numeral.simps distrib mult_1)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   886
  then have "divmod m n = divmod_step n (divmod m (Num.Bit0 n))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   887
    by (simp add: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   888
  with False show ?thesis by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   889
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   890
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   891
text \<open>The division rewrite proper -- first, trivial results involving \<open>1\<close>\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   892
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   893
lemma divmod_trivial [simp]:
71756
3d1f72d25fc3 more complete rules on numerals
haftmann
parents: 71148
diff changeset
   894
  "divmod m Num.One = (numeral m, 0)"
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   895
  "divmod num.One (num.Bit0 n) = (0, Numeral1)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   896
  "divmod num.One (num.Bit1 n) = (0, Numeral1)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   897
  using divmod_divmod_step [of "Num.One"] by (simp_all add: divmod_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   898
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   899
text \<open>Division by an even number is a right-shift\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   900
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   901
lemma divmod_cancel [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   902
  "divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r))" (is ?P)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   903
  "divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r + 1))" (is ?Q)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   904
proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   905
  have *: "\<And>q. numeral (Num.Bit0 q) = 2 * numeral q"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   906
    "\<And>q. numeral (Num.Bit1 q) = 2 * numeral q + 1"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   907
    by (simp_all only: numeral_mult numeral.simps distrib) simp_all
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   908
  have "1 div 2 = 0" "1 mod 2 = 1" by (auto intro: div_less mod_less)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   909
  then show ?P and ?Q
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   910
    by (simp_all add: fst_divmod snd_divmod prod_eq_iff split_def * [of m] * [of n] mod_mult_mult1
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   911
      div_mult2_eq [of _ _ 2] mod_mult2_eq [of _ _ 2]
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   912
      add.commute del: numeral_times_numeral)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   913
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   914
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   915
text \<open>The really hard work\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   916
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   917
lemma divmod_steps [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   918
  "divmod (num.Bit0 m) (num.Bit1 n) =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   919
      (if m \<le> n then (0, numeral (num.Bit0 m))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   920
       else divmod_step (num.Bit1 n)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   921
             (divmod (num.Bit0 m)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   922
               (num.Bit0 (num.Bit1 n))))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   923
  "divmod (num.Bit1 m) (num.Bit1 n) =
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   924
      (if m < n then (0, numeral (num.Bit1 m))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   925
       else divmod_step (num.Bit1 n)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   926
             (divmod (num.Bit1 m)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   927
               (num.Bit0 (num.Bit1 n))))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   928
  by (simp_all add: divmod_divmod_step)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   929
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   930
lemmas divmod_algorithm_code = divmod_step_eq divmod_trivial divmod_cancel divmod_steps  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   931
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   932
text \<open>Special case: divisibility\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   933
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   934
definition divides_aux :: "'a \<times> 'a \<Rightarrow> bool"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   935
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   936
  "divides_aux qr \<longleftrightarrow> snd qr = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   937
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   938
lemma divides_aux_eq [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   939
  "divides_aux (q, r) \<longleftrightarrow> r = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   940
  by (simp add: divides_aux_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   941
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   942
lemma dvd_numeral_simp [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   943
  "numeral m dvd numeral n \<longleftrightarrow> divides_aux (divmod n m)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   944
  by (simp add: divmod_def mod_eq_0_iff_dvd)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   945
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   946
text \<open>Generic computation of quotient and remainder\<close>  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   947
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   948
lemma numeral_div_numeral [simp]: 
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   949
  "numeral k div numeral l = fst (divmod k l)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   950
  by (simp add: fst_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   951
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   952
lemma numeral_mod_numeral [simp]: 
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   953
  "numeral k mod numeral l = snd (divmod k l)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   954
  by (simp add: snd_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   955
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   956
lemma one_div_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   957
  "1 div numeral n = fst (divmod num.One n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   958
  by (simp add: fst_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   959
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   960
lemma one_mod_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   961
  "1 mod numeral n = snd (divmod num.One n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   962
  by (simp add: snd_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   963
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   964
text \<open>Computing congruences modulo \<open>2 ^ q\<close>\<close>
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   965
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   966
lemma cong_exp_iff_simps:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   967
  "numeral n mod numeral Num.One = 0
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   968
    \<longleftrightarrow> True"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   969
  "numeral (Num.Bit0 n) mod numeral (Num.Bit0 q) = 0
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   970
    \<longleftrightarrow> numeral n mod numeral q = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   971
  "numeral (Num.Bit1 n) mod numeral (Num.Bit0 q) = 0
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   972
    \<longleftrightarrow> False"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   973
  "numeral m mod numeral Num.One = (numeral n mod numeral Num.One)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   974
    \<longleftrightarrow> True"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   975
  "numeral Num.One mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   976
    \<longleftrightarrow> True"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   977
  "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   978
    \<longleftrightarrow> False"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   979
  "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   980
    \<longleftrightarrow> (numeral n mod numeral q) = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   981
  "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   982
    \<longleftrightarrow> False"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   983
  "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   984
    \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   985
  "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   986
    \<longleftrightarrow> False"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   987
  "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   988
    \<longleftrightarrow> (numeral m mod numeral q) = 0"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   989
  "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   990
    \<longleftrightarrow> False"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   991
  "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   992
    \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   993
  by (auto simp add: case_prod_beta dest: arg_cong [of _ _ even])
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   994
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   995
end
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   996
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   997
hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   998
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
   999
instantiation nat :: unique_euclidean_semiring_numeral
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1000
begin
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1001
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1002
definition divmod_nat :: "num \<Rightarrow> num \<Rightarrow> nat \<times> nat"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1003
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1004
  divmod'_nat_def: "divmod_nat m n = (numeral m div numeral n, numeral m mod numeral n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1005
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1006
definition divmod_step_nat :: "num \<Rightarrow> nat \<times> nat \<Rightarrow> nat \<times> nat"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1007
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1008
  "divmod_step_nat l qr = (let (q, r) = qr
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1009
    in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1010
    else (2 * q, r))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1011
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1012
instance by standard
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1013
  (auto simp add: divmod'_nat_def divmod_step_nat_def div_greater_zero_iff div_mult2_eq mod_mult2_eq)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1014
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1015
end
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1016
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1017
declare divmod_algorithm_code [where ?'a = nat, code]
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1018
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1019
lemma Suc_0_div_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1020
  fixes k l :: num
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1021
  shows "Suc 0 div numeral k = fst (divmod Num.One k)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1022
  by (simp_all add: fst_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1023
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1024
lemma Suc_0_mod_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1025
  fixes k l :: num
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1026
  shows "Suc 0 mod numeral k = snd (divmod Num.One k)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1027
  by (simp_all add: snd_divmod)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1028
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1029
instantiation int :: unique_euclidean_semiring_numeral
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1030
begin
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1031
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1032
definition divmod_int :: "num \<Rightarrow> num \<Rightarrow> int \<times> int"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1033
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1034
  "divmod_int m n = (numeral m div numeral n, numeral m mod numeral n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1035
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1036
definition divmod_step_int :: "num \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1037
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1038
  "divmod_step_int l qr = (let (q, r) = qr
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1039
    in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1040
    else (2 * q, r))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1041
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1042
instance
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1043
  by standard (auto intro: zmod_le_nonneg_dividend simp add: divmod_int_def divmod_step_int_def
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1044
    pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1045
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1046
end
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1047
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1048
declare divmod_algorithm_code [where ?'a = int, code]
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1049
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1050
context
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1051
begin
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1052
  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1053
qualified definition adjust_div :: "int \<times> int \<Rightarrow> int"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1054
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1055
  "adjust_div qr = (let (q, r) = qr in q + of_bool (r \<noteq> 0))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1056
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1057
qualified lemma adjust_div_eq [simp, code]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1058
  "adjust_div (q, r) = q + of_bool (r \<noteq> 0)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1059
  by (simp add: adjust_div_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1060
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1061
qualified definition adjust_mod :: "int \<Rightarrow> int \<Rightarrow> int"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1062
where
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1063
  [simp]: "adjust_mod l r = (if r = 0 then 0 else l - r)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1064
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1065
lemma minus_numeral_div_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1066
  "- numeral m div numeral n = - (adjust_div (divmod m n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1067
proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1068
  have "int (fst (divmod m n)) = fst (divmod m n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1069
    by (simp only: fst_divmod divide_int_def) auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1070
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1071
    by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1072
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1073
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1074
lemma minus_numeral_mod_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1075
  "- numeral m mod numeral n = adjust_mod (numeral n) (snd (divmod m n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1076
proof (cases "snd (divmod m n) = (0::int)")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1077
  case True
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1078
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1079
    by (simp add: mod_eq_0_iff_dvd divides_aux_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1080
next
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1081
  case False
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1082
  then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1083
    by (simp only: snd_divmod modulo_int_def) auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1084
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1085
    by (simp add: divides_aux_def adjust_div_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1086
      (simp add: divides_aux_def modulo_int_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1087
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1088
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1089
lemma numeral_div_minus_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1090
  "numeral m div - numeral n = - (adjust_div (divmod m n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1091
proof -
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1092
  have "int (fst (divmod m n)) = fst (divmod m n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1093
    by (simp only: fst_divmod divide_int_def) auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1094
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1095
    by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1096
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1097
  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1098
lemma numeral_mod_minus_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1099
  "numeral m mod - numeral n = - adjust_mod (numeral n) (snd (divmod m n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1100
proof (cases "snd (divmod m n) = (0::int)")
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1101
  case True
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1102
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1103
    by (simp add: mod_eq_0_iff_dvd divides_aux_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1104
next
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1105
  case False
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1106
  then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1107
    by (simp only: snd_divmod modulo_int_def) auto
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1108
  then show ?thesis
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1109
    by (simp add: divides_aux_def adjust_div_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1110
      (simp add: divides_aux_def modulo_int_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1111
qed
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1112
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1113
lemma minus_one_div_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1114
  "- 1 div numeral n = - (adjust_div (divmod Num.One n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1115
  using minus_numeral_div_numeral [of Num.One n] by simp  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1116
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1117
lemma minus_one_mod_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1118
  "- 1 mod numeral n = adjust_mod (numeral n) (snd (divmod Num.One n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1119
  using minus_numeral_mod_numeral [of Num.One n] by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1120
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1121
lemma one_div_minus_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1122
  "1 div - numeral n = - (adjust_div (divmod Num.One n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1123
  using numeral_div_minus_numeral [of Num.One n] by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1124
  
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1125
lemma one_mod_minus_numeral [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1126
  "1 mod - numeral n = - adjust_mod (numeral n) (snd (divmod Num.One n) :: int)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1127
  using numeral_mod_minus_numeral [of Num.One n] by simp
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1128
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1129
end
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1130
71756
3d1f72d25fc3 more complete rules on numerals
haftmann
parents: 71148
diff changeset
  1131
lemma divmod_BitM_2_eq [simp]:
3d1f72d25fc3 more complete rules on numerals
haftmann
parents: 71148
diff changeset
  1132
  \<open>divmod (Num.BitM m) (Num.Bit0 Num.One) = (numeral m - 1, (1 :: int))\<close>
3d1f72d25fc3 more complete rules on numerals
haftmann
parents: 71148
diff changeset
  1133
  by (cases m) simp_all
3d1f72d25fc3 more complete rules on numerals
haftmann
parents: 71148
diff changeset
  1134
71757
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1135
lemma bit_numeral_Bit0_Suc_iff [simp]:
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1136
  \<open>bit (numeral (Num.Bit0 m) :: int) (Suc n) \<longleftrightarrow> bit (numeral m :: int) n\<close>
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1137
  by (simp add: bit_Suc)
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1138
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1139
lemma bit_numeral_Bit1_Suc_iff [simp]:
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1140
  \<open>bit (numeral (Num.Bit1 m) :: int) (Suc n) \<longleftrightarrow> bit (numeral m :: int) n\<close>
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1141
  by (simp add: bit_Suc)
02c50bba9304 bit on numerals
haftmann
parents: 71756
diff changeset
  1142
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1143
lemma div_positive_int:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1144
  "k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1145
  using that div_positive [of l k] by blast
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1146
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1147
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1148
subsubsection \<open>Dedicated simproc for calculation\<close>
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1149
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  1150
text \<open>
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1151
  There is space for improvement here: the calculation itself
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66806
diff changeset
  1152
  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
  1153
  (simplifier setup) for generic calculation would be helpful. 
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  1154
\<close>
53067
ee0b7c2315d2 type class for generic division algorithm on numerals
haftmann
parents: 53066
diff changeset
  1155
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1156
simproc_setup numeral_divmod
66806
a4e82b58d833 abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
haftmann
parents: 66801
diff changeset
  1157
  ("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
  1158
   "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
  1159
   "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
  1160
   "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
  1161
   "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
  1162
   "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
  1163
   "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
  1164
   "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
  1165
   "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
  1166
   "1 div - numeral b :: int" |"1 mod - numeral b :: int" |
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1167
   "- 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
  1168
   "- 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
  1169
   "- 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
  1170
   "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
  1171
   "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
  1172
   "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
  1173
   "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
  1174
   "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
  1175
   "- numeral a div 0 :: int" | "- numeral a mod 0 :: int" |
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1176
   "- numeral a div 1 :: int" | "- numeral a mod 1 :: int" |
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1177
   "- numeral a div - 1 :: int" | "- numeral a mod - 1 :: int" |
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1178
   "- 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
  1179
   "- 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
  1180
\<open> let
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69216
diff changeset
  1181
    val if_cong = the (Code.get_case_cong \<^theory> \<^const_name>\<open>If\<close>);
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1182
    fun successful_rewrite ctxt ct =
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1183
      let
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1184
        val thm = Simplifier.rewrite ctxt ct
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1185
      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
  1186
  in fn phi =>
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1187
    let
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1188
      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
  1189
        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
  1190
        one_div_minus_numeral one_mod_minus_numeral
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1191
        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
  1192
        numeral_div_minus_numeral numeral_mod_minus_numeral
60930
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1193
        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
  1194
        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
  1195
        divmod_cancel divmod_steps divmod_step_eq fst_conv snd_conv numeral_One
60930
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1196
        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
  1197
        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
  1198
        @ [@{lemma "0 = 0 \<longleftrightarrow> True" by simp}]);
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1199
      fun prepare_simpset ctxt = HOL_ss |> Simplifier.simpset_map ctxt
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1200
        (Simplifier.add_cong if_cong #> fold Simplifier.add_simp simps)
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1201
    in fn ctxt => successful_rewrite (Simplifier.put_simpset (prepare_simpset ctxt) ctxt) end
69216
1a52baa70aed clarified ML_Context.expression: it is a closed expression, not a let-declaration -- thus source positions are more accurate (amending d8849cfad60f, 162a4c2e97bc);
wenzelm
parents: 68644
diff changeset
  1202
  end
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1203
\<close>
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 33804
diff changeset
  1204
35673
178caf872f95 weakend class ring_div; tuned
haftmann
parents: 35644
diff changeset
  1205
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  1206
subsubsection \<open>Code generation\<close>
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
  1207
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1208
definition divmod_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1209
  where "divmod_nat m n = (m div n, m mod n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1210
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1211
lemma fst_divmod_nat [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1212
  "fst (divmod_nat m n) = m div n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1213
  by (simp add: divmod_nat_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1214
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1215
lemma snd_divmod_nat [simp]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1216
  "snd (divmod_nat m n) = m mod n"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1217
  by (simp add: divmod_nat_def)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1218
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1219
lemma divmod_nat_if [code]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1220
  "Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1221
    let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1222
  by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1223
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1224
lemma [code]:
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1225
  "m div n = fst (divmod_nat m n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1226
  "m mod n = snd (divmod_nat m n)"
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1227
  by simp_all
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1228
60868
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1229
lemma [code]:
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1230
  fixes k :: int
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1231
  shows 
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1232
    "k div 0 = 0"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1233
    "k mod 0 = k"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1234
    "0 div k = 0"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1235
    "0 mod k = 0"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1236
    "k div Int.Pos Num.One = k"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1237
    "k mod Int.Pos Num.One = 0"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1238
    "k div Int.Neg Num.One = - k"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1239
    "k mod Int.Neg Num.One = 0"
dd18c33c001e direct bootstrap of integer division from natural division
haftmann
parents: 60867
diff changeset
  1240
    "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
  1241
    "Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)"
60930
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1242
    "Int.Neg m div Int.Pos n = - (Divides.adjust_div (divmod m n) :: int)"
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1243
    "Int.Neg m mod Int.Pos n = Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1244
    "Int.Pos m div Int.Neg n = - (Divides.adjust_div (divmod m n) :: int)"
dd8ab7252ba2 qualified adjust_*
haftmann
parents: 60868
diff changeset
  1245
    "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
  1246
    "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
  1247
    "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
  1248
  by simp_all
53069
d165213e3924 execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
haftmann
parents: 53068
diff changeset
  1249
52435
6646bb548c6b migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents: 52398
diff changeset
  1250
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
  1251
  code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
33364
2bd12592c5e8 tuned code setup
haftmann
parents: 33361
diff changeset
  1252
64246
15d1ee6e847b eliminated irregular aliasses
haftmann
parents: 64244
diff changeset
  1253
72261
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1254
subsection \<open>More on bit operations\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1255
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1256
lemma take_bit_incr_eq:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1257
  \<open>take_bit n (k + 1) = 1 + take_bit n k\<close> if \<open>take_bit n k \<noteq> 2 ^ n - 1\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1258
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1259
proof -
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1260
  from that have \<open>2 ^ n \<noteq> k mod 2 ^ n + 1\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1261
    by (simp add: take_bit_eq_mod)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1262
  moreover have \<open>k mod 2 ^ n < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1263
    by simp
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1264
  ultimately have *: \<open>k mod 2 ^ n + 1 < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1265
    by linarith
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1266
  have \<open>(k + 1) mod 2 ^ n = (k mod 2 ^ n + 1) mod 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1267
    by (simp add: mod_simps)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1268
  also have \<open>\<dots> = k mod 2 ^ n + 1\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1269
    using * by (simp add: zmod_trival_iff)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1270
  finally have \<open>(k + 1) mod 2 ^ n = k mod 2 ^ n + 1\<close> .
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1271
  then show ?thesis
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1272
    by (simp add: take_bit_eq_mod)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1273
qed
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1274
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1275
lemma take_bit_decr_eq:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1276
  \<open>take_bit n (k - 1) = take_bit n k - 1\<close> if \<open>take_bit n k \<noteq> 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1277
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1278
proof -
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1279
  from that have \<open>k mod 2 ^ n \<noteq> 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1280
    by (simp add: take_bit_eq_mod)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1281
  moreover have \<open>k mod 2 ^ n \<ge> 0\<close> \<open>k mod 2 ^ n < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1282
    by simp_all
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1283
  ultimately have *: \<open>k mod 2 ^ n > 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1284
    by linarith
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1285
  have \<open>(k - 1) mod 2 ^ n = (k mod 2 ^ n - 1) mod 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1286
    by (simp add: mod_simps)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1287
  also have \<open>\<dots> = k mod 2 ^ n - 1\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1288
    by (simp add: zmod_trival_iff)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1289
      (use \<open>k mod 2 ^ n < 2 ^ n\<close> * in linarith)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1290
  finally have \<open>(k - 1) mod 2 ^ n = k mod 2 ^ n - 1\<close> .
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1291
  then show ?thesis
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1292
    by (simp add: take_bit_eq_mod)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1293
qed
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1294
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1295
lemma take_bit_int_less_eq_self_iff:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1296
  \<open>take_bit n k \<le> k \<longleftrightarrow> 0 \<le> k\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1297
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1298
proof
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1299
  assume ?P
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1300
  show ?Q
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1301
  proof (rule ccontr)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1302
    assume \<open>\<not> 0 \<le> k\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1303
    then have \<open>k < 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1304
      by simp
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1305
    with \<open>?P\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1306
    have \<open>take_bit n k < 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1307
      by (rule le_less_trans)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1308
    then show False
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1309
      by simp
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1310
  qed
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1311
next
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1312
  assume ?Q
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1313
  then show ?P
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1314
    by (simp add: take_bit_eq_mod zmod_le_nonneg_dividend)
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1315
qed
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1316
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1317
lemma take_bit_int_less_self_iff:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1318
  \<open>take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1319
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1320
  by (auto simp add: less_le take_bit_int_less_eq_self_iff take_bit_int_eq_self_iff
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1321
    intro: order_trans [of 0 \<open>2 ^ n\<close> k])
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1322
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1323
lemma take_bit_int_greater_self_iff:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1324
  \<open>k < take_bit n k \<longleftrightarrow> k < 0\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1325
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1326
  using take_bit_int_less_eq_self_iff [of n k] by auto
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1327
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1328
lemma take_bit_int_greater_eq_self_iff:
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1329
  \<open>k \<le> take_bit n k \<longleftrightarrow> k < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1330
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1331
  by (auto simp add: le_less take_bit_int_greater_self_iff take_bit_int_eq_self_iff
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1332
    dest: sym not_sym intro: less_trans [of k 0 \<open>2 ^ n\<close>])
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1333
5193570b739a more lemmas
haftmann
parents: 72187
diff changeset
  1334
68253
a8660a39e304 grouped material on numeral division
haftmann
parents: 68157
diff changeset
  1335
subsection \<open>Lemmas of doubtful value\<close>
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66806
diff changeset
  1336
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
  1337
lemma div_geq: "m div n = Suc ((m - n) div n)" if "0 < n" and " \<not> m < n" for m n :: nat
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66806
diff changeset
  1338
  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
  1339
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
  1340
lemma mod_geq: "m mod n = (m - n) mod n" if "\<not> m < n" for m n :: nat
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66806
diff changeset
  1341
  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
  1342
68631
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
  1343
lemma mod_eq_0D: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: nat
bc1369804692 de-applying
paulson <lp15@cam.ac.uk>
parents: 68626
diff changeset
  1344
  using that by (auto simp add: mod_eq_0_iff_dvd)
66816
212a3334e7da more fundamental definition of div and mod on int
haftmann
parents: 66815
diff changeset
  1345
69695
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1346
lemma pos_mod_conj: "0 < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b" for a b :: int
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1347
  by simp
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1348
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1349
lemma neg_mod_conj: "b < 0 \<Longrightarrow> a mod b \<le> 0 \<and> b < a mod b" for a b :: int
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1350
  by simp
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1351
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1352
lemma zmod_eq_0_iff: "m mod d = 0 \<longleftrightarrow> (\<exists>q. m = d * q)" for m d :: int
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1353
  by (auto simp add: mod_eq_0_iff_dvd)
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1354
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1355
(* REVISIT: should this be generalized to all semiring_div types? *)
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1356
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
  1357
  using that by auto
753ae9e9773d algebraized more material from theory Divides
haftmann
parents: 69593
diff changeset
  1358
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72023
diff changeset
  1359
find_theorems \<open>(?k::int) mod _ = ?k\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72023
diff changeset
  1360
33361
1f18de40b43f combined former theories Divides and IntDiv to one theory Divides
haftmann
parents: 33340
diff changeset
  1361
end