src/HOL/Library/Polynomial.thy
changeset 65390 83586780598b
parent 65366 10ca63a18e56
equal deleted inserted replaced
65389:6f9c6ae27984 65390:83586780598b
   101 
   101 
   102 instantiation poly :: (zero) zero
   102 instantiation poly :: (zero) zero
   103 begin
   103 begin
   104 
   104 
   105 lift_definition zero_poly :: "'a poly"
   105 lift_definition zero_poly :: "'a poly"
   106   is "\<lambda>_. 0" by (rule MOST_I) simp
   106   is "\<lambda>_. 0"
       
   107   by (rule MOST_I) simp
   107 
   108 
   108 instance ..
   109 instance ..
   109 
   110 
   110 end
   111 end
   111 
   112 
   375   from replicate_length_same [of as 0] have "(\<forall>n. as \<noteq> replicate n 0) \<longleftrightarrow> (\<exists>a\<in>set as. a \<noteq> 0)"
   376   from replicate_length_same [of as 0] have "(\<forall>n. as \<noteq> replicate n 0) \<longleftrightarrow> (\<exists>a\<in>set as. a \<noteq> 0)"
   376     by (auto dest: sym [of _ as])
   377     by (auto dest: sym [of _ as])
   377   with Cons show ?case by auto
   378   with Cons show ?case by auto
   378 qed
   379 qed
   379 
   380 
   380 lemma last_coeffs_not_0: "p \<noteq> 0 \<Longrightarrow> last (coeffs p) \<noteq> 0"
   381 lemma no_trailing_coeffs [simp]:
   381   by (induct p) (auto simp add: cCons_def)
   382   "no_trailing (HOL.eq 0) (coeffs p)"
   382 
   383   by (induct p)  auto
   383 lemma strip_while_coeffs [simp]: "strip_while (HOL.eq 0) (coeffs p) = coeffs p"
   384 
   384   by (cases "p = 0") (auto dest: last_coeffs_not_0 intro: strip_while_not_last)
   385 lemma strip_while_coeffs [simp]:
       
   386   "strip_while (HOL.eq 0) (coeffs p) = coeffs p"
       
   387   by simp
   385 
   388 
   386 lemma coeffs_eq_iff: "p = q \<longleftrightarrow> coeffs p = coeffs q"
   389 lemma coeffs_eq_iff: "p = q \<longleftrightarrow> coeffs p = coeffs q"
   387   (is "?P \<longleftrightarrow> ?Q")
   390   (is "?P \<longleftrightarrow> ?Q")
   388 proof
   391 proof
   389   assume ?P
   392   assume ?P
   400 lemma [code]: "coeff p = nth_default 0 (coeffs p)"
   403 lemma [code]: "coeff p = nth_default 0 (coeffs p)"
   401   by (simp add: nth_default_coeffs_eq)
   404   by (simp add: nth_default_coeffs_eq)
   402 
   405 
   403 lemma coeffs_eqI:
   406 lemma coeffs_eqI:
   404   assumes coeff: "\<And>n. coeff p n = nth_default 0 xs n"
   407   assumes coeff: "\<And>n. coeff p n = nth_default 0 xs n"
   405   assumes zero: "xs \<noteq> [] \<Longrightarrow> last xs \<noteq> 0"
   408   assumes zero: "no_trailing (HOL.eq 0) xs"
   406   shows "coeffs p = xs"
   409   shows "coeffs p = xs"
   407 proof -
   410 proof -
   408   from coeff have "p = Poly xs" by (simp add: poly_eq_iff)
   411   from coeff have "p = Poly xs"
   409   with zero show ?thesis by simp (cases xs; simp)
   412     by (simp add: poly_eq_iff)
       
   413   with zero show ?thesis by simp
   410 qed
   414 qed
   411 
   415 
   412 lemma degree_eq_length_coeffs [code]: "degree p = length (coeffs p) - 1"
   416 lemma degree_eq_length_coeffs [code]: "degree p = length (coeffs p) - 1"
   413   by (simp add: coeffs_def)
   417   by (simp add: coeffs_def)
   414 
   418 
   735   "coeffs (p + q) = plus_coeffs (coeffs p) (coeffs q)"
   739   "coeffs (p + q) = plus_coeffs (coeffs p) (coeffs q)"
   736 proof -
   740 proof -
   737   have *: "nth_default 0 (plus_coeffs xs ys) n = nth_default 0 xs n + nth_default 0 ys n"
   741   have *: "nth_default 0 (plus_coeffs xs ys) n = nth_default 0 xs n + nth_default 0 ys n"
   738     for xs ys :: "'a list" and n
   742     for xs ys :: "'a list" and n
   739   proof (induct xs ys arbitrary: n rule: plus_coeffs.induct)
   743   proof (induct xs ys arbitrary: n rule: plus_coeffs.induct)
   740     case 3
   744     case (3 x xs y ys n)
   741     then show ?case by (cases n) (auto simp: cCons_def)
   745     then show ?case
       
   746       by (cases n) (auto simp add: cCons_def)
   742   qed simp_all
   747   qed simp_all
   743   have **: "last (plus_coeffs xs ys) \<noteq> 0"
   748   have **: "no_trailing (HOL.eq 0) (plus_coeffs xs ys)"
   744     if "xs \<noteq> [] \<Longrightarrow> last xs \<noteq> 0" and "ys \<noteq> [] \<Longrightarrow> last ys \<noteq> 0" and "plus_coeffs xs ys \<noteq> []"
   749     if "no_trailing (HOL.eq 0) xs" and "no_trailing (HOL.eq 0) ys"
   745     for xs ys :: "'a list"
   750     for xs ys :: "'a list"
   746     using that
   751     using that by (induct xs ys rule: plus_coeffs.induct) (simp_all add: cCons_def)
   747   proof (induct xs ys rule: plus_coeffs.induct)
       
   748     case 3
       
   749     then show ?case by (auto simp add: cCons_def) metis
       
   750   qed simp_all
       
   751   show ?thesis
   752   show ?thesis
   752     apply (rule coeffs_eqI)
   753     by (rule coeffs_eqI) (auto simp add: * nth_default_coeffs_eq intro: **)
   753      apply (simp add: * nth_default_coeffs_eq)
   754 qed
   754     apply (rule **)
   755 
   755       apply (auto dest: last_coeffs_not_0)
   756 lemma coeffs_uminus [code abstract]:
   756     done
   757   "coeffs (- p) = map uminus (coeffs p)"
   757 qed
   758 proof -
   758 
   759   have eq_0: "HOL.eq 0 \<circ> uminus = HOL.eq (0::'a)"
   759 lemma coeffs_uminus [code abstract]: "coeffs (- p) = map (\<lambda>a. - a) (coeffs p)"
   760     by (simp add: fun_eq_iff)
   760   by (rule coeffs_eqI)
   761   show ?thesis
   761     (simp_all add: not_0_coeffs_not_Nil last_map last_coeffs_not_0 nth_default_map_eq nth_default_coeffs_eq)
   762     by (rule coeffs_eqI) (simp_all add: nth_default_map_eq nth_default_coeffs_eq no_trailing_map eq_0)
       
   763 qed
   762 
   764 
   763 lemma [code]: "p - q = p + - q"
   765 lemma [code]: "p - q = p + - q"
   764   for p q :: "'a::ab_group_add poly"
   766   for p q :: "'a::ab_group_add poly"
   765   by (fact diff_conv_add_uminus)
   767   by (fact diff_conv_add_uminus)
   766 
   768 
   883   by (simp add: poly_eq_iff)
   885   by (simp add: poly_eq_iff)
   884 
   886 
   885 lemma coeffs_smult [code abstract]:
   887 lemma coeffs_smult [code abstract]:
   886   "coeffs (smult a p) = (if a = 0 then [] else map (Groups.times a) (coeffs p))"
   888   "coeffs (smult a p) = (if a = 0 then [] else map (Groups.times a) (coeffs p))"
   887   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   889   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   888   by (rule coeffs_eqI)
   890 proof -
   889     (auto simp add: not_0_coeffs_not_Nil last_map last_coeffs_not_0
   891   have eq_0: "HOL.eq 0 \<circ> times a = HOL.eq (0::'a)" if "a \<noteq> 0"
   890       nth_default_map_eq nth_default_coeffs_eq)
   892     using that by (simp add: fun_eq_iff)
       
   893   show ?thesis
       
   894     by (rule coeffs_eqI) (auto simp add: no_trailing_map nth_default_map_eq nth_default_coeffs_eq eq_0)
       
   895 qed  
   891 
   896 
   892 lemma smult_eq_iff:
   897 lemma smult_eq_iff:
   893   fixes b :: "'a :: field"
   898   fixes b :: "'a :: field"
   894   assumes "b \<noteq> 0"
   899   assumes "b \<noteq> 0"
   895   shows "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
   900   shows "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
  1118 
  1123 
  1119 lemma coeffs_map_poly [code abstract]:
  1124 lemma coeffs_map_poly [code abstract]:
  1120   "coeffs (map_poly f p) = strip_while (op = 0) (map f (coeffs p))"
  1125   "coeffs (map_poly f p) = strip_while (op = 0) (map f (coeffs p))"
  1121   by (simp add: map_poly_def)
  1126   by (simp add: map_poly_def)
  1122 
  1127 
  1123 lemma set_coeffs_map_poly:
       
  1124   "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
       
  1125   by (cases "p = 0") (auto simp: coeffs_map_poly last_map last_coeffs_not_0)
       
  1126 
       
  1127 lemma coeffs_map_poly':
  1128 lemma coeffs_map_poly':
  1128   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  1129   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  1129   shows "coeffs (map_poly f p) = map f (coeffs p)"
  1130   shows "coeffs (map_poly f p) = map f (coeffs p)"
  1130   by (cases "p = 0")
  1131   using assms by (simp add: coeffs_map_poly no_trailing_map strip_while_idem_iff)
  1131     (auto simp: assms coeffs_map_poly last_map last_coeffs_not_0
  1132     (metis comp_def no_leading_def no_trailing_coeffs)
  1132       intro!: strip_while_not_last split: if_splits)
  1133 
       
  1134 lemma set_coeffs_map_poly:
       
  1135   "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
       
  1136   by (simp add: coeffs_map_poly')
  1133 
  1137 
  1134 lemma degree_map_poly:
  1138 lemma degree_map_poly:
  1135   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  1139   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  1136   shows "degree (map_poly f p) = degree p"
  1140   shows "degree (map_poly f p) = degree p"
  1137   by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
  1141   by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
  2144   by (simp add: poly_eq_iff coeff_poly_shift)
  2148   by (simp add: poly_eq_iff coeff_poly_shift)
  2145 
  2149 
  2146 lemma poly_shift_monom: "poly_shift n (monom c m) = (if m \<ge> n then monom c (m - n) else 0)"
  2150 lemma poly_shift_monom: "poly_shift n (monom c m) = (if m \<ge> n then monom c (m - n) else 0)"
  2147   by (auto simp add: poly_eq_iff coeff_poly_shift)
  2151   by (auto simp add: poly_eq_iff coeff_poly_shift)
  2148 
  2152 
  2149 lemma coeffs_shift_poly [code abstract]: "coeffs (poly_shift n p) = drop n (coeffs p)"
  2153 lemma coeffs_shift_poly [code abstract]:
       
  2154   "coeffs (poly_shift n p) = drop n (coeffs p)"
  2150 proof (cases "p = 0")
  2155 proof (cases "p = 0")
  2151   case True
  2156   case True
  2152   then show ?thesis by simp
  2157   then show ?thesis by simp
  2153 next
  2158 next
  2154   case False
  2159   case False
  2155   then show ?thesis
  2160   then show ?thesis
  2156     by (intro coeffs_eqI)
  2161     by (intro coeffs_eqI)
  2157       (simp_all add: coeff_poly_shift nth_default_drop last_coeffs_not_0 nth_default_coeffs_eq)
  2162       (simp_all add: coeff_poly_shift nth_default_drop nth_default_coeffs_eq)
  2158 qed
  2163 qed
  2159 
  2164 
  2160 
  2165 
  2161 subsection \<open>Truncating polynomials\<close>
  2166 subsection \<open>Truncating polynomials\<close>
  2162 
  2167 
  2190     by simp
  2195     by simp
  2191   with False have "last (strip_while (op = 0) (take n (coeffs p))) \<noteq> 0"
  2196   with False have "last (strip_while (op = 0) (take n (coeffs p))) \<noteq> 0"
  2192     unfolding no_trailing_unfold by auto
  2197     unfolding no_trailing_unfold by auto
  2193   then show ?thesis
  2198   then show ?thesis
  2194     by (intro coeffs_eqI)
  2199     by (intro coeffs_eqI)
  2195       (simp_all add: coeff_poly_cutoff last_coeffs_not_0 nth_default_take nth_default_coeffs_eq)
  2200       (simp_all add: coeff_poly_cutoff nth_default_take nth_default_coeffs_eq)
  2196 qed
  2201 qed
  2197 
  2202 
  2198 
  2203 
  2199 subsection \<open>Reflecting polynomials\<close>
  2204 subsection \<open>Reflecting polynomials\<close>
  2200 
  2205 
  2306 
  2311 
  2307 lemma reflect_poly_prod_list: "reflect_poly (prod_list xs) = prod_list (map reflect_poly xs)"
  2312 lemma reflect_poly_prod_list: "reflect_poly (prod_list xs) = prod_list (map reflect_poly xs)"
  2308   for xs :: "_::{comm_semiring_0,semiring_no_zero_divisors} poly list"
  2313   for xs :: "_::{comm_semiring_0,semiring_no_zero_divisors} poly list"
  2309   by (induct xs) (simp_all add: reflect_poly_mult)
  2314   by (induct xs) (simp_all add: reflect_poly_mult)
  2310 
  2315 
  2311 lemma reflect_poly_Poly_nz: "xs \<noteq> [] \<Longrightarrow> last xs \<noteq> 0 \<Longrightarrow> reflect_poly (Poly xs) = Poly (rev xs)"
  2316 lemma reflect_poly_Poly_nz:
       
  2317   "no_trailing (HOL.eq 0) xs \<Longrightarrow> reflect_poly (Poly xs) = Poly (rev xs)"
  2312   by (simp add: reflect_poly_def)
  2318   by (simp add: reflect_poly_def)
  2313 
  2319 
  2314 lemmas reflect_poly_simps =
  2320 lemmas reflect_poly_simps =
  2315   reflect_poly_0 reflect_poly_1 reflect_poly_const reflect_poly_smult reflect_poly_mult
  2321   reflect_poly_0 reflect_poly_1 reflect_poly_const reflect_poly_smult reflect_poly_mult
  2316   reflect_poly_power reflect_poly_prod reflect_poly_prod_list
  2322   reflect_poly_power reflect_poly_prod reflect_poly_prod_list
  4135             minus_poly_rev_list)
  4141             minus_poly_rev_list)
  4136     qed
  4142     qed
  4137   qed simp
  4143   qed simp
  4138 qed simp
  4144 qed simp
  4139 
  4145 
  4140 lemma pseudo_divmod_impl[code]: "pseudo_divmod (f::'a::comm_ring_1 poly) g =
  4146 lemma pseudo_divmod_impl [code]:
  4141   map_prod poly_of_list poly_of_list (pseudo_divmod_list (coeffs f) (coeffs g))"
  4147   "pseudo_divmod f g = map_prod poly_of_list poly_of_list (pseudo_divmod_list (coeffs f) (coeffs g))"
       
  4148     for f g :: "'a::comm_ring_1 poly"
  4142 proof (cases "g = 0")
  4149 proof (cases "g = 0")
  4143   case False
  4150   case False
  4144   then have coeffs_g_nonempty:"(coeffs g) \<noteq> []"
  4151   then have "last (coeffs g) \<noteq> 0"
  4145     by simp
  4152     and "last (coeffs g) = lead_coeff g"
  4146   then have lastcoeffs: "last (coeffs g) = coeff g (degree g)"
  4153     and "coeffs g \<noteq> []"
  4147     by (simp add: hd_rev last_coeffs_eq_coeff_degree not_0_coeffs_not_Nil)
  4154     by (simp_all add: last_coeffs_eq_coeff_degree)
  4148   obtain q r where qr:
  4155   moreover obtain q r where qr: "pseudo_divmod_main_list
  4149     "pseudo_divmod_main_list
  4156     (last (coeffs g)) (rev [])
  4150       (last (coeffs g)) (rev [])
  4157     (rev (coeffs f)) (rev (coeffs g))
  4151       (rev (coeffs f)) (rev (coeffs g))
  4158     (1 + length (coeffs f) -
  4152       (1 + length (coeffs f) - length (coeffs g)) = (q, rev (rev r))"
  4159     length (coeffs g)) = (q, rev (rev r))"
  4153     by force
  4160     by force
  4154   then have qr':
  4161   ultimately have "(Poly q, Poly (rev r)) = pseudo_divmod_main (lead_coeff g) 0 f g
  4155     "pseudo_divmod_main_list
  4162     (length (coeffs f) - Suc 0) (Suc (length (coeffs f)) - length (coeffs g))"
  4156       (hd (rev (coeffs g))) []
  4163     by (subst pseudo_divmod_main_list_invar [symmetric]) auto
  4157       (rev (coeffs f)) (rev (coeffs g))
  4164   moreover have "pseudo_divmod_main_list
  4158       (1 + length (coeffs f) - length (coeffs g)) = (q, r)"
  4165     (hd (rev (coeffs g))) []
  4159     using hd_rev[OF coeffs_g_nonempty] by auto
  4166     (rev (coeffs f)) (rev (coeffs g))
  4160   from False have cg: "coeffs g = [] \<longleftrightarrow> False"
  4167     (1 + length (coeffs f) -
  4161     by auto
  4168     length (coeffs g)) = (q, r)"
  4162   from False have last_non0: "last (coeffs g) \<noteq> 0"
  4169     using qr hd_rev [OF \<open>coeffs g \<noteq> []\<close>] by simp
  4163     by (simp add: last_coeffs_not_0)
  4170   ultimately show ?thesis
  4164   from False show ?thesis
  4171     by (auto simp: degree_eq_length_coeffs pseudo_divmod_def pseudo_divmod_list_def Let_def)
  4165     unfolding pseudo_divmod_def pseudo_divmod_list_def Let_def qr' map_prod_def split cg if_False
       
  4166     pseudo_divmod_main_list_invar[OF last_non0 _ _ qr,unfolded lastcoeffs,simplified,symmetric,OF False]
       
  4167     poly_of_list_def
       
  4168     by (auto simp: degree_eq_length_coeffs)
       
  4169 next
  4172 next
  4170   case True
  4173   case True
  4171   then show ?thesis
  4174   then show ?thesis
  4172     by (auto simp: pseudo_divmod_def pseudo_divmod_list_def)
  4175     by (auto simp add: pseudo_divmod_def pseudo_divmod_list_def)
  4173 qed
  4176 qed
  4174 
  4177 
  4175 lemma pseudo_mod_main_list:
  4178 lemma pseudo_mod_main_list:
  4176   "snd (pseudo_divmod_main_list l q xs ys n) = pseudo_mod_main_list l xs ys n"
  4179   "snd (pseudo_divmod_main_list l q xs ys n) = pseudo_mod_main_list l xs ys n"
  4177   by (induct n arbitrary: l q xs ys) (auto simp: Let_def)
  4180   by (induct n arbitrary: l q xs ys) (auto simp: Let_def)