author | nipkow |
Fri, 05 Jan 2018 18:41:42 +0100 | |
changeset 67341 | df79ef3b3a41 |
parent 66453 | cc19f7ca2ed6 |
permissions | -rw-r--r-- |
53653 | 1 |
(* Title: HOL/Quotient_Examples/Int_Pow.thy |
2 |
Author: Ondrej Kuncar |
|
3 |
Author: Lars Noschinski |
|
4 |
*) |
|
5 |
||
6 |
theory Int_Pow |
|
66453
cc19f7ca2ed6
session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
wenzelm
parents:
63540
diff
changeset
|
7 |
imports Main "HOL-Algebra.Group" |
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
8 |
begin |
53653 | 9 |
|
10 |
(* |
|
11 |
This file demonstrates how to restore Lifting/Transfer enviromenent. |
|
12 |
||
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
13 |
We want to define int_pow (a power with an integer exponent) by directly accessing |
53653 | 14 |
the representation type "nat * nat" that was used to define integers. |
15 |
*) |
|
16 |
||
17 |
context monoid |
|
18 |
begin |
|
19 |
||
20 |
(* first some additional lemmas that are missing in monoid *) |
|
21 |
||
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
22 |
lemma Units_nat_pow_Units [intro, simp]: |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
23 |
"a \<in> Units G \<Longrightarrow> a [^] (c :: nat) \<in> Units G" by (induct c) auto |
53653 | 24 |
|
25 |
lemma Units_r_cancel [simp]: |
|
26 |
"[| z \<in> Units G; x \<in> carrier G; y \<in> carrier G |] ==> |
|
27 |
(x \<otimes> z = y \<otimes> z) = (x = y)" |
|
28 |
proof |
|
29 |
assume eq: "x \<otimes> z = y \<otimes> z" |
|
30 |
and G: "z \<in> Units G" "x \<in> carrier G" "y \<in> carrier G" |
|
31 |
then have "x \<otimes> (z \<otimes> inv z) = y \<otimes> (z \<otimes> inv z)" |
|
32 |
by (simp add: m_assoc[symmetric] Units_closed del: Units_r_inv) |
|
33 |
with G show "x = y" by simp |
|
34 |
next |
|
35 |
assume eq: "x = y" |
|
36 |
and G: "z \<in> Units G" "x \<in> carrier G" "y \<in> carrier G" |
|
37 |
then show "x \<otimes> z = y \<otimes> z" by simp |
|
38 |
qed |
|
39 |
||
40 |
lemma inv_mult_units: |
|
41 |
"[| x \<in> Units G; y \<in> Units G |] ==> inv (x \<otimes> y) = inv y \<otimes> inv x" |
|
42 |
proof - |
|
43 |
assume G: "x \<in> Units G" "y \<in> Units G" |
|
63540 | 44 |
then have "x \<in> carrier G" "y \<in> carrier G" by auto |
45 |
with G have "inv (x \<otimes> y) \<otimes> (x \<otimes> y) = (inv y \<otimes> inv x) \<otimes> (x \<otimes> y)" |
|
53653 | 46 |
by (simp add: m_assoc) (simp add: m_assoc [symmetric]) |
47 |
with G show ?thesis by (simp del: Units_l_inv) |
|
48 |
qed |
|
49 |
||
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
50 |
lemma mult_same_comm: |
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
51 |
assumes [simp, intro]: "a \<in> Units G" |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
52 |
shows "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = inv (a [^] n) \<otimes> a [^] m" |
53653 | 53 |
proof (cases "m\<ge>n") |
63167 | 54 |
have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed) |
53653 | 55 |
case True |
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
56 |
then obtain k where *:"m = k + n" and **:"m = n + k" by (metis le_iff_add add.commute) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
57 |
have "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = a [^] k" |
53653 | 58 |
using * by (auto simp add: nat_pow_mult[symmetric] m_assoc) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
59 |
also have "\<dots> = inv (a [^] n) \<otimes> a [^] m" |
53653 | 60 |
using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric]) |
61 |
finally show ?thesis . |
|
62 |
next |
|
63167 | 63 |
have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed) |
53653 | 64 |
case False |
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
65 |
then obtain k where *:"n = k + m" and **:"n = m + k" |
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
66 |
by (metis le_iff_add add.commute nat_le_linear) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
67 |
have "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = inv(a [^] k)" |
53653 | 68 |
using * by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
69 |
also have "\<dots> = inv (a [^] n) \<otimes> a [^] m" |
53653 | 70 |
using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc inv_mult_units) |
71 |
finally show ?thesis . |
|
72 |
qed |
|
73 |
||
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
74 |
lemma mult_inv_same_comm: |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
75 |
"a \<in> Units G \<Longrightarrow> inv (a [^] (m::nat)) \<otimes> inv (a [^] (n::nat)) = inv (a [^] n) \<otimes> inv (a [^] m)" |
53653 | 76 |
by (simp add: inv_mult_units[symmetric] nat_pow_mult ac_simps Units_closed) |
77 |
||
78 |
context |
|
79 |
includes int.lifting (* restores Lifting/Transfer for integers *) |
|
80 |
begin |
|
81 |
||
82 |
lemma int_pow_rsp: |
|
83 |
assumes eq: "(b::nat) + e = d + c" |
|
84 |
assumes a_in_G [simp, intro]: "a \<in> Units G" |
|
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
85 |
shows "a [^] b \<otimes> inv (a [^] c) = a [^] d \<otimes> inv (a [^] e)" |
53653 | 86 |
proof(cases "b\<ge>c") |
63167 | 87 |
have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed) |
53653 | 88 |
case True |
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
89 |
then obtain n where "b = n + c" by (metis le_iff_add add.commute) |
53653 | 90 |
then have "d = n + e" using eq by arith |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
91 |
from \<open>b = _\<close> have "a [^] b \<otimes> inv (a [^] c) = a [^] n" |
53653 | 92 |
by (auto simp add: nat_pow_mult[symmetric] m_assoc) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
93 |
also from \<open>d = _\<close> have "\<dots> = a [^] d \<otimes> inv (a [^] e)" |
53653 | 94 |
by (auto simp add: nat_pow_mult[symmetric] m_assoc) |
95 |
finally show ?thesis . |
|
96 |
next |
|
63167 | 97 |
have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed) |
53653 | 98 |
case False |
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
99 |
then obtain n where "c = n + b" by (metis le_iff_add add.commute nat_le_linear) |
53653 | 100 |
then have "e = n + d" using eq by arith |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
101 |
from \<open>c = _\<close> have "a [^] b \<otimes> inv (a [^] c) = inv (a [^] n)" |
53653 | 102 |
by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
103 |
also from \<open>e = _\<close> have "\<dots> = a [^] d \<otimes> inv (a [^] e)" |
53653 | 104 |
by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units) |
105 |
finally show ?thesis . |
|
106 |
qed |
|
107 |
||
108 |
(* |
|
109 |
This definition is more convinient than the definition in HOL/Algebra/Group because |
|
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
110 |
it doesn't contain a test z < 0 when a [^] z is being defined. |
53653 | 111 |
*) |
112 |
||
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
113 |
lift_definition int_pow :: "('a, 'm) monoid_scheme \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> 'a" is |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
114 |
"\<lambda>G a (n1, n2). if a \<in> Units G \<and> monoid G then (a [^]\<^bsub>G\<^esub> n1) \<otimes>\<^bsub>G\<^esub> (inv\<^bsub>G\<^esub> (a [^]\<^bsub>G\<^esub> n2)) else \<one>\<^bsub>G\<^esub>" |
53653 | 115 |
unfolding intrel_def by (auto intro: monoid.int_pow_rsp) |
116 |
||
117 |
(* |
|
62378
85ed00c1fe7c
generalize more theorems to support enat and ennreal
hoelzl
parents:
57512
diff
changeset
|
118 |
Thus, for example, the proof of distributivity of int_pow and addition |
53653 | 119 |
doesn't require a substantial number of case distinctions. |
120 |
*) |
|
121 |
||
122 |
lemma int_pow_dist: |
|
123 |
assumes [simp]: "a \<in> Units G" |
|
124 |
shows "int_pow G a ((n::int) + m) = int_pow G a n \<otimes>\<^bsub>G\<^esub> int_pow G a m" |
|
125 |
proof - |
|
126 |
{ |
|
127 |
fix k l m :: nat |
|
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
128 |
have "a [^] l \<otimes> (inv (a [^] m) \<otimes> inv (a [^] k)) = (a [^] l \<otimes> inv (a [^] k)) \<otimes> inv (a [^] m)" |
53653 | 129 |
(is "?lhs = _") |
130 |
by (simp add: mult_inv_same_comm m_assoc Units_closed) |
|
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
131 |
also have "\<dots> = (inv (a [^] k) \<otimes> a [^] l) \<otimes> inv (a [^] m)" |
53653 | 132 |
by (simp add: mult_same_comm) |
67341
df79ef3b3a41
Renamed (^) to [^] in preparation of the move from "op X" to (X)
nipkow
parents:
66453
diff
changeset
|
133 |
also have "\<dots> = inv (a [^] k) \<otimes> (a [^] l \<otimes> inv (a [^] m))" (is "_ = ?rhs") |
53653 | 134 |
by (simp add: m_assoc Units_closed) |
135 |
finally have "?lhs = ?rhs" . |
|
136 |
} |
|
137 |
then show ?thesis |
|
138 |
by (transfer fixing: G) (auto simp add: nat_pow_mult[symmetric] inv_mult_units m_assoc Units_closed) |
|
139 |
qed |
|
140 |
||
141 |
end |
|
142 |
||
143 |
lifting_update int.lifting |
|
144 |
lifting_forget int.lifting |
|
145 |
||
146 |
end |
|
53682
1b55aeda0e46
include Int_Pow into Quotient_Examples; add end of the theory
kuncar
parents:
53653
diff
changeset
|
147 |
|
1b55aeda0e46
include Int_Pow into Quotient_Examples; add end of the theory
kuncar
parents:
53653
diff
changeset
|
148 |
end |