src/HOL/GCD.thy
author wenzelm
Wed, 12 Mar 2025 11:39:00 +0100
changeset 82265 4b875a4c83b0
parent 81125 ec121999a9cb
child 82446 2aab65a687ec
permissions -rw-r--r--
update for release;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     1
(*  Title:      HOL/GCD.thy
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     2
    Author:     Christophe Tabacznyj
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     3
    Author:     Lawrence C. Paulson
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     4
    Author:     Amine Chaieb
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     5
    Author:     Thomas M. Rasmussen
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     6
    Author:     Jeremy Avigad
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
     7
    Author:     Tobias Nipkow
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
     8
32479
521cc9bf2958 some reorganization of number theory
haftmann
parents: 32415
diff changeset
     9
This file deals with the functions gcd and lcm.  Definitions and
521cc9bf2958 some reorganization of number theory
haftmann
parents: 32415
diff changeset
    10
lemmas are proved uniformly for the natural numbers and integers.
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    11
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    12
This file combines and revises a number of prior developments.
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    13
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    14
The original theories "GCD" and "Primes" were by Christophe Tabacznyj
58623
2db1df2c8467 more bibtex entries;
wenzelm
parents: 57514
diff changeset
    15
and Lawrence C. Paulson, based on @{cite davenport92}. They introduced
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    16
gcd, lcm, and prime for the natural numbers.
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    17
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    18
The original theory "IntPrimes" was by Thomas M. Rasmussen, and
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    19
extended gcd, lcm, primes to the integers. Amine Chaieb provided
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    20
another extension of the notions to the integers, and added a number
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    21
of results to "Primes" and "GCD". IntPrimes also defined and developed
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    22
the congruence relations on the integers. The notion was extended to
34915
7894c7dab132 Adapted to changes in induct method.
berghofe
parents: 34223
diff changeset
    23
the natural numbers by Chaieb.
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    24
32036
8a9228872fbd Moved factorial lemmas from Binomial.thy to Fact.thy and merged.
avigad
parents: 31952
diff changeset
    25
Jeremy Avigad combined all of these, made everything uniform for the
8a9228872fbd Moved factorial lemmas from Binomial.thy to Fact.thy and merged.
avigad
parents: 31952
diff changeset
    26
natural numbers and the integers, and added a number of new theorems.
8a9228872fbd Moved factorial lemmas from Binomial.thy to Fact.thy and merged.
avigad
parents: 31952
diff changeset
    27
31798
fe9a3043d36c Cleaned up GCD
nipkow
parents: 31766
diff changeset
    28
Tobias Nipkow cleaned up a lot.
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
    29
*)
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
    30
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
    31
section \<open>Greatest common divisor and least common multiple\<close>
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
    32
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
    33
theory GCD
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 73109
diff changeset
    34
  imports Groups_List Code_Numeral
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    35
begin
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
    36
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    37
subsection \<open>Abstract bounded quasi semilattices as common foundation\<close>
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
    38
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
    39
locale bounded_quasi_semilattice = abel_semigroup +
80932
261cd8722677 standardize mixfix annotations via "isabelle update -u mixfix_cartouches -l Pure HOL" --- to simplify systematic editing;
wenzelm
parents: 80771
diff changeset
    40
  fixes top :: 'a  (\<open>\<^bold>\<top>\<close>) and bot :: 'a  (\<open>\<^bold>\<bottom>\<close>)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    41
    and normalize :: "'a \<Rightarrow> 'a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    42
  assumes idem_normalize [simp]: "a \<^bold>* a = normalize a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    43
    and normalize_left_idem [simp]: "normalize a \<^bold>* b = a \<^bold>* b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    44
    and normalize_idem [simp]: "normalize (a \<^bold>* b) = a \<^bold>* b"
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    45
    and normalize_top [simp]: "normalize \<^bold>\<top> = \<^bold>\<top>"
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    46
    and normalize_bottom [simp]: "normalize \<^bold>\<bottom> = \<^bold>\<bottom>"
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    47
    and top_left_normalize [simp]: "\<^bold>\<top> \<^bold>* a = normalize a"
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    48
    and bottom_left_bottom [simp]: "\<^bold>\<bottom> \<^bold>* a = \<^bold>\<bottom>"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    49
