src/HOL/Euclidean_Division.thy
author wenzelm
Sun, 12 Mar 2017 18:50:02 +0100
changeset 65202 187277b77d50
parent 64785 ae0bbc8e45ad
child 66798 39bb2462e681
permissions -rw-r--r--
suppress vacuous messages;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
64785
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     1
(*  Title:      HOL/Euclidean_Division.thy
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     2
    Author:     Manuel Eberl, TU Muenchen
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     3
    Author:     Florian Haftmann, TU Muenchen
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     4
*)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     5
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     6
section \<open>Uniquely determined division in euclidean (semi)rings\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     7
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     8
theory Euclidean_Division
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
     9
  imports Nat_Transfer
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    10
begin
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    11
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    12
subsection \<open>Quotient and remainder in integral domains\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    13
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    14
class semidom_modulo = algebraic_semidom + semiring_modulo
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    15
begin
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    16
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    17
lemma mod_0 [simp]: "0 mod a = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    18
  using div_mult_mod_eq [of 0 a] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    19
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    20
lemma mod_by_0 [simp]: "a mod 0 = a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    21
  using div_mult_mod_eq [of a 0] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    22
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    23
lemma mod_by_1 [simp]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    24
  "a mod 1 = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    25
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    26
  from div_mult_mod_eq [of a one] div_by_1 have "a + a mod 1 = a" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    27
  then have "a + a mod 1 = a + 0" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    28
  then show ?thesis by (rule add_left_imp_eq)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    29
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    30
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    31
lemma mod_self [simp]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    32
  "a mod a = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    33
  using div_mult_mod_eq [of a a] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    34
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    35
lemma dvd_imp_mod_0 [simp]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    36
  assumes "a dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    37
  shows "b mod a = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    38
  using assms minus_div_mult_eq_mod [of b a] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    39
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    40
lemma mod_0_imp_dvd: 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    41
  assumes "a mod b = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    42
  shows   "b dvd a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    43
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    44
  have "b dvd ((a div b) * b)" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    45
  also have "(a div b) * b = a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    46
    using div_mult_mod_eq [of a b] by (simp add: assms)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    47
  finally show ?thesis .
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    48
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    49
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    50
lemma mod_eq_0_iff_dvd:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    51
  "a mod b = 0 \<longleftrightarrow> b dvd a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    52
  by (auto intro: mod_0_imp_dvd)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    53
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    54
lemma dvd_eq_mod_eq_0 [nitpick_unfold, code]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    55
  "a dvd b \<longleftrightarrow> b mod a = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    56
  by (simp add: mod_eq_0_iff_dvd)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    57
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    58
lemma dvd_mod_iff: 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    59
  assumes "c dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    60
  shows "c dvd a mod b \<longleftrightarrow> c dvd a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    61
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    62
  from assms have "(c dvd a mod b) \<longleftrightarrow> (c dvd ((a div b) * b + a mod b))" 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    63
    by (simp add: dvd_add_right_iff)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    64
  also have "(a div b) * b + a mod b = a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    65
    using div_mult_mod_eq [of a b] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    66
  finally show ?thesis .
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    67
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    68
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    69
lemma dvd_mod_imp_dvd:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    70
  assumes "c dvd a mod b" and "c dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    71
  shows "c dvd a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    72
  using assms dvd_mod_iff [of c b a] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    73
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    74
end
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    75
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    76
class idom_modulo = idom + semidom_modulo
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    77
begin
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    78
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    79
subclass idom_divide ..
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    80
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    81
lemma div_diff [simp]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    82
  "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> (a - b) div c = a div c - b div c"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    83
  using div_add [of _  _ "- b"] by (simp add: dvd_neg_div)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    84
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    85
end
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    86
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    87
  
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    88
subsection \<open>Euclidean (semi)rings with explicit division and remainder\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    89
  
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    90
class euclidean_semiring = semidom_modulo + normalization_semidom + 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    91
  fixes euclidean_size :: "'a \<Rightarrow> nat"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    92
  assumes size_0 [simp]: "euclidean_size 0 = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    93
  assumes mod_size_less: 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    94
    "b \<noteq> 0 \<Longrightarrow> euclidean_size (a mod b) < euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    95
  assumes size_mult_mono:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    96
    "b \<noteq> 0 \<Longrightarrow> euclidean_size a \<le> euclidean_size (a * b)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    97
begin
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    98
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
    99
lemma size_mult_mono': "b \<noteq> 0 \<Longrightarrow> euclidean_size a \<le> euclidean_size (b * a)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   100
  by (subst mult.commute) (rule size_mult_mono)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   101
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   102
lemma euclidean_size_normalize [simp]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   103
  "euclidean_size (normalize a) = euclidean_size a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   104
