diff -r ba2a92af88b4 -r 023b353911c5 src/HOL/Algebra/Group.thy --- a/src/HOL/Algebra/Group.thy Sat Jun 16 22:09:24 2018 +0200 +++ b/src/HOL/Algebra/Group.thy Sun Jun 17 22:00:43 2018 +0100 @@ -136,10 +136,7 @@ lemma (in monoid) Units_r_inv [simp]: "x \ Units G ==> x \ inv x = \" - apply (unfold Units_def m_inv_def, auto) - apply (rule theI2, fast) - apply (fast intro: inv_unique, fast) - done + by (metis (full_types) Units_closed Units_inv_closed Units_l_inv Units_r_inv_ex inv_unique) lemma (in monoid) inv_one [simp]: "inv \ = \" @@ -503,10 +500,6 @@ "x \ H \ x \ carrier G" using subset by blast -lemma submonoid_imp_subset: - "submonoid H G \ H \ carrier G" - by (rule submonoid.subset) - lemma (in submonoid) submonoid_is_monoid [intro]: assumes "monoid G" shows "monoid (G\carrier := H\)" @@ -516,15 +509,6 @@ by (simp add: monoid_def m_assoc) qed -lemma (in monoid) submonoidE: - assumes "submonoid H G" - shows "H \ carrier G" - and "H \ {}" - and "\a b. \a \ H; b \ H\ \ a \ b \ H" - using assms submonoid_imp_subset apply blast - using assms submonoid_def apply auto[1] - by (simp add: assms submonoid.m_closed)+ - lemma submonoid_nonempty: "~ submonoid {} G" by (blast dest: submonoid.one_closed) @@ -569,21 +553,15 @@ "x \ H \ x \ carrier G" using subset by blast -(*DELETE*) -lemma subgroup_imp_subset: - "subgroup H G \ H \ carrier G" - by (rule subgroup.subset) - lemma (in subgroup) subgroup_is_group [intro]: assumes "group G" shows "group (G\carrier := H\)" proof - interpret group G by fact - show ?thesis - apply (rule monoid.group_l_invI) - apply (unfold_locales) [1] - apply (auto intro: m_assoc l_inv mem_carrier) - done + have "Group.monoid (G\carrier := H\)" + by (simp add: monoid_axioms submonoid.intro submonoid.submonoid_is_monoid subset) + then show ?thesis + by (rule monoid.group_l_invI) (auto intro: l_inv mem_carrier) qed lemma (in group) subgroup_inv_equality: @@ -808,23 +786,42 @@ using iso_set_refl unfolding is_iso_def by auto lemma (in group) iso_set_sym: - "h \ iso G H \ inv_into (carrier G) h \ (iso H G)" -apply (simp add: iso_def bij_betw_inv_into) -apply (subgoal_tac "inv_into (carrier G) h \ carrier H \ carrier G") - prefer 2 apply (simp add: bij_betw_imp_funcset [OF bij_betw_inv_into]) -apply (simp add: hom_def bij_betw_def inv_into_f_eq f_inv_into_f Pi_def) -done + assumes "h \ iso G H" + shows "inv_into (carrier G) h \ iso H G" +proof - + have h: "h \ hom G H" "bij_betw h (carrier G) (carrier H)" + using assms by (auto simp add: iso_def bij_betw_inv_into) + then have HG: "bij_betw (inv_into (carrier G) h) (carrier H) (carrier G)" + by (simp add: bij_betw_inv_into) + have "inv_into (carrier G) h \ hom H G" + unfolding hom_def + proof safe + show *: "\x. x \ carrier H \ inv_into (carrier G) h x \ carrier G" + by (meson HG bij_betwE) + show "inv_into (carrier G) h (x \\<^bsub>H\<^esub> y) = inv_into (carrier G) h x \ inv_into (carrier G) h y" + if "x \ carrier H" "y \ carrier H" for x y + proof (rule inv_into_f_eq) + show "inj_on h (carrier G)" + using bij_betw_def h(2) by blast + show "inv_into (carrier G) h x \ inv_into (carrier G) h y \ carrier G" + by (simp add: * that) + show "h (inv_into (carrier G) h x \ inv_into (carrier G) h y) = x \\<^bsub>H\<^esub> y" + using h bij_betw_inv_into_right [of h] unfolding hom_def by (simp add: "*" that) + qed + qed + then show ?thesis + by (simp add: Group.iso_def bij_betw_inv_into h) +qed -corollary (in group) iso_sym : -"G \ H \ H \ G" + +corollary (in group) iso_sym: "G \ H \ H \ G" using iso_set_sym unfolding is_iso_def by auto lemma (in group) iso_set_trans: "[|h \ iso G H; i \ iso H I|] ==> (compose (carrier G) i h) \ iso G I" by (auto simp add: iso_def hom_compose bij_betw_compose) -corollary (in group) iso_trans : -"\G \ H ; H \ I\ \ G \ I" +corollary (in group) iso_trans: "\G \ H ; H \ I\ \ G \ I" using iso_set_trans unfolding is_iso_def by blast (* Next four lemmas contributed by Paulo. *) @@ -1143,15 +1140,6 @@ shows "comm_monoid G" by (rule comm_monoidI) (auto intro: m_assoc m_comm) -(*lemma (in comm_monoid) r_one [simp]: - "x \ carrier G ==> x \ \ = x" -proof - - assume G: "x \ carrier G" - then have "x \ \ = \ \ x" by (simp add: m_comm) - also from G have "... = x" by simp - finally show ?thesis . -qed*) - lemma (in comm_monoid) nat_pow_distr: "[| x \ carrier G; y \ carrier G |] ==> (x \ y) [^] (n::nat) = x [^] n \ y [^] n" @@ -1397,22 +1385,24 @@ \carrier = Units G, Group.monoid.mult = Group.monoid.mult G, one = one G\" lemma (in monoid) units_group: "group (units_of G)" - apply (unfold units_of_def) - apply (rule groupI) - apply auto - apply (subst m_assoc) - apply auto - apply (rule_tac x = "inv x" in bexI) - apply auto - done +proof - + have "\x y z. \x \ Units G; y \ Units G; z \ Units G\ \ x \ y \ z = x \ (y \ z)" + by (simp add: Units_closed m_assoc) + moreover have "\x. x \ Units G \ \y\Units G. y \ x = \" + using Units_l_inv by blast + ultimately show ?thesis + unfolding units_of_def + by (force intro!: groupI) +qed lemma (in comm_monoid) units_comm_group: "comm_group (units_of G)" - apply (rule group.group_comm_groupI) - apply (rule units_group) - apply (insert comm_monoid_axioms) - apply (unfold units_of_def Units_def comm_monoid_def comm_monoid_axioms_def) - apply auto - done +proof - + have "\x y. \x \ carrier (units_of G); y \ carrier (units_of G)\ + \ x \\<^bsub>units_of G\<^esub> y = y \\<^bsub>units_of G\<^esub> x" + by (simp add: Units_closed m_comm units_of_def) + then show ?thesis + by (rule group.group_comm_groupI [OF units_group]) auto +qed lemma units_of_carrier: "carrier (units_of G) = Units G" by (auto simp: units_of_def) @@ -1423,39 +1413,14 @@ lemma units_of_one: "one (units_of G) = one G" by (auto simp: units_of_def) -lemma (in monoid) units_of_inv: "x \ Units G \ m_inv (units_of G) x = m_inv G x" - apply (rule sym) - apply (subst m_inv_def) - apply (rule the1_equality) - apply (rule ex_ex1I) - apply (subst (asm) Units_def) - apply auto - apply (erule inv_unique) - apply auto - apply (rule Units_closed) - apply (simp_all only: units_of_carrier [symmetric]) - apply (insert units_group) - apply auto - apply (subst units_of_mult [symmetric]) - apply (subst units_of_one [symmetric]) - apply (erule group.r_inv, assumption) - apply (subst units_of_mult [symmetric]) - apply (subst units_of_one [symmetric]) - apply (erule group.l_inv, assumption) - done - -lemma (in group) inj_on_const_mult: "a \ carrier G \ inj_on (\x. a \ x) (carrier G)" - unfolding inj_on_def by auto +lemma (in monoid) units_of_inv: + assumes "x \ Units G" + shows "m_inv (units_of G) x = m_inv G x" + by (simp add: assms group.inv_equality units_group units_of_carrier units_of_mult units_of_one) lemma (in group) surj_const_mult: "a \ carrier G \ (\x. a \ x) ` carrier G = carrier G" apply (auto simp add: image_def) - apply (rule_tac x = "(m_inv G a) \ x" in bexI) - apply auto -(* auto should get this. I suppose we need "comm_monoid_simprules" - for ac_simps rewriting. *) - apply (subst m_assoc [symmetric]) - apply auto - done + by (metis inv_closed inv_solve_left m_closed) lemma (in group) l_cancel_one [simp]: "x \ carrier G \ a \ carrier G \ x \ a = x \ a = one G" by (metis Units_eq Units_l_cancel monoid.r_one monoid_axioms one_closed)