This instance will be upgraded to Heptapod 0.31.0 (final) on 2022-05-24 at 14:00 UTC+2 (a few minutes of down time)

### Merging developments in Algebraic Number theory and refinements on other entries

parent 54fdb3942ec8
 ... ... @@ -33,9 +33,6 @@ fun show_factorization :: "'a :: {semiring_1,show} \ (('a poly \ n | "show_factorization (c,((p,i) # ps)) = show_factorization (c,ps) @ '' * ('' @ show p @ '')'' @ (if i = 1 then [] else ''^'' @ show i)" definition show_sf_factorization :: "'a :: {semiring_1,show} \ (('a poly \ nat)list) \ string" where "show_sf_factorization x = show_factorization (case x of (c,xs) \ (c, map (\ (p,i). (p, Suc i)) xs))" text \Determine the roots over the rational, real, and complex numbers.\ definition "testpoly = [:5/2, -7/2, 1/2, -5, 7, -1, 5/2, -7/2, 1/2:]" ... ... @@ -48,7 +45,7 @@ value [code] "show_lines (complex_roots_of_rat_poly testpoly)" text \Factorize polynomials over the rational, real, and complex numbers.\ value [code] "show_sf_factorization (factorize_rat_poly testpoly)" value [code] "show_factorization (factorize_rat_poly testpoly)" value [code] "show_factorization (the (factorize_real_poly testpoly))" value [code] "show_factorization (the (factorize_complex_poly testpoly))" ... ...
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -16,26 +16,8 @@ imports "../Containers/Set_Impl" begin declare [[code drop: Gcd_fin]] declare [[code drop: Lcm_fin]] definition gcds :: "'a::semiring_gcd list \ 'a" where [simp, code_abbrev]: "gcds xs = gcd_list xs" lemma [code]: "gcds xs = fold gcd xs 0" by (simp add: Gcd_fin.set_eq_fold) definition lcms :: "'a::semiring_gcd list \ 'a" where [simp, code_abbrev]: "lcms xs = lcm_list xs" lemma [code]: "lcms xs = fold lcm xs 1" by (simp add: Lcm_fin.set_eq_fold) lemma in_reals_code [code_unfold]: "x \ \ \ Im x = 0" by (fact complex_is_Real_iff) lemma in_reals_code[code_unfold]: "((x :: complex) \ \) = (Im x = 0)" by (rule complex_is_Real_iff) definition is_norm_1 :: "complex \ bool" where "is_norm_1 z = ((Re z)\<^sup>2 + (Im z)\<^sup>2 = 1)" ... ...
This diff is collapsed.
 ... ... @@ -63,11 +63,11 @@ begin lemma map_poly_Re_poly: fixes x :: real shows "poly (map_poly Re p) x = poly p (of_real x)" proof - interpret cr: ring_hom complex_of_real by (unfold_locales, auto) interpret cr: field_hom' complex_of_real by (unfold_locales, auto) have id: "map_poly (of_real o Re) p = p" by (rule map_poly_idI, insert coeffs, auto) by (rule map_poly_eqI, insert coeffs, auto) show ?thesis unfolding arg_cong[OF id, of poly, symmetric] by (subst map_poly_map_poly[symmetric], force+) by (subst map_poly_map_poly[symmetric], auto) qed lemma map_poly_Re_coeffs: ... ... @@ -161,55 +161,39 @@ lemma real_poly_minus: using assms unfolding diff_conv_add_uminus by (intro real_poly_uminus real_poly_add, auto) lemma real_poly_pdivmod: fixes p :: "'a :: real_field poly" assumes p: "set (coeffs p) \ \" and *: "set (coeffs q) \ \" "(q div p, q mod p) = (r,s)" shows "set (coeffs r) \ \ \ set (coeffs s) \ \" using * proof (induct q arbitrary: r s) lemma fixes p :: "'a :: real_field poly" assumes p: "set (coeffs p) \ \" and *: "set (coeffs q) \ \" shows real_poly_div: "set (coeffs (q div p)) \ \" and real_poly_mod: "set (coeffs (q mod p)) \ \" proof (atomize(full), insert *, induct q) case 0 then show ?case by auto thus ?case by auto next case (pCons a q r s) case (pCons a q) from pCons(1,3) have a: "a \ \" and q: "set (coeffs q) \ \" by auto note res = pCons(4) [unfolded div_pCons_eq mod_pCons_eq] note res = pCons show ?case proof (cases "p = 0") case True with res pCons(3) show ?thesis by auto next case False obtain ss rr where r: "(q div p, q mod p) = (ss, rr)" by force from pCons(2)[OF q r] have IH: "set (coeffs ss) \ \" "set (coeffs rr) \ \" by auto define c where "c = coeff (pCons a rr) (degree p) / coeff p (degree p)" from pCons have IH: "set (coeffs (q div p)) \ \" "set (coeffs (q mod p)) \ \" by auto define c where "c = coeff (pCons a (q mod p)) (degree p) / coeff p (degree p)" { have "coeff (pCons a rr) (degree p) \ \" by (rule real_poly_real_coeff, insert IH(2) a, intro real_poly_pCons) have "coeff (pCons a (q mod p)) (degree p) \ \" by (rule real_poly_real_coeff, insert IH a, intro real_poly_pCons) moreover have "coeff p (degree p) \ \" by (rule real_poly_real_coeff[OF p]) ultimately have "c \ \" unfolding c_def by simp } note c = this from res [symmetric] False r have r: "r = pCons c ss" and s: "s = pCons a rr - smult c p" using c_def by auto have "set (coeffs r) \ \" using c IH unfolding r by (intro real_poly_pCons) moreover have "set (coeffs s) \ \" using c IH unfolding s using c a p by (intro real_poly_minus real_poly_smult real_poly_pCons, auto) ultimately show ?thesis by auto from False have r: "pCons a q div p = pCons c (q div p)" and s: "pCons a q mod p = pCons a (q mod p) - smult c p" unfolding c_def div_pCons_eq mod_pCons_eq by simp_all show ?thesis unfolding r s using a p c IH by (intro conjI real_poly_pCons real_poly_minus real_poly_smult) qed qed lemma real_poly_div: fixes p :: "'a :: real_field poly" assumes p: "set (coeffs p) \ \" and q: "set (coeffs q) \ \" shows "set (coeffs (p div q)) \ \" proof - obtain r s where pq: "(p div q, p mod q) = (r, s)" by force from real_poly_pdivmod [OF q p this] show ?thesis using pq [unfolded] by auto qed lemma real_poly_factor: fixes p :: "'a :: real_field poly" assumes "set (coeffs (p * q)) \ \" "set (coeffs p) \ \" ... ... @@ -267,7 +251,7 @@ proof - from `p \ 0` have nz: "?fac1 \ 0" "?fac2 \ 0" "?fac \ 0" "r \ 0" unfolding p by auto have id: "?fac = [: ?c * c, - (?c + c), 1 :]" by simp have cfac: "coeffs ?fac = [ ?c * c, - (?c + c), 1 ]" unfolding id by simp have cfac: "set (coeffs ?fac) \ \" unfolding cfac by (auto simp: field_simps Reals_cnj_iff) have cfac: "set (coeffs ?fac) \ \" unfolding cfac by (cases c, auto simp: Reals_cnj_iff) have "degree p = degree ?fac + degree r" unfolding p by (rule degree_mult_eq, insert nz, auto) also have "degree ?fac = degree ?fac1 + degree ?fac2" ... ... @@ -307,21 +291,20 @@ qed lemma map_poly_of_real_Re: assumes "set (coeffs p) \ \" shows "map_poly of_real (map_poly Re p) = p" by (subst map_poly_map_poly, force+, rule map_poly_idI, insert assms, auto) by (subst map_poly_map_poly, force+, rule map_poly_eqI, insert assms, auto) lemma map_poly_Re_of_real: "map_poly Re (map_poly of_real p) = p" by (subst map_poly_map_poly, force+, rule map_poly_idI, auto) by (subst map_poly_map_poly, force+, rule map_poly_eqI, auto) lemma map_poly_Re_mult: assumes p: "set (coeffs p) \ \" and q: "set (coeffs q) \ \" shows "map_poly Re (p * q) = map_poly Re p * map_poly Re q" proof - let ?r = "map_poly Re" let ?c = "map_poly complex_of_real" interpret c: inj_field_hom_0 complex_of_real by (unfold_locales, auto) interpret c: field_hom' complex_of_real by (unfold_locales, auto) have "?r (p * q) = ?r (?c (?r p) * ?c (?r q))" unfolding map_poly_of_real_Re[OF p] map_poly_of_real_Re[OF q] by simp also have "?c (?r p) * ?c (?r q) = ?c (?r p * ?r q)" unfolding c.map_poly_mult .. also have "?c (?r p) * ?c (?r q) = ?c (?r p * ?r q)" by simp also have "?r \ = ?r p * ?r q" unfolding map_poly_Re_of_real .. finally show ?thesis . qed ... ... @@ -402,16 +385,15 @@ qed lemma real_degree_2_factorization_exists: fixes p :: "real poly" shows "\ qs. p = prod_list qs \ (\ q \ set qs. degree q \ 2)" proof - interpret cr: inj_field_hom complex_of_real by (unfold_locales, auto) let ?cp = "map_poly complex_of_real" let ?rp = "map_poly Re" let ?p = "?cp p" have "set (coeffs ?p) \ \" unfolding cr.coeffs_map_poly by auto have "set (coeffs ?p) \ \" unfolding of_real_hom.coeffs_map_poly by auto from real_degree_2_factorization_exists_complex[OF this] obtain qs where p: "?p = prod_list qs" and qs: "\ q. q \ set qs \ set (coeffs q) \ \ \ degree q \ 2" by auto have p: "p = ?rp (prod_list qs)" unfolding arg_cong[OF p, of ?rp, symmetric] by (subst map_poly_map_poly, force+, rule sym, rule map_poly_idI, auto) by (subst map_poly_map_poly, force, rule sym, rule map_poly_eqI, auto) from qs have "\ rs. prod_list qs = ?cp (prod_list rs) \ (\ r \ set rs. degree r \ 2)" proof (induct qs) case Nil ... ... @@ -423,14 +405,14 @@ proof - from Cons(2)[of q] have q: "set (coeffs q) \ \" and dq: "degree q \ 2" by auto define r where "r = ?rp q" have q: "q = ?cp r" unfolding r_def by (subst map_poly_map_poly, force+, rule sym, rule map_poly_idI, insert q, auto) by (subst map_poly_map_poly, force, rule sym, rule map_poly_eqI, insert q, auto) have dr: "degree r \ 2" using dq unfolding q by (simp add: degree_map_poly) show ?case by (rule exI[of _ "r # rs"], unfold prod_list.Cons cr.map_poly_mult qs q, insert dr rs, auto) by (rule exI[of _ "r # rs"], unfold prod_list.Cons qs q, insert dr rs, auto) qed then obtain rs where id: "prod_list qs = ?cp (prod_list rs)" and deg: "\ r \ set rs. degree r \ 2" by auto show ?thesis unfolding p id by (intro exI, rule conjI[OF _ deg], subst map_poly_map_poly, force+, rule map_poly_idI, auto) by (intro exI, rule conjI[OF _ deg], subst map_poly_map_poly, force, rule map_poly_eqI, auto) qed ... ...
This diff is collapsed.
 section \Real Factorization\ text \This theory contains an algorithm to completely factorize real polynomials with rational coefficients. It internally does a complex-number factorization, and then combines the coefficients. It internally does a complex polynomial factorization, and then combines all non-real roots with their conjugates.\ theory Real_Factorization ... ... @@ -29,6 +29,9 @@ definition factorize_real_poly :: "real poly \ (real \ (real (\ (c,ris). (Re c, complex_roots_to_real_factorization ris)) (factorize_complex_main (map_poly of_real p))" lemma monic_imp_nonzero: "monic x \ x \ 0" for x :: "'a :: semiring_1 poly" by auto lemma delete_cnj: assumes "order x (\(x, i)\xis. [:- x, 1:] ^ Suc i) \ si" "si \ 0" shows "(\(x, i)\xis. [:- x, 1:] ^ Suc i) = ... ... @@ -49,8 +52,8 @@ next let ?x = "[: - x, 1 :]" let ?xi = "?x ^ i" have "monic (\(x,i)\(y, j) # yjs. [:- x, 1:] ^ Suc i)" by (rule monic_prod_list_pow) hence yy0: "?yj * ?yjs \ 0" by auto by (rule monic_prod_list_pow) then have "monic (?yj * ?yjs)" by simp from monic_imp_nonzero[OF this] have yy0: "?yj * ?yjs \ 0" by auto have id: "(\(x,i)\(y, j) # yjs. [:- x, 1:] ^ Suc i) = ?yj * ?yjs" by simp from 1(3-) have ord: "i \ order x (?yj * ?yjs)" and i: "i \ 0" unfolding id by auto from ord[unfolded order_mult[OF yy0]] have ord: "i \ order x ?yj + order x ?yjs" . ... ... @@ -102,7 +105,8 @@ lemma factorize_real_poly: assumes fp: "factorize_real_poly p = Some (c,qis)" shows "p = smult c (\(q, i)\qis. q ^ i)" "(q,j) \ set qis \ irreducible q \ j \ 0 \ monic q \ degree q \ {1,2}" proof - proof - interpret map_poly_inj_idom_hom of_real.. have "(p = smult c (\(q, i)\qis. q ^ i)) \ ((q,j) \ set qis \ irreducible q \ j \ 0 \ monic q \ degree q \ {1,2})" proof (cases "p = 0") case True ... ... @@ -123,31 +127,27 @@ proof - (is "_ = smult d ?q") . from arg_cong[OF this, of "\ p. coeff p (degree p)"] have "coeff ?p (degree ?p) = coeff (smult d ?q) (degree (smult d ?q))" . also have "coeff ?p (degree ?p) = ?c (coeff p (degree p))" by (subst degree_map_poly, simp, simp, auto simp: subst coeff_map_poly) also have "coeff ?p (degree ?p) = ?c (coeff p (degree p))" by simp also have "coeff (smult d ?q) (degree (smult d ?q)) = d * coeff ?q (degree ?q)" by simp also have "monic ?q" by (rule monic_prod_list_pow) finally have d: "d = ?c (coeff p (degree p))" by auto from arg_cong[OF this, of Re, folded c] have c: "c = coeff p (degree p)" by auto have "set (coeffs ?p) \ \" by (subst coeffs_map_poly, auto) have "set (coeffs ?p) \ \" by auto with p have q': "set (coeffs (smult d ?q)) \ \" by auto from d p0 have d0: "d \ 0" by auto interpret c: inj_field_hom_0' ?c by (unfold_locales, auto) have "smult d ?q = [:d:] * ?q" by auto from real_poly_factor[OF q'[unfolded this]] d0 d have q: "set (coeffs ?q) \ \" by auto have "p = ?rp ?p" by (rule sym, subst map_poly_map_poly, force+, rule map_poly_idI, auto) by (rule sym, subst map_poly_map_poly, force, rule map_poly_eqI, auto) also have "\ = ?rp (smult d ?q)" unfolding p .. also have "?q = ?cp (?rp ?q)" by (rule sym, rule map_poly_of_real_Re, insert q, auto) also have "d = ?c c" unfolding d c .. also have "smult (?c c) (?cp (?rp ?q)) = ?cp (smult c (?rp ?q))" unfolding c.map_poly_smult .. also have "smult (?c c) (?cp (?rp ?q)) = ?cp (smult c (?rp ?q))" by simp also have "?rp \ = smult c (?rp ?q)" by (subst map_poly_map_poly, force+, rule map_poly_idI, auto) by (subst map_poly_map_poly, force, rule map_poly_eqI, auto) finally have p: "p = smult c (?rp ?q)" . let ?fact = complex_roots_to_real_factorization have "?rp ?q = (\(q, i)\qis. q ^ i) \ ... ... @@ -155,7 +155,7 @@ proof - using q unfolding qis proof (induct xis rule: complex_roots_to_real_factorization.induct) case 1 show ?case by (simp add: one_poly_def) show ?case by simp next case (2 x i xis) note IH = 2(1-2) ... ... @@ -193,7 +193,7 @@ proof - with IH show ?thesis by auto next assume "q = [:- Re x, 1:] \ j = Suc i" with linear_irreducible[of "[:- Re x, 1:]"] show ?thesis by auto with linear_irreducible_field[of "[:- Re x, 1:]"] show ?thesis by auto qed qed next ... ... @@ -201,14 +201,16 @@ proof - define xi where "xi = [:Re x * Re x + Im x * Im x, - (2 * Re x), 1:]" obtain xx where xx: "xx = cnj x" by auto have xi: "xi = ?rp ([:-x,1:] * [:-xx,1:])" unfolding xx xi_def by auto have cpxi: "?cp xi = [:-x,1:] * [:-xx,1:]" unfolding xi_def by (auto simp: xx complex_eq_iff) have cpxi: "?cp xi = [:-x,1:] * [:-xx,1:]" unfolding xi_def by (cases x, auto simp: xx legacy_Complex_simps) obtain yis where yis: "yis = delete_cnj xx (Suc i) xis" by auto from False have fact: "?fact ((x,i) # xis) = ((xi,Suc i) # ?fact yis)" unfolding xi_def xx yis by simp note IH = IH(2)[OF False xx yis xi] have "irreducible xi" proof (rule irreducibleI) apply (fold irreducible_connect) apply (rule Polynomial_Divisibility.irreducible_connect) proof (rule Missing_Polynomial.irreducibleI) show "degree xi \ 0" unfolding xi by auto fix q :: "real poly" assume "degree q \ 0" "degree q < degree xi" ... ... @@ -225,11 +227,10 @@ proof - { fix c :: complex assume rt: "poly (?cp xi) c = 0" hence "poly (?cp q * ?cp p) c = 0" unfolding qp c.map_poly_mult[symmetric] by simp hence "poly (?cp q * ?cp p) c = 0" by (simp add: qp) hence "(poly (?cp q) c = 0 \ poly (?cp p) c = 0)" by auto hence "c = roots1 (?cp q) \ c = roots1 (?cp p)" using roots1[of "?cp q"] roots1[of "?cp p"] dp dq by (auto simp: degree_map_poly) using roots1[of "?cp q"] roots1[of "?cp p"] dp dq by auto hence "c \ \" unfolding roots1_def by auto hence "c \ x" using False by auto } ... ... @@ -246,8 +247,8 @@ proof - by (rule real_poly_power, auto simp: xi) have mon: "monic (\(x, i)\(x, i) # xis. [:- x, 1:] ^ Suc i)" by (rule monic_prod_list_pow) hence xixis: "?xi * ?xis \ 0" unfolding id by auto from False have xxx: "xx \ x" unfolding xx by (auto simp: Reals_cnj_iff) from monic_imp_nonzero[OF this] have xixis: "?xi * ?xis \ 0" unfolding id by auto from False have xxx: "xx \ x" unfolding xx by (cases x, auto simp: legacy_Complex_simps Reals_def) from prems[unfolded id] have prems: "set (coeffs (?xi * ?xis)) \ \" . from id have "[:- x, 1:] ^ Suc i dvd ?xi * ?xis" by auto from xixis this[unfolded order_divides] ... ... @@ -270,8 +271,7 @@ proof - note IH = IH[OF yis] have "?rp (?xi * ?xis) = ?rp ?yi * ?rp ?yis" unfolding idd by (rule map_poly_Re_mult[OF yi yis]) also have "?rp ?yi = xi^Suc i" unfolding c.map_poly_power[symmetric] by (rule map_poly_Re_of_real) also have "?rp ?yi = xi^Suc i" by (fold hom_distribs, rule map_poly_Re_of_real) also have "?rp ?yis = (\ (a,b) \ ?fact yis. a ^ b)" using IH by auto also have "xi ^ Suc i * (\ (a,b) \ ?fact yis. a ^ b) = ... ...
This diff is collapsed.