proof (cases "a = 0")
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   105
  case True
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   106
  then show ?thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   107
    by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   108
next
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   109
  case [simp]: False
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   110
  have "euclidean_size (normalize a) \<le> euclidean_size (normalize a * unit_factor a)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   111
    by (rule size_mult_mono) simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   112
  moreover have "euclidean_size a \<le> euclidean_size (a * (1 div unit_factor a))"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   113
    by (rule size_mult_mono) simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   114
  ultimately show ?thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   115
    by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   116
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   117
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   118
lemma dvd_euclidean_size_eq_imp_dvd:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   119
  assumes "a \<noteq> 0" and "euclidean_size a = euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   120
    and "b dvd a" 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   121
  shows "a dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   122
proof (rule ccontr)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   123
  assume "\<not> a dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   124
  hence "b mod a \<noteq> 0" using mod_0_imp_dvd [of b a] by blast
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   125
  then have "b mod a \<noteq> 0" by (simp add: mod_eq_0_iff_dvd)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   126
  from \<open>b dvd a\<close> have "b dvd b mod a" by (simp add: dvd_mod_iff)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   127
  then obtain c where "b mod a = b * c" unfolding dvd_def by blast
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   128
    with \<open>b mod a \<noteq> 0\<close> have "c \<noteq> 0" by auto
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   129
  with \<open>b mod a = b * c\<close> have "euclidean_size (b mod a) \<ge> euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   130
    using size_mult_mono by force
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   131
  moreover from \<open>\<not> a dvd b\<close> and \<open>a \<noteq> 0\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   132
  have "euclidean_size (b mod a) < euclidean_size a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   133
    using mod_size_less by blast
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   134
  ultimately show False using \<open>euclidean_size a = euclidean_size b\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   135
    by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   136
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   137
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   138
lemma euclidean_size_times_unit:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   139
  assumes "is_unit a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   140
  shows   "euclidean_size (a * b) = euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   141
