# HG changeset patch # User paulson # Date 1554134563 -3600 # Node ID 095dce9892e8bba888d6794b774a40c928280be6 # Parent 571909ef3103a64344869cfbde4e93ffe94fea0e A few results in Algebra, and bits for Analysis diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/Coset.thy --- a/src/HOL/Algebra/Coset.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/Coset.thy Mon Apr 01 17:02:43 2019 +0100 @@ -1379,7 +1379,7 @@ qed qed -lemma (in group) normal_inter_subgroup: +lemma (in group) normal_Int_subgroup: assumes "subgroup H G" and "N \ G" shows "(N\H) \ (G\carrier := H\)" diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/Generated_Groups.thy --- a/src/HOL/Algebra/Generated_Groups.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/Generated_Groups.thy Mon Apr 01 17:02:43 2019 +0100 @@ -563,4 +563,13 @@ by (simp add: int_pow_def2 pow_subgroup_generated) qed +lemma kernel_from_subgroup_generated [simp]: + "subgroup S G \ kernel (subgroup_generated G S) H f = kernel G H f \ S" + using subgroup.carrier_subgroup_generated_subgroup subgroup.subset + by (fastforce simp add: kernel_def set_eq_iff) + +lemma kernel_to_subgroup_generated [simp]: + "kernel G (subgroup_generated H S) f = kernel G H f" + by (simp add: kernel_def) + end \ No newline at end of file diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/Group.thy --- a/src/HOL/Algebra/Group.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/Group.thy Mon Apr 01 17:02:43 2019 +0100 @@ -425,7 +425,20 @@ end lemma int_pow_int: "x [^]\<^bsub>G\<^esub> (int n) = x [^]\<^bsub>G\<^esub> n" -by(simp add: int_pow_def nat_pow_def) + by(simp add: int_pow_def nat_pow_def) + +lemma pow_nat: + assumes "i\0" + shows "x [^]\<^bsub>G\<^esub> nat i = x [^]\<^bsub>G\<^esub> i" +proof (cases i rule: int_cases) + case (nonneg n) + then show ?thesis + by (simp add: int_pow_int) +next + case (neg n) + then show ?thesis + using assms by linarith +qed lemma int_pow_0 [simp]: "x [^]\<^bsub>G\<^esub> (0::int) = \\<^bsub>G\<^esub>" by (simp add: int_pow_def) @@ -450,6 +463,9 @@ "x \ carrier G \ x [^] (-i::int) = inv (x [^] i)" by (simp add: int_pow_def2) +lemma (in group) int_pow_neg_int: "x \ carrier G \ x [^] -(int n) = inv (x [^] n)" + by (simp add: int_pow_neg int_pow_int) + lemma (in group) int_pow_mult: assumes "x \ carrier G" shows "x [^] (i + j::int) = x [^] i \ x [^] j" proof - @@ -502,6 +518,38 @@ by(simp add: inj_on_def) +lemma (in monoid) group_commutes_pow: + fixes n::nat + shows "\x \ y = y \ x; x \ carrier G; y \ carrier G\ \ x [^] n \ y = y \ x [^] n" + apply (induction n, auto) + by (metis m_assoc nat_pow_closed) + +lemma (in monoid) pow_mult_distrib: + assumes eq: "x \ y = y \ x" and xy: "x \ carrier G" "y \ carrier G" + shows "(x \ y) [^] (n::nat) = x [^] n \ y [^] n" +proof (induct n) + case (Suc n) + have "x \ (y [^] n \ y) = y [^] n \ x \ y" + by (simp add: eq group_commutes_pow m_assoc xy) + then show ?case + using assms Suc.hyps m_assoc by auto +qed auto + +lemma (in group) int_pow_mult_distrib: + assumes eq: "x \ y = y \ x" and xy: "x \ carrier G" "y \ carrier G" + shows "(x \ y) [^] (i::int) = x [^] i \ y [^] i" +proof (cases i rule: int_cases) + case (nonneg n) + then show ?thesis + by (metis eq int_pow_int pow_mult_distrib xy) +next + case (neg n) + then show ?thesis + unfolding neg + apply (simp add: xy int_pow_neg_int del: of_nat_Suc) + by (metis eq inv_mult_group local.nat_pow_Suc nat_pow_closed pow_mult_distrib xy) +qed + subsection \Submonoids\ locale submonoid = \<^marker>\contributor \Martin Baillon\\ @@ -852,7 +900,7 @@ lemma id_iso: "id \ iso G G" by (simp add: iso_def hom_def inj_on_def bij_betw_def Pi_def) -corollary iso_refl : "G \ G" +corollary iso_refl [simp]: "G \ G" using iso_set_refl unfolding is_iso_def by auto lemma trivial_hom: @@ -901,11 +949,11 @@ 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) +lemma iso_set_trans: + "\h \ Group.iso G H; i \ Group.iso H I\ \ i \ h \ Group.iso G I" + by (force simp: iso_def hom_compose intro: bij_betw_trans) -corollary (in group) iso_trans: "\G \ H ; H \ I\ \ G \ I" +corollary iso_trans [trans]: "\G \ H ; H \ I\ \ G \ I" using iso_set_trans unfolding is_iso_def by blast lemma iso_same_card: "G \ H \ card (carrier G) = card (carrier H)" @@ -1081,6 +1129,8 @@ fixes h assumes homh [simp]: "h \ hom G H" +declare group_hom.homh [simp] + lemma (in group_hom) hom_mult [simp]: "[| x \ carrier G; y \ carrier G |] ==> h (x \\<^bsub>G\<^esub> y) = h x \\<^bsub>H\<^esub> h y" proof - @@ -1170,14 +1220,21 @@ using subgroup.subgroup_is_group[OF assms is_group] is_group subgroup.subset[OF assms] by auto -lemma (in group_hom) nat_pow_hom: \<^marker>\contributor \Paulo Emílio de Vilhena\\ +lemma (in group_hom) hom_nat_pow: \<^marker>\contributor \Paulo Emílio de Vilhena\\ "x \ carrier G \ h (x [^] (n :: nat)) = (h x) [^]\<^bsub>H\<^esub> n" by (induction n) auto -lemma (in group_hom) int_pow_hom: \<^marker>\contributor \Paulo Emílio de Vilhena\\ +lemma (in group_hom) hom_int_pow: \<^marker>\contributor \Paulo Emílio de Vilhena\\ "x \ carrier G \ h (x [^] (n :: int)) = (h x) [^]\<^bsub>H\<^esub> n" - using nat_pow_hom by (simp add: int_pow_def2) + using hom_nat_pow by (simp add: int_pow_def2) +lemma hom_nat_pow: + "\h \ hom G H; x \ carrier G; group G; group H\ \ h (x [^]\<^bsub>G\<^esub> (n :: nat)) = (h x) [^]\<^bsub>H\<^esub> n" + by (simp add: group_hom.hom_nat_pow group_hom_axioms_def group_hom_def) + +lemma hom_int_pow: + "\h \ hom G H; x \ carrier G; group G; group H\ \ h (x [^]\<^bsub>G\<^esub> (n :: int)) = (h x) [^]\<^bsub>H\<^esub> n" + by (simp add: group_hom.hom_int_pow group_hom_axioms.intro group_hom_def) subsection \Commutative Structures\ @@ -1225,11 +1282,6 @@ shows "comm_monoid G" by (rule comm_monoidI) (auto intro: m_assoc m_comm) -lemma (in comm_monoid) nat_pow_distr: - "[| x \ carrier G; y \ carrier G |] ==> - (x \ y) [^] (n::nat) = x [^] n \ y [^] n" - by (induct n) (simp, simp add: m_ac) - lemma (in comm_monoid) submonoid_is_comm_monoid : assumes "submonoid H G" shows "comm_monoid (G\carrier := H\)" @@ -1279,6 +1331,17 @@ "[| x \ carrier G; y \ carrier G |] ==> inv (x \ y) = inv x \ inv y" by (simp add: m_ac inv_mult_group) +lemma (in comm_monoid) nat_pow_distrib: + fixes n::nat + assumes "x \ carrier G" "y \ carrier G" + shows "(x \ y) [^] n = x [^] n \ y [^] n" + by (simp add: assms pow_mult_distrib m_comm) + +lemma (in comm_group) int_pow_distrib: + assumes "x \ carrier G" "y \ carrier G" + shows "(x \ y) [^] (i::int) = x [^] i \ y [^] i" + by (simp add: assms int_pow_mult_distrib m_comm) + lemma (in comm_monoid) hom_imp_img_comm_monoid: \<^marker>\contributor \Paulo Emílio de Vilhena\\ assumes "h \ hom G H" shows "comm_monoid (H \ carrier := h ` (carrier G), one := h \\<^bsub>G\<^esub> \)" (is "comm_monoid ?h_img") diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/Polynomials.thy --- a/src/HOL/Algebra/Polynomials.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/Polynomials.thy Mon Apr 01 17:02:43 2019 +0100 @@ -2190,7 +2190,7 @@ have eq: "\t. t \ set (dense_repr p) \ h [ fst t ] \\<^bsub>A\<^esub> (h X [^]\<^bsub>A\<^esub> (snd t)) = (h \ ?f) t" using ring_hom_memE(2)[OF ring_hom_ring.homh[OF assms(3)] const_in_carrier var_pow_closed[OF assms(1)]] - ring_hom_ring.nat_pow_hom[OF assms(3) var_closed(1)[OF assms(1)]] by auto + ring_hom_ring.hom_nat_pow[OF assms(3) var_closed(1)[OF assms(1)]] by auto show ?thesis using A.add.finprod_cong'[OF _ h eq] hp by simp qed diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/RingHom.thy --- a/src/HOL/Algebra/RingHom.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/RingHom.thy Mon Apr 01 17:02:43 2019 +0100 @@ -176,7 +176,7 @@ using assms by (auto simp: intro: homeq_imp_rcos rcos_imp_homeq a_elemrcos_carrier) qed -lemma (in ring_hom_ring) nat_pow_hom: +lemma (in ring_hom_ring) hom_nat_pow: "x \ carrier R \ h (x [^] (n :: nat)) = (h x) [^]\<^bsub>S\<^esub> n" by (induct n) (auto) diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Algebra/Zassenhaus.thy --- a/src/HOL/Algebra/Zassenhaus.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Algebra/Zassenhaus.thy Mon Apr 01 17:02:43 2019 +0100 @@ -203,7 +203,7 @@ hence N_incl : "N \ N <#> H" by (metis assms(1) normal_imp_subgroup coset_mult_one subgroup_def) thus "normal N (G\carrier := N <#> H\)" - using normal_inter_subgroup[OF mult_norm_subgroup[OF assms] assms(1)] + using normal_Int_subgroup[OF mult_norm_subgroup[OF assms] assms(1)] by (simp add : inf_absorb1) qed @@ -308,7 +308,7 @@ ultimately have "(G\carrier := H\ Mod N \ H) \ (G\carrier := N <#> H\ Mod N)" using group_hom.FactGroup_iso[OF homomorphism im_f] by auto hence "G\carrier := N <#> H\ Mod N \ G\carrier := H\ Mod N \ H" - by (simp add: group.iso_sym assms normal.factorgroup_is_group normal_inter_subgroup) + by (simp add: group.iso_sym assms normal.factorgroup_is_group normal_Int_subgroup) thus "G\carrier := N <#> H\ Mod N \ G\carrier := H\ Mod N \ H" by auto qed @@ -636,8 +636,7 @@ qed hence "Gmod3 = Gmod4" using Hp Gmod4_def by simp hence "Gmod1 \ Gmod2" - using group.iso_sym group.iso_trans Hyp normal.factorgroup_is_group - by (metis assms Gmod1_def Gmod2_def preliminary2) + by (metis assms group.iso_sym iso_trans Hyp normal.factorgroup_is_group Gmod2_def preliminary2) thus ?thesis using Gmod1_def Gmod2_def by (simp add: inf_commute) qed diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Analysis/Abstract_Euclidean_Space.thy --- a/src/HOL/Analysis/Abstract_Euclidean_Space.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Analysis/Abstract_Euclidean_Space.thy Mon Apr 01 17:02:43 2019 +0100 @@ -81,13 +81,13 @@ "\continuous_map X (Euclidean_space n) f; continuous_map X (Euclidean_space n) g\ \ continuous_map X (Euclidean_space n) (\x i. f x i + g x i)" unfolding Euclidean_space_def continuous_map_in_subtopology - by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_real_add) + by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_add) lemma continuous_map_Euclidean_space_diff [continuous_intros]: "\continuous_map X (Euclidean_space n) f; continuous_map X (Euclidean_space n) g\ \ continuous_map X (Euclidean_space n) (\x i. f x i - g x i)" unfolding Euclidean_space_def continuous_map_in_subtopology - by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_real_diff) + by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_diff) lemma homeomorphic_Euclidean_space_product_topology: "Euclidean_space n homeomorphic_space product_topology (\i. euclideanreal) {..x i. if i = k then -x i else x i)" proof - - have cm: "continuous_map (powertop_real UNIV) - euclideanreal (\x. if j = k then - x j else x j)" for j + have cm: "continuous_map (powertop_real UNIV) euclideanreal (\x. if j = k then - x j else x j)" for j proof (cases "j=k") case True then show ?thesis - by simp (metis UNIV_I continuous_map_product_projection continuous_map_real_minus) + by simp (metis UNIV_I continuous_map_product_projection) next case False then show ?thesis @@ -173,7 +172,7 @@ by simp show ?thesis apply (simp add: nsphere continuous_map_in_subtopology continuous_map_componentwise_UNIV - continuous_map_from_subtopology cm topspace_subtopology) + continuous_map_from_subtopology cm) apply (intro conjI allI impI continuous_intros continuous_map_from_subtopology continuous_map_product_projection) apply (auto simp: power2_eq_square if_distrib [where f = "\x. x * _"] eq cong: if_cong) done diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Analysis/Abstract_Limits.thy --- a/src/HOL/Analysis/Abstract_Limits.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Analysis/Abstract_Limits.thy Mon Apr 01 17:02:43 2019 +0100 @@ -47,7 +47,7 @@ definition limitin :: "'a topology \ ('b \ 'a) \ 'a \ 'b filter \ bool" where "limitin X f l F \ l \ topspace X \ (\U. openin X U \ l \ U \ eventually (\x. f x \ U) F)" -lemma limitin_euclideanreal_iff [simp]: "limitin euclideanreal f l F \ (f \ l) F" +lemma limitin_canonical_iff [simp]: "limitin euclidean f l F \ (f \ l) F" by (auto simp: limitin_def tendsto_def) lemma limitin_topspace: "limitin X f l F \ l \ topspace X" @@ -203,8 +203,8 @@ subsection\Combining theorems for continuous functions into the reals\ -lemma continuous_map_real_const [simp,continuous_intros]: - "continuous_map X euclideanreal (\x. c)" +lemma continuous_map_canonical_const [continuous_intros]: + "continuous_map X euclidean (\x. c)" by simp lemma continuous_map_real_mult [continuous_intros]: @@ -240,24 +240,31 @@ "continuous_map X euclideanreal (\x. f x * c) \ c = 0 \ continuous_map X euclideanreal f" by (simp add: mult.commute flip: continuous_map_real_mult_left_eq) -lemma continuous_map_real_minus [continuous_intros]: - "continuous_map X euclideanreal f \ continuous_map X euclideanreal (\x. - f x)" +lemma continuous_map_minus [continuous_intros]: + fixes f :: "'a\'b::real_normed_vector" + shows "continuous_map X euclidean f \ continuous_map X euclidean (\x. - f x)" by (simp add: continuous_map_atin tendsto_minus) -lemma continuous_map_real_minus_eq: - "continuous_map X euclideanreal (\x. - f x) \ continuous_map X euclideanreal f" - using continuous_map_real_mult_left_eq [where c = "-1"] by auto +lemma continuous_map_minus_eq [simp]: + fixes f :: "'a\'b::real_normed_vector" + shows "continuous_map X euclidean (\x. - f x) \ continuous_map X euclidean f" + using continuous_map_minus add.inverse_inverse continuous_map_eq by fastforce -lemma continuous_map_real_add [continuous_intros]: - "\continuous_map X euclideanreal f; continuous_map X euclideanreal g\ - \ continuous_map X euclideanreal (\x. f x + g x)" +lemma continuous_map_add [continuous_intros]: + fixes f :: "'a\'b::real_normed_vector" + shows "\continuous_map X euclidean f; continuous_map X euclidean g\ \ continuous_map X euclidean (\x. f x + g x)" by (simp add: continuous_map_atin tendsto_add) -lemma continuous_map_real_diff [continuous_intros]: - "\continuous_map X euclideanreal f; continuous_map X euclideanreal g\ - \ continuous_map X euclideanreal (\x. f x - g x)" +lemma continuous_map_diff [continuous_intros]: + fixes f :: "'a\'b::real_normed_vector" + shows "\continuous_map X euclidean f; continuous_map X euclidean g\ \ continuous_map X euclidean (\x. f x - g x)" by (simp add: continuous_map_atin tendsto_diff) +lemma continuous_map_norm [continuous_intros]: + fixes f :: "'a\'b::real_normed_vector" + shows "continuous_map X euclidean f \ continuous_map X euclidean (\x. norm(f x))" + by (simp add: continuous_map_atin tendsto_norm) + lemma continuous_map_real_abs [continuous_intros]: "continuous_map X euclideanreal f \ continuous_map X euclideanreal (\x. abs(f x))" by (simp add: continuous_map_atin tendsto_rabs) @@ -273,8 +280,9 @@ by (simp add: continuous_map_atin tendsto_min) lemma continuous_map_sum [continuous_intros]: - "\finite I; \i. i \ I \ continuous_map X euclideanreal (\x. f x i)\ - \ continuous_map X euclideanreal (\x. sum (f x) I)" + fixes f :: "'a\'b\'c::real_normed_vector" + shows "\finite I; \i. i \ I \ continuous_map X euclidean (\x. f x i)\ + \ continuous_map X euclidean (\x. sum (f x) I)" by (simp add: continuous_map_atin tendsto_sum) lemma continuous_map_prod [continuous_intros]: diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Analysis/Function_Topology.thy --- a/src/HOL/Analysis/Function_Topology.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Analysis/Function_Topology.thy Mon Apr 01 17:02:43 2019 +0100 @@ -608,7 +608,7 @@ using continuous_map_product_coordinates [of _ UNIV "\i. euclidean"] by (metis (no_types) continuous_map_iff_continuous euclidean_product_topology iso_tuple_UNIV_I subtopology_UNIV) -lemma continuous_on_coordinatewise_then_product [intro, continuous_intros]: +lemma continuous_on_coordinatewise_then_product [continuous_intros]: fixes f :: "'a::topological_space \ 'b \ 'c::topological_space" assumes "\i. continuous_on S (\x. f x i)" shows "continuous_on S f" @@ -635,7 +635,7 @@ lemma continuous_on_coordinatewise_iff: fixes f :: "('a \ real) \ 'b \ real" shows "continuous_on (A \ S) f \ (\i. continuous_on (A \ S) (\x. f x i))" - by (auto simp: continuous_on_product_then_coordinatewise) + by (auto simp: continuous_on_product_then_coordinatewise continuous_on_coordinatewise_then_product) subsubsection%important \Topological countability for product spaces\ diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Analysis/T1_Spaces.thy --- a/src/HOL/Analysis/T1_Spaces.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Analysis/T1_Spaces.thy Mon Apr 01 17:02:43 2019 +0100 @@ -411,7 +411,7 @@ "\Hausdorff_space X; finite S\ \ closedin X S \ S \ topspace X" by (meson closedin_Hausdorff_finite closedin_def) -lemma derived_set_of_infinite_open_in: +lemma derived_set_of_infinite_openin: "Hausdorff_space X \ X derived_set_of S = {x \ topspace X. \U. x \ U \ openin X U \ infinite(S \ U)}" diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Analysis/Topology_Euclidean_Space.thy --- a/src/HOL/Analysis/Topology_Euclidean_Space.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Analysis/Topology_Euclidean_Space.thy Mon Apr 01 17:02:43 2019 +0100 @@ -879,7 +879,7 @@ "is_interval (s::real set) \ (\a\s. \b\s. \ x. a \ x \ x \ b \ x \ s)" unfolding is_interval_def by auto -lemma is_interval_inter: "is_interval X \ is_interval Y \ is_interval (X \ Y)" +lemma is_interval_Int: "is_interval X \ is_interval Y \ is_interval (X \ Y)" unfolding is_interval_def by blast diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Decision_Procs/Commutative_Ring.thy --- a/src/HOL/Decision_Procs/Commutative_Ring.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Decision_Procs/Commutative_Ring.thy Mon Apr 01 17:02:43 2019 +0100 @@ -319,12 +319,12 @@ proof (cases "even k") case True with * \in_carrier ls\ show ?thesis - by (simp add: even_pow sqr_ci nat_pow_distr nat_pow_mult + by (simp add: even_pow sqr_ci nat_pow_distrib nat_pow_mult mult_2 [symmetric] even_two_times_div_two) next case False with * \in_carrier ls\ show ?thesis - by (simp add: odd_pow mul_ci sqr_ci nat_pow_distr nat_pow_mult + by (simp add: odd_pow mul_ci sqr_ci nat_pow_distrib nat_pow_mult mult_2 [symmetric] trans [OF nat_pow_Suc m_comm, symmetric]) qed qed diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Decision_Procs/Reflective_Field.thy --- a/src/HOL/Decision_Procs/Reflective_Field.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Decision_Procs/Reflective_Field.thy Mon Apr 01 17:02:43 2019 +0100 @@ -159,7 +159,7 @@ proof (cases x y rule: pexpr_cases2) case (PPow_PPow e n e' m) then show ?thesis - by (simp del: npemul.simps add: 1 npepow_correct nat_pow_distr + by (simp del: npemul.simps add: 1 npepow_correct nat_pow_distrib npemul.simps [of "PExpr2 (PPow e n)" "PExpr2 (PPow e' m)"]) qed simp_all qed @@ -258,7 +258,7 @@ by (induct e n e' m arbitrary: p e'' rule: isin.induct) (force simp add: - nat_pow_distr nat_pow_pow nat_pow_mult m_ac + nat_pow_distrib nat_pow_pow nat_pow_mult m_ac npemul_correct npepow_correct split: option.split_asm prod.split_asm if_split_asm)+ @@ -323,7 +323,7 @@ peval xs (PExpr2 (PMul (snd (snd (split_aux e\<^sub>1 n e\<^sub>2))) (fst (snd (split_aux e\<^sub>1 n e\<^sub>2)))))" by (induct e\<^sub>1 n e\<^sub>2 rule: split_aux_induct) (auto simp add: split_beta - nat_pow_distr nat_pow_pow nat_pow_mult m_ac + nat_pow_distrib nat_pow_pow nat_pow_mult m_ac npemul_correct npepow_correct isin_correct' split: option.split) diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Finite_Set.thy --- a/src/HOL/Finite_Set.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Finite_Set.thy Mon Apr 01 17:02:43 2019 +0100 @@ -2045,24 +2045,49 @@ for f :: "'a \ 'a" by (fastforce simp:surj_def dest!: endo_inj_surj) -corollary infinite_UNIV_nat [iff]: "\ finite (UNIV :: nat set)" -proof - assume "finite (UNIV :: nat set)" - with finite_UNIV_inj_surj [of Suc] show False - by simp (blast dest: Suc_neq_Zero surjD) -qed - -lemma infinite_UNIV_char_0: "\ finite (UNIV :: 'a::semiring_char_0 set)" +lemma surjective_iff_injective_gen: + assumes fS: "finite S" + and fT: "finite T" + and c: "card S = card T" + and ST: "f ` S \ T" + shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" + (is "?lhs \ ?rhs") proof - assume "finite (UNIV :: 'a set)" - with subset_UNIV have "finite (range of_nat :: 'a set)" - by (rule finite_subset) - moreover have "inj (of_nat :: nat \ 'a)" - by (simp add: inj_on_def) - ultimately have "finite (UNIV :: nat set)" - by (rule finite_imageD) - then show False - by simp + assume h: "?lhs" + { + fix x y + assume x: "x \ S" + assume y: "y \ S" + assume f: "f x = f y" + from x fS have S0: "card S \ 0" + by auto + have "x = y" + proof (rule ccontr) + assume xy: "\ ?thesis" + have th: "card S \ card (f ` (S - {y}))" + unfolding c + proof (rule card_mono) + show "finite (f ` (S - {y}))" + by (simp add: fS) + have "\x \ y; x \ S; z \ S; f x = f y\ + \ \x \ S. x \ y \ f z = f x" for z + by (case_tac "z = y \ z = x") auto + then show "T \ f ` (S - {y})" + using h xy x y f by fastforce + qed + also have " \ \ card (S - {y})" + by (simp add: card_image_le fS) + also have "\ \ card S - 1" using y fS by simp + finally show False using S0 by arith + qed + } + then show ?rhs + unfolding inj_on_def by blast +next + assume h: ?rhs + have "f ` S = T" + by (simp add: ST c card_image card_subset_eq fT h) + then show ?lhs by blast qed hide_const (open) Finite_Set.fold @@ -2084,6 +2109,26 @@ infinite set, the result is still infinite. \ +lemma infinite_UNIV_nat [iff]: "infinite (UNIV :: nat set)" +proof + assume "finite (UNIV :: nat set)" + with finite_UNIV_inj_surj [of Suc] show False + by simp (blast dest: Suc_neq_Zero surjD) +qed + +lemma infinite_UNIV_char_0: "infinite (UNIV :: 'a::semiring_char_0 set)" +proof + assume "finite (UNIV :: 'a set)" + with subset_UNIV have "finite (range of_nat :: 'a set)" + by (rule finite_subset) + moreover have "inj (of_nat :: nat \ 'a)" + by (simp add: inj_on_def) + ultimately have "finite (UNIV :: nat set)" + by (rule finite_imageD) + then show False + by simp +qed + lemma infinite_imp_nonempty: "infinite S \ S \ {}" by auto diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Real_Vector_Spaces.thy --- a/src/HOL/Real_Vector_Spaces.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Real_Vector_Spaces.thy Mon Apr 01 17:02:43 2019 +0100 @@ -148,6 +148,10 @@ by simp qed +lemma linear_scale_real: + fixes r::real shows "linear f \ f (r * b) = r * f b" + using linear_scale by fastforce + interpretation scaleR_left: additive "(\a. scaleR a x :: 'a::real_vector)" by standard (rule scaleR_left_distrib) diff -r 571909ef3103 -r 095dce9892e8 src/HOL/Vector_Spaces.thy --- a/src/HOL/Vector_Spaces.thy Sat Mar 30 15:37:27 2019 +0100 +++ b/src/HOL/Vector_Spaces.thy Mon Apr 01 17:02:43 2019 +0100 @@ -993,48 +993,6 @@ end -lemma surjective_iff_injective_gen: - assumes fS: "finite S" - and fT: "finite T" - and c: "card S = card T" - and ST: "f ` S \ T" - shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" - (is "?lhs \ ?rhs") -proof - assume h: "?lhs" - { - fix x y - assume x: "x \ S" - assume y: "y \ S" - assume f: "f x = f y" - from x fS have S0: "card S \ 0" - by auto - have "x = y" - proof (rule ccontr) - assume xy: "\ ?thesis" - have th: "card S \ card (f ` (S - {y}))" - unfolding c - proof (rule card_mono) - show "finite (f ` (S - {y}))" - by (simp add: fS) - show "T \ f ` (S - {y})" - using h xy x y f unfolding subset_eq image_iff - by (metis member_remove remove_def) - qed - also have " \ \ card (S - {y})" - by (simp add: card_image_le fS) - also have "\ \ card S - 1" using y fS by simp - finally show False using S0 by arith - qed - } - then show ?rhs - unfolding inj_on_def by blast -next - assume h: ?rhs - have "f ` S = T" - by (simp add: ST c card_image card_subset_eq fT h) - then show ?lhs by blast -qed locale finite_dimensional_vector_space = vector_space + fixes Basis :: "'b set"