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