proof (rule antisym)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   142
  from assms have [simp]: "a \<noteq> 0" by auto
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   143
  thus "euclidean_size (a * b) \<ge> euclidean_size b" by (rule size_mult_mono')
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   144
  from assms have "is_unit (1 div a)" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   145
  hence "1 div a \<noteq> 0" by (intro notI) simp_all
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   146
  hence "euclidean_size (a * b) \<le> euclidean_size ((1 div a) * (a * b))"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   147
    by (rule size_mult_mono')
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   148
  also from assms have "(1 div a) * (a * b) = b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   149
    by (simp add: algebra_simps unit_div_mult_swap)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   150
  finally show "euclidean_size (a * b) \<le> euclidean_size b" .
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   151
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   152
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   153
lemma euclidean_size_unit:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   154
  "is_unit a \<Longrightarrow> euclidean_size a = euclidean_size 1"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   155
  using euclidean_size_times_unit [of a 1] by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   156
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   157
lemma unit_iff_euclidean_size: 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   158
  "is_unit a \<longleftrightarrow> euclidean_size a = euclidean_size 1 \<and> a \<noteq> 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   159
proof safe
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   160
  assume A: "a \<noteq> 0" and B: "euclidean_size a = euclidean_size 1"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   161
  show "is_unit a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   162
    by (rule dvd_euclidean_size_eq_imp_dvd [OF A B]) simp_all
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   163
qed (auto intro: euclidean_size_unit)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   164
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   165
lemma euclidean_size_times_nonunit:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   166
  assumes "a \<noteq> 0" "b \<noteq> 0" "\<not> is_unit a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   167
  shows   "euclidean_size b < euclidean_size (a * b)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   168
proof (rule ccontr)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   169
  assume "\<not>euclidean_size b < euclidean_size (a * b)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   170
  with size_mult_mono'[OF assms(1), of b] 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   171
    have eq: "euclidean_size (a * b) = euclidean_size b" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   172
  have "a * b dvd b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   173
    by (rule dvd_euclidean_size_eq_imp_dvd [OF _ eq]) (insert assms, simp_all)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   174
  hence "a * b dvd 1 * b" by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   175
  with \<open>b \<noteq> 0\<close> have "is_unit a" by (subst (asm) dvd_times_right_cancel_iff)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   176
  with assms(3) show False by contradiction
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   177
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   178
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   179
lemma dvd_imp_size_le:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   180
  assumes "a dvd b" "b \<noteq> 0" 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   181
  shows   "euclidean_size a \<le> euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   182
  using assms by (auto elim!: dvdE simp: size_mult_mono)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   183
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   184
lemma dvd_proper_imp_size_less:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   185
  assumes "a dvd b" "\<not> b dvd a" "b \<noteq> 0" 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   186
  shows   "euclidean_size a < euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   187
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   188
  from assms(1) obtain c where "b = a * c" by (erule dvdE)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   189
  hence z: "b = c * a" by (simp add: mult.commute)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   190
  from z assms have "\<not>is_unit c" by (auto simp: mult.commute mult_unit_dvd_iff)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   191
  with z assms show ?thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   192
    by (auto intro!: euclidean_size_times_nonunit)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   193
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   194
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   195
end
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   196
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   197
class euclidean_ring = idom_modulo + euclidean_semiring
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   198
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   199
  
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   200
subsection \<open>Uniquely determined division\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   201
  
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   202
class unique_euclidean_semiring = euclidean_semiring + 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   203
  fixes uniqueness_constraint :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   204
  assumes size_mono_mult:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   205
    "b \<noteq> 0 \<Longrightarrow> euclidean_size a < euclidean_size c
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   206
      \<Longrightarrow> euclidean_size (a * b) < euclidean_size (c * b)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   207
    -- \<open>FIXME justify\<close>
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   208
  assumes uniqueness_constraint_mono_mult:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   209
    "uniqueness_constraint a b \<Longrightarrow> uniqueness_constraint (a * c) (b * c)"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   210
  assumes uniqueness_constraint_mod:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   211
    "b \<noteq> 0 \<Longrightarrow> \<not> b dvd a \<Longrightarrow> uniqueness_constraint (a mod b) b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   212
  assumes div_bounded:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   213
    "b \<noteq> 0 \<Longrightarrow> uniqueness_constraint r b
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   214
    \<Longrightarrow> euclidean_size r < euclidean_size b
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   215
    \<Longrightarrow> (q * b + r) div b = q"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   216
begin
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   217
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   218
lemma divmod_cases [case_names divides remainder by0]:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   219
  obtains 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   220
    (divides) q where "b \<noteq> 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   221
      and "a div b = q"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   222
      and "a mod b = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   223
      and "a = q * b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   224
  | (remainder) q r where "b \<noteq> 0" and "r \<noteq> 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   225
      and "uniqueness_constraint r b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   226
      and "euclidean_size r < euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   227
      and "a div b = q"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   228
      and "a mod b = r"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   229
      and "a = q * b + r"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   230
  | (by0) "b = 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   231
proof (cases "b = 0")
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   232
  case True
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   233
  then show thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   234
  by (rule by0)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   235
next
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   236
  case False
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   237
  show thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   238
  proof (cases "b dvd a")
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   239
    case True
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   240
    then obtain q where "a = b * q" ..
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   241
    with \<open>b \<noteq> 0\<close> divides
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   242
    show thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   243
      by (simp add: ac_simps)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   244
  next
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   245
    case False
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   246
    then have "a mod b \<noteq> 0"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   247
      by (simp add: mod_eq_0_iff_dvd)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   248
    moreover from \<open>b \<noteq> 0\<close> \<open>\<not> b dvd a\<close> have "uniqueness_constraint (a mod b) b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   249
      by (rule uniqueness_constraint_mod)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   250
    moreover have "euclidean_size (a mod b) < euclidean_size b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   251
      using \<open>b \<noteq> 0\<close> by (rule mod_size_less)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   252
    moreover have "a = a div b * b + a mod b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   253
      by (simp add: div_mult_mod_eq)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   254
    ultimately show thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   255
      using \<open>b \<noteq> 0\<close> by (blast intro: remainder)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   256
  qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   257
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   258
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   259
lemma div_eqI:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   260
  "a div b = q" if "b \<noteq> 0" "uniqueness_constraint r b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   261
    "euclidean_size r < euclidean_size b" "q * b + r = a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   262
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   263
  from that have "(q * b + r) div b = q"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   264
    by (auto intro: div_bounded)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   265
  with that show ?thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   266
    by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   267
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   268
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   269
lemma mod_eqI:
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   270
  "a mod b = r" if "b \<noteq> 0" "uniqueness_constraint r b"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   271
    "euclidean_size r < euclidean_size b" "q * b + r = a" 
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   272
proof -
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   273
  from that have "a div b = q"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   274
    by (rule div_eqI)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   275
  moreover have "a div b * b + a mod b = a"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   276
    by (fact div_mult_mod_eq)
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   277
  ultimately have "a div b * b + a mod b = a div b * b + r"
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   278
    using \<open>q * b + r = a\<close> by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   279
  then show ?thesis
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   280
    by simp
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   281
qed
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   282
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   283
end
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   284
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   285
class unique_euclidean_ring = euclidean_ring + unique_euclidean_semiring
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   286
ae0bbc8e45ad moved euclidean ring to HOL
haftmann
parents:
diff changeset
   287
end