src/HOL/Quotient_Examples/Int_Pow.thy
changeset 67341 df79ef3b3a41
parent 66453 cc19f7ca2ed6
equal deleted inserted replaced
67340:150d40a25622 67341:df79ef3b3a41
    18 begin
    18 begin
    19 
    19 
    20 (* first some additional lemmas that are missing in monoid *)
    20 (* first some additional lemmas that are missing in monoid *)
    21 
    21 
    22 lemma Units_nat_pow_Units [intro, simp]:
    22 lemma Units_nat_pow_Units [intro, simp]:
    23   "a \<in> Units G \<Longrightarrow> a (^) (c :: nat) \<in> Units G" by (induct c) auto
    23   "a \<in> Units G \<Longrightarrow> a [^] (c :: nat) \<in> Units G" by (induct c) auto
    24 
    24 
    25 lemma Units_r_cancel [simp]:
    25 lemma Units_r_cancel [simp]:
    26   "[| z \<in> Units G; x \<in> carrier G; y \<in> carrier G |] ==>
    26   "[| z \<in> Units G; x \<in> carrier G; y \<in> carrier G |] ==>
    27    (x \<otimes> z = y \<otimes> z) = (x = y)"
    27    (x \<otimes> z = y \<otimes> z) = (x = y)"
    28 proof
    28 proof
    47   with G show ?thesis by (simp del: Units_l_inv)
    47   with G show ?thesis by (simp del: Units_l_inv)
    48 qed
    48 qed
    49 
    49 
    50 lemma mult_same_comm:
    50 lemma mult_same_comm:
    51   assumes [simp, intro]: "a \<in> Units G"
    51   assumes [simp, intro]: "a \<in> Units G"
    52   shows "a (^) (m::nat) \<otimes> inv (a (^) (n::nat)) = inv (a (^) n) \<otimes> a (^) m"
    52   shows "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = inv (a [^] n) \<otimes> a [^] m"
    53 proof (cases "m\<ge>n")
    53 proof (cases "m\<ge>n")
    54   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    54   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    55   case True
    55   case True
    56     then obtain k where *:"m = k + n" and **:"m = n + k" by (metis le_iff_add add.commute)
    56     then obtain k where *:"m = k + n" and **:"m = n + k" by (metis le_iff_add add.commute)
    57     have "a (^) (m::nat) \<otimes> inv (a (^) (n::nat)) = a (^) k"
    57     have "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = a [^] k"
    58       using * by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    58       using * by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    59     also have "\<dots> = inv (a (^) n) \<otimes> a (^) m"
    59     also have "\<dots> = inv (a [^] n) \<otimes> a [^] m"
    60       using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric])
    60       using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric])
    61     finally show ?thesis .
    61     finally show ?thesis .
    62 next
    62 next
    63   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    63   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    64   case False
    64   case False
    65     then obtain k where *:"n = k + m" and **:"n = m + k"
    65     then obtain k where *:"n = k + m" and **:"n = m + k"
    66       by (metis le_iff_add add.commute nat_le_linear)
    66       by (metis le_iff_add add.commute nat_le_linear)
    67     have "a (^) (m::nat) \<otimes> inv (a (^) (n::nat)) = inv(a (^) k)"
    67     have "a [^] (m::nat) \<otimes> inv (a [^] (n::nat)) = inv(a [^] k)"
    68       using * by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
    68       using * by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
    69     also have "\<dots> = inv (a (^) n) \<otimes> a (^) m"
    69     also have "\<dots> = inv (a [^] n) \<otimes> a [^] m"
    70       using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc inv_mult_units)
    70       using ** by (auto simp add: nat_pow_mult[symmetric] m_assoc inv_mult_units)
    71     finally show ?thesis .
    71     finally show ?thesis .
    72 qed
    72 qed
    73 
    73 
    74 lemma mult_inv_same_comm:
    74 lemma mult_inv_same_comm:
    75   "a \<in> Units G \<Longrightarrow> inv (a (^) (m::nat)) \<otimes> inv (a (^) (n::nat)) = inv (a (^) n) \<otimes> inv (a (^) m)"
    75   "a \<in> Units G \<Longrightarrow> inv (a [^] (m::nat)) \<otimes> inv (a [^] (n::nat)) = inv (a [^] n) \<otimes> inv (a [^] m)"
    76 by (simp add: inv_mult_units[symmetric] nat_pow_mult ac_simps Units_closed)
    76 by (simp add: inv_mult_units[symmetric] nat_pow_mult ac_simps Units_closed)
    77 
    77 
    78 context
    78 context
    79 includes int.lifting (* restores Lifting/Transfer for integers *)
    79 includes int.lifting (* restores Lifting/Transfer for integers *)
    80 begin
    80 begin
    81 
    81 
    82 lemma int_pow_rsp:
    82 lemma int_pow_rsp:
    83   assumes eq: "(b::nat) + e = d + c"
    83   assumes eq: "(b::nat) + e = d + c"
    84   assumes a_in_G [simp, intro]: "a \<in> Units G"
    84   assumes a_in_G [simp, intro]: "a \<in> Units G"
    85   shows "a (^) b \<otimes> inv (a (^) c) = a (^) d \<otimes> inv (a (^) e)"
    85   shows "a [^] b \<otimes> inv (a [^] c) = a [^] d \<otimes> inv (a [^] e)"
    86 proof(cases "b\<ge>c")
    86 proof(cases "b\<ge>c")
    87   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    87   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    88   case True
    88   case True
    89     then obtain n where "b = n + c" by (metis le_iff_add add.commute)
    89     then obtain n where "b = n + c" by (metis le_iff_add add.commute)
    90     then have "d = n + e" using eq by arith
    90     then have "d = n + e" using eq by arith
    91     from \<open>b = _\<close> have "a (^) b \<otimes> inv (a (^) c) = a (^) n"
    91     from \<open>b = _\<close> have "a [^] b \<otimes> inv (a [^] c) = a [^] n"
    92       by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    92       by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    93     also from \<open>d = _\<close>  have "\<dots> = a (^) d \<otimes> inv (a (^) e)"
    93     also from \<open>d = _\<close>  have "\<dots> = a [^] d \<otimes> inv (a [^] e)"
    94       by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    94       by (auto simp add: nat_pow_mult[symmetric] m_assoc)
    95     finally show ?thesis .
    95     finally show ?thesis .
    96 next
    96 next
    97   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    97   have [simp]: "a \<in> carrier G" using \<open>a \<in> _\<close> by (rule Units_closed)
    98   case False
    98   case False
    99     then obtain n where "c = n + b" by (metis le_iff_add add.commute nat_le_linear)
    99     then obtain n where "c = n + b" by (metis le_iff_add add.commute nat_le_linear)
   100     then have "e = n + d" using eq by arith
   100     then have "e = n + d" using eq by arith
   101     from \<open>c = _\<close> have "a (^) b \<otimes> inv (a (^) c) = inv (a (^) n)"
   101     from \<open>c = _\<close> have "a [^] b \<otimes> inv (a [^] c) = inv (a [^] n)"
   102       by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
   102       by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
   103     also from \<open>e = _\<close> have "\<dots> = a (^) d \<otimes> inv (a (^) e)"
   103     also from \<open>e = _\<close> have "\<dots> = a [^] d \<otimes> inv (a [^] e)"
   104       by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
   104       by (auto simp add: nat_pow_mult[symmetric] m_assoc[symmetric] inv_mult_units)
   105     finally show ?thesis .
   105     finally show ?thesis .
   106 qed
   106 qed
   107 
   107 
   108 (*
   108 (*
   109   This definition is more convinient than the definition in HOL/Algebra/Group because
   109   This definition is more convinient than the definition in HOL/Algebra/Group because
   110   it doesn't contain a test z < 0 when a (^) z is being defined.
   110   it doesn't contain a test z < 0 when a [^] z is being defined.
   111 *)
   111 *)
   112 
   112 
   113 lift_definition int_pow :: "('a, 'm) monoid_scheme \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> 'a" is
   113 lift_definition int_pow :: "('a, 'm) monoid_scheme \<Rightarrow> 'a \<Rightarrow> int \<Rightarrow> 'a" is
   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>"
   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>"
   115 unfolding intrel_def by (auto intro: monoid.int_pow_rsp)
   115 unfolding intrel_def by (auto intro: monoid.int_pow_rsp)
   116 
   116 
   117 (*
   117 (*
   118   Thus, for example, the proof of distributivity of int_pow and addition
   118   Thus, for example, the proof of distributivity of int_pow and addition
   119   doesn't require a substantial number of case distinctions.
   119   doesn't require a substantial number of case distinctions.
   123   assumes [simp]: "a \<in> Units G"
   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"
   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 -
   125 proof -
   126   {
   126   {
   127     fix k l m :: nat
   127     fix k l m :: nat
   128     have "a (^) l \<otimes> (inv (a (^) m) \<otimes> inv (a (^) k)) = (a (^) l \<otimes> inv (a (^) k)) \<otimes> inv (a (^) m)"
   128     have "a [^] l \<otimes> (inv (a [^] m) \<otimes> inv (a [^] k)) = (a [^] l \<otimes> inv (a [^] k)) \<otimes> inv (a [^] m)"
   129       (is "?lhs = _")
   129       (is "?lhs = _")
   130       by (simp add: mult_inv_same_comm m_assoc Units_closed)
   130       by (simp add: mult_inv_same_comm m_assoc Units_closed)
   131     also have "\<dots> = (inv (a (^) k) \<otimes> a (^) l) \<otimes> inv (a (^) m)"
   131     also have "\<dots> = (inv (a [^] k) \<otimes> a [^] l) \<otimes> inv (a [^] m)"
   132       by (simp add: mult_same_comm)
   132       by (simp add: mult_same_comm)
   133     also have "\<dots> = inv (a (^) k) \<otimes> (a (^) l \<otimes> inv (a (^) m))" (is "_ = ?rhs")
   133     also have "\<dots> = inv (a [^] k) \<otimes> (a [^] l \<otimes> inv (a [^] m))" (is "_ = ?rhs")
   134       by (simp add: m_assoc Units_closed)
   134       by (simp add: m_assoc Units_closed)
   135     finally have "?lhs = ?rhs" .
   135     finally have "?lhs = ?rhs" .
   136   }
   136   }
   137   then show ?thesis
   137   then show ?thesis
   138     by (transfer fixing: G) (auto simp add: nat_pow_mult[symmetric] inv_mult_units m_assoc Units_closed)
   138     by (transfer fixing: G) (auto simp add: nat_pow_mult[symmetric] inv_mult_units m_assoc Units_closed)