begin
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    50
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    51
lemma left_idem [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    52
  "a \<^bold>* (a \<^bold>* b) = a \<^bold>* b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    53
  using assoc [of a a b, symmetric] by simp
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    54
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    55
lemma right_idem [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    56
  "(a \<^bold>* b) \<^bold>* b = a \<^bold>* b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    57
  using left_idem [of b a] by (simp add: ac_simps)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    58
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    59
lemma comp_fun_idem: "comp_fun_idem f"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    60
  by standard (simp_all add: fun_eq_iff ac_simps)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    61
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    62
interpretation comp_fun_idem f
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    63
  by (fact comp_fun_idem)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    64
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    65
lemma top_right_normalize [simp]:
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    66
  "a \<^bold>* \<^bold>\<top> = normalize a"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    67
  using top_left_normalize [of a] by (simp add: ac_simps)
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
    68
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    69
lemma bottom_right_bottom [simp]:
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    70
  "a \<^bold>* \<^bold>\<bottom> = \<^bold>\<bottom>"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    71
  using bottom_left_bottom [of a] by (simp add: ac_simps)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    72
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    73
lemma normalize_right_idem [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    74
  "a \<^bold>* normalize b = a \<^bold>* b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    75
  using normalize_left_idem [of b a] by (simp add: ac_simps)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    76
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
    77
end
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    78
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    79
locale bounded_quasi_semilattice_set = bounded_quasi_semilattice
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    80
begin
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    81
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    82
interpretation comp_fun_idem f
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    83
  by (fact comp_fun_idem)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    84
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    85
definition F :: "'a set \<Rightarrow> 'a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    86
where
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    87
  eq_fold: "F A = (if finite A then Finite_Set.fold f \<^bold>\<top> A else \<^bold>\<bottom>)"
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    88
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    89
lemma infinite [simp]:
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    90
  "infinite A \<Longrightarrow> F A = \<^bold>\<bottom>"
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    91
  by (simp add: eq_fold)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    92
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    93
lemma set_eq_fold [code]:
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    94
  "F (set xs) = fold f xs \<^bold>\<top>"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    95
  by (simp add: eq_fold fold_set_fold)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    96
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    97
lemma empty [simp]:
65555
85ed070017b7 include GCD as integral part of computational algebra in session HOL
haftmann
parents: 65552
diff changeset
    98
  "F {} = \<^bold>\<top>"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
    99
  by (simp add: eq_fold)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   100
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   101
lemma insert [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   102
  "F (insert a A) = a \<^bold>* F A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   103
  by (cases "finite A") (simp_all add: eq_fold)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   104
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   105
lemma normalize [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   106
  "normalize (F A) = F A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   107
  by (induct A rule: infinite_finite_induct) simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   108
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   109
lemma in_idem:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   110
  assumes "a \<in> A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   111
  shows "a \<^bold>* F A = F A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   112
  using assms by (induct A rule: infinite_finite_induct)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   113
    (auto simp: left_commute [of a])
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   114
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   115
lemma union:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   116
  "F (A \<union> B) = F A \<^bold>* F B"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   117
  by (induct A rule: infinite_finite_induct)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   118
    (simp_all add: ac_simps)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   119
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   120
lemma remove:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   121
  assumes "a \<in> A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   122
  shows "F A = a \<^bold>* F (A - {a})"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   123
proof -
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   124
  from assms obtain B where "A = insert a B" and "a \<notin> B"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   125
    by (blast dest: mk_disjoint_insert)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   126
  with assms show ?thesis by simp
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   127
qed
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   128
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   129
lemma insert_remove:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   130
  "F (insert a A) = a \<^bold>* F (A - {a})"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   131
  by (cases "a \<in> A") (simp_all add: insert_absorb remove)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   132
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   133
lemma subset:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   134
  assumes "B \<subseteq> A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   135
  shows "F B \<^bold>* F A = F A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   136
  using assms by (simp add: union [symmetric] Un_absorb1)
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
   137
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   138
end
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   139
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   140
subsection \<open>Abstract GCD and LCM\<close>
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
   141
31992
f8aed98faae7 More about gcd/lcm, and some cleaning up
nipkow
parents: 31952
diff changeset
   142
class gcd = zero + one + dvd +
41550
efa734d9b221 eliminated global prems;
wenzelm
parents: 37770
diff changeset
   143
  fixes gcd :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
efa734d9b221 eliminated global prems;
wenzelm
parents: 37770
diff changeset
   144
    and lcm :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
   145
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   146
class Gcd = gcd +
63025
92680537201f capitalized GCD and LCM syntax
haftmann
parents: 62429
diff changeset
   147
  fixes Gcd :: "'a set \<Rightarrow> 'a"
92680537201f capitalized GCD and LCM syntax
haftmann
parents: 62429
diff changeset
   148
    and Lcm :: "'a set \<Rightarrow> 'a"
62350
66a381d3f88f more sophisticated GCD syntax
haftmann
parents: 62349
diff changeset
   149
66a381d3f88f more sophisticated GCD syntax
haftmann
parents: 62349
diff changeset
   150
syntax
80934
8e72f55295fd more inner syntax markup: HOL;
wenzelm
parents: 80932
diff changeset
   151
  "_GCD1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           (\<open>(\<open>indent=3 notation=\<open>binder GCD\<close>\<close>GCD _./ _)\<close> [0, 10] 10)
8e72f55295fd more inner syntax markup: HOL;
wenzelm
parents: 80932
diff changeset
   152
  "_GCD"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  (\<open>(\<open>indent=3 notation=\<open>binder GCD\<close>\<close>GCD _\<in>_./ _)\<close> [0, 0, 10] 10)
8e72f55295fd more inner syntax markup: HOL;
wenzelm
parents: 80932
diff changeset
   153
  "_LCM1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           (\<open>(\<open>indent=3 notation=\<open>binder LCM\<close>\<close>LCM _./ _)\<close> [0, 10] 10)
8e72f55295fd more inner syntax markup: HOL;
wenzelm
parents: 80932
diff changeset
   154
  "_LCM"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  (\<open>(\<open>indent=3 notation=\<open>binder LCM\<close>\<close>LCM _\<in>_./ _)\<close> [0, 0, 10] 10)
68795
210b687cdbbe dropped redundant syntax translation rules for big operators
haftmann
parents: 68708
diff changeset
   155
80760
be8c0e039a5e more markup for syntax consts;
wenzelm
parents: 80084
diff changeset
   156
syntax_consts
be8c0e039a5e more markup for syntax consts;
wenzelm
parents: 80084
diff changeset
   157
  "_GCD1" "_GCD" \<rightleftharpoons> Gcd and
be8c0e039a5e more markup for syntax consts;
wenzelm
parents: 80084
diff changeset
   158
  "_LCM1" "_LCM" \<rightleftharpoons> Lcm
be8c0e039a5e more markup for syntax consts;
wenzelm
parents: 80084
diff changeset
   159
62350
66a381d3f88f more sophisticated GCD syntax
haftmann
parents: 62349
diff changeset
   160
translations
68796
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   161
  "GCD x y. f"   \<rightleftharpoons> "GCD x. GCD y. f"
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   162
  "GCD x. f"     \<rightleftharpoons> "CONST Gcd (CONST range (\<lambda>x. f))"
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   163
  "GCD x\<in>A. f"   \<rightleftharpoons> "CONST Gcd ((\<lambda>x. f) ` A)"
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   164
  "LCM x y. f"   \<rightleftharpoons> "LCM x. LCM y. f"
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   165
  "LCM x. f"     \<rightleftharpoons> "CONST Lcm (CONST range (\<lambda>x. f))"
9ca183045102 simplified syntax setup for big operators under image, retaining input abbreviations for backward compatibility
haftmann
parents: 68795
diff changeset
   166
  "LCM x\<in>A. f"   \<rightleftharpoons> "CONST Lcm ((\<lambda>x. f) ` A)"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   167
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   168
class semiring_gcd = normalization_semidom + gcd +
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
   169
  assumes gcd_dvd1 [iff]: "gcd a b dvd a"
59977
ad2d1cd53877 eliminated hard tabs;
wenzelm
parents: 59807
diff changeset
   170
    and gcd_dvd2 [iff]: "gcd a b dvd b"
ad2d1cd53877 eliminated hard tabs;
wenzelm
parents: 59807
diff changeset
   171
    and gcd_greatest: "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> c dvd gcd a b"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   172
    and normalize_gcd [simp]: "normalize (gcd a b) = gcd a b"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   173
    and lcm_gcd: "lcm a b = normalize (a * b div gcd a b)"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   174
begin
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   175
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   176
lemma gcd_greatest_iff [simp]: "a dvd gcd b c \<longleftrightarrow> a dvd b \<and> a dvd c"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   177
  by (blast intro!: gcd_greatest intro: dvd_trans)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   178
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   179
lemma gcd_dvdI1: "a dvd c \<Longrightarrow> gcd a b dvd c"
60689
8a2d7c04d8c0 more cautious use of [iff] declarations
haftmann
parents: 60688
diff changeset
   180
  by (rule dvd_trans) (rule gcd_dvd1)
8a2d7c04d8c0 more cautious use of [iff] declarations
haftmann
parents: 60688
diff changeset
   181
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   182
lemma gcd_dvdI2: "b dvd c \<Longrightarrow> gcd a b dvd c"
60689
8a2d7c04d8c0 more cautious use of [iff] declarations
haftmann
parents: 60688
diff changeset
   183
  by (rule dvd_trans) (rule gcd_dvd2)
8a2d7c04d8c0 more cautious use of [iff] declarations
haftmann
parents: 60688
diff changeset
   184
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   185
lemma dvd_gcdD1: "a dvd gcd b c \<Longrightarrow> a dvd b"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   186
  using gcd_dvd1 [of b c] by (blast intro: dvd_trans)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   187
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   188
lemma dvd_gcdD2: "a dvd gcd b c \<Longrightarrow> a dvd c"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   189
  using gcd_dvd2 [of b c] by (blast intro: dvd_trans)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   190
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   191
lemma gcd_0_left [simp]: "gcd 0 a = normalize a"
60688
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   192
  by (rule associated_eqI) simp_all
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   193
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   194
lemma gcd_0_right [simp]: "gcd a 0 = normalize a"
60688
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   195
  by (rule associated_eqI) simp_all
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   196
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   197
lemma gcd_eq_0_iff [simp]: "gcd a b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   198
  (is "?P \<longleftrightarrow> ?Q")
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   199
proof
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   200
  assume ?P
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   201
  then have "0 dvd gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   202
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   203
  then have "0 dvd a" and "0 dvd b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   204
    by (blast intro: dvd_trans)+
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   205
  then show ?Q
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   206
    by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   207
next
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   208
  assume ?Q
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   209
  then show ?P
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   210
    by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   211
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   212
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   213
lemma unit_factor_gcd: "unit_factor (gcd a b) = (if a = 0 \<and> b = 0 then 0 else 1)"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   214
proof (cases "gcd a b = 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   215
  case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   216
  then show ?thesis by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   217
next
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   218
  case False
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   219
  have "unit_factor (gcd a b) * normalize (gcd a b) = gcd a b"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   220
    by (rule unit_factor_mult_normalize)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   221
  then have "unit_factor (gcd a b) * gcd a b = gcd a b"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   222
    by simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   223
  then have "unit_factor (gcd a b) * gcd a b div gcd a b = gcd a b div gcd a b"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   224
    by simp
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   225
  with False show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   226
    by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   227
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   228
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
   229
lemma is_unit_gcd_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
   230
  "is_unit (gcd a b) \<longleftrightarrow> gcd a b = 1"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   231
  by (cases "a = 0 \<and> b = 0") (auto simp: unit_factor_gcd dest: is_unit_unit_factor)
60690
a9e45c9588c3 tuned facts
haftmann
parents: 60689
diff changeset
   232
61605
1bf7b186542e qualifier is mandatory by default;
wenzelm
parents: 61566
diff changeset
   233
sublocale gcd: abel_semigroup gcd
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   234
proof
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   235
  fix a b c
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   236
  show "gcd a b = gcd b a"
60688
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   237
    by (rule associated_eqI) simp_all
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   238
  from gcd_dvd1 have "gcd (gcd a b) c dvd a"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   239
    by (rule dvd_trans) simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   240
  moreover from gcd_dvd1 have "gcd (gcd a b) c dvd b"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   241
    by (rule dvd_trans) simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   242
  ultimately have P1: "gcd (gcd a b) c dvd gcd a (gcd b c)"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   243
    by (auto intro!: gcd_greatest)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   244
  from gcd_dvd2 have "gcd a (gcd b c) dvd b"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   245
    by (rule dvd_trans) simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   246
  moreover from gcd_dvd2 have "gcd a (gcd b c) dvd c"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   247
    by (rule dvd_trans) simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   248
  ultimately have P2: "gcd a (gcd b c) dvd gcd (gcd a b) c"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   249
    by (auto intro!: gcd_greatest)
60688
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   250
  from P1 P2 show "gcd (gcd a b) c = gcd a (gcd b c)"
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   251
    by (rule associated_eqI) simp_all
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   252
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   253
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   254
sublocale gcd: bounded_quasi_semilattice gcd 0 1 normalize
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   255
proof
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   256
  show "gcd a a = normalize a" for a
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   257
  proof -
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   258
    have "a dvd gcd a a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   259
      by (rule gcd_greatest) simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   260
    then show ?thesis
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   261
      by (auto intro: associated_eqI)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   262
  qed
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   263
  show "gcd (normalize a) b = gcd a b" for a b
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   264
    using gcd_dvd1 [of "normalize a" b]
60688
01488b559910 avoid explicit definition of the relation of associated elements in a ring -- prefer explicit normalization instead
haftmann
parents: 60687
diff changeset
   265
    by (auto intro: associated_eqI)
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
   266
  show "gcd 1 a = 1" for a
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   267
    by (rule associated_eqI) simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   268
qed simp_all
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
   269
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   270
lemma gcd_self: "gcd a a = normalize a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   271
  by (fact gcd.idem_normalize)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   272
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   273
lemma gcd_left_idem: "gcd a (gcd a b) = gcd a b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   274
  by (fact gcd.left_idem)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   275
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   276
lemma gcd_right_idem: "gcd (gcd a b) b = gcd a b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   277
  by (fact gcd.right_idem)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   278
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   279
lemma gcdI:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   280
  assumes "c dvd a" and "c dvd b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   281
    and greatest: "\<And>d. d dvd a \<Longrightarrow> d dvd b \<Longrightarrow> d dvd c"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   282
    and "normalize c = c"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   283
  shows "c = gcd a b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   284
  by (rule associated_eqI) (auto simp: assms intro: gcd_greatest)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   285
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   286
lemma gcd_unique:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   287
  "d dvd a \<and> d dvd b \<and> normalize d = d \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   288
  by rule (auto intro: gcdI simp: gcd_greatest)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   289
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   290
lemma gcd_dvd_prod: "gcd a b dvd k * b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   291
  using mult_dvd_mono [of 1] by auto
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   292
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   293
lemma gcd_proj2_if_dvd: "b dvd a \<Longrightarrow> gcd a b = normalize b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   294
  by (rule gcdI [symmetric]) simp_all
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   295
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   296
lemma gcd_proj1_if_dvd: "a dvd b \<Longrightarrow> gcd a b = normalize a"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   297
  by (rule gcdI [symmetric]) simp_all
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   298
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   299
lemma gcd_proj1_iff: "gcd m n = normalize m \<longleftrightarrow> m dvd n"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   300
proof
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   301
  assume *: "gcd m n = normalize m"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   302
  show "m dvd n"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   303
  proof (cases "m = 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   304
    case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   305
    with * show ?thesis by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   306
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   307
    case [simp]: False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   308
    from * have **: "m = gcd m n * unit_factor m"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   309
      by (simp add: unit_eq_div2)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   310
    show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   311
      by (subst **) (simp add: mult_unit_dvd_iff)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   312
  qed
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   313
next
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   314
  assume "m dvd n"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   315
  then show "gcd m n = normalize m"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   316
    by (rule gcd_proj1_if_dvd)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   317
qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   318
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   319
lemma gcd_proj2_iff: "gcd m n = normalize n \<longleftrightarrow> n dvd m"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   320
  using gcd_proj1_iff [of n m] by (simp add: ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   321
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   322
lemma gcd_mult_left: "gcd (c * a) (c * b) = normalize (c * gcd a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   323
proof (cases "c = 0")
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   324
  case True
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   325
  then show ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   326
next
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   327
  case False
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   328
  then have *: "c * gcd a b dvd gcd (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   329
    by (auto intro: gcd_greatest)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   330
  moreover from False * have "gcd (c * a) (c * b) dvd c * gcd a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   331
    by (metis div_dvd_iff_mult dvd_mult_left gcd_dvd1 gcd_dvd2 gcd_greatest mult_commute)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   332
  ultimately have "normalize (gcd (c * a) (c * b)) = normalize (c * gcd a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   333
    by (auto intro: associated_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   334
  then show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   335
    by (simp add: normalize_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   336
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   337
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   338
lemma gcd_mult_right: "gcd (a * c) (b * c) = normalize (gcd b a * c)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   339
  using gcd_mult_left [of c a b] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   340
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   341
lemma dvd_lcm1 [iff]: "a dvd lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   342
  by (metis div_mult_swap dvd_mult2 dvd_normalize_iff dvd_refl gcd_dvd2 lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   343
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   344
lemma dvd_lcm2 [iff]: "b dvd lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   345
  by (metis dvd_div_mult dvd_mult dvd_normalize_iff dvd_refl gcd_dvd1 lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   346
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   347
lemma dvd_lcmI1: "a dvd b \<Longrightarrow> a dvd lcm b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   348
  by (rule dvd_trans) (assumption, blast)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   349
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   350
lemma dvd_lcmI2: "a dvd c \<Longrightarrow> a dvd lcm b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   351
  by (rule dvd_trans) (assumption, blast)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   352
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   353
lemma lcm_dvdD1: "lcm a b dvd c \<Longrightarrow> a dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   354
  using dvd_lcm1 [of a b] by (blast intro: dvd_trans)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   355
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   356
lemma lcm_dvdD2: "lcm a b dvd c \<Longrightarrow> b dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   357
  using dvd_lcm2 [of a b] by (blast intro: dvd_trans)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   358
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   359
lemma lcm_least:
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   360
  assumes "a dvd c" and "b dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   361
  shows "lcm a b dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   362
proof (cases "c = 0")
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   363
  case True
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   364
  then show ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   365
next
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   366
  case False
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   367
  then have *: "is_unit (unit_factor c)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   368
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   369
  show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   370
  proof (cases "gcd a b = 0")
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   371
    case True
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   372
    with assms show ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   373
  next
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   374
    case False
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   375
    have "a * b dvd normalize (c * gcd a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   376
      using assms by (subst gcd_mult_left [symmetric]) (auto intro!: gcd_greatest simp: mult_ac)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   377
    with False have "(a * b div gcd a b) dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   378
      by (subst div_dvd_iff_mult) auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   379
    thus ?thesis by (simp add: lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   380
  qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   381
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   382
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   383
lemma lcm_least_iff [simp]: "lcm a b dvd c \<longleftrightarrow> a dvd c \<and> b dvd c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   384
  by (blast intro!: lcm_least intro: dvd_trans)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   385
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   386
lemma normalize_lcm [simp]: "normalize (lcm a b) = lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   387
  by (simp add: lcm_gcd dvd_normalize_div)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   388
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   389
lemma lcm_0_left [simp]: "lcm 0 a = 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   390
  by (simp add: lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   391
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   392
lemma lcm_0_right [simp]: "lcm a 0 = 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   393
  by (simp add: lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   394
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   395
lemma lcm_eq_0_iff: "lcm a b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   396
  (is "?P \<longleftrightarrow> ?Q")
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   397
proof
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   398
  assume ?P
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   399
  then have "0 dvd lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   400
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   401
  also have "lcm a b dvd (a * b)"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   402
    by simp
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   403
  finally show ?Q
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   404
    by auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   405
next
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   406
  assume ?Q
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   407
  then show ?P
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   408
    by auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   409
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   410
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   411
lemma zero_eq_lcm_iff: "0 = lcm a b \<longleftrightarrow> a = 0 \<or> b = 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   412
  using lcm_eq_0_iff[of a b] by auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   413
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   414
lemma lcm_eq_1_iff [simp]: "lcm a b = 1 \<longleftrightarrow> is_unit a \<and> is_unit b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   415
  by (auto intro: associated_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   416
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   417
lemma unit_factor_lcm: "unit_factor (lcm a b) = (if a = 0 \<or> b = 0 then 0 else 1)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   418
  using lcm_eq_0_iff[of a b] by (cases "lcm a b = 0") (auto simp: lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   419
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   420
sublocale lcm: abel_semigroup lcm
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   421
proof
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   422
  fix a b c
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   423
  show "lcm a b = lcm b a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   424
    by (simp add: lcm_gcd ac_simps normalize_mult dvd_normalize_div)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   425
  have "lcm (lcm a b) c dvd lcm a (lcm b c)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   426
    and "lcm a (lcm b c) dvd lcm (lcm a b) c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   427
    by (auto intro: lcm_least
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   428
      dvd_trans [of b "lcm b c" "lcm a (lcm b c)"]
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   429
      dvd_trans [of c "lcm b c" "lcm a (lcm b c)"]
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   430
      dvd_trans [of a "lcm a b" "lcm (lcm a b) c"]
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   431
      dvd_trans [of b "lcm a b" "lcm (lcm a b) c"])
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   432
  then show "lcm (lcm a b) c = lcm a (lcm b c)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   433
    by (rule associated_eqI) simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   434
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   435
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   436
sublocale lcm: bounded_quasi_semilattice lcm 1 0 normalize
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   437
proof
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   438
  show "lcm a a = normalize a" for a
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   439
  proof -
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   440
    have "lcm a a dvd a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   441
      by (rule lcm_least) simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   442
    then show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   443
      by (auto intro: associated_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   444
  qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   445
  show "lcm (normalize a) b = lcm a b" for a b
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   446
    using dvd_lcm1 [of "normalize a" b] unfolding normalize_dvd_iff
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   447
    by (auto intro: associated_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   448
  show "lcm 1 a = normalize a" for a
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   449
    by (rule associated_eqI) simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   450
qed simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   451
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   452
lemma lcm_self: "lcm a a = normalize a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   453
  by (fact lcm.idem_normalize)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   454
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   455
lemma lcm_left_idem: "lcm a (lcm a b) = lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   456
  by (fact lcm.left_idem)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   457
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   458
lemma lcm_right_idem: "lcm (lcm a b) b = lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   459
  by (fact lcm.right_idem)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   460
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   461
lemma gcd_lcm:
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   462
  assumes "a \<noteq> 0" and "b \<noteq> 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   463
  shows "gcd a b = normalize (a * b div lcm a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   464
proof -
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   465
  from assms have [simp]: "a * b div gcd a b \<noteq> 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   466
    by (subst dvd_div_eq_0_iff) auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   467
  let ?u = "unit_factor (a * b div gcd a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   468
  have "gcd a b * normalize (a * b div gcd a b) =
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   469
          gcd a b * ((a * b div gcd a b) * (1 div ?u))"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   470
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   471
  also have "\<dots> = a * b div ?u"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   472
    by (subst mult.assoc [symmetric]) auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   473
  also have "\<dots> dvd a * b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   474
    by (subst div_unit_dvd_iff) auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   475
  finally have "gcd a b dvd ((a * b) div lcm a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   476
    by (intro dvd_mult_imp_div) (auto simp: lcm_gcd)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   477
  moreover have "a * b div lcm a b dvd a" and "a * b div lcm a b dvd b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   478
    using assms by (subst div_dvd_iff_mult; simp add: lcm_eq_0_iff mult.commute[of b "lcm a b"])+
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   479
  ultimately have "normalize (gcd a b) = normalize (a * b div lcm a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   480
    apply -
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   481
    apply (rule associated_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   482
    using assms
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   483
    apply (auto simp: div_dvd_iff_mult zero_eq_lcm_iff)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   484
    done
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   485
  thus ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   486
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   487
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   488
lemma lcm_1_left: "lcm 1 a = normalize a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   489
  by (fact lcm.top_left_normalize)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   490
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   491
lemma lcm_1_right: "lcm a 1 = normalize a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   492
  by (fact lcm.top_right_normalize)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   493
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   494
lemma lcm_mult_left: "lcm (c * a) (c * b) = normalize (c * lcm a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   495
proof (cases "c = 0")
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   496
  case True
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   497
  then show ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   498
next
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   499
  case False
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   500
  then have *: "lcm (c * a) (c * b) dvd c * lcm a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   501
    by (auto intro: lcm_least)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   502
  moreover have "lcm a b dvd lcm (c * a) (c * b) div c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   503
    by (intro lcm_least) (auto intro!: dvd_mult_imp_div simp: mult_ac)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   504
  hence "c * lcm a b dvd lcm (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   505
    using False by (subst (asm) dvd_div_iff_mult) (auto simp: mult_ac intro: dvd_lcmI1)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   506
  ultimately have "normalize (lcm (c * a) (c * b)) = normalize (c * lcm a b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   507
    by (auto intro: associated_eqI)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   508
  then show ?thesis
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   509
    by (simp add: normalize_mult)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   510
qed
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   511
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   512
lemma lcm_mult_right: "lcm (a * c) (b * c) = normalize (lcm b a * c)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   513
  using lcm_mult_left [of c a b] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   514
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   515
lemma lcm_mult_unit1: "is_unit a \<Longrightarrow> lcm (b * a) c = lcm b c"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   516
  by (rule associated_eqI) (simp_all add: mult_unit_dvd_iff dvd_lcmI1)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   517
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   518
lemma lcm_mult_unit2: "is_unit a \<Longrightarrow> lcm b (c * a) = lcm b c"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   519
  using lcm_mult_unit1 [of a c b] by (simp add: ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   520
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   521
lemma lcm_div_unit1:
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   522
  "is_unit a \<Longrightarrow> lcm (b div a) c = lcm b c"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   523
  by (erule is_unitE [of _ b]) (simp add: lcm_mult_unit1)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   524
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   525
lemma lcm_div_unit2: "is_unit a \<Longrightarrow> lcm b (c div a) = lcm b c"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   526
  by (erule is_unitE [of _ c]) (simp add: lcm_mult_unit2)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   527
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   528
lemma normalize_lcm_left: "lcm (normalize a) b = lcm a b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   529
  by (fact lcm.normalize_left_idem)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   530
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   531
lemma normalize_lcm_right: "lcm a (normalize b) = lcm a b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
   532
  by (fact lcm.normalize_right_idem)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   533
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   534
lemma comp_fun_idem_gcd: "comp_fun_idem gcd"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   535
  by standard (simp_all add: fun_eq_iff ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   536
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   537
lemma comp_fun_idem_lcm: "comp_fun_idem lcm"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   538
  by standard (simp_all add: fun_eq_iff ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   539
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   540
lemma gcd_dvd_antisym: "gcd a b dvd gcd c d \<Longrightarrow> gcd c d dvd gcd a b \<Longrightarrow> gcd a b = gcd c d"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   541
proof (rule gcdI)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   542
  assume *: "gcd a b dvd gcd c d"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   543
    and **: "gcd c d dvd gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   544
  have "gcd c d dvd c"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   545
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   546
  with * show "gcd a b dvd c"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   547
    by (rule dvd_trans)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   548
  have "gcd c d dvd d"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   549
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   550
  with * show "gcd a b dvd d"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   551
    by (rule dvd_trans)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   552
  show "normalize (gcd a b) = gcd a b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   553
    by simp
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   554
  fix l assume "l dvd c" and "l dvd d"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   555
  then have "l dvd gcd c d"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   556
    by (rule gcd_greatest)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   557
  from this and ** show "l dvd gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   558
    by (rule dvd_trans)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   559
qed
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   560
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   561
declare unit_factor_lcm [simp]
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   562
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   563
lemma lcmI:
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   564
  assumes "a dvd c" and "b dvd c" and "\<And>d. a dvd d \<Longrightarrow> b dvd d \<Longrightarrow> c dvd d"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   565
    and "normalize c = c"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   566
  shows "c = lcm a b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   567
  by (rule associated_eqI) (auto simp: assms intro: lcm_least)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   568
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   569
lemma gcd_dvd_lcm [simp]: "gcd a b dvd lcm a b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   570
  using gcd_dvd2 by (rule dvd_lcmI2)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   571
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   572
lemmas lcm_0 = lcm_0_right
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   573
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   574
lemma lcm_unique:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   575
  "a dvd d \<and> b dvd d \<and> normalize d = d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   576
  by rule (auto intro: lcmI simp: lcm_least lcm_eq_0_iff)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   577
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   578
lemma lcm_proj1_if_dvd:
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   579
  assumes "b dvd a" shows "lcm a b = normalize a"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   580
proof -
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   581
  have "normalize (lcm a b) = normalize a"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   582
    by (rule associatedI) (use assms in auto)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   583
  thus ?thesis by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   584
qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   585
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   586
lemma lcm_proj2_if_dvd: "a dvd b \<Longrightarrow> lcm a b = normalize b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   587
  using lcm_proj1_if_dvd [of a b] by (simp add: ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   588
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   589
lemma lcm_proj1_iff: "lcm m n = normalize m \<longleftrightarrow> n dvd m"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   590
proof
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   591
  assume *: "lcm m n = normalize m"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   592
  show "n dvd m"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   593
  proof (cases "m = 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   594
    case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   595
    then show ?thesis by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   596
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   597
    case [simp]: False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   598
    from * have **: "m = lcm m n * unit_factor m"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   599
      by (simp add: unit_eq_div2)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   600
    show ?thesis by (subst **) simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   601
  qed
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   602
next
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   603
  assume "n dvd m"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   604
  then show "lcm m n = normalize m"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   605
    by (rule lcm_proj1_if_dvd)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   606
qed
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   607
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   608
lemma lcm_proj2_iff: "lcm m n = normalize n \<longleftrightarrow> m dvd n"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   609
  using lcm_proj1_iff [of n m] by (simp add: ac_simps)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   610
69785
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   611
lemma gcd_mono: "a dvd c \<Longrightarrow> b dvd d \<Longrightarrow> gcd a b dvd gcd c d"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   612
  by (simp add: gcd_dvdI1 gcd_dvdI2)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   613
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   614
lemma lcm_mono: "a dvd c \<Longrightarrow> b dvd d \<Longrightarrow> lcm a b dvd lcm c d"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   615
  by (simp add: dvd_lcmI1 dvd_lcmI2)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
   616
63924
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   617
lemma dvd_productE:
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
   618
  assumes "p dvd a * b"
63924
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   619
  obtains x y where "p = x * y" "x dvd a" "y dvd b"
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   620
proof (cases "a = 0")
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   621
  case True
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   622
  thus ?thesis by (intro that[of p 1]) simp_all
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   623
next
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   624
  case False
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   625
  define x y where "x = gcd a p" and "y = p div x"
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   626
  have "p = x * y" by (simp add: x_def y_def)
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   627
  moreover have "x dvd a" by (simp add: x_def)
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   628
  moreover from assms have "p dvd gcd (b * a) (b * p)"
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   629
    by (intro gcd_greatest) (simp_all add: mult.commute)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   630
  hence "p dvd b * gcd a p" by (subst (asm) gcd_mult_left) auto
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
   631
  with False have "y dvd b"
63924
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   632
    by (simp add: x_def y_def div_dvd_iff_mult assms)
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   633
  ultimately show ?thesis by (rule that)
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   634
qed
f91766530e13 more generic algebraic lemmas
haftmann
parents: 63915
diff changeset
   635
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   636
lemma gcd_mult_unit1: 
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   637
  assumes "is_unit a" shows "gcd (b * a) c = gcd b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   638
proof -
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   639
  have "gcd (b * a) c dvd b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   640
    using assms dvd_mult_unit_iff by blast
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   641
  then show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   642
    by (rule gcdI) simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   643
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   644
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   645
lemma gcd_mult_unit2: "is_unit a \<Longrightarrow> gcd b (c * a) = gcd b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   646
  using gcd.commute gcd_mult_unit1 by auto
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   647
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   648
lemma gcd_div_unit1: "is_unit a \<Longrightarrow> gcd (b div a) c = gcd b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   649
  by (erule is_unitE [of _ b]) (simp add: gcd_mult_unit1)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   650
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   651
lemma gcd_div_unit2: "is_unit a \<Longrightarrow> gcd b (c div a) = gcd b c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   652
  by (erule is_unitE [of _ c]) (simp add: gcd_mult_unit2)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   653
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   654
lemma normalize_gcd_left: "gcd (normalize a) b = gcd a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   655
  by (fact gcd.normalize_left_idem)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   656
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   657
lemma normalize_gcd_right: "gcd a (normalize b) = gcd a b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   658
  by (fact gcd.normalize_right_idem)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   659
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   660
lemma gcd_add1 [simp]: "gcd (m + n) n = gcd m n"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   661
  by (rule gcdI [symmetric]) (simp_all add: dvd_add_left_iff)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   662
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   663
lemma gcd_add2 [simp]: "gcd m (m + n) = gcd m n"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   664
  using gcd_add1 [of n m] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   665
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   666
lemma gcd_add_mult: "gcd m (k * m + n) = gcd m n"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   667
  by (rule gcdI [symmetric]) (simp_all add: dvd_add_right_iff)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   668
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   669
end
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   670
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   671
class ring_gcd = comm_ring_1 + semiring_gcd
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   672
begin
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   673
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   674
lemma gcd_neg1 [simp]: "gcd (-a) b = gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   675
  by (rule sym, rule gcdI) (simp_all add: gcd_greatest)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   676
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   677
lemma gcd_neg2 [simp]: "gcd a (-b) = gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   678
  by (rule sym, rule gcdI) (simp_all add: gcd_greatest)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   679
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   680
lemma gcd_neg_numeral_1 [simp]: "gcd (- numeral n) a = gcd (numeral n) a"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   681
  by (fact gcd_neg1)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   682
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   683
lemma gcd_neg_numeral_2 [simp]: "gcd a (- numeral n) = gcd a (numeral n)"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   684
  by (fact gcd_neg2)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   685
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   686
lemma gcd_diff1: "gcd (m - n) n = gcd m n"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   687
  by (subst diff_conv_add_uminus, subst gcd_neg2[symmetric], subst gcd_add1, simp)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   688
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   689
lemma gcd_diff2: "gcd (n - m) n = gcd m n"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   690
  by (subst gcd_neg1[symmetric]) (simp only: minus_diff_eq gcd_diff1)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   691
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   692
lemma lcm_neg1 [simp]: "lcm (-a) b = lcm a b"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   693
  by (rule sym, rule lcmI) (simp_all add: lcm_least lcm_eq_0_iff)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   694
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   695
lemma lcm_neg2 [simp]: "lcm a (-b) = lcm a b"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   696
  by (rule sym, rule lcmI) (simp_all add: lcm_least lcm_eq_0_iff)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   697
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   698
lemma lcm_neg_numeral_1 [simp]: "lcm (- numeral n) a = lcm (numeral n) a"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   699
  by (fact lcm_neg1)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   700
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   701
lemma lcm_neg_numeral_2 [simp]: "lcm a (- numeral n) = lcm a (numeral n)"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   702
  by (fact lcm_neg2)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   703
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   704
end
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   705
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   706
class semiring_Gcd = semiring_gcd + Gcd +
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   707
  assumes Gcd_dvd: "a \<in> A \<Longrightarrow> Gcd A dvd a"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   708
    and Gcd_greatest: "(\<And>b. b \<in> A \<Longrightarrow> a dvd b) \<Longrightarrow> a dvd Gcd A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   709
    and normalize_Gcd [simp]: "normalize (Gcd A) = Gcd A"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   710
  assumes dvd_Lcm: "a \<in> A \<Longrightarrow> a dvd Lcm A"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   711
    and Lcm_least: "(\<And>b. b \<in> A \<Longrightarrow> b dvd a) \<Longrightarrow> Lcm A dvd a"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   712
    and normalize_Lcm [simp]: "normalize (Lcm A) = Lcm A"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   713
begin
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   714
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   715
lemma Lcm_Gcd: "Lcm A = Gcd {b. \<forall>a\<in>A. a dvd b}"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   716
  by (rule associated_eqI) (auto intro: Gcd_dvd dvd_Lcm Gcd_greatest Lcm_least)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   717
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   718
lemma Gcd_Lcm: "Gcd A = Lcm {b. \<forall>a\<in>A. b dvd a}"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   719
  by (rule associated_eqI) (auto intro: Gcd_dvd dvd_Lcm Gcd_greatest Lcm_least)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   720
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   721
lemma Gcd_empty [simp]: "Gcd {} = 0"
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   722
  by (rule dvd_0_left, rule Gcd_greatest) simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   723
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   724
lemma Lcm_empty [simp]: "Lcm {} = 1"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   725
  by (auto intro: associated_eqI Lcm_least)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   726
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   727
lemma Gcd_insert [simp]: "Gcd (insert a A) = gcd a (Gcd A)"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   728
proof -
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   729
  have "Gcd (insert a A) dvd gcd a (Gcd A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   730
    by (auto intro: Gcd_dvd Gcd_greatest)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   731
  moreover have "gcd a (Gcd A) dvd Gcd (insert a A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   732
  proof (rule Gcd_greatest)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   733
    fix b
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   734
    assume "b \<in> insert a A"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   735
    then show "gcd a (Gcd A) dvd b"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   736
    proof
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   737
      assume "b = a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   738
      then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   739
        by simp
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   740
    next
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   741
      assume "b \<in> A"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   742
      then have "Gcd A dvd b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   743
        by (rule Gcd_dvd)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   744
      moreover have "gcd a (Gcd A) dvd Gcd A"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   745
        by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   746
      ultimately show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   747
        by (blast intro: dvd_trans)
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   748
    qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   749
  qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   750
  ultimately show ?thesis
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   751
    by (auto intro: associated_eqI)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   752
qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   753
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   754
lemma Lcm_insert [simp]: "Lcm (insert a A) = lcm a (Lcm A)"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   755
proof (rule sym)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   756
  have "lcm a (Lcm A) dvd Lcm (insert a A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   757
    by (auto intro: dvd_Lcm Lcm_least)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   758
  moreover have "Lcm (insert a A) dvd lcm a (Lcm A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   759
  proof (rule Lcm_least)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   760
    fix b
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   761
    assume "b \<in> insert a A"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   762
    then show "b dvd lcm a (Lcm A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   763
    proof
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   764
      assume "b = a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   765
      then show ?thesis by simp
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   766
    next
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   767
      assume "b \<in> A"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   768
      then have "b dvd Lcm A"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   769
        by (rule dvd_Lcm)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   770
      moreover have "Lcm A dvd lcm a (Lcm A)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   771
        by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   772
      ultimately show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   773
        by (blast intro: dvd_trans)
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   774
    qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   775
  qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   776
  ultimately show "lcm a (Lcm A) = Lcm (insert a A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   777
    by (rule associated_eqI) (simp_all add: lcm_eq_0_iff)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   778
qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   779
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   780
lemma LcmI:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   781
  assumes "\<And>a. a \<in> A \<Longrightarrow> a dvd b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   782
    and "\<And>c. (\<And>a. a \<in> A \<Longrightarrow> a dvd c) \<Longrightarrow> b dvd c"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   783
    and "normalize b = b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   784
  shows "b = Lcm A"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   785
  by (rule associated_eqI) (auto simp: assms dvd_Lcm intro: Lcm_least)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   786
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   787
lemma Lcm_subset: "A \<subseteq> B \<Longrightarrow> Lcm A dvd Lcm B"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   788
  by (blast intro: Lcm_least dvd_Lcm)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   789
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   790
lemma Lcm_Un: "Lcm (A \<union> B) = lcm (Lcm A) (Lcm B)"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   791
proof -
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   792
  have "\<And>d. \<lbrakk>Lcm A dvd d; Lcm B dvd d\<rbrakk> \<Longrightarrow> Lcm (A \<union> B) dvd d"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   793
    by (meson UnE Lcm_least dvd_Lcm dvd_trans)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   794
  then show ?thesis
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   795
    by (meson Lcm_subset lcm_unique normalize_Lcm sup.cobounded1 sup.cobounded2)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   796
qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   797
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   798
lemma Gcd_0_iff [simp]: "Gcd A = 0 \<longleftrightarrow> A \<subseteq> {0}"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   799
  (is "?P \<longleftrightarrow> ?Q")
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   800
proof
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   801
  assume ?P
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   802
  show ?Q
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   803
  proof
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   804
    fix a
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   805
    assume "a \<in> A"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   806
    then have "Gcd A dvd a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   807
      by (rule Gcd_dvd)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   808
    with \<open>?P\<close> have "a = 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   809
      by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   810
    then show "a \<in> {0}"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   811
      by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   812
  qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   813
next
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   814
  assume ?Q
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   815
  have "0 dvd Gcd A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   816
  proof (rule Gcd_greatest)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   817
    fix a
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   818
    assume "a \<in> A"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   819
    with \<open>?Q\<close> have "a = 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   820
      by auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   821
    then show "0 dvd a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   822
      by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   823
  qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   824
  then show ?P
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   825
    by simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   826
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   827
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   828
lemma Lcm_1_iff [simp]: "Lcm A = 1 \<longleftrightarrow> (\<forall>a\<in>A. is_unit a)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   829
  (is "?P \<longleftrightarrow> ?Q")
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   830
proof
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   831
  assume ?P
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   832
  show ?Q
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   833
  proof
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   834
    fix a
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   835
    assume "a \<in> A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   836
    then have "a dvd Lcm A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   837
      by (rule dvd_Lcm)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   838
    with \<open>?P\<close> show "is_unit a"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   839
      by simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   840
  qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   841
next
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   842
  assume ?Q
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   843
  then have "is_unit (Lcm A)"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   844
    by (blast intro: Lcm_least)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   845
  then have "normalize (Lcm A) = 1"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   846
    by (rule is_unit_normalize)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   847
  then show ?P
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   848
    by simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   849
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   850
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   851
lemma unit_factor_Lcm: "unit_factor (Lcm A) = (if Lcm A = 0 then 0 else 1)"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   852
proof (cases "Lcm A = 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   853
  case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   854
  then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   855
    by simp
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   856
next
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   857
  case False
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   858
  with unit_factor_normalize have "unit_factor (normalize (Lcm A)) = 1"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   859
    by blast
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   860
  with False show ?thesis
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   861
    by simp
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   862
qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   863
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   864
lemma unit_factor_Gcd: "unit_factor (Gcd A) = (if Gcd A = 0 then 0 else 1)"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   865
  by (simp add: Gcd_Lcm unit_factor_Lcm)
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   866
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   867
lemma GcdI:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   868
  assumes "\<And>a. a \<in> A \<Longrightarrow> b dvd a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   869
    and "\<And>c. (\<And>a. a \<in> A \<Longrightarrow> c dvd a) \<Longrightarrow> c dvd b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   870
    and "normalize b = b"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   871
  shows "b = Gcd A"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   872
  by (rule associated_eqI) (auto simp: assms Gcd_dvd intro: Gcd_greatest)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
   873
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   874
lemma Gcd_eq_1_I:
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   875
  assumes "is_unit a" and "a \<in> A"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   876
  shows "Gcd A = 1"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   877
proof -
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   878
  from assms have "is_unit (Gcd A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   879
    by (blast intro: Gcd_dvd dvd_unit_imp_unit)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   880
  then have "normalize (Gcd A) = 1"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   881
    by (rule is_unit_normalize)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   882
  then show ?thesis
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   883
    by simp
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   884
qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   885
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   886
lemma Lcm_eq_0_I:
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   887
  assumes "0 \<in> A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   888
  shows "Lcm A = 0"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   889
proof -
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   890
  from assms have "0 dvd Lcm A"
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   891
    by (rule dvd_Lcm)
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   892
  then show ?thesis
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   893
    by simp
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   894
qed
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   895
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   896
lemma Gcd_UNIV [simp]: "Gcd UNIV = 1"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   897
  using dvd_refl by (rule Gcd_eq_1_I) simp
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   898
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   899
lemma Lcm_UNIV [simp]: "Lcm UNIV = 0"
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   900
  by (rule Lcm_eq_0_I) simp
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   901
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   902
lemma Lcm_0_iff:
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   903
  assumes "finite A"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   904
  shows "Lcm A = 0 \<longleftrightarrow> 0 \<in> A"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   905
proof (cases "A = {}")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   906
  case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   907
  then show ?thesis by simp
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   908
next
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   909
  case False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   910
  with assms show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
   911
    by (induct A rule: finite_ne_induct) (auto simp: lcm_eq_0_iff)
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
   912
qed
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
   913
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   914
lemma Gcd_image_normalize [simp]: "Gcd (normalize ` A) = Gcd A"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   915
proof -
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   916
  have "Gcd (normalize ` A) dvd a" if "a \<in> A" for a
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   917
  proof -
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   918
    from that obtain B where "A = insert a B"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   919
      by blast
62350
66a381d3f88f more sophisticated GCD syntax
haftmann
parents: 62349
diff changeset
   920
    moreover have "gcd (normalize a) (Gcd (normalize ` B)) dvd normalize a"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   921
      by (rule gcd_dvd1)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   922
    ultimately show "Gcd (normalize ` A) dvd a"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   923
      by simp
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   924
  qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   925
  then have "Gcd (normalize ` A) dvd Gcd A" and "Gcd A dvd Gcd (normalize ` A)"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   926
    by (auto intro!: Gcd_greatest intro: Gcd_dvd)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   927
  then show ?thesis
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   928
    by (auto intro: associated_eqI)
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   929
qed
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
   930
62346
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   931
lemma Gcd_eqI:
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   932
  assumes "normalize a = a"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   933
  assumes "\<And>b. b \<in> A \<Longrightarrow> a dvd b"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   934
    and "\<And>c. (\<And>b. b \<in> A \<Longrightarrow> c dvd b) \<Longrightarrow> c dvd a"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   935
  shows "Gcd A = a"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   936
  using assms by (blast intro: associated_eqI Gcd_greatest Gcd_dvd normalize_Gcd)
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   937
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   938
lemma dvd_GcdD: "x dvd Gcd A \<Longrightarrow> y \<in> A \<Longrightarrow> x dvd y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   939
  using Gcd_dvd dvd_trans by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   940
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   941
lemma dvd_Gcd_iff: "x dvd Gcd A \<longleftrightarrow> (\<forall>y\<in>A. x dvd y)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   942
  by (blast dest: dvd_GcdD intro: Gcd_greatest)
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   943
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   944
lemma Gcd_mult: "Gcd ((*) c ` A) = normalize (c * Gcd A)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   945
proof (cases "c = 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   946
  case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   947
  then show ?thesis by auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   948
next
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   949
  case [simp]: False
69064
5840724b1d71 Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents: 69038
diff changeset
   950
  have "Gcd ((*) c ` A) div c dvd Gcd A"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   951
    by (intro Gcd_greatest, subst div_dvd_iff_mult)
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   952
       (auto intro!: Gcd_greatest Gcd_dvd simp: mult.commute[of _ c])
69064
5840724b1d71 Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents: 69038
diff changeset
   953
  then have "Gcd ((*) c ` A) dvd c * Gcd A"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   954
    by (subst (asm) div_dvd_iff_mult) (auto intro: Gcd_greatest simp: mult_ac)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   955
  moreover have "c * Gcd A dvd Gcd ((*) c ` A)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   956
    by (intro Gcd_greatest) (auto intro: mult_dvd_mono Gcd_dvd)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   957
  ultimately have "normalize (Gcd ((*) c ` A)) = normalize (c * Gcd A)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   958
    by (rule associatedI)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   959
  then show ?thesis by simp    
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   960
qed
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   961
62346
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   962
lemma Lcm_eqI:
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   963
  assumes "normalize a = a"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   964
    and "\<And>b. b \<in> A \<Longrightarrow> b dvd a"
62346
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   965
    and "\<And>c. (\<And>b. b \<in> A \<Longrightarrow> b dvd c) \<Longrightarrow> a dvd c"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   966
  shows "Lcm A = a"
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   967
  using assms by (blast intro: associated_eqI Lcm_least dvd_Lcm normalize_Lcm)
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
   968
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   969
lemma Lcm_dvdD: "Lcm A dvd x \<Longrightarrow> y \<in> A \<Longrightarrow> y dvd x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   970
  using dvd_Lcm dvd_trans by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   971
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   972
lemma Lcm_dvd_iff: "Lcm A dvd x \<longleftrightarrow> (\<forall>y\<in>A. y dvd x)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   973
  by (blast dest: Lcm_dvdD intro: Lcm_least)
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   974
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   975
lemma Lcm_mult:
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   976
  assumes "A \<noteq> {}"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   977
  shows "Lcm ((*) c ` A) = normalize (c * Lcm A)"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   978
proof (cases "c = 0")
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   979
  case True
69064
5840724b1d71 Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents: 69038
diff changeset
   980
  with assms have "(*) c ` A = {0}"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   981
    by auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   982
  with True show ?thesis by auto
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   983
next
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   984
  case [simp]: False
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   985
  from assms obtain x where x: "x \<in> A"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   986
    by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   987
  have "c dvd c * x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   988
    by simp
69064
5840724b1d71 Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents: 69038
diff changeset
   989
  also from x have "c * x dvd Lcm ((*) c ` A)"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   990
    by (intro dvd_Lcm) auto
69064
5840724b1d71 Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents: 69038
diff changeset
   991
  finally have dvd: "c dvd Lcm ((*) c ` A)" .
69768
7e4966eaf781 proper congruence rule for image operator
haftmann
parents: 69593
diff changeset
   992
  moreover have "Lcm A dvd Lcm ((*) c ` A) div c"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   993
    by (intro Lcm_least dvd_mult_imp_div)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
   994
      (auto intro!: Lcm_least dvd_Lcm simp: mult.commute[of _ c])
69768
7e4966eaf781 proper congruence rule for image operator
haftmann
parents: 69593
diff changeset
   995
  ultimately have "c * Lcm A dvd Lcm ((*) c ` A)"
7e4966eaf781 proper congruence rule for image operator
haftmann
parents: 69593
diff changeset
   996
    by auto
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   997
  moreover have "Lcm ((*) c ` A) dvd c * Lcm A"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
   998
    by (intro Lcm_least) (auto intro: mult_dvd_mono dvd_Lcm)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
   999
  ultimately have "normalize (c * Lcm A) = normalize (Lcm ((*) c ` A))"
63359
99b51ba8da1c More lemmas on Gcd/Lcm
Manuel Eberl <eberlm@in.tum.de>
parents: 63145
diff changeset
  1000
    by (rule associatedI)
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1001
  then show ?thesis by simp
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1002
qed
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1003
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1004
lemma Lcm_no_units: "Lcm A = Lcm (A - {a. is_unit a})"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1005
proof -
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1006
  have "(A - {a. is_unit a}) \<union> {a\<in>A. is_unit a} = A"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1007
    by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1008
  then have "Lcm A = lcm (Lcm (A - {a. is_unit a})) (Lcm {a\<in>A. is_unit a})"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1009
    by (simp add: Lcm_Un [symmetric])
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1010
  also have "Lcm {a\<in>A. is_unit a} = 1"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1011
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1012
  finally show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1013
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1014
qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1015
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1016
lemma Lcm_0_iff': "Lcm A = 0 \<longleftrightarrow> (\<nexists>l. l \<noteq> 0 \<and> (\<forall>a\<in>A. a dvd l))"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1017
  by (metis Lcm_least dvd_0_left dvd_Lcm)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1018
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1019
lemma Lcm_no_multiple: "(\<forall>m. m \<noteq> 0 \<longrightarrow> (\<exists>a\<in>A. \<not> a dvd m)) \<Longrightarrow> Lcm A = 0"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1020
  by (auto simp: Lcm_0_iff')
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1021
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1022
lemma Lcm_singleton [simp]: "Lcm {a} = normalize a"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1023
  by simp
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1024
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1025
lemma Lcm_2 [simp]: "Lcm {a, b} = lcm a b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1026
  by simp
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1027
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1028
lemma Gcd_1: "1 \<in> A \<Longrightarrow> Gcd A = 1"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1029
  by (auto intro!: Gcd_eq_1_I)
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1030
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1031
lemma Gcd_singleton [simp]: "Gcd {a} = normalize a"
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1032
  by simp
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1033
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1034
lemma Gcd_2 [simp]: "Gcd {a, b} = gcd a b"
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1035
  by simp
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  1036
69785
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1037
lemma Gcd_mono:
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1038
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x dvd g x"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1039
  shows   "(GCD x\<in>A. f x) dvd (GCD x\<in>A. g x)"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1040
proof (intro Gcd_greatest, safe)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1041
  fix x assume "x \<in> A"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1042
  hence "(GCD x\<in>A. f x) dvd f x"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1043
    by (intro Gcd_dvd) auto
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1044
  also have "f x dvd g x"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1045
    using \<open>x \<in> A\<close> assms by blast
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1046
  finally show "(GCD x\<in>A. f x) dvd \<dots>" .
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1047
qed
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1048
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1049
lemma Lcm_mono:
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1050
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x dvd g x"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1051
  shows   "(LCM x\<in>A. f x) dvd (LCM x\<in>A. g x)"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1052
proof (intro Lcm_least, safe)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1053
  fix x assume "x \<in> A"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1054
  hence "f x dvd g x" by (rule assms)
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1055
  also have "g x dvd (LCM x\<in>A. g x)"
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1056
    using \<open>x \<in> A\<close> by (intro dvd_Lcm) auto
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1057
  finally show "f x dvd \<dots>" .
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1058
qed
9e326f6f8a24 More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
Manuel Eberl <eberlm@in.tum.de>
parents: 69768
diff changeset
  1059
62350
66a381d3f88f more sophisticated GCD syntax
haftmann
parents: 62349
diff changeset
  1060
end
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1061
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
  1062
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1063
subsection \<open>An aside: GCD and LCM on finite sets for incomplete gcd rings\<close>
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1064
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1065
context semiring_gcd
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1066
begin
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1067
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1068
sublocale Gcd_fin: bounded_quasi_semilattice_set gcd 0 1 normalize
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1069
defines
80932
261cd8722677 standardize mixfix annotations via "isabelle update -u mixfix_cartouches -l Pure HOL" --- to simplify systematic editing;
wenzelm
parents: 80771
diff changeset
  1070
  Gcd_fin (\<open>Gcd\<^sub>f\<^sub>i\<^sub>n\<close>) = "Gcd_fin.F :: 'a set \<Rightarrow> 'a" ..
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1071
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1072
abbreviation gcd_list :: "'a list \<Rightarrow> 'a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1073
  where "gcd_list xs \<equiv> Gcd\<^sub>f\<^sub>i\<^sub>n (set xs)"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1074
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1075
sublocale Lcm_fin: bounded_quasi_semilattice_set lcm 1 0 normalize
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1076
defines
80932
261cd8722677 standardize mixfix annotations via "isabelle update -u mixfix_cartouches -l Pure HOL" --- to simplify systematic editing;
wenzelm
parents: 80771
diff changeset
  1077
  Lcm_fin (\<open>Lcm\<^sub>f\<^sub>i\<^sub>n\<close>) = Lcm_fin.F ..
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1078
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1079
abbreviation lcm_list :: "'a list \<Rightarrow> 'a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1080
  where "lcm_list xs \<equiv> Lcm\<^sub>f\<^sub>i\<^sub>n (set xs)"
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
  1081
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1082
lemma Gcd_fin_dvd:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1083
  "a \<in> A \<Longrightarrow> Gcd\<^sub>f\<^sub>i\<^sub>n A dvd a"
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
  1084
  by (induct A rule: infinite_finite_induct)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1085
    (auto intro: dvd_trans)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1086
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1087
lemma dvd_Lcm_fin:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1088
  "a \<in> A \<Longrightarrow> a dvd Lcm\<^sub>f\<^sub>i\<^sub>n A"
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
  1089
  by (induct A rule: infinite_finite_induct)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1090
    (auto intro: dvd_trans)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1091
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1092
lemma Gcd_fin_greatest:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1093
  "a dvd Gcd\<^sub>f\<^sub>i\<^sub>n A" if "finite A" and "\<And>b. b \<in> A \<Longrightarrow> a dvd b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1094
  using that by (induct A) simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1095
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1096
lemma Lcm_fin_least:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1097
  "Lcm\<^sub>f\<^sub>i\<^sub>n A dvd a" if "finite A" and "\<And>b. b \<in> A \<Longrightarrow> b dvd a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1098
  using that by (induct A) simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1099
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1100
lemma gcd_list_greatest:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1101
  "a dvd gcd_list bs" if "\<And>b. b \<in> set bs \<Longrightarrow> a dvd b"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1102
  by (rule Gcd_fin_greatest) (simp_all add: that)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1103
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1104
lemma lcm_list_least:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1105
  "lcm_list bs dvd a" if "\<And>b. b \<in> set bs \<Longrightarrow> b dvd a"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1106
  by (rule Lcm_fin_least) (simp_all add: that)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1107
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1108
lemma dvd_Gcd_fin_iff:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1109
  "b dvd Gcd\<^sub>f\<^sub>i\<^sub>n A \<longleftrightarrow> (\<forall>a\<in>A. b dvd a)" if "finite A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1110
  using that by (auto intro: Gcd_fin_greatest Gcd_fin_dvd dvd_trans [of b "Gcd\<^sub>f\<^sub>i\<^sub>n A"])
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1111
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1112
lemma dvd_gcd_list_iff:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1113
  "b dvd gcd_list xs \<longleftrightarrow> (\<forall>a\<in>set xs. b dvd a)"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1114
  by (simp add: dvd_Gcd_fin_iff)
65552
f533820e7248 theories "GCD" and "Binomial" are already included in "Main": this avoids improper imports in applications;
wenzelm
parents: 64850
diff changeset
  1115
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1116
lemma Lcm_fin_dvd_iff:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1117
  "Lcm\<^sub>f\<^sub>i\<^sub>n A dvd b  \<longleftrightarrow> (\<forall>a\<in>A. a dvd b)" if "finite A"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1118
  using that by (auto intro: Lcm_fin_least dvd_Lcm_fin dvd_trans [of _ "Lcm\<^sub>f\<^sub>i\<^sub>n A" b])
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1119
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1120
lemma lcm_list_dvd_iff:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1121
  "lcm_list xs dvd b  \<longleftrightarrow> (\<forall>a\<in>set xs. a dvd b)"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1122
  by (simp add: Lcm_fin_dvd_iff)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1123
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1124
lemma Gcd_fin_mult:
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1125
  "Gcd\<^sub>f\<^sub>i\<^sub>n (image (times b) A) = normalize (b * Gcd\<^sub>f\<^sub>i\<^sub>n A)" if "finite A"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1126
  using that by induction (auto simp: gcd_mult_left)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1127
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1128
lemma Lcm_fin_mult:
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1129
  "Lcm\<^sub>f\<^sub>i\<^sub>n (image (times b) A) = normalize (b * Lcm\<^sub>f\<^sub>i\<^sub>n A)" if "A \<noteq> {}"
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1130
proof (cases "b = 0")
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1131
  case True
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1132
  moreover from that have "times 0 ` A = {0}"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1133
    by auto
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1134
  ultimately show ?thesis
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1135
    by simp
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1136
next
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1137
  case False
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1138
  show ?thesis proof (cases "finite A")
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1139
    case False
66936
cf8d8fc23891 tuned some proofs and added some lemmas
haftmann
parents: 66836
diff changeset
  1140
    moreover have "inj_on (times b) A"
cf8d8fc23891 tuned some proofs and added some lemmas
haftmann
parents: 66836
diff changeset
  1141
      using \<open>b \<noteq> 0\<close> by (rule inj_on_mult)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1142
    ultimately have "infinite (times b ` A)"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1143
      by (simp add: finite_image_iff)
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1144
    with False show ?thesis
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1145
      by simp
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1146
  next
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1147
    case True
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1148
    then show ?thesis using that
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1149
      by (induct A rule: finite_ne_induct) (auto simp: lcm_mult_left)
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1150
  qed
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1151
qed
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1152
65811
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1153
lemma unit_factor_Gcd_fin:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1154
  "unit_factor (Gcd\<^sub>f\<^sub>i\<^sub>n A) = of_bool (Gcd\<^sub>f\<^sub>i\<^sub>n A \<noteq> 0)"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1155
  by (rule normalize_idem_imp_unit_factor_eq) simp
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1156
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1157
lemma unit_factor_Lcm_fin:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1158
  "unit_factor (Lcm\<^sub>f\<^sub>i\<^sub>n A) = of_bool (Lcm\<^sub>f\<^sub>i\<^sub>n A \<noteq> 0)"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1159
  by (rule normalize_idem_imp_unit_factor_eq) simp
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1160
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1161
lemma is_unit_Gcd_fin_iff [simp]:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1162
  "is_unit (Gcd\<^sub>f\<^sub>i\<^sub>n A) \<longleftrightarrow> Gcd\<^sub>f\<^sub>i\<^sub>n A = 1"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1163
  by (rule normalize_idem_imp_is_unit_iff) simp
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1164
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1165
lemma is_unit_Lcm_fin_iff [simp]:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1166
  "is_unit (Lcm\<^sub>f\<^sub>i\<^sub>n A) \<longleftrightarrow> Lcm\<^sub>f\<^sub>i\<^sub>n A = 1"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1167
  by (rule normalize_idem_imp_is_unit_iff) simp
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1168
 
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1169
lemma Gcd_fin_0_iff:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1170
  "Gcd\<^sub>f\<^sub>i\<^sub>n A = 0 \<longleftrightarrow> A \<subseteq> {0} \<and> finite A"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1171
  by (induct A rule: infinite_finite_induct) simp_all
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1172
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1173
lemma Lcm_fin_0_iff:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1174
  "Lcm\<^sub>f\<^sub>i\<^sub>n A = 0 \<longleftrightarrow> 0 \<in> A" if "finite A"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1175
  using that by (induct A) (auto simp: lcm_eq_0_iff)
65811
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1176
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1177
lemma Lcm_fin_1_iff:
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1178
  "Lcm\<^sub>f\<^sub>i\<^sub>n A = 1 \<longleftrightarrow> (\<forall>a\<in>A. is_unit a) \<and> finite A"
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1179
  by (induct A rule: infinite_finite_induct) simp_all
2653f1cd8775 more lemmas
haftmann
parents: 65555
diff changeset
  1180
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1181
end
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1182
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1183
context semiring_Gcd
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1184
begin
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1185
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1186
lemma Gcd_fin_eq_Gcd [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1187
  "Gcd\<^sub>f\<^sub>i\<^sub>n A = Gcd A" if "finite A" for A :: "'a set"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1188
  using that by induct simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1189
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1190
lemma Gcd_set_eq_fold [code_unfold]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1191
  "Gcd (set xs) = fold gcd xs 0"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1192
  by (simp add: Gcd_fin.set_eq_fold [symmetric])
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1193
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1194
lemma Lcm_fin_eq_Lcm [simp]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1195
  "Lcm\<^sub>f\<^sub>i\<^sub>n A = Lcm A" if "finite A" for A :: "'a set"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1196
  using that by induct simp_all
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1197
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1198
lemma Lcm_set_eq_fold [code_unfold]:
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1199
  "Lcm (set xs) = fold lcm xs 1"
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1200
  by (simp add: Lcm_fin.set_eq_fold [symmetric])
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1201
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  1202
end
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1203
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1204
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1205
subsection \<open>Coprimality\<close>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1206
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1207
context semiring_gcd
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1208
begin
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1209
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1210
lemma coprime_imp_gcd_eq_1 [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1211
  "gcd a b = 1" if "coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1212
proof -
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1213
  define t r s where "t = gcd a b" and "r = a div t" and "s = b div t"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1214
  then have "a = t * r" and "b = t * s"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1215
    by simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1216
  with that have "coprime (t * r) (t * s)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1217
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1218
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1219
    by (simp add: t_def)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1220
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1221
68270
2bc921b2159b treat gcd_eq_1_imp_coprime analogously to mod_0_imp_dvd
haftmann
parents: 67399
diff changeset
  1222
lemma gcd_eq_1_imp_coprime [dest!]:
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1223
  "coprime a b" if "gcd a b = 1"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1224
proof (rule coprimeI)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1225
  fix c
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1226
  assume "c dvd a" and "c dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1227
  then have "c dvd gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1228
    by (rule gcd_greatest)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1229
  with that show "is_unit c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1230
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1231
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1232
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1233
lemma coprime_iff_gcd_eq_1 [presburger, code]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1234
  "coprime a b \<longleftrightarrow> gcd a b = 1"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1235
  by rule (simp_all add: gcd_eq_1_imp_coprime)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1236
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1237
lemma is_unit_gcd [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1238
  "is_unit (gcd a b) \<longleftrightarrow> coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1239
  by (simp add: coprime_iff_gcd_eq_1)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1240
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1241
lemma coprime_add_one_left [simp]: "coprime (a + 1) a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1242
  by (simp add: gcd_eq_1_imp_coprime ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1243
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1244
lemma coprime_add_one_right [simp]: "coprime a (a + 1)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1245
  using coprime_add_one_left [of a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1246
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1247
lemma coprime_mult_left_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1248
  "coprime (a * b) c \<longleftrightarrow> coprime a c \<and> coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1249
proof
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1250
  assume "coprime (a * b) c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1251
  with coprime_common_divisor [of "a * b" c]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1252
  have *: "is_unit d" if "d dvd a * b" and "d dvd c" for d
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1253
    using that by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1254
  have "coprime a c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1255
    by (rule coprimeI, rule *) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1256
  moreover have "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1257
    by (rule coprimeI, rule *) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1258
  ultimately show "coprime a c \<and> coprime b c" ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1259
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1260
  assume "coprime a c \<and> coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1261
  then have "coprime a c" "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1262
    by simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1263
  show "coprime (a * b) c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1264
  proof (rule coprimeI)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1265
    fix d
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1266
    assume "d dvd a * b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1267
    then obtain r s where d: "d = r * s" "r dvd a" "s dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1268
      by (rule dvd_productE)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1269
    assume "d dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1270
    with d have "r * s dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1271
      by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1272
    then have "r dvd c" "s dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1273
      by (auto intro: dvd_mult_left dvd_mult_right)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1274
    from \<open>coprime a c\<close> \<open>r dvd a\<close> \<open>r dvd c\<close>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1275
    have "is_unit r"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1276
      by (rule coprime_common_divisor)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1277
    moreover from \<open>coprime b c\<close> \<open>s dvd b\<close> \<open>s dvd c\<close>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1278
    have "is_unit s"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1279
      by (rule coprime_common_divisor)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1280
    ultimately show "is_unit d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1281
      by (simp add: d is_unit_mult_iff)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1282
  qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1283
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1284
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1285
lemma coprime_mult_right_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1286
  "coprime c (a * b) \<longleftrightarrow> coprime c a \<and> coprime c b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1287
  using coprime_mult_left_iff [of a b c] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1288
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1289
lemma coprime_power_left_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1290
  "coprime (a ^ n) b \<longleftrightarrow> coprime a b \<or> n = 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1291
proof (cases "n = 0")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1292
  case True
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1293
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1294
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1295
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1296
  case False
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1297
  then have "n > 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1298
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1299
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1300
    by (induction n rule: nat_induct_non_zero) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1301
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1302
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1303
lemma coprime_power_right_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1304
  "coprime a (b ^ n) \<longleftrightarrow> coprime a b \<or> n = 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1305
  using coprime_power_left_iff [of b n a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1306
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1307
lemma prod_coprime_left:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1308
  "coprime (\<Prod>i\<in>A. f i) a" if "\<And>i. i \<in> A \<Longrightarrow> coprime (f i) a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1309
  using that by (induct A rule: infinite_finite_induct) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1310
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1311
lemma prod_coprime_right:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1312
  "coprime a (\<Prod>i\<in>A. f i)" if "\<And>i. i \<in> A \<Longrightarrow> coprime a (f i)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1313
  using that prod_coprime_left [of A f a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1314
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1315
lemma prod_list_coprime_left:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1316
  "coprime (prod_list xs) a" if "\<And>x. x \<in> set xs \<Longrightarrow> coprime x a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1317
  using that by (induct xs) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1318
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1319
lemma prod_list_coprime_right:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1320
  "coprime a (prod_list xs)" if "\<And>x. x \<in> set xs \<Longrightarrow> coprime a x"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1321
  using that prod_list_coprime_left [of xs a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1322
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1323
lemma coprime_dvd_mult_left_iff:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1324
  "a dvd b * c \<longleftrightarrow> a dvd b" if "coprime a c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1325
proof
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1326
  assume "a dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1327
  then show "a dvd b * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1328
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1329
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1330
  assume "a dvd b * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1331
  show "a dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1332
  proof (cases "b = 0")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1333
    case True
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1334
    then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1335
      by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1336
  next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1337
    case False
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1338
    then have unit: "is_unit (unit_factor b)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1339
      by simp
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1340
    from \<open>coprime a c\<close>
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1341
    have "gcd (b * a) (b * c) * unit_factor b = b"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1342
      by (subst gcd_mult_left) (simp add: ac_simps)
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1343
    moreover from \<open>a dvd b * c\<close>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1344
    have "a dvd gcd (b * a) (b * c) * unit_factor b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1345
      by (simp add: dvd_mult_unit_iff unit)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1346
    ultimately show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1347
      by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1348
  qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1349
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1350
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1351
lemma coprime_dvd_mult_right_iff:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1352
  "a dvd c * b \<longleftrightarrow> a dvd b" if "coprime a c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1353
  using that coprime_dvd_mult_left_iff [of a c b] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1354
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1355
lemma divides_mult:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1356
  "a * b dvd c" if "a dvd c" and "b dvd c" and "coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1357
proof -
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1358
  from \<open>b dvd c\<close> obtain b' where "c = b * b'" ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1359
  with \<open>a dvd c\<close> have "a dvd b' * b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1360
    by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1361
  with \<open>coprime a b\<close> have "a dvd b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1362
    by (simp add: coprime_dvd_mult_left_iff)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1363
  then obtain a' where "b' = a * a'" ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1364
  with \<open>c = b * b'\<close> have "c = (a * b) * a'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1365
    by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1366
  then show ?thesis ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1367
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1368
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1369
lemma div_gcd_coprime:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1370
  assumes "a \<noteq> 0 \<or> b \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1371
  shows "coprime (a div gcd a b) (b div gcd a b)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1372
proof -
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1373
  let ?g = "gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1374
  let ?a' = "a div ?g"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1375
  let ?b' = "b div ?g"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1376
  let ?g' = "gcd ?a' ?b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1377
  have dvdg: "?g dvd a" "?g dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1378
    by simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1379
  have dvdg': "?g' dvd ?a'" "?g' dvd ?b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1380
    by simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1381
  from dvdg dvdg' obtain ka kb ka' kb' where
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1382
    kab: "a = ?g * ka" "b = ?g * kb" "?a' = ?g' * ka'" "?b' = ?g' * kb'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1383
    unfolding dvd_def by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1384
  from this [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1385
    by (simp_all add: mult.assoc mult.left_commute [of "gcd a b"])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1386
  then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1387
    by (auto simp: dvd_mult_div_cancel [OF dvdg(1)] dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1388
  have "?g \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1389
    using assms by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1390
  moreover from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1391
  ultimately show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1392
    using dvd_times_left_cancel_iff [of "gcd a b" _ 1]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1393
    by simp (simp only: coprime_iff_gcd_eq_1)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1394
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1395
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1396
lemma gcd_coprime:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1397
  assumes c: "gcd a b \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1398
    and a: "a = a' * gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1399
    and b: "b = b' * gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1400
  shows "coprime a' b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1401
proof -
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1402
  from c have "a \<noteq> 0 \<or> b \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1403
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1404
  with div_gcd_coprime have "coprime (a div gcd a b) (b div gcd a b)" .
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1405
  also from assms have "a div gcd a b = a'"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1406
    using dvd_div_eq_mult gcd_dvd1 by blast
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1407
  also from assms have "b div gcd a b = b'"
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1408
    using dvd_div_eq_mult gcd_dvd1 by blast
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1409
  finally show ?thesis .
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1410
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1411
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1412
lemma gcd_coprime_exists:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1413
  assumes "gcd a b \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1414
  shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1415
proof -
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1416
  have "coprime (a div gcd a b) (b div gcd a b)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1417
    using assms div_gcd_coprime by auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1418
  then show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1419
    by force
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1420
qed
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1421
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1422
lemma pow_divides_pow_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1423
  "a ^ n dvd b ^ n \<longleftrightarrow> a dvd b" if "n > 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1424
proof (cases "gcd a b = 0")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1425
  case True
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1426
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1427
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1428
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1429
  case False
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1430
  show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1431
  proof
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1432
    let ?d = "gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1433
    from \<open>n > 0\<close> obtain m where m: "n = Suc m"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1434
      by (cases n) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1435
    from False have zn: "?d ^ n \<noteq> 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1436
      by (rule power_not_zero)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1437
    from gcd_coprime_exists [OF False]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1438
    obtain a' b' where ab': "a = a' * ?d" "b = b' * ?d" "coprime a' b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1439
      by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1440
    assume "a ^ n dvd b ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1441
    then have "(a' * ?d) ^ n dvd (b' * ?d) ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1442
      by (simp add: ab'(1,2)[symmetric])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1443
    then have "?d^n * a'^n dvd ?d^n * b'^n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1444
      by (simp only: power_mult_distrib ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1445
    with zn have "a' ^ n dvd b' ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1446
      by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1447
    then have "a' dvd b' ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1448
      using dvd_trans[of a' "a'^n" "b'^n"] by (simp add: m)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1449
    then have "a' dvd b' ^ m * b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1450
      by (simp add: m ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1451
    moreover have "coprime a' (b' ^ n)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1452
      using \<open>coprime a' b'\<close> by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1453
    then have "a' dvd b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1454
      using \<open>a' dvd b' ^ n\<close> coprime_dvd_mult_left_iff dvd_mult by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1455
    then have "a' * ?d dvd b' * ?d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1456
      by (rule mult_dvd_mono) simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1457
    with ab'(1,2) show "a dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1458
      by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1459
  next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1460
    assume "a dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1461
    with \<open>n > 0\<close> show "a ^ n dvd b ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1462
      by (induction rule: nat_induct_non_zero)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1463
        (simp_all add: mult_dvd_mono)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1464
  qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1465
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1466
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1467
lemma coprime_crossproduct:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1468
  fixes a b c d :: 'a
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1469
  assumes "coprime a d" and "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1470
  shows "normalize a * normalize c = normalize b * normalize d \<longleftrightarrow>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1471
    normalize a = normalize b \<and> normalize c = normalize d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1472
    (is "?lhs \<longleftrightarrow> ?rhs")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1473
proof
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1474
  assume ?rhs
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1475
  then show ?lhs by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1476
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1477
  assume ?lhs
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1478
  from \<open>?lhs\<close> have "normalize a dvd normalize b * normalize d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1479
    by (auto intro: dvdI dest: sym)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1480
  with \<open>coprime a d\<close> have "a dvd b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1481
    by (simp add: coprime_dvd_mult_left_iff normalize_mult [symmetric])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1482
  from \<open>?lhs\<close> have "normalize b dvd normalize a * normalize c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1483
    by (auto intro: dvdI dest: sym)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1484
  with \<open>coprime b c\<close> have "b dvd a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1485
    by (simp add: coprime_dvd_mult_left_iff normalize_mult [symmetric])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1486
  from \<open>?lhs\<close> have "normalize c dvd normalize d * normalize b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1487
    by (auto intro: dvdI dest: sym simp add: mult.commute)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1488
  with \<open>coprime b c\<close> have "c dvd d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1489
    by (simp add: coprime_dvd_mult_left_iff coprime_commute normalize_mult [symmetric])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1490
  from \<open>?lhs\<close> have "normalize d dvd normalize c * normalize a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1491
    by (auto intro: dvdI dest: sym simp add: mult.commute)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1492
  with \<open>coprime a d\<close> have "d dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1493
    by (simp add: coprime_dvd_mult_left_iff coprime_commute normalize_mult [symmetric])
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1494
  from \<open>a dvd b\<close> \<open>b dvd a\<close> have "normalize a = normalize b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1495
    by (rule associatedI)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1496
  moreover from \<open>c dvd d\<close> \<open>d dvd c\<close> have "normalize c = normalize d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1497
    by (rule associatedI)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1498
  ultimately show ?rhs ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1499
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1500
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1501
lemma gcd_mult_left_left_cancel:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1502
  "gcd (c * a) b = gcd a b" if "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1503
proof -
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1504
  have "coprime (gcd b (a * c)) c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1505
    by (rule coprimeI) (auto intro: that coprime_common_divisor)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1506
  then have "gcd b (a * c) dvd a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1507
    using coprime_dvd_mult_left_iff [of "gcd b (a * c)" c a]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1508
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1509
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1510
    by (auto intro: associated_eqI simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1511
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1512
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1513
lemma gcd_mult_left_right_cancel:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1514
  "gcd (a * c) b = gcd a b" if "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1515
  using that gcd_mult_left_left_cancel [of b c a]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1516
  by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1517
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1518
lemma gcd_mult_right_left_cancel:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1519
  "gcd a (c * b) = gcd a b" if "coprime a c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1520
  using that gcd_mult_left_left_cancel [of a c b]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1521
  by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1522
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1523
lemma gcd_mult_right_right_cancel:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1524
  "gcd a (b * c) = gcd a b" if "coprime a c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1525
  using that gcd_mult_right_left_cancel [of a c b]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1526
  by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1527
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1528
lemma gcd_exp_weak:
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1529
  "gcd (a ^ n) (b ^ n) = normalize (gcd a b ^ n)"
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1530
proof (cases "a = 0 \<and> b = 0 \<or> n = 0")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1531
  case True
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1532
  then show ?thesis
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1533
    by (cases n) simp_all
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1534
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1535
  case False
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1536
  then have "coprime (a div gcd a b) (b div gcd a b)" and "n > 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1537
    by (auto intro: div_gcd_coprime)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1538
  then have "coprime ((a div gcd a b) ^ n) ((b div gcd a b) ^ n)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1539
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1540
  then have "1 = gcd ((a div gcd a b) ^ n) ((b div gcd a b) ^ n)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1541
    by simp
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1542
  then have "normalize (gcd a b ^ n) = normalize (gcd a b ^ n * \<dots>)"
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1543
    by simp
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1544
  also have "\<dots> = gcd (gcd a b ^ n * (a div gcd a b) ^ n) (gcd a b ^ n * (b div gcd a b) ^ n)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1545
    by (rule gcd_mult_left [symmetric])
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1546
  also have "(gcd a b) ^ n * (a div gcd a b) ^ n = a ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1547
    by (simp add: ac_simps div_power dvd_power_same)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1548
  also have "(gcd a b) ^ n * (b div gcd a b) ^ n = b ^ n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1549
    by (simp add: ac_simps div_power dvd_power_same)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1550
  finally show ?thesis by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1551
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1552
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1553
lemma division_decomp:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1554
  assumes "a dvd b * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1555
  shows "\<exists>b' c'. a = b' * c' \<and> b' dvd b \<and> c' dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1556
proof (cases "gcd a b = 0")
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1557
  case True
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1558
  then have "a = 0 \<and> b = 0"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1559
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1560
  then have "a = 0 * c \<and> 0 dvd b \<and> c dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1561
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1562
  then show ?thesis by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1563
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1564
  case False
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1565
  let ?d = "gcd a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1566
  from gcd_coprime_exists [OF False]
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1567
    obtain a' b' where ab': "a = a' * ?d" "b = b' * ?d" "coprime a' b'"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1568
    by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1569
  from ab'(1) have "a' dvd a" ..
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1570
  with assms have "a' dvd b * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1571
    using dvd_trans [of a' a "b * c"] by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1572
  from assms ab'(1,2) have "a' * ?d dvd (b' * ?d) * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1573
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1574
  then have "?d * a' dvd ?d * (b' * c)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1575
    by (simp add: mult_ac)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1576
  with \<open>?d \<noteq> 0\<close> have "a' dvd b' * c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1577
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1578
  then have "a' dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1579
    using \<open>coprime a' b'\<close> by (simp add: coprime_dvd_mult_right_iff)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1580
  with ab'(1) have "a = ?d * a' \<and> ?d dvd b \<and> a' dvd c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1581
    by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1582
  then show ?thesis by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1583
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1584
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1585
lemma lcm_coprime: "coprime a b \<Longrightarrow> lcm a b = normalize (a * b)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1586
  by (subst lcm_gcd) simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1587
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1588
end
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1589
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1590
context ring_gcd
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1591
begin
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1592
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1593
lemma coprime_minus_left_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1594
  "coprime (- a) b \<longleftrightarrow> coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1595
  by (rule; rule coprimeI) (auto intro: coprime_common_divisor)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1596
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1597
lemma coprime_minus_right_iff [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1598
  "coprime a (- b) \<longleftrightarrow> coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1599
  using coprime_minus_left_iff [of b a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1600
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1601
lemma coprime_diff_one_left [simp]: "coprime (a - 1) a"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1602
  using coprime_add_one_right [of "a - 1"] by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1603
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1604
lemma coprime_doff_one_right [simp]: "coprime a (a - 1)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1605
  using coprime_diff_one_left [of a] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1606
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1607
end
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1608
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1609
context semiring_Gcd
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1610
begin
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1611
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1612
lemma Lcm_coprime:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1613
  assumes "finite A"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1614
    and "A \<noteq> {}"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1615
    and "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<noteq> b \<Longrightarrow> coprime a b"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1616
  shows "Lcm A = normalize (\<Prod>A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1617
  using assms
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1618
proof (induct rule: finite_ne_induct)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1619
  case singleton
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1620
  then show ?case by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1621
next
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1622
  case (insert a A)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1623
  have "Lcm (insert a A) = lcm a (Lcm A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1624
    by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1625
  also from insert have "Lcm A = normalize (\<Prod>A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1626
    by blast
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1627
  also have "lcm a \<dots> = lcm a (\<Prod>A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1628
    by (cases "\<Prod>A = 0") (simp_all add: lcm_div_unit2)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1629
  also from insert have "coprime a (\<Prod>A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1630
    by (subst coprime_commute, intro prod_coprime_left) auto
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1631
  with insert have "lcm a (\<Prod>A) = normalize (\<Prod>(insert a A))"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1632
    by (simp add: lcm_coprime)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1633
  finally show ?case .
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1634
qed
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1635
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1636
lemma Lcm_coprime':
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1637
  "card A \<noteq> 0 \<Longrightarrow>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1638
    (\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<noteq> b \<Longrightarrow> coprime a b) \<Longrightarrow>
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1639
    Lcm A = normalize (\<Prod>A)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1640
  by (rule Lcm_coprime) (simp_all add: card_eq_0_iff)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1641
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1642
end
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1643
74965
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1644
text \<open>And some consequences: cancellation modulo @{term m}\<close>
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1645
lemma mult_mod_cancel_right:
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1646
  fixes m :: "'a::{euclidean_ring_cancel,semiring_gcd}"
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1647
  assumes eq: "(a * n) mod m = (b * n) mod m" and "coprime m n" 
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1648
  shows "a mod m = b mod m"
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1649
proof -
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1650
  have "m dvd (a*n - b*n)" 
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1651
    using eq mod_eq_dvd_iff by blast
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1652
  then have "m dvd a-b"
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1653
    by (metis \<open>coprime m n\<close> coprime_dvd_mult_left_iff left_diff_distrib')
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1654
  then show ?thesis
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1655
    using mod_eq_dvd_iff by blast
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1656
qed
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1657
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1658
lemma mult_mod_cancel_left:
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1659
  fixes m :: "'a::{euclidean_ring_cancel,semiring_gcd}"
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1660
  assumes "(n * a) mod m = (n * b) mod m" and "coprime m n" 
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1661
  shows "a mod m = b mod m"
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1662
  by (metis assms mult.commute mult_mod_cancel_right)
9469d9223689 Tiny additions inspired by Roth development
paulson <lp15@cam.ac.uk>
parents: 74101
diff changeset
  1663
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  1664
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1665
subsection \<open>GCD and LCM for multiplicative normalisation functions\<close>
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1666
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1667
class semiring_gcd_mult_normalize = semiring_gcd + normalization_semidom_multiplicative
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1668
begin
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1669
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1670
lemma mult_gcd_left: "c * gcd a b = unit_factor c * gcd (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1671
  by (simp add: gcd_mult_left normalize_mult mult.assoc [symmetric])
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1672
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1673
lemma mult_gcd_right: "gcd a b * c = gcd (a * c) (b * c) * unit_factor c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1674
  using mult_gcd_left [of c a b] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1675
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1676
lemma gcd_mult_distrib': "normalize c * gcd a b = gcd (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1677
  by (subst gcd_mult_left) (simp_all add: normalize_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1678
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1679
lemma gcd_mult_distrib: "k * gcd a b = gcd (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1680
proof-
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1681
  have "normalize k * gcd a b = gcd (k * a) (k * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1682
    by (simp add: gcd_mult_distrib')
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1683
  then have "normalize k * gcd a b * unit_factor k = gcd (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1684
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1685
  then have "normalize k * unit_factor k * gcd a b  = gcd (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1686
    by (simp only: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1687
  then show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1688
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1689
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1690
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1691
lemma gcd_mult_lcm [simp]: "gcd a b * lcm a b = normalize a * normalize b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1692
  by (simp add: lcm_gcd normalize_mult dvd_normalize_div)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1693
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1694
lemma lcm_mult_gcd [simp]: "lcm a b * gcd a b = normalize a * normalize b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1695
  using gcd_mult_lcm [of a b] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1696
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1697
lemma mult_lcm_left: "c * lcm a b = unit_factor c * lcm (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1698
  by (simp add: lcm_mult_left mult.assoc [symmetric] normalize_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1699
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1700
lemma mult_lcm_right: "lcm a b * c = lcm (a * c) (b * c) * unit_factor c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1701
  using mult_lcm_left [of c a b] by (simp add: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1702
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1703
lemma lcm_gcd_prod: "lcm a b * gcd a b = normalize (a * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1704
  by (simp add: lcm_gcd dvd_normalize_div normalize_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1705
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1706
lemma lcm_mult_distrib': "normalize c * lcm a b = lcm (c * a) (c * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1707
  by (subst lcm_mult_left) (simp add: normalize_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1708
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1709
lemma lcm_mult_distrib: "k * lcm a b = lcm (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1710
proof-
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1711
  have "normalize k * lcm a b = lcm (k * a) (k * b)"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1712
    by (simp add: lcm_mult_distrib')
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1713
  then have "normalize k * lcm a b * unit_factor k = lcm (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1714
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1715
  then have "normalize k * unit_factor k * lcm a b  = lcm (k * a) (k * b) * unit_factor k"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1716
    by (simp only: ac_simps)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1717
  then show ?thesis
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1718
    by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1719
qed
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1720
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1721
lemma coprime_crossproduct':
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1722
  fixes a b c d
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1723
  assumes "b \<noteq> 0"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1724
  assumes unit_factors: "unit_factor b = unit_factor d"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1725
  assumes coprime: "coprime a b" "coprime c d"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1726
  shows "a * d = b * c \<longleftrightarrow> a = c \<and> b = d"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1727
proof safe
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1728
  assume eq: "a * d = b * c"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1729
  hence "normalize a * normalize d = normalize c * normalize b"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1730
    by (simp only: normalize_mult [symmetric] mult_ac)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1731
  with coprime have "normalize b = normalize d"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1732
    by (subst (asm) coprime_crossproduct) simp_all
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1733
  from this and unit_factors show "b = d"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1734
    by (rule normalize_unit_factor_eqI)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1735
  from eq have "a * d = c * d" by (simp only: \<open>b = d\<close> mult_ac)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1736
  with \<open>b \<noteq> 0\<close> \<open>b = d\<close> show "a = c" by simp
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1737
qed (simp_all add: mult_ac)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1738
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1739
lemma gcd_exp [simp]:
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1740
  "gcd (a ^ n) (b ^ n) = gcd a b ^ n"
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1741
  using gcd_exp_weak[of a n b] by (simp add: normalize_power)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1742
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1743
end
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1744
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1745
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69064
diff changeset
  1746
subsection \<open>GCD and LCM on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1747
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1748
instantiation nat :: gcd
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1749
begin
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1750
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1751
fun gcd_nat  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1752
  where "gcd_nat x y = (if y = 0 then x else gcd y (x mod y))"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1753
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1754
definition lcm_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1755
  where "lcm_nat x y = x * y div (gcd x y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1756
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1757
instance ..
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1758
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1759
end
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1760
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1761
instantiation int :: gcd
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1762
begin
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1763
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1764
definition gcd_int  :: "int \<Rightarrow> int \<Rightarrow> int"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1765
  where "gcd_int x y = int (gcd (nat \<bar>x\<bar>) (nat \<bar>y\<bar>))"
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1766
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1767
definition lcm_int :: "int \<Rightarrow> int \<Rightarrow> int"
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  1768
  where "lcm_int x y = int (lcm (nat \<bar>x\<bar>) (nat \<bar>y\<bar>))"
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1769
61944
5d06ecfdb472 prefer symbols for "abs";
wenzelm
parents: 61929
diff changeset
  1770
instance ..
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1771
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1772
end
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1773
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1774
lemma gcd_int_int_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1775
  "gcd (int m) (int n) = int (gcd m n)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1776
  by (simp add: gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1777
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1778
lemma gcd_nat_abs_left_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1779
  "gcd (nat \<bar>k\<bar>) n = nat (gcd k (int n))"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1780
  by (simp add: gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1781
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1782
lemma gcd_nat_abs_right_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1783
  "gcd n (nat \<bar>k\<bar>) = nat (gcd (int n) k)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1784
  by (simp add: gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1785
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1786
lemma abs_gcd_int [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1787
  "\<bar>gcd x y\<bar> = gcd x y"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1788
  for x y :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1789
  by (simp only: gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1790
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1791
lemma gcd_abs1_int [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1792
  "gcd \<bar>x\<bar> y = gcd x y"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1793
  for x y :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1794
  by (simp only: gcd_int_def) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1795
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1796
lemma gcd_abs2_int [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1797
  "gcd x \<bar>y\<bar> = gcd x y"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1798
  for x y :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1799
  by (simp only: gcd_int_def) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1800
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1801
lemma lcm_int_int_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1802
  "lcm (int m) (int n) = int (lcm m n)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1803
  by (simp add: lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1804
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1805
lemma lcm_nat_abs_left_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1806
  "lcm (nat \<bar>k\<bar>) n = nat (lcm k (int n))"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1807
  by (simp add: lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1808
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1809
lemma lcm_nat_abs_right_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1810
  "lcm n (nat \<bar>k\<bar>) = nat (lcm (int n) k)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1811
  by (simp add: lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1812
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1813
lemma lcm_abs1_int [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1814
  "lcm \<bar>x\<bar> y = lcm x y"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1815
  for x y :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1816
  by (simp only: lcm_int_def) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1817
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1818
lemma lcm_abs2_int [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1819
  "lcm x \<bar>y\<bar> = lcm x y"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1820
  for x y :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1821
  by (simp only: lcm_int_def) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1822
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1823
lemma abs_lcm_int [simp]: "\<bar>lcm i j\<bar> = lcm i j"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1824
  for i j :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1825
  by (simp only: lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1826
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1827
lemma gcd_nat_induct [case_names base step]:
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1828
  fixes m n :: nat
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1829
  assumes "\<And>m. P m 0"
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1830
    and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1831
  shows "P m n"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1832
proof (induction m n rule: gcd_nat.induct)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1833
  case (1 x y)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1834
  then show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1835
    using assms neq0_conv by blast
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1836
qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1837
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1838
lemma gcd_neg1_int [simp]: "gcd (- x) y = gcd x y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1839
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1840
  by (simp only: gcd_int_def) simp
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1841
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1842
lemma gcd_neg2_int [simp]: "gcd x (- y) = gcd x y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1843
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1844
  by (simp only: gcd_int_def) simp
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1845
31952
40501bb2d57c renamed lemmas: nat_xyz/int_xyz -> xyz_nat/xyz_int
nipkow
parents: 31814
diff changeset
  1846
lemma gcd_cases_int:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1847
  fixes x y :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1848
  assumes "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (gcd x y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1849
    and "x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (gcd x (- y))"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1850
    and "x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (gcd (- x) y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1851
    and "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (gcd (- x) (- y))"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1852
  shows "P (gcd x y)"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1853
  using assms by auto arith
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1854
31952
40501bb2d57c renamed lemmas: nat_xyz/int_xyz -> xyz_nat/xyz_int
nipkow
parents: 31814
diff changeset
  1855
lemma gcd_ge_0_int [simp]: "gcd (x::int) y >= 0"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1856
  for x y :: int
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1857
  by (simp add: gcd_int_def)
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1858
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1859
lemma lcm_neg1_int: "lcm (- x) y = lcm x y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1860
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1861
  by (simp only: lcm_int_def) simp
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1862
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1863
lemma lcm_neg2_int: "lcm x (- y) = lcm x y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1864
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1865
  by (simp only: lcm_int_def) simp
31814
7c122634da81 lcm abs lemmas
nipkow
parents: 31813
diff changeset
  1866
31952
40501bb2d57c renamed lemmas: nat_xyz/int_xyz -> xyz_nat/xyz_int
nipkow
parents: 31814
diff changeset
  1867
lemma lcm_cases_int:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1868
  fixes x y :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1869
  assumes "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (lcm x y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1870
    and "x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (lcm x (- y))"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1871
    and "x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (lcm (- x) y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1872
    and "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (lcm (- x) (- y))"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1873
  shows "P (lcm x y)"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1874
  using assms by (auto simp: lcm_neg1_int lcm_neg2_int) arith
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1875
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1876
lemma lcm_ge_0_int [simp]: "lcm x y \<ge> 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1877
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1878
  by (simp only: lcm_int_def)
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1879
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1880
lemma gcd_0_nat: "gcd x 0 = x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1881
  for x :: nat
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1882
  by simp
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1883
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1884
lemma gcd_0_int [simp]: "gcd x 0 = \<bar>x\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1885
  for x :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1886
  by (auto simp: gcd_int_def)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1887
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1888
lemma gcd_0_left_nat: "gcd 0 x = x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1889
  for x :: nat
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1890
  by simp
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  1891
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1892
lemma gcd_0_left_int [simp]: "gcd 0 x = \<bar>x\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1893
  for x :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1894
  by (auto simp: gcd_int_def)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1895
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1896
lemma gcd_red_nat: "gcd x y = gcd y (x mod y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1897
  for x y :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1898
  by (cases "y = 0") auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1899
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1900
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1901
text \<open>Weaker, but useful for the simplifier.\<close>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1902
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1903
lemma gcd_non_0_nat: "y \<noteq> 0 \<Longrightarrow> gcd x y = gcd y (x mod y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1904
  for x y :: nat
21263
wenzelm
parents: 21256
diff changeset
  1905
  by simp
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1906
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1907
lemma gcd_1_nat [simp]: "gcd m 1 = 1"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1908
  for m :: nat
60690
a9e45c9588c3 tuned facts
haftmann
parents: 60689
diff changeset
  1909
  by simp
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1910
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1911
lemma gcd_Suc_0 [simp]: "gcd m (Suc 0) = Suc 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1912
  for m :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1913
  by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1914
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1915
lemma gcd_1_int [simp]: "gcd m 1 = 1"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1916
  for m :: int
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1917
  by (simp add: gcd_int_def)
30082
43c5b7bfc791 make more proofs work whether or not One_nat_def is a simp rule
huffman
parents: 30042
diff changeset
  1918
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1919
lemma gcd_idem_nat: "gcd x x = x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1920
  for x :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1921
  by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1922
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1923
lemma gcd_idem_int: "gcd x x = \<bar>x\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1924
  for x :: int
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1925
  by (auto simp: gcd_int_def)
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1926
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  1927
declare gcd_nat.simps [simp del]
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1928
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  1929
text \<open>
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69064
diff changeset
  1930
  \<^medskip> \<^term>\<open>gcd m n\<close> divides \<open>m\<close> and \<open>n\<close>.
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1931
  The conjunctions don't seem provable separately.
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  1932
\<close>
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  1933
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1934
instance nat :: semiring_gcd
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1935
proof
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1936
  fix m n :: nat
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1937
  show "gcd m n dvd m" and "gcd m n dvd n"
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1938
  proof (induct m n rule: gcd_nat_induct)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1939
    case (step m n)
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1940
    then have "gcd n (m mod n) dvd m"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1941
      by (metis dvd_mod_imp_dvd)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1942
    with step show "gcd m n dvd m"
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1943
      by (simp add: gcd_non_0_nat)
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1944
  qed (simp_all add: gcd_0_nat gcd_non_0_nat)
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1945
next
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1946
  fix m n k :: nat
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1947
  assume "k dvd m" and "k dvd n"
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1948
  then show "k dvd gcd m n"
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1949
    by (induct m n rule: gcd_nat_induct) (simp_all add: gcd_non_0_nat dvd_mod gcd_0_nat)
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
  1950
qed (simp_all add: lcm_nat_def)
59667
651ea265d568 Removal of the file HOL/Number_Theory/Binomial!! And class field_char_0 now declared in Int.thy
paulson <lp15@cam.ac.uk>
parents: 59545
diff changeset
  1951
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  1952
instance int :: ring_gcd
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1953
proof
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1954
  fix k l r :: int
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1955
  show [simp]: "gcd k l dvd k" "gcd k l dvd l"
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1956
    using gcd_dvd1 [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1957
      gcd_dvd2 [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1958
    by simp_all
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1959
  show "lcm k l = normalize (k * l div gcd k l)"
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1960
    using lcm_gcd [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  1961
    by (simp add: nat_eq_iff of_nat_div abs_mult abs_div)
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1962
  assume "r dvd k" "r dvd l"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1963
  then show "r dvd gcd k l"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1964
    using gcd_greatest [of "nat \<bar>r\<bar>" "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1965
    by simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  1966
qed simp
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1967
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1968
lemma gcd_le1_nat [simp]: "a \<noteq> 0 \<Longrightarrow> gcd a b \<le> a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1969
  for a b :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1970
  by (rule dvd_imp_le) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1971
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1972
lemma gcd_le2_nat [simp]: "b \<noteq> 0 \<Longrightarrow> gcd a b \<le> b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1973
  for a b :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1974
  by (rule dvd_imp_le) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1975
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1976
lemma gcd_le1_int [simp]: "a > 0 \<Longrightarrow> gcd a b \<le> a"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1977
  for a b :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1978
  by (rule zdvd_imp_le) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1979
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1980
lemma gcd_le2_int [simp]: "b > 0 \<Longrightarrow> gcd a b \<le> b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1981
  for a b :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1982
  by (rule zdvd_imp_le) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1983
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1984
lemma gcd_pos_nat [simp]: "gcd m n > 0 \<longleftrightarrow> m \<noteq> 0 \<or> n \<noteq> 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1985
  for m n :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1986
  using gcd_eq_0_iff [of m n] by arith
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1987
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1988
lemma gcd_pos_int [simp]: "gcd m n > 0 \<longleftrightarrow> m \<noteq> 0 \<or> n \<noteq> 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1989
  for m n :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1990
  using gcd_eq_0_iff [of m n] gcd_ge_0_int [of m n] by arith
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1991
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1992
lemma gcd_unique_nat: "d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1993
  for d a :: nat
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1994
  using gcd_unique by fastforce
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1995
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1996
lemma gcd_unique_int:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1997
  "d \<ge> 0 \<and> d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  1998
  for d a :: int
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  1999
  using zdvd_antisym_nonneg by auto
30082
43c5b7bfc791 make more proofs work whether or not One_nat_def is a simp rule
huffman
parents: 30042
diff changeset
  2000
61913
58b153bfa737 tuned proofs and augmented some lemmas
haftmann
parents: 61856
diff changeset
  2001
interpretation gcd_nat:
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2002
  semilattice_neutr_order gcd "0::nat" Rings.dvd "\<lambda>m n. m dvd n \<and> m \<noteq> n"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2003
  by standard (auto simp: gcd_unique_nat [symmetric] intro: dvd_antisym dvd_trans)
31798
fe9a3043d36c Cleaned up GCD
nipkow
parents: 31766
diff changeset
  2004
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2005
lemma gcd_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> gcd x y = \<bar>x\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2006
  for x y :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2007
  by (metis abs_dvd_iff gcd_0_left_int gcd_unique_int)
31798
fe9a3043d36c Cleaned up GCD
nipkow
parents: 31766
diff changeset
  2008
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2009
lemma gcd_proj2_if_dvd_int [simp]: "y dvd x \<Longrightarrow> gcd x y = \<bar>y\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2010
  for x y :: int
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2011
  by (metis gcd_proj1_if_dvd_int gcd.commute)
31798
fe9a3043d36c Cleaned up GCD
nipkow
parents: 31766
diff changeset
  2012
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2013
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2014
text \<open>\<^medskip> Multiplication laws.\<close>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2015
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2016
lemma gcd_mult_distrib_nat: "k * gcd m n = gcd (k * m) (k * n)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2017
  for k m n :: nat
77172
816959264c32 isabelle update -u cite -l "";
wenzelm
parents: 74965
diff changeset
  2018
  \<comment> \<open>\<^cite>\<open>\<open>page 27\<close> in davenport92\<close>\<close>
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2019
  by (simp add: gcd_mult_left)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2020
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2021
lemma gcd_mult_distrib_int: "\<bar>k\<bar> * gcd m n = gcd (k * m) (k * n)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2022
  for k m n :: int
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2023
  by (simp add: gcd_mult_left abs_mult)
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  2024
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2025
text \<open>\medskip Addition laws.\<close>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2026
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2027
(* TODO: add the other variations? *)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2028
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2029
lemma gcd_diff1_nat: "m \<ge> n \<Longrightarrow> gcd (m - n) n = gcd m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2030
  for m n :: nat
62429
25271ff79171 Tuned Euclidean Rings/GCD rings
Manuel Eberl <eberlm@in.tum.de>
parents: 62353
diff changeset
  2031
  by (subst gcd_add1 [symmetric]) auto
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2032
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2033
lemma gcd_diff2_nat: "n \<ge> m \<Longrightarrow> gcd (n - m) n = gcd m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2034
  for m n :: nat
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2035
  by (metis gcd.commute gcd_add2 gcd_diff1_nat le_add_diff_inverse2)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2036
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2037
lemma gcd_non_0_int: 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2038
  fixes x y :: int
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2039
  assumes "y > 0" shows "gcd x y = gcd y (x mod y)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2040
proof (cases "x mod y = 0")
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2041
  case False
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2042
  then have neg: "x mod y = y - (- x) mod y"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2043
    by (simp add: zmod_zminus1_eq_if)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2044
  have xy: "0 \<le> x mod y" 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2045
    by (simp add: assms)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2046
  show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2047
  proof (cases "x < 0")
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2048
    case True
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2049
    have "nat (- x mod y) \<le> nat y"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2050
      by (simp add: assms dual_order.order_iff_strict)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2051
    moreover have "gcd (nat (- x)) (nat y) = gcd (nat (- x mod y)) (nat y)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2052
      using True assms gcd_non_0_nat nat_mod_distrib by auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2053
    ultimately have "gcd (nat (- x)) (nat y) = gcd (nat y) (nat (x mod y))"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2054
      using assms 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2055
      by (simp add: neg nat_diff_distrib') (metis gcd.commute gcd_diff2_nat)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2056
    with assms \<open>0 \<le> x mod y\<close> show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2057
      by (simp add: True dual_order.order_iff_strict gcd_int_def)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2058
  next
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2059
    case False
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2060
    with assms xy have "gcd (nat x) (nat y) = gcd (nat y) (nat x mod nat y)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2061
      using gcd_red_nat by blast
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2062
    with False assms show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2063
      by (simp add: gcd_int_def nat_mod_distrib)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2064
  qed
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2065
qed (use assms in auto)
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  2066
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2067
lemma gcd_red_int: "gcd x y = gcd y (x mod y)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2068
  for x y :: int
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2069
proof (cases y "0::int" rule: linorder_cases)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2070
  case less
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2071
  with gcd_non_0_int [of "- y" "- x"] show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2072
    by auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2073
next
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2074
  case greater
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2075
  with gcd_non_0_int [of y x] show ?thesis
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2076
    by auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2077
qed auto
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2078
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2079
(* TODO: differences, and all variations of addition rules
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2080
    as simplification rules for nat and int *)
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2081
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2082
(* TODO: add the three variations of these, and for ints? *)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2083
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2084
lemma finite_divisors_nat [simp]: (* FIXME move *)
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2085
  fixes m :: nat
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2086
  assumes "m > 0"
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2087
  shows "finite {d. d dvd m}"
31734
a4a79836d07b new lemmas
nipkow
parents: 31730
diff changeset
  2088
proof-
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2089
  from assms have "{d. d dvd m} \<subseteq> {d. d \<le> m}"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2090
    by (auto dest: dvd_imp_le)
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2091
  then show ?thesis
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2092
    using finite_Collect_le_nat by (rule finite_subset)
31734
a4a79836d07b new lemmas
nipkow
parents: 31730
diff changeset
  2093
qed
a4a79836d07b new lemmas
nipkow
parents: 31730
diff changeset
  2094
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2095
lemma finite_divisors_int [simp]:
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2096
  fixes i :: int
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2097
  assumes "i \<noteq> 0"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2098
  shows "finite {d. d dvd i}"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2099
proof -
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2100
  have "{d. \<bar>d\<bar> \<le> \<bar>i\<bar>} = {- \<bar>i\<bar>..\<bar>i\<bar>}"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2101
    by (auto simp: abs_if)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2102
  then have "finite {d. \<bar>d\<bar> \<le> \<bar>i\<bar>}"
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2103
    by simp
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2104
  from finite_subset [OF _ this] show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2105
    using assms by (simp add: dvd_imp_le_int subset_iff)
31734
a4a79836d07b new lemmas
nipkow
parents: 31730
diff changeset
  2106
qed
a4a79836d07b new lemmas
nipkow
parents: 31730
diff changeset
  2107
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2108
lemma Max_divisors_self_nat [simp]: "n \<noteq> 0 \<Longrightarrow> Max {d::nat. d dvd n} = n"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2109
  by (fastforce intro: antisym Max_le_iff[THEN iffD2] simp: dvd_imp_le)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2110
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2111
lemma Max_divisors_self_int [simp]: 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2112
  assumes "n \<noteq> 0" shows "Max {d::int. d dvd n} = \<bar>n\<bar>"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2113
proof (rule antisym)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2114
  show "Max {d. d dvd n} \<le> \<bar>n\<bar>"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2115
    using assms by (auto intro: abs_le_D1 dvd_imp_le_int intro!: Max_le_iff [THEN iffD2])
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2116
qed (simp add: assms)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2117
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2118
lemma gcd_is_Max_divisors_nat:
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2119
  fixes m n :: nat
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2120
  assumes "n > 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2121
proof (rule Max_eqI[THEN sym], simp_all)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2122
  show "finite {d. d dvd m \<and> d dvd n}"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2123
    by (simp add: \<open>n > 0\<close>)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2124
  show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2125
    by (simp add: \<open>n > 0\<close> dvd_imp_le)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2126
qed
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2127
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2128
lemma gcd_is_Max_divisors_int:
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2129
  fixes m n :: int
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2130
  assumes "n \<noteq> 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2131
proof (rule Max_eqI[THEN sym], simp_all)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2132
  show "finite {d. d dvd m \<and> d dvd n}"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2133
    by (simp add: \<open>n \<noteq> 0\<close>)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2134
  show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2135
    by (simp add: \<open>n \<noteq> 0\<close> zdvd_imp_le)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2136
qed
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2137
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2138
lemma gcd_code_int [code]: "gcd k l = \<bar>if l = 0 then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2139
  for k l :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2140
  using gcd_red_int [of "\<bar>k\<bar>" "\<bar>l\<bar>"] by simp
34030
829eb528b226 resorted code equations from "old" number theory version
haftmann
parents: 33946
diff changeset
  2141
67051
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2142
lemma coprime_Suc_left_nat [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2143
  "coprime (Suc n) n"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2144
  using coprime_add_one_left [of n] by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2145
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2146
lemma coprime_Suc_right_nat [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2147
  "coprime n (Suc n)"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2148
  using coprime_Suc_left_nat [of n] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2149
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2150
lemma coprime_diff_one_left_nat [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2151
  "coprime (n - 1) n" if "n > 0" for n :: nat
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2152
  using that coprime_Suc_right_nat [of "n - 1"] by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2153
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2154
lemma coprime_diff_one_right_nat [simp]:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2155
  "coprime n (n - 1)" if "n > 0" for n :: nat
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2156
  using that coprime_diff_one_left_nat [of n] by (simp add: ac_simps)
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2157
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2158
lemma coprime_crossproduct_nat:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2159
  fixes a b c d :: nat
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2160
  assumes "coprime a d" and "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2161
  shows "a * c = b * d \<longleftrightarrow> a = b \<and> c = d"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2162
  using assms coprime_crossproduct [of a d b c] by simp
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2163
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2164
lemma coprime_crossproduct_int:
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2165
  fixes a b c d :: int
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2166
  assumes "coprime a d" and "coprime b c"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2167
  shows "\<bar>a\<bar> * \<bar>c\<bar> = \<bar>b\<bar> * \<bar>d\<bar> \<longleftrightarrow> \<bar>a\<bar> = \<bar>b\<bar> \<and> \<bar>c\<bar> = \<bar>d\<bar>"
e7e54a0b9197 dedicated definition for coprimality
haftmann
parents: 66936
diff changeset
  2168
  using assms coprime_crossproduct [of a d b c] by simp
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2169
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2170
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  2171
subsection \<open>Bezout's theorem\<close>
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2172
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2173
text \<open>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2174
  Function \<open>bezw\<close> returns a pair of witnesses to Bezout's theorem --
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2175
  see the theorems that follow the definition.
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2176
\<close>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2177
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2178
fun bezw :: "nat \<Rightarrow> nat \<Rightarrow> int * int"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2179
  where "bezw x y =
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2180
    (if y = 0 then (1, 0)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2181
     else
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2182
      (snd (bezw y (x mod y)),
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2183
       fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y)))"
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2184
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2185
lemma bezw_0 [simp]: "bezw x 0 = (1, 0)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2186
  by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2187
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2188
lemma bezw_non_0:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2189
  "y > 0 \<Longrightarrow> bezw x y =
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2190
    (snd (bezw y (x mod y)), fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y))"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2191
  by simp
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2192
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2193
declare bezw.simps [simp del]
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2194
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2195
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2196
lemma bezw_aux: "int (gcd x y) = fst (bezw x y) * int x + snd (bezw x y) * int y"
31952
40501bb2d57c renamed lemmas: nat_xyz/int_xyz -> xyz_nat/xyz_int
nipkow
parents: 31814
diff changeset
  2197
proof (induct x y rule: gcd_nat_induct)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2198
  case (step m n)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2199
  then have "fst (bezw m n) * int m + snd (bezw m n) * int n - int (gcd m n) 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2200
             = int m * snd (bezw n (m mod n)) -
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2201
               (int (m mod n) * snd (bezw n (m mod n)) + int n * (int (m div n) * snd (bezw n (m mod n))))"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2202
    by (simp add: bezw_non_0 gcd_non_0_nat field_simps)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2203
  also have "\<dots> = int m * snd (bezw n (m mod n)) - (int (m mod n) + int (n * (m div n))) * snd (bezw n (m mod n))"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2204
    by (simp add: distrib_right)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2205
  also have "\<dots> = 0"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2206
    by (metis cancel_comm_monoid_add_class.diff_cancel mod_mult_div_eq of_nat_add)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2207
  finally show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2208
    by simp
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2209
qed auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2210
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2211
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2212
lemma bezout_int: "\<exists>u v. u * x + v * y = gcd x y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2213
  for x y :: int
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2214
proof -
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2215
  have aux: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> \<exists>u v. u * x + v * y = gcd x y" for x y :: int
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2216
    apply (rule_tac x = "fst (bezw (nat x) (nat y))" in exI)
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2217
    apply (rule_tac x = "snd (bezw (nat x) (nat y))" in exI)
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2218
    by (simp add: bezw_aux gcd_int_def)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2219
  consider "x \<ge> 0" "y \<ge> 0" | "x \<ge> 0" "y \<le> 0" | "x \<le> 0" "y \<ge> 0" | "x \<le> 0" "y \<le> 0"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2220
    using linear by blast
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2221
  then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2222
  proof cases
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2223
    case 1
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2224
    then show ?thesis by (rule aux)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2225
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2226
    case 2
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2227
    then show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2228
      using aux [of x "-y"]
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2229
      by (metis gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2230
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2231
    case 3
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2232
    then show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2233
      using aux [of "-x" y]
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2234
      by (metis gcd.commute gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2235
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2236
    case 4
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2237
    then show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2238
      using aux [of "-x" "-y"]
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2239
      by (metis diff_0 diff_ge_0_iff_ge gcd_neg1_int gcd_neg2_int mult.commute mult_minus_right)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2240
  qed
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2241
qed
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2242
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2243
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2244
text \<open>Versions of Bezout for \<open>nat\<close>, by Amine Chaieb.\<close>
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2245
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2246
lemma Euclid_induct [case_names swap zero add]:
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2247
  fixes P :: "nat \<Rightarrow> nat \<Rightarrow> bool"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2248
  assumes c: "\<And>a b. P a b \<longleftrightarrow> P b a"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2249
    and z: "\<And>a. P a 0"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2250
    and add: "\<And>a b. P a b \<longrightarrow> P a (a + b)"
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2251
  shows "P a b"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2252
proof (induct "a + b" arbitrary: a b rule: less_induct)
34915
7894c7dab132 Adapted to changes in induct method.
berghofe
parents: 34223
diff changeset
  2253
  case less
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2254
  consider (eq) "a = b" | (lt) "a < b" "a + b - a < a + b" | "b = 0" | "b + a - b < a + b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2255
    by arith
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2256
  show ?case
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2257
  proof (cases a b rule: linorder_cases)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2258
    case equal
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2259
    with add [rule_format, OF z [rule_format, of a]] show ?thesis by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2260
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2261
    case lt: less
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2262
    then consider "a = 0" | "a + b - a < a + b" by arith
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2263
    then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2264
    proof cases
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2265
      case 1
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2266
      with z c show ?thesis by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2267
    next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2268
      case 2
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2269
      also have *: "a + b - a = a + (b - a)" using lt by arith
34915
7894c7dab132 Adapted to changes in induct method.
berghofe
parents: 34223
diff changeset
  2270
      finally have "a + (b - a) < a + b" .
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2271
      then have "P a (a + (b - a))" by (rule add [rule_format, OF less])
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2272
      then show ?thesis by (simp add: *[symmetric])
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2273
    qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2274
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2275
    case gt: greater
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2276
    then consider "b = 0" | "b + a - b < a + b" by arith
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2277
    then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2278
    proof cases
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2279
      case 1
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2280
      with z c show ?thesis by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2281
    next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2282
      case 2
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2283
      also have *: "b + a - b = b + (a - b)" using gt by arith
34915
7894c7dab132 Adapted to changes in induct method.
berghofe
parents: 34223
diff changeset
  2284
      finally have "b + (a - b) < a + b" .
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2285
      then have "P b (b + (a - b))" by (rule add [rule_format, OF less])
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2286
      then have "P b a" by (simp add: *[symmetric])
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2287
      with c show ?thesis by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2288
    qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2289
  qed
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2290
qed
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2291
31952
40501bb2d57c renamed lemmas: nat_xyz/int_xyz -> xyz_nat/xyz_int
nipkow
parents: 31814
diff changeset
  2292
lemma bezout_lemma_nat:
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2293
  fixes d::nat
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2294
  shows "\<lbrakk>d dvd a; d dvd b; a * x = b * y + d \<or> b * x = a * y + d\<rbrakk>
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2295
    \<Longrightarrow> \<exists>x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2296
  apply auto
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2297
  apply (metis add_mult_distrib2 left_add_mult_distrib)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2298
  apply (rule_tac x=x in exI)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2299
  by (metis add_mult_distrib2 mult.commute add.assoc)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2300
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2301
lemma bezout_add_nat: 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2302
  "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2303
proof (induct a b rule: Euclid_induct)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2304
  case (swap a b)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2305
  then show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2306
    by blast
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2307
next
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2308
  case (zero a)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2309
  then show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2310
    by fastforce    
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2311
next
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2312
  case (add a b)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2313
  then show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2314
    by (meson bezout_lemma_nat)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2315
qed
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2316
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2317
lemma bezout1_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x - b * y = d \<or> b * x - a * y = d)"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2318
  using bezout_add_nat[of a b]  by (metis add_diff_cancel_left')
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2319
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2320
lemma bezout_add_strong_nat:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2321
  fixes a b :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2322
  assumes a: "a \<noteq> 0"
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2323
  shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2324
proof -
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2325
  consider d x y where "d dvd a" "d dvd b" "a * x = b * y + d"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2326
         | d x y where "d dvd a" "d dvd b" "b * x = a * y + d"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2327
    using bezout_add_nat [of a b] by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2328
  then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2329
  proof cases
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2330
    case 1
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2331
    then show ?thesis by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2332
  next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2333
    case H: 2
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2334
    show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2335
    proof (cases "b = 0")
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2336
      case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2337
      with H show ?thesis by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2338
    next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2339
      case False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2340
      then have bp: "b > 0" by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2341
      with dvd_imp_le [OF H(2)] consider "d = b" | "d < b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2342
        by atomize_elim auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2343
      then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2344
      proof cases
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2345
        case 1
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2346
        with a H show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2347
          by (metis Suc_pred add.commute mult.commute mult_Suc_right neq0_conv)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2348
      next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2349
        case 2
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2350
        show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2351
        proof (cases "x = 0")
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2352
          case True
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2353
          with a H show ?thesis by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2354
        next
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2355
          case x0: False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2356
          then have xp: "x > 0" by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2357
          from \<open>d < b\<close> have "d \<le> b - 1" by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2358
          then have "d * b \<le> b * (b - 1)" by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2359
          with xp mult_mono[of "1" "x" "d * b" "b * (b - 1)"]
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2360
          have dble: "d * b \<le> x * b * (b - 1)" using bp by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2361
          from H(3) have "d + (b - 1) * (b * x) = d + (b - 1) * (a * y + d)"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2362
            by simp
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2363
          then have "d + (b - 1) * a * y + (b - 1) * d = d + (b - 1) * b * x"
57512
cc97b347b301 reduced name variants for assoc and commute on plus and mult
haftmann
parents: 56218
diff changeset
  2364
            by (simp only: mult.assoc distrib_left)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2365
          then have "a * ((b - 1) * y) + d * (b - 1 + 1) = d + x * b * (b - 1)"
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2366
            by algebra
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2367
          then have "a * ((b - 1) * y) = d + x * b * (b - 1) - d * b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2368
            using bp by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2369
          then have "a * ((b - 1) * y) = d + (x * b * (b - 1) - d * b)"
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32879
diff changeset
  2370
            by (simp only: diff_add_assoc[OF dble, of d, symmetric])
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2371
          then have "a * ((b - 1) * y) = b * (x * (b - 1) - d) + d"
59008
f61482b0f240 formally self-contained gcd type classes
haftmann
parents: 58889
diff changeset
  2372
            by (simp only: diff_mult_distrib2 ac_simps)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2373
          with H(1,2) show ?thesis
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2374
            by blast
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2375
        qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2376
      qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2377
    qed
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2378
  qed
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2379
qed
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2380
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2381
lemma bezout_nat:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2382
  fixes a :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2383
  assumes a: "a \<noteq> 0"
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2384
  shows "\<exists>x y. a * x = b * y + gcd a b"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2385
proof -
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2386
  obtain d x y where d: "d dvd a" "d dvd b" and eq: "a * x = b * y + d"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2387
    using bezout_add_strong_nat [OF a, of b] by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2388
  from d have "d dvd gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2389
    by simp
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2390
  then obtain k where k: "gcd a b = d * k"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2391
    unfolding dvd_def by blast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2392
  from eq have "a * x * k = (b * y + d) * k"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2393
    by auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2394
  then have "a * (x * k) = b * (y * k) + gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2395
    by (algebra add: k)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2396
  then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2397
    by blast
27669
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2398
qed
4b1642284dd7 Tuned and simplified proofs; Rules added to presburger's and algebra's context; moved Bezout theorems from Primes.thy
chaieb
parents: 27651
diff changeset
  2399
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2400
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69064
diff changeset
  2401
subsection \<open>LCM properties on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2402
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2403
lemma lcm_altdef_int [code]: "lcm a b = \<bar>a\<bar> * \<bar>b\<bar> div gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2404
  for a b :: int
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2405
  by (simp add: abs_mult lcm_gcd abs_div)
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2406
  
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2407
lemma prod_gcd_lcm_nat: "m * n = gcd m n * lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2408
  for m n :: nat
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2409
  by (simp add: lcm_gcd)
31706
1db0c8f235fb new GCD library, courtesy of Jeremy Avigad
huffman
parents: 30738
diff changeset
  2410
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2411
lemma prod_gcd_lcm_int: "\<bar>m\<bar> * \<bar>n\<bar> = gcd m n * lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2412
  for m n :: int
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2413
  by (simp add: lcm_gcd abs_div abs_mult)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2414
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2415
lemma lcm_pos_nat: "m > 0 \<Longrightarrow> n > 0 \<Longrightarrow> lcm m n > 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2416
  for m n :: nat
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2417
  using lcm_eq_0_iff [of m n] by auto
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2418
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2419
lemma lcm_pos_int: "m \<noteq> 0 \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> lcm m n > 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2420
  for m n :: int
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2421
  by (simp add: less_le lcm_eq_0_iff)
23687
06884f7ffb18 extended - convers now basic lcm properties also
haftmann
parents: 23431
diff changeset
  2422
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2423
lemma dvd_pos_nat: "n > 0 \<Longrightarrow> m dvd n \<Longrightarrow> m > 0"  (* FIXME move *)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2424
  for m n :: nat
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2425
  by auto
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2426
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2427
lemma lcm_unique_nat:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2428
  "a dvd d \<and> b dvd d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2429
  for a b d :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2430
  by (auto intro: dvd_antisym lcm_least)
27568
9949dc7a24de Theorem names as in IntPrimes.thy, also several theorems moved from there
chaieb
parents: 27556
diff changeset
  2431
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2432
lemma lcm_unique_int:
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2433
  "d \<ge> 0 \<and> a dvd d \<and> b dvd d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2434
  for a b d :: int
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2435
  using lcm_least zdvd_antisym_nonneg by auto
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 34915
diff changeset
  2436
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2437
lemma lcm_proj2_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm x y = y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2438
  for x y :: nat
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2439
  by (simp add: lcm_proj2_if_dvd)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2440
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2441
lemma lcm_proj2_if_dvd_int [simp]: "x dvd y \<Longrightarrow> lcm x y = \<bar>y\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2442
  for x y :: int
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2443
  by (simp add: lcm_proj2_if_dvd)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2444
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2445
lemma lcm_proj1_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm y x = y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2446
  for x y :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2447
  by (subst lcm.commute) (erule lcm_proj2_if_dvd_nat)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2448
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2449
lemma lcm_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> lcm y x = \<bar>y\<bar>"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2450
  for x y :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2451
  by (subst lcm.commute) (erule lcm_proj2_if_dvd_int)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2452
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2453
lemma lcm_proj1_iff_nat [simp]: "lcm m n = m \<longleftrightarrow> n dvd m"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2454
  for m n :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2455
  by (metis lcm_proj1_if_dvd_nat lcm_unique_nat)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2456
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2457
lemma lcm_proj2_iff_nat [simp]: "lcm m n = n \<longleftrightarrow> m dvd n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2458
  for m n :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2459
  by (metis lcm_proj2_if_dvd_nat lcm_unique_nat)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2460
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2461
lemma lcm_proj1_iff_int [simp]: "lcm m n = \<bar>m\<bar> \<longleftrightarrow> n dvd m"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2462
  for m n :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2463
  by (metis dvd_abs_iff lcm_proj1_if_dvd_int lcm_unique_int)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2464
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2465
lemma lcm_proj2_iff_int [simp]: "lcm m n = \<bar>n\<bar> \<longleftrightarrow> m dvd n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2466
  for m n :: int
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2467
  by (metis dvd_abs_iff lcm_proj2_if_dvd_int lcm_unique_int)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2468
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2469
lemma lcm_1_iff_nat [simp]: "lcm m n = Suc 0 \<longleftrightarrow> m = Suc 0 \<and> n = Suc 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2470
  for m n :: nat
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2471
  using lcm_eq_1_iff [of m n] by simp
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2472
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2473
lemma lcm_1_iff_int [simp]: "lcm m n = 1 \<longleftrightarrow> (m = 1 \<or> m = -1) \<and> (n = 1 \<or> n = -1)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2474
  for m n :: int
61913
58b153bfa737 tuned proofs and augmented some lemmas
haftmann
parents: 61856
diff changeset
  2475
  by auto
31995
8f37cf60b885 more gcd/lcm lemmas
nipkow
parents: 31992
diff changeset
  2476
34030
829eb528b226 resorted code equations from "old" number theory version
haftmann
parents: 33946
diff changeset
  2477
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69064
diff changeset
  2478
subsection \<open>The complete divisibility lattice on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2479
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2480
text \<open>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2481
  Lifting \<open>gcd\<close> and \<open>lcm\<close> to sets (\<open>Gcd\<close> / \<open>Lcm\<close>).
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2482
  \<open>Gcd\<close> is defined via \<open>Lcm\<close> to facilitate the proof that we have a complete lattice.
60758
d8d85a8172b5 isabelle update_cartouches;
wenzelm
parents: 60690
diff changeset
  2483
\<close>
45264
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2484
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2485
instantiation nat :: semiring_Gcd
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2486
begin
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2487
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2488
interpretation semilattice_neutr_set lcm "1::nat"
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2489
  by standard simp_all
54867
c21a2465cac1 prefer ephemeral interpretation over interpretation in proof contexts;
haftmann
parents: 54489
diff changeset
  2490
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2491
definition "Lcm M = (if finite M then F M else 0)" for M :: "nat set"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2492
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2493
lemma Lcm_nat_empty: "Lcm {} = (1::nat)"
60690
a9e45c9588c3 tuned facts
haftmann
parents: 60689
diff changeset
  2494
  by (simp add: Lcm_nat_def del: One_nat_def)
51489
f738e6dbd844 fundamental revision of big operators on sets
haftmann
parents: 49962
diff changeset
  2495
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2496
lemma Lcm_nat_insert: "Lcm (insert n M) = lcm n (Lcm M)" for n :: nat
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2497
  by (cases "finite M") (auto simp: Lcm_nat_def simp del: One_nat_def)
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2498
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2499
lemma Lcm_nat_infinite: "infinite M \<Longrightarrow> Lcm M = 0" for M :: "nat set"
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2500
  by (simp add: Lcm_nat_def)
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2501
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2502
lemma dvd_Lcm_nat [simp]:
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2503
  fixes M :: "nat set"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2504
  assumes "m \<in> M"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2505
  shows "m dvd Lcm M"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2506
proof -
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2507
  from assms have "insert m M = M"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2508
    by auto
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2509
  moreover have "m dvd Lcm (insert m M)"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2510
    by (simp add: Lcm_nat_insert)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2511
  ultimately show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2512
    by simp
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2513
qed
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2514
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2515
lemma Lcm_dvd_nat [simp]:
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2516
  fixes M :: "nat set"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2517
  assumes "\<forall>m\<in>M. m dvd n"
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2518
  shows "Lcm M dvd n"
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2519
proof (cases "n > 0")
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2520
  case False
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2521
  then show ?thesis by simp
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2522
next
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2523
  case True
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2524
  then have "finite {d. d dvd n}"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2525
    by (rule finite_divisors_nat)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2526
  moreover have "M \<subseteq> {d. d dvd n}"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2527
    using assms by fast
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2528
  ultimately have "finite M"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2529
    by (rule rev_finite_subset)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2530
  then show ?thesis
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2531
    using assms by (induct M) (simp_all add: Lcm_nat_empty Lcm_nat_insert)
61929
b8e242e52c97 tuned proofs and augmented lemmas
haftmann
parents: 61913
diff changeset
  2532
qed
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2533
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2534
definition "Gcd M = Lcm {d. \<forall>m\<in>M. d dvd m}" for M :: "nat set"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2535
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2536
instance
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2537
proof
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2538
  fix N :: "nat set"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2539
  fix n :: nat
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2540
  show "Gcd N dvd n" if "n \<in> N"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2541
    using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2542
  show "n dvd Gcd N" if "\<And>m. m \<in> N \<Longrightarrow> n dvd m"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2543
    using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2544
  show "n dvd Lcm N" if "n \<in> N"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2545
    using that by (induct N rule: infinite_finite_induct) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2546
  show "Lcm N dvd n" if "\<And>m. m \<in> N \<Longrightarrow> m dvd n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2547
    using that by (induct N rule: infinite_finite_induct) auto
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2548
  show "normalize (Gcd N) = Gcd N" and "normalize (Lcm N) = Lcm N"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2549
    by simp_all
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2550
qed
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2551
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2552
end
61913
58b153bfa737 tuned proofs and augmented some lemmas
haftmann
parents: 61856
diff changeset
  2553
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2554
lemma Gcd_nat_eq_one: "1 \<in> N \<Longrightarrow> Gcd N = 1"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2555
  for N :: "nat set"
62346
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
  2556
  by (rule Gcd_eq_1_I) auto
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
  2557
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2558
instance nat :: semiring_gcd_mult_normalize
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2559
  by intro_classes (auto simp: unit_factor_nat_def)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2560
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2561
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2562
text \<open>Alternative characterizations of Gcd:\<close>
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2563
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2564
lemma Gcd_eq_Max:
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2565
  fixes M :: "nat set"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2566
  assumes "finite (M::nat set)" and "M \<noteq> {}" and "0 \<notin> M"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2567
  shows "Gcd M = Max (\<Inter>m\<in>M. {d. d dvd m})"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2568
proof (rule antisym)
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2569
  from assms obtain m where "m \<in> M" and "m > 0"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2570
    by auto
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2571
  from \<open>m > 0\<close> have "finite {d. d dvd m}"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2572
    by (blast intro: finite_divisors_nat)
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2573
  with \<open>m \<in> M\<close> have fin: "finite (\<Inter>m\<in>M. {d. d dvd m})"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2574
    by blast
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2575
  from fin show "Gcd M \<le> Max (\<Inter>m\<in>M. {d. d dvd m})"
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2576
    by (auto intro: Max_ge Gcd_dvd)
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2577
  from fin show "Max (\<Inter>m\<in>M. {d. d dvd m}) \<le> Gcd M"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2578
  proof (rule Max.boundedI, simp_all)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2579
    show "(\<Inter>m\<in>M. {d. d dvd m}) \<noteq> {}"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2580
      by auto
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2581
    show "\<And>a. \<forall>x\<in>M. a dvd x \<Longrightarrow> a \<le> Gcd M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2582
      by (meson Gcd_dvd Gcd_greatest \<open>0 < m\<close> \<open>m \<in> M\<close> dvd_imp_le dvd_pos_nat)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2583
  qed
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2584
qed
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2585
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2586
lemma Gcd_remove0_nat: "finite M \<Longrightarrow> Gcd M = Gcd (M - {0})"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2587
  for M :: "nat set"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2588
proof (induct pred: finite)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2589
  case (insert x M)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2590
  then show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2591
    by (simp add: insert_Diff_if)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2592
qed auto
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2593
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2594
lemma Lcm_in_lcm_closed_set_nat:
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2595
  fixes M :: "nat set" 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2596
  assumes "finite M" "M \<noteq> {}" "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2597
  shows "Lcm M \<in> M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2598
  using assms
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2599
proof (induction M rule: finite_linorder_min_induct)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2600
  case (insert x M)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2601
  then have "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> lcm m n \<in> M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2602
    by (metis dvd_lcm1 gr0I insert_iff lcm_pos_nat nat_dvd_not_less)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2603
  with insert show ?case
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2604
    by simp (metis Lcm_nat_empty One_nat_def dvd_1_left dvd_lcm2)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2605
qed auto
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2606
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2607
lemma Lcm_eq_Max_nat:
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2608
  fixes M :: "nat set" 
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2609
  assumes M: "finite M" "M \<noteq> {}" "0 \<notin> M" and lcm: "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2610
  shows "Lcm M = Max M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2611
proof (rule antisym)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2612
  show "Lcm M \<le> Max M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2613
    by (simp add: Lcm_in_lcm_closed_set_nat \<open>finite M\<close> \<open>M \<noteq> {}\<close> lcm)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2614
  show "Max M \<le> Lcm M"
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2615
    by (meson Lcm_0_iff Max_in M dvd_Lcm dvd_imp_le le_0_eq not_le)
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2616
qed
32112
6da9c2a49fed Made dvd/gcd/lcm a complete lattice by introducing Gcd/GCD/Lcm/LCM
nipkow
parents: 32111
diff changeset
  2617
34222
e33ee7369ecb added lemma
nipkow
parents: 34221
diff changeset
  2618
lemma mult_inj_if_coprime_nat:
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2619
  "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> (\<And>a b. \<lbrakk>a\<in>A; b\<in>B\<rbrakk> \<Longrightarrow> coprime (f a) (g b)) \<Longrightarrow>
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2620
    inj_on (\<lambda>(a, b). f a * g b) (A \<times> B)"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2621
  for f :: "'a \<Rightarrow> nat" and g :: "'b \<Rightarrow> nat"
68708
77858f347020 de-applying
paulson <lp15@cam.ac.uk>
parents: 68270
diff changeset
  2622
  by (auto simp: inj_on_def coprime_crossproduct_nat simp del: One_nat_def)
34222
e33ee7369ecb added lemma
nipkow
parents: 34221
diff changeset
  2623
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2624
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2625
subsubsection \<open>Setwise GCD and LCM for integers\<close>
45264
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2626
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2627
instantiation int :: Gcd
45264
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2628
begin
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2629
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2630
definition Gcd_int :: "int set \<Rightarrow> int"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2631
  where "Gcd K = int (GCD k\<in>K. (nat \<circ> abs) k)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2632
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2633
definition Lcm_int :: "int set \<Rightarrow> int"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2634
  where "Lcm K = int (LCM k\<in>K. (nat \<circ> abs) k)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2635
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2636
instance ..
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2637
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2638
end
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2639
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2640
lemma Gcd_int_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2641
  "(GCD n\<in>N. int n) = int (Gcd N)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2642
  by (simp add: Gcd_int_def image_image)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2643
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2644
lemma Gcd_nat_abs_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2645
  "(GCD k\<in>K. nat \<bar>k\<bar>) = nat (Gcd K)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2646
  by (simp add: Gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2647
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2648
lemma abs_Gcd_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2649
  "\<bar>Gcd K\<bar> = Gcd K" for K :: "int set"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2650
  by (simp only: Gcd_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2651
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2652
lemma Gcd_int_greater_eq_0 [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2653
  "Gcd K \<ge> 0"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2654
  for K :: "int set"
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2655
  using abs_ge_zero [of "Gcd K"] by simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2656
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2657
lemma Gcd_abs_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2658
  "(GCD k\<in>K. \<bar>k\<bar>) = Gcd K"
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2659
  for K :: "int set"
67118
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2660
  by (simp only: Gcd_int_def image_image) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2661
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2662
lemma Lcm_int_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2663
  "(LCM n\<in>N. int n) = int (Lcm N)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2664
  by (simp add: Lcm_int_def image_image)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2665
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2666
lemma Lcm_nat_abs_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2667
  "(LCM k\<in>K. nat \<bar>k\<bar>) = nat (Lcm K)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2668
  by (simp add: Lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2669
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2670
lemma abs_Lcm_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2671
  "\<bar>Lcm K\<bar> = Lcm K" for K :: "int set"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2672
  by (simp only: Lcm_int_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2673
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2674
lemma Lcm_int_greater_eq_0 [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2675
  "Lcm K \<ge> 0"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2676
  for K :: "int set"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2677
  using abs_ge_zero [of "Lcm K"] by simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2678
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2679
lemma Lcm_abs_eq [simp]:
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2680
  "(LCM k\<in>K. \<bar>k\<bar>) = Lcm K"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2681
  for K :: "int set"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2682
  by (simp only: Lcm_int_def image_image) simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2683
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2684
instance int :: semiring_Gcd
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2685
proof
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2686
  fix K :: "int set" and k :: int
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2687
  show "Gcd K dvd k" and "k dvd Lcm K" if "k \<in> K"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2688
    using that Gcd_dvd [of "nat \<bar>k\<bar>" "(nat \<circ> abs) ` K"]
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2689
      dvd_Lcm [of "nat \<bar>k\<bar>" "(nat \<circ> abs) ` K"]
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2690
    by (simp_all add: comp_def)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2691
  show "k dvd Gcd K" if "\<And>l. l \<in> K \<Longrightarrow> k dvd l"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2692
  proof -
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2693
    have "nat \<bar>k\<bar> dvd (GCD k\<in>K. nat \<bar>k\<bar>)"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2694
      by (rule Gcd_greatest) (use that in auto)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2695
    then show ?thesis by simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2696
  qed
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2697
  show "Lcm K dvd k" if "\<And>l. l \<in> K \<Longrightarrow> l dvd k"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2698
  proof -
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2699
    have "(LCM k\<in>K. nat \<bar>k\<bar>) dvd nat \<bar>k\<bar>"
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2700
      by (rule Lcm_least) (use that in auto)
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2701
    then show ?thesis by simp
ccab07d1196c more simplification rules
haftmann
parents: 67051
diff changeset
  2702
  qed
71398
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2703
qed (simp_all add: sgn_mult)
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2704
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2705
instance int :: semiring_gcd_mult_normalize
e0237f2eb49d Removed multiplicativity assumption from normalization_semidom
Manuel Eberl <eberlm@in.tum.de>
parents: 69906
diff changeset
  2706
  by intro_classes (auto simp: sgn_mult)
62346
97f2ed240431 more theorems concerning gcd/lcm/Gcd/Lcm
haftmann
parents: 62345
diff changeset
  2707
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2708
69593
3dda49e08b9d isabelle update -u control_cartouches;
wenzelm
parents: 69064
diff changeset
  2709
subsection \<open>GCD and LCM on \<^typ>\<open>integer\<close>\<close>
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2710
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2711
instantiation integer :: gcd
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2712
begin
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2713
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2714
context
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2715
  includes integer.lifting
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2716
begin
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2717
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2718
lift_definition gcd_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is gcd .
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2719
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2720
lift_definition lcm_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is lcm .
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2721
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2722
end
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2723
45264
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2724
instance ..
60686
ea5bc46c11e6 more algebraic properties for gcd/lcm
haftmann
parents: 60597
diff changeset
  2725
21256
47195501ecf7 moved theories Parity, GCD, Binomial to Library;
wenzelm
parents:
diff changeset
  2726
end
45264
3b2c770f6631 merge Gcd/GCD and Lcm/LCM
huffman
parents: 44890
diff changeset
  2727
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2728
lifting_update integer.lifting
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2729
lifting_forget integer.lifting
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2730
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2731
context
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2732
  includes integer.lifting
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2733
begin
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2734
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2735
lemma gcd_code_integer [code]: "gcd k l = \<bar>if l = (0::integer) then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2736
  by transfer (fact gcd_code_int)
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2737
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2738
lemma lcm_code_integer [code]: "lcm a b = \<bar>a\<bar> * \<bar>b\<bar> div gcd a b"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2739
  for a b :: integer
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2740
  by transfer (fact lcm_altdef_int)
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2741
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2742
end
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2743
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2744
code_printing
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2745
  constant "gcd :: integer \<Rightarrow> _" \<rightharpoonup>
69906
55534affe445 migrated from Nums to Zarith as library for OCaml integer arithmetic
haftmann
parents: 69785
diff changeset
  2746
    (OCaml) "!(fun k l -> if Z.equal k Z.zero then/ Z.abs l else if Z.equal/ l Z.zero then Z.abs k else Z.gcd k l)"
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2747
  and (Haskell) "Prelude.gcd"
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2748
  and (Scala) "_.gcd'((_)')"
61975
b4b11391c676 isabelle update_cartouches -c -t;
wenzelm
parents: 61954
diff changeset
  2749
  \<comment> \<open>There is no gcd operation in the SML standard library, so no code setup for SML\<close>
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2750
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2751
text \<open>Some code equations\<close>
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2752
64850
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  2753
lemmas Gcd_nat_set_eq_fold [code] = Gcd_set_eq_fold [where ?'a = nat]
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  2754
lemmas Lcm_nat_set_eq_fold [code] = Lcm_set_eq_fold [where ?'a = nat]
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  2755
lemmas Gcd_int_set_eq_fold [code] = Gcd_set_eq_fold [where ?'a = int]
fc9265882329 gcd/lcm on finite sets
haftmann
parents: 64591
diff changeset
  2756
lemmas Lcm_int_set_eq_fold [code] = Lcm_set_eq_fold [where ?'a = int]
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2757
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2758
text \<open>Fact aliases.\<close>
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2759
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2760
lemma lcm_0_iff_nat [simp]: "lcm m n = 0 \<longleftrightarrow> m = 0 \<or> n = 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2761
  for m n :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2762
  by (fact lcm_eq_0_iff)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2763
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2764
lemma lcm_0_iff_int [simp]: "lcm m n = 0 \<longleftrightarrow> m = 0 \<or> n = 0"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2765
  for m n :: int
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2766
  by (fact lcm_eq_0_iff)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2767
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2768
lemma dvd_lcm_I1_nat [simp]: "k dvd m \<Longrightarrow> k dvd lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2769
  for k m n :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2770
  by (fact dvd_lcmI1)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2771
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2772
lemma dvd_lcm_I2_nat [simp]: "k dvd n \<Longrightarrow> k dvd lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2773
  for k m n :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2774
  by (fact dvd_lcmI2)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2775
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2776
lemma dvd_lcm_I1_int [simp]: "i dvd m \<Longrightarrow> i dvd lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2777
  for i m n :: int
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2778
  by (fact dvd_lcmI1)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2779
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2780
lemma dvd_lcm_I2_int [simp]: "i dvd n \<Longrightarrow> i dvd lcm m n"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2781
  for i m n :: int
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2782
  by (fact dvd_lcmI2)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2783
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2784
lemmas Gcd_dvd_nat [simp] = Gcd_dvd [where ?'a = nat]
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2785
lemmas Gcd_dvd_int [simp] = Gcd_dvd [where ?'a = int]
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2786
lemmas Gcd_greatest_nat [simp] = Gcd_greatest [where ?'a = nat]
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2787
lemmas Gcd_greatest_int [simp] = Gcd_greatest [where ?'a = int]
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2788
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2789
lemma dvd_Lcm_int [simp]: "m \<in> M \<Longrightarrow> m dvd Lcm M"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2790
  for M :: "int set"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2791
  by (fact dvd_Lcm)
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2792
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2793
lemma gcd_neg_numeral_1_int [simp]: "gcd (- numeral n :: int) x = gcd (numeral n) x"
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2794
  by (fact gcd_neg1_int)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2795
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2796
lemma gcd_neg_numeral_2_int [simp]: "gcd x (- numeral n :: int) = gcd x (numeral n)"
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2797
  by (fact gcd_neg2_int)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2798
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2799
lemma gcd_proj1_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> gcd x y = x"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2800
  for x y :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2801
  by (fact gcd_nat.absorb1)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2802
63489
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2803
lemma gcd_proj2_if_dvd_nat [simp]: "y dvd x \<Longrightarrow> gcd x y = y"
cd540c8031a4 misc tuning and modernization;
wenzelm
parents: 63359
diff changeset
  2804
  for x y :: nat
62344
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2805
  by (fact gcd_nat.absorb2)
759d684c0e60 pulled out legacy aliasses and infamous dvd interpretations into theory appendix
haftmann
parents: 62343
diff changeset
  2806
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2807
lemma Gcd_in:
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2808
  fixes A :: "nat set"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2809
  assumes "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> gcd a b \<in> A"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2810
  assumes "A \<noteq> {}"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2811
  shows   "Gcd A \<in> A"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2812
proof (cases "A = {0}")
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2813
  case False
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2814
  with assms obtain x where "x \<in> A" "x > 0"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2815
    by auto
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2816
  thus "Gcd A \<in> A"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2817
  proof (induction x rule: less_induct)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2818
    case (less x)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2819
    show ?case
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2820
    proof (cases "x = Gcd A")
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2821
      case False
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2822
      have "\<exists>y\<in>A. \<not>x dvd y"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2823
        using False less.prems by (metis Gcd_dvd Gcd_greatest_nat gcd_nat.asym)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2824
      then obtain y where y: "y \<in> A" "\<not>x dvd y"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2825
        by blast
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2826
      have "gcd x y \<in> A"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2827
        by (rule assms(1)) (use \<open>x \<in> A\<close> y in auto)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2828
      moreover have "gcd x y < x"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2829
        using \<open>x > 0\<close> y by (metis gcd_dvd1 gcd_dvd2 nat_dvd_not_less nat_neq_iff)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2830
      moreover have "gcd x y > 0"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2831
        using \<open>x > 0\<close> by auto
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2832
      ultimately show ?thesis using less.IH by blast
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2833
    qed (use less in auto)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2834
  qed
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2835
qed auto
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2836
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2837
lemma bezout_gcd_nat':
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2838
  fixes a b :: nat
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2839
  shows "\<exists>x y. b * y \<le> a * x \<and> a * x - b * y = gcd a b \<or> a * y \<le> b * x \<and> b * x - a * y = gcd a b"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2840
  using bezout_nat[of a b]
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2841
  by (metis add_diff_cancel_left' diff_zero gcd.commute gcd_0_nat
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2842
            le_add_same_cancel1 mult.right_neutral zero_le)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2843
62353
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2844
lemmas Lcm_eq_0_I_nat [simp] = Lcm_eq_0_I [where ?'a = nat]
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2845
lemmas Lcm_0_iff_nat [simp] = Lcm_0_iff [where ?'a = nat]
7f927120b5a2 dropped various legacy fact bindings and tuned proofs
haftmann
parents: 62350
diff changeset
  2846
lemmas Lcm_least_int [simp] = Lcm_least [where ?'a = int]
62345
e66d7841d5a2 further generalization and polishing
haftmann
parents: 62344
diff changeset
  2847
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2848
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2849
subsection \<open>Characteristic of a semiring\<close>
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2850
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2851
definition (in semiring_1) semiring_char :: "'a itself \<Rightarrow> nat" 
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2852
  where "semiring_char _ = Gcd {n. of_nat n = (0 :: 'a)}"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2853
81125
ec121999a9cb more inner-syntax markup;
wenzelm
parents: 80934
diff changeset
  2854
syntax "_type_char" :: "type => nat" (\<open>(\<open>indent=1 notation=\<open>mixfix CHAR\<close>\<close>CHAR/(1'(_')))\<close>)
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2855
syntax_consts "_type_char" \<rightleftharpoons> semiring_char
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2856
translations "CHAR('t)" \<rightharpoonup> "CONST semiring_char (CONST Pure.type :: 't itself)"
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2857
print_translation \<open>
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2858
  let
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2859
    fun char_type_tr' ctxt [Const (\<^const_syntax>\<open>Pure.type\<close>, Type (_, [T]))] =
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2860
      Syntax.const \<^syntax_const>\<open>_type_char\<close> $ Syntax_Phases.term_of_typ ctxt T
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2861
  in [(\<^const_syntax>\<open>semiring_char\<close>, char_type_tr')] end
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2862
\<close>
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2863
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2864
context semiring_1
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2865
begin
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2866
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2867
lemma of_nat_CHAR [simp]: "of_nat CHAR('a) = (0 :: 'a)"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2868
proof -
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2869
  have "CHAR('a) \<in> {n. of_nat n = (0::'a)}"
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2870
    unfolding semiring_char_def
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2871
  proof (rule Gcd_in, clarify)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2872
    fix a b :: nat
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2873
    assume *: "of_nat a = (0 :: 'a)" "of_nat b = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2874
    show "of_nat (gcd a b) = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2875
    proof (cases "a = 0")
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2876
      case False
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2877
      with bezout_nat obtain x y where "a * x = b * y + gcd a b"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2878
        by blast
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2879
      hence "of_nat (a * x) = (of_nat (b * y + gcd a b) :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2880
        by (rule arg_cong)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2881
      thus "of_nat (gcd a b) = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2882
        using * by simp
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2883
    qed (use * in auto)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2884
  next
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2885
    have "of_nat 0 = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2886
      by simp
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2887
    thus "{n. of_nat n = (0 :: 'a)} \<noteq> {}"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2888
      by blast
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2889
  qed
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2890
  thus ?thesis
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2891
    by simp
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2892
qed
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2893
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2894
lemma of_nat_eq_0_iff_char_dvd: "of_nat n = (0 :: 'a) \<longleftrightarrow> CHAR('a) dvd n"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2895
proof
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2896
  assume "of_nat n = (0 :: 'a)"
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2897
  thus "CHAR('a) dvd n"
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2898
    unfolding semiring_char_def by (intro Gcd_dvd) auto
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2899
next
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2900
  assume "CHAR('a) dvd n"
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2901
  then obtain m where "n = CHAR('a) * m"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2902
    by auto
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2903
  thus "of_nat n = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2904
    by simp
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2905
qed
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2906
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2907
lemma CHAR_eqI:
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2908
  assumes "of_nat c = (0 :: 'a)"
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2909
  assumes "\<And>x. of_nat x = (0 :: 'a) \<Longrightarrow> c dvd x"
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2910
  shows   "CHAR('a) = c"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2911
  using assms by (intro dvd_antisym) (auto simp: of_nat_eq_0_iff_char_dvd)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2912
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2913
lemma CHAR_eq0_iff: "CHAR('a) = 0 \<longleftrightarrow> (\<forall>n>0. of_nat n \<noteq> (0::'a))"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2914
  by (auto simp: of_nat_eq_0_iff_char_dvd)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2915
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2916
lemma CHAR_pos_iff: "CHAR('a) > 0 \<longleftrightarrow> (\<exists>n>0. of_nat n = (0::'a))"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2917
  using CHAR_eq0_iff neq0_conv by blast
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2918
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2919
lemma CHAR_eq_posI:
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2920
  assumes "c > 0" "of_nat c = (0 :: 'a)" "\<And>x. x > 0 \<Longrightarrow> x < c \<Longrightarrow> of_nat x \<noteq> (0 :: 'a)"
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2921
  shows   "CHAR('a) = c"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2922
proof (rule antisym)
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2923
  from assms have "CHAR('a) > 0"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2924
    by (auto simp: CHAR_pos_iff)
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2925
  from assms(3)[OF this] show "CHAR('a) \<ge> c"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2926
    by force
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2927
next
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2928
  have "CHAR('a) dvd c"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2929
    using assms by (auto simp: of_nat_eq_0_iff_char_dvd)
80766
72beac575e9c use nicer notation, following 783406dd051e;
wenzelm
parents: 80764
diff changeset
  2930
  thus "CHAR('a) \<le> c"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2931
    using \<open>c > 0\<close> by (intro dvd_imp_le) auto
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2932
qed
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2933
61856
4b1b85f38944 add gcd instance for integer and serialisation to target language operations
Andreas Lochbihler
parents: 61799
diff changeset
  2934
end
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2935
80771
fd01ef524169 use nicer notation, following 783406dd051e;
wenzelm
parents: 80766
diff changeset
  2936
lemma (in semiring_char_0) CHAR_eq_0 [simp]: "CHAR('a) = 0"
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2937
  by (simp add: CHAR_eq0_iff)
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2938
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  2939
79544
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2940
lemma CHAR_not_1 [simp]: "CHAR('a :: {semiring_1, zero_neq_one}) \<noteq> Suc 0"
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2941
  by (metis One_nat_def of_nat_1 of_nat_CHAR zero_neq_one)
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2942
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2943
lemma (in idom) CHAR_not_1' [simp]: "CHAR('a) \<noteq> Suc 0"
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2944
  using local.of_nat_CHAR by fastforce
50ee2921da94 A few more new theorems taken from AFP entries
paulson <lp15@cam.ac.uk>
parents: 77172
diff changeset
  2945
80084
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2946
lemma (in ring_1) uminus_CHAR_2:
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2947
  assumes "CHAR('a) = 2"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2948
  shows   "-(x :: 'a) = x"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2949
proof -
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2950
  have "x + x = 2 * x"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2951
    by (simp add: mult_2)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2952
  also have "2 = (0 :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2953
    using assms local.of_nat_CHAR by auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2954
  finally show ?thesis
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2955
    by (simp add: add_eq_0_iff2)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2956
qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2957
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2958
lemma (in ring_1) minus_CHAR_2:
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2959
  assumes "CHAR('a) = 2"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2960
  shows   "(x - y :: 'a) = x + y"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2961
proof -
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2962
  have "x - y = x + (-y)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2963
    by simp
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2964
  also have "-y = y"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2965
    by (rule uminus_CHAR_2) fact
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2966
  finally show ?thesis .
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2967
qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2968
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2969
lemma (in semiring_1_cancel) of_nat_eq_iff_char_dvd:
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2970
  assumes "m < n"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2971
  shows   "of_nat m = (of_nat n :: 'a) \<longleftrightarrow> CHAR('a) dvd (n - m)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2972
proof
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2973
  assume *: "of_nat m = (of_nat n :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2974
  have "of_nat n = (of_nat m + of_nat (n - m) :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2975
    using assms by (metis le_add_diff_inverse local.of_nat_add nless_le)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2976
  hence "of_nat (n - m) = (0 :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2977
    by (simp add: *)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2978
  thus "CHAR('a) dvd (n - m)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2979
    by (simp add: of_nat_eq_0_iff_char_dvd)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2980
next
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2981
  assume "CHAR('a) dvd (n - m)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2982
  hence "of_nat (n - m) = (0 :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2983
    by (simp add: of_nat_eq_0_iff_char_dvd)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2984
  hence "of_nat m = (of_nat m + of_nat (n - m) :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2985
    by simp
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2986
  also have "\<dots> = of_nat n"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2987
    using assms by (metis le_add_diff_inverse local.of_nat_add nless_le)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2988
  finally show "of_nat m = (of_nat n :: 'a)" .
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2989
qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2990
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2991
lemma (in ring_1) of_int_eq_0_iff_char_dvd:
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2992
  "(of_int n = (0 :: 'a)) = (int CHAR('a) dvd n)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2993
proof (cases "n \<ge> 0")
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2994
  case True
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2995
  hence "(of_int n = (0 :: 'a)) \<longleftrightarrow> (of_nat (nat n)) = (0 :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2996
    by auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2997
  also have "\<dots> \<longleftrightarrow> CHAR('a) dvd nat n"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2998
    by (subst of_nat_eq_0_iff_char_dvd) auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  2999
  also have "\<dots> \<longleftrightarrow> int CHAR('a) dvd n"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3000
    using True by presburger
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3001
  finally show ?thesis .
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3002
next
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3003
  case False
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3004
  hence "(of_int n = (0 :: 'a)) \<longleftrightarrow> -(of_nat (nat (-n))) = (0 :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3005
    by auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3006
  also have "\<dots> \<longleftrightarrow> CHAR('a) dvd nat (-n)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3007
    by (auto simp: of_nat_eq_0_iff_char_dvd)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3008
  also have "\<dots> \<longleftrightarrow> int CHAR('a) dvd n"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3009
    using False dvd_nat_abs_iff[of "CHAR('a)" n] by simp
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3010
  finally show ?thesis .
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3011
qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3012
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3013
lemma (in semiring_1_cancel) finite_imp_CHAR_pos:
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3014
  assumes "finite (UNIV :: 'a set)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3015
  shows   "CHAR('a) > 0"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3016
proof -
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3017
  have "\<exists>n\<in>UNIV. infinite {m \<in> UNIV. of_nat m = (of_nat n :: 'a)}"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3018
  proof (rule pigeonhole_infinite)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3019
    show "infinite (UNIV :: nat set)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3020
      by simp
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3021
    show "finite (range (of_nat :: nat \<Rightarrow> 'a))"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3022
      by (rule finite_subset[OF _ assms]) auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3023
  qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3024
  then obtain n :: nat where "infinite {m \<in> UNIV. of_nat m = (of_nat n :: 'a)}"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3025
    by blast
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3026
  hence "\<not>({m \<in> UNIV. of_nat m = (of_nat n :: 'a)} \<subseteq> {n})"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3027
    by (intro notI) (use finite_subset in blast)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3028
  then obtain m where "m \<noteq> n" "of_nat m = (of_nat n :: 'a)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3029
    by blast
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3030
  thus ?thesis
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3031
  proof (induction m n rule: linorder_wlog)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3032
    case (le m n)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3033
    hence "CHAR('a) dvd (n - m)"
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3034
      using of_nat_eq_iff_char_dvd[of m n] by auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3035
    thus ?thesis
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3036
      using le by (intro Nat.gr0I) auto
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3037
  qed (simp_all add: eq_commute)
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3038
qed
173548e4d5d0 moved over material from the AFP to HOL, HOL-Computational_Algebra, and HOL-Number_Theory
Manuel Eberl <manuel@pruvisto.org>
parents: 79544
diff changeset
  3039
73109
783406dd051e some algebra material for HOL: characteristic of a ring, algebraic integers
Manuel Eberl <eberlm@in.tum.de>
parents: 71398
diff changeset
  3040
end