Theory Ring_Powers
theory Ring_Powers
imports "HOL-Algebra.Chinese_Remainder" "HOL-Combinatorics.List_Permutation"
Padic_Ints.Function_Ring "HOL-Algebra.Generated_Rings" Cring_Multivariable_Poly Indices
begin
type_synonym arity = nat
type_synonym 'a tuple = "'a list"
section‹Cartesian Powers of a Ring›
subsection‹Constructing the Cartesian Power of a Ring›
text‹Powers of a ring›
text‹\texttt{R\_list n R} produces the list $[R, ... , R]$ of length n›
fun R_list :: "nat ⇒ ('a, 'b) ring_scheme ⇒ (('a, 'b) ring_scheme ) list" where
"R_list n R = map (λ_. R) (index_list n)"
text‹Cartesian powers of a ring›
definition cartesian_power :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a list) ring" ("_⇗_⇖" 80) where
"R⇗n⇖ ≡ RDirProd_list (R_list n R)"
lemma R_list_length:
"length (R_list n R) = n"
apply(induction n) by auto
lemma R_list_nth:
"i < n ⟹ R_list n R ! i = R"
by (simp add: index_list_length)
lemma cartesian_power_car_memI:
assumes "length as = n"
assumes "set as ⊆ carrier R"
shows "as ∈ carrier (R⇗n⇖)"
unfolding cartesian_power_def
apply(rule RDirProd_list_carrier_memI)
using R_list_length assms(1) apply auto[1]
by (metis R_list_length R_list_nth assms(1) assms(2) nth_mem subsetD)
lemma cartesian_power_car_memI':
assumes "length as = n"
assumes "⋀i. i < n ⟹ as ! i ∈ carrier R"
shows "as ∈ carrier (R⇗n⇖)"
unfolding cartesian_power_def
apply(rule RDirProd_list_carrier_memI)
using R_list_length assms(1) apply auto[1]
by (metis R_list_length R_list_nth assms(2))
lemma cartesian_power_car_memE:
assumes "as ∈ carrier (R⇗n⇖)"
shows "length as = n"
using RDirProd_list_carrier_mem(1)
by (metis R_list_length assms cartesian_power_def)
lemma cartesian_power_car_memE':
assumes "as ∈ carrier (R⇗n⇖)"
assumes "i < n"
shows " as ! i ∈ carrier R"
using assms RDirProd_list_carrier_mem(2)
by (metis (no_types, lifting) R_list_length R_list_nth cartesian_power_def)
lemma cartesian_power_car_memE'':
assumes "as ∈ carrier (R⇗n⇖)"
shows "set as ⊆ carrier R"
using cartesian_power_car_memE'
by (metis assms cartesian_power_car_memE in_set_conv_nth subsetI)
lemma cartesian_power_car_memI'':
assumes "length as = n + k"
assumes "take n as ∈ carrier (R⇗n⇖)"
assumes "drop n as ∈ carrier (R⇗k⇖)"
shows "as ∈ carrier (R⇗n+k⇖)"
apply(rule cartesian_power_car_memI')
apply (simp add: assms(1))
proof- fix i assume A: "i < n + k"
show " as ! i ∈ carrier R"
apply(cases "i < n")
apply (metis assms(2) cartesian_power_car_memE' nth_take)
by (metis A add_diff_inverse_nat add_less_imp_less_left
append_take_drop_id assms(2) assms(3) cartesian_power_car_memE
cartesian_power_car_memE' nth_append_length_plus)
qed
lemma cartesian_power_cons:
assumes " as ∈ carrier (R⇗n⇖)"
assumes "a ∈ carrier R"
shows "a#as ∈ carrier (R⇗n+1⇖)"
apply(rule cartesian_power_car_memI)
apply (metis One_nat_def assms(1) cartesian_power_car_memE list.size(4))
by (metis assms(1) assms(2) cartesian_power_car_memE cartesian_power_car_memE' in_set_conv_nth set_ConsD subsetI)
lemma cartesian_power_append:
assumes " as ∈ carrier (R⇗n⇖)"
assumes "a ∈ carrier R"
shows "as@[a] ∈ carrier (R⇗n+1⇖)"
apply(rule cartesian_power_car_memI'')
apply (metis add.commute assms(1) cartesian_power_car_memE length_append_singleton plus_1_eq_Suc)
apply (metis append_eq_append_conv_if assms(1) butlast_snoc cartesian_power_car_memE length_append_singleton lessI take_butlast)
by (metis add.commute add.right_neutral append_eq_conv_conj assms(1) assms(2) bot_least
cartesian_power_car_memE cartesian_power_car_memI cartesian_power_cons
list.set(1) list.size(3))
lemma cartesian_power_head:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "hd as ∈ carrier R"
by (metis assms cartesian_power_car_memE cartesian_power_car_memE'' list.set_sel(1) list.size(3) old.nat.distinct(1) subsetD)
lemma cartesian_power_tail:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "tl as ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI)
apply (metis add_diff_cancel_left' assms cartesian_power_car_memE length_tl plus_1_eq_Suc)
by (metis assms cartesian_power_car_memE cartesian_power_car_memE'' list.set_sel(2) list.size(3) nat.simps(3) subsetD subsetI)
lemma insert_at_index_closed:
assumes "length as = n"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "a ∈ carrier R"
assumes "k ≤ n"
shows "(insert_at_index as a k) ∈ carrier (R⇗Suc n⇖)"
apply(rule cartesian_power_car_memI')
apply (metis Groups.add_ac(2) assms(1) insert_at_index_length plus_1_eq_Suc)
by (smt R_list_length Suc_le_eq assms(1) assms(2) assms(3) assms(4)
cartesian_power_car_memE' insert_at_index_eq insert_at_index_eq'
insert_at_index_eq'' less_Suc_eq less_Suc_eq_0_disj not_less_eq_eq)
lemma insert_at_index_pow_not_car:
assumes "k ≤n"
assumes "length x = n"
assumes "(insert_at_index x a k) ∈ carrier (R⇗Suc n⇖)"
shows "x ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI')
apply (simp add: assms(2))
by (metis Suc_mono assms(1) assms(2) assms(3)
cartesian_power_car_memE' insert_at_index_eq'
insert_at_index_eq'' leI less_SucI)
lemma insert_at_index_pow_not_car':
assumes "k ≤n"
assumes "length x = n"
assumes "x ∉ carrier (R⇗n⇖)"
shows "(insert_at_index x a n) ∉ carrier (R⇗Suc n⇖)"
by (metis assms(2) assms(3) insert_at_index_pow_not_car lessI less_Suc_eq_le)
lemma take_closed:
assumes "k ≤n"
assumes "x ∈ carrier (R⇗n⇖)"
shows "take k x ∈ carrier (R⇗k⇖)"
apply(rule cartesian_power_car_memI)
apply (metis assms(1) assms(2) cartesian_power_car_memE length_take min.absorb_iff2)
by (meson assms(2) cartesian_power_car_memE'' set_take_subset subset_trans)
lemma drop_closed:
assumes "k < n"
assumes "x ∈ carrier (R⇗n⇖)"
shows "drop k x ∈ carrier (R⇗n - k⇖)"
apply(rule cartesian_power_car_memI[of "drop k x" "n - k"] )
using assms(2) cartesian_power_car_memE length_drop apply blast
by (metis add_diff_inverse_nat assms(1) assms(2) cartesian_power_car_memE
cartesian_power_car_memE' in_set_conv_nth length_drop less_imp_le_nat
nat_add_left_cancel_less nth_drop order.asym subsetI)
lemma last_closed:
assumes "n > 0"
assumes "x ∈ carrier (R⇗n⇖)"
shows "last x ∈ carrier R"
using assms
by (metis Suc_diff_1 cartesian_power_car_memE cartesian_power_car_memE'
last_conv_nth lessI list.size(3) neq0_conv)
lemma cartesian_power_concat:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "b ∈ carrier (R⇗k⇖)"
shows "a@b ∈ carrier (R⇗n+k⇖)"
"b@a ∈ carrier (R⇗n+k⇖)"
apply (metis (no_types, lifting) append_eq_conv_conj assms(1) assms(2)
cartesian_power_car_memE cartesian_power_car_memI'' length_append)
by (metis (no_types, lifting) add.commute append_eq_conv_conj assms(1) assms(2)
cartesian_power_car_memE cartesian_power_car_memI'' length_append)
lemma cartesian_power_decomp:
assumes "a ∈ carrier (R⇗n+k⇖)"
obtains a0 a1 where "a0 ∈ carrier (R⇗n⇖) ∧ a1 ∈ carrier (R⇗k⇖) ∧ a0@a1 = a"
using assms
by (metis (no_types, lifting) add_diff_cancel_left' append.assoc append_eq_append_conv
append_take_drop_id cartesian_power_car_memE drop_closed le_add1
le_neq_implies_less length_append take_closed)
lemma list_segment_pow:
assumes "as ∈ carrier (R⇗n⇖)"
assumes "j ≤ n"
assumes "i ≤ j"
shows "list_segment i j as ∈ carrier (R⇗j - i⇖)"
apply(rule cartesian_power_car_memI)
using list_segment_length assms cartesian_power_car_memE
apply blast
using assms
by (metis cartesian_power_car_memE cartesian_power_car_memE''
dual_order.trans list_segment_subset_list_set)
lemma nth_list_segment:
assumes "as ∈ carrier (R⇗n⇖)"
assumes "j ≤n"
assumes "i ≤ j"
assumes "k < j - i"
shows "(list_segment i j as) ! k = as ! (i + k)"
unfolding list_segment_def
using assms nth_map_upt[of k j i "((!) as)" ]
by blast
subsection‹Mapping the Carrier of a Ring to its 1-Dimensional Cartesian Power.›
context cring
begin
lemma R1_carI:
assumes "length as = 1"
assumes "as!0 ∈ carrier R"
shows "as ∈ carrier (R⇗1⇖)"
apply(rule cartesian_power_car_memI)
using assms
apply blast
using assms
by (metis in_set_conv_nth less_one subsetI)
abbreviation(input) to_R1 where
"to_R1 a ≡ [a]"
abbreviation(input) to_R :: "'a list ⇒ 'a" where
"to_R as ≡ as!0"
lemma to_R1_to_R:
assumes "a ∈ carrier (R⇗1⇖)"
shows "to_R1 (to_R a) = a"
proof-
have "length a = 1"
using assms cartesian_power_car_memE by blast
then obtain b where "a = [b]"
by (metis One_nat_def length_0_conv length_Suc_conv)
then show ?thesis
using assms
by (metis nth_Cons_0)
qed
lemma to_R_to_R1:
shows "to_R (to_R1 a) = a"
by (meson nth_Cons_0)
lemma to_R1_closed:
assumes "a ∈ carrier R"
shows "to_R1 a ∈ carrier (R⇗1⇖)"
proof(rule R1_carI)
show "length [a] = 1"
by simp
show "[a] ! 0 ∈ carrier R"
using assms to_R_to_R1 by presburger
qed
lemma to_R_pow_closed:
assumes "a ∈ carrier (R⇗1⇖)"
shows "to_R a ∈ carrier R"
using assms cartesian_power_car_memE' by blast
lemma to_R1_intersection:
assumes "A ⊆ carrier R"
assumes "B ⊆ carrier R"
shows "to_R1 ` (A ∩ B) = to_R1` A ∩ to_R1 ` B"
proof
show "(λa. [a]) ` (A ∩ B) ⊆ (λa. [a]) ` A ∩ (λa. [a]) ` B"
by blast
show "(λa. [a]) ` A ∩ (λa. [a]) ` B ⊆ (λa. [a]) ` (A ∩ B)"
using assms
by blast
qed
lemma to_R1_finite:
assumes "finite A"
shows "finite (to_R1` A)"
"card A = card (to_R1` A)"
using assms
apply blast
apply(rule finite.induct[of A])
apply (simp add: assms(1))
apply simp
by (smt card_insert_if finite_imageI image_iff image_insert list.inject)
lemma to_R1_carrier:
"to_R1` (carrier R)= carrier (R⇗1⇖)"
proof
show "(λa. [a]) ` carrier R ⊆ carrier (R⇗1⇖)"
proof fix x
assume "x ∈ (λa. [a]) ` carrier R"
then show "x ∈ carrier (R⇗1⇖)"
using cartesian_power_car_memI[of x 1 R]
by (metis (no_types, lifting) image_iff to_R1_closed)
qed
show "carrier (R⇗1⇖) ⊆ (λa. [a]) ` carrier R"
proof fix x
assume "x ∈ carrier (R⇗1⇖)"
then obtain a where a_def: "a ∈ carrier R ∧ x = [a]"
using cartesian_power_car_memE'[of x R 1] cartesian_power_car_memE[of x R 1]
by (metis less_numeral_extra(1) to_R1_to_R)
then show "x ∈ (λa. [a]) ` carrier R"
by blast
qed
qed
lemma to_R1_diff:
"to_R1` (A - B) = to_R1` A - to_R1` B"
proof
show "(λa. [a]) ` (A - B) ⊆ (λa. [a]) ` A - (λa. [a]) ` B"
by blast
show "(λa. [a]) ` A - (λa. [a]) ` B ⊆ (λa. [a]) ` (A - B)"
by blast
qed
lemma to_R1_complement:
shows "to_R1` (carrier R - A) = carrier (R⇗1⇖) - to_R1` A"
by (metis to_R1_carrier to_R1_diff)
lemma to_R1_subset:
assumes "A ⊆ B"
shows "to_R1` A ⊆ to_R1` B"
using assms
by blast
lemma to_R1_car_subset:
assumes "A ⊆ carrier R"
shows "to_R1` A ⊆ carrier (R⇗1⇖)"
using assms to_R1_carrier
by blast
end
subsection‹Simple Cartesian Products›
definition cartesian_product :: "('a list) set ⇒ ('a list) set ⇒ ('a list) set" where
"cartesian_product A B ≡ {xs. ∃as ∈ A. ∃bs ∈ B. xs = as@bs}"
lemma cartesian_product_closed:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
shows "cartesian_product A B ⊆ carrier (R⇗n + m⇖)"
proof
fix x
assume A: "x ∈ cartesian_product A B "
then obtain as bs where as_bs_def: "x = as@bs ∧ as ∈ A ∧ bs ∈ B"
unfolding cartesian_product_def by blast
show "x ∈ carrier (R⇗n + m⇖) "
apply(rule cartesian_power_car_memI')
apply (metis as_bs_def assms cartesian_power_car_memE length_append subsetD)
using A unfolding cartesian_product_def
by (metis (no_types, lifting) add_diff_inverse_nat as_bs_def assms(1)
assms(2) cartesian_power_car_memE cartesian_power_car_memE'
nat_add_left_cancel_less nth_append subsetD)
qed
lemma cartesian_product_closed':
assumes "a ∈ carrier (R⇗n⇖)"
assumes "b ∈ carrier (R⇗m⇖)"
shows "(a@b) ∈ carrier (R⇗n + m⇖)"
proof-
have "a@b ∈ cartesian_product {a} {b}"
using cartesian_product_def by blast
then show ?thesis
using cartesian_product_closed[of "{a}" R n "{b}" m]
assms
by blast
qed
lemma cartesian_product_carrier:
"cartesian_product (carrier (R⇗n⇖)) (carrier (R⇗m⇖)) = carrier (R⇗n + m⇖)"
proof
show "cartesian_product (carrier (R⇗n⇖)) (carrier (R⇗m⇖)) ⊆ carrier (R⇗n + m⇖)"
using cartesian_product_closed[of "(carrier (R⇗n⇖))" R n "(carrier (R⇗m⇖)) " m]
by blast
show "carrier (R⇗n + m⇖) ⊆ cartesian_product (carrier (R⇗n⇖)) (carrier (R⇗m⇖))"
proof
fix x
assume A: "x ∈ carrier (R⇗n + m⇖)"
have 0: "take n x ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI')
apply (metis A cartesian_power_car_memE le_add1 length_take min.absorb2)
by (metis A add.commute cartesian_power_car_memE'
nth_take trans_less_add2)
have 1: "drop n x ∈ carrier (R⇗m⇖)"
apply(rule cartesian_power_car_memI')
apply (metis A add_diff_cancel_left' cartesian_power_car_memE length_drop)
by (metis A cartesian_power_car_memE cartesian_power_car_memE' le_add1 nat_add_left_cancel_less nth_drop)
show "x ∈ cartesian_product (carrier (R⇗n⇖)) (carrier (R⇗m⇖))"
using 0 1
by (smt A cartesian_power_decomp cartesian_product_def mem_Collect_eq)
qed
text‹Higher function rings›
qed
lemma cartesian_product_memI:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "take n a ∈ A"
assumes "drop n a ∈ B"
shows "a ∈ cartesian_product A B"
proof-
have "a = (take n a) @ (drop n a)"
by (metis append_take_drop_id)
then show ?thesis
using assms(3) assms(4) cartesian_product_def by blast
qed
lemma cartesian_product_memI':
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "a ∈ A"
assumes "b ∈ B"
shows "a@b ∈ cartesian_product A B"
using assms unfolding cartesian_product_def
by blast
lemma cartesian_product_memE:
assumes "a ∈ cartesian_product A B"
assumes "A ⊆ carrier (R⇗n⇖)"
shows "take n a ∈ A"
"drop n a ∈ B"
using assms unfolding cartesian_product_def
apply (smt append_eq_conv_conj cartesian_power_car_memE in_mono mem_Collect_eq)
using assms unfolding cartesian_product_def
by (smt append_eq_conv_conj cartesian_power_car_memE in_mono mem_Collect_eq)
lemma cartesian_product_intersection:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "C ⊆ carrier (R⇗n⇖)"
assumes "D ⊆ carrier (R⇗m⇖)"
shows "cartesian_product A B ∩ cartesian_product C D = cartesian_product (A ∩ C) (B ∩ D)"
proof
show "cartesian_product A B ∩ cartesian_product C D ⊆ cartesian_product (A ∩ C) (B ∩ D)"
proof fix x
assume "x ∈ cartesian_product A B ∩ cartesian_product C D"
then show "x ∈ cartesian_product (A ∩ C) (B ∩ D)"
using assms cartesian_product_memE[of x C D] cartesian_product_memE[of x A B]
cartesian_product_memI[of "A ∩ C" R n "B ∩ D" m x]
by (smt Int_iff inf.coboundedI1)
qed
show "cartesian_product (A ∩ C) (B ∩ D) ⊆ cartesian_product A B ∩ cartesian_product C D"
proof fix x
assume "x ∈ cartesian_product (A ∩ C) (B ∩ D)"
then show "x ∈ cartesian_product A B ∩ cartesian_product C D"
using assms cartesian_product_memI[of C R n D m] cartesian_product_memI[of A R n B m]
cartesian_product_memE[of x "A ∩ B" "C ∩ D" R n ]
by (metis (no_types, lifting) Int_iff cartesian_product_memE(1) cartesian_product_memE(2) inf_le1 subset_trans)
qed
qed
lemma cartesian_product_subsetI:
assumes "C ⊆ A"
assumes "D ⊆ B"
shows "cartesian_product C D ⊆ cartesian_product A B"
using assms unfolding cartesian_product_def
by blast
lemma cartesian_product_binary_union_right:
assumes "C ⊆ carrier (R⇗n⇖)"
assumes "D ⊆ carrier (R⇗n⇖)"
shows "cartesian_product A (C ∪ D) = (cartesian_product A C) ∪ (cartesian_product A D)"
proof
show "cartesian_product A (C ∪ D) ⊆ cartesian_product A C ∪ cartesian_product A D"
unfolding cartesian_product_def by blast
show "cartesian_product A C ∪ cartesian_product A D ⊆ cartesian_product A (C ∪ D)"
unfolding cartesian_product_def by blast
qed
lemma cartesian_product_binary_union_left:
assumes "C ⊆ carrier (R⇗n⇖)"
assumes "D ⊆ carrier (R⇗n⇖)"
shows "cartesian_product (C ∪ D) A = (cartesian_product C A) ∪ (cartesian_product D A)"
proof
show "cartesian_product (C ∪ D) A ⊆ cartesian_product C A ∪ cartesian_product D A"
unfolding cartesian_product_def by blast
show "cartesian_product C A ∪ cartesian_product D A ⊆ cartesian_product (C ∪ D) A"
unfolding cartesian_product_def by blast
qed
lemma cartesian_product_binary_intersection_right:
assumes "C ⊆ carrier (R⇗n⇖)"
assumes "D ⊆ carrier (R⇗n⇖)"
assumes "A ⊆ carrier (R⇗m⇖)"
shows "cartesian_product A (C ∩ D) = (cartesian_product A C) ∩ (cartesian_product A D)"
proof
show "cartesian_product A (C ∩ D) ⊆ cartesian_product A C ∩ cartesian_product A D"
unfolding cartesian_product_def by blast
show "cartesian_product A C ∩ cartesian_product A D ⊆ cartesian_product A (C ∩ D)"
proof fix x assume A: "x ∈ cartesian_product A C ∩ cartesian_product A D"
show "x ∈ cartesian_product A (C ∩ D)" apply(rule cartesian_product_memI[of A R m _ n ])
apply (simp add: assms(3))
apply (simp add: assms(1) inf.coboundedI1)
apply (meson A IntD1 assms(3) cartesian_product_memE(1))
by (meson A Int_iff assms(3) cartesian_product_memE(2))
qed
qed
lemma cartesian_product_binary_intersection_left:
assumes "C ⊆ carrier (R⇗n⇖)"
assumes "D ⊆ carrier (R⇗n⇖)"
assumes "A ⊆ carrier (R⇗m⇖)"
shows "cartesian_product (C ∩ D) A = (cartesian_product C A) ∩ (cartesian_product D A)"
proof
show "cartesian_product (C ∩ D) A ⊆ cartesian_product C A ∩ cartesian_product D A"
unfolding cartesian_product_def by blast
show "cartesian_product C A ∩ cartesian_product D A ⊆ cartesian_product (C ∩ D) A"
proof fix x assume A: "x ∈ cartesian_product C A ∩ cartesian_product D A"
show "x ∈ cartesian_product (C ∩ D) A" apply(rule cartesian_product_memI[of _ R n _ m ])
apply (simp add: assms(2) inf.coboundedI2)
apply (simp add: assms(3))
apply (meson A Int_iff assms(1) assms(2) cartesian_product_memE(1))
by (meson A IntD1 assms(1) cartesian_product_memE(2))
qed
qed
lemma cartesian_product_car_complement_right:
assumes "A ⊆ carrier (R⇗m⇖)"
shows "carrier (R⇗n + m⇖) - cartesian_product (carrier (R⇗n⇖)) A =
cartesian_product (carrier (R⇗n⇖)) ((carrier (R⇗m⇖)) - A)"
proof
show "carrier (R⇗n + m⇖) - cartesian_product (carrier (R⇗n⇖)) A ⊆ cartesian_product (carrier (R⇗n⇖)) ((carrier (R⇗m⇖)) - A)"
proof fix x assume A: "x ∈ (carrier (R⇗n + m⇖) - cartesian_product (carrier (R⇗n⇖)) A)"
show "x ∈ cartesian_product (carrier (R⇗n⇖)) ((carrier (R⇗m⇖)) - A)"
apply(rule cartesian_product_memI[of _ R n _ m])
apply simp
apply simp
apply (meson A DiffE le_add1 take_closed)
apply(rule ccontr)
proof-
assume A': "drop n x ∉ (carrier (R⇗m⇖) - A)"
have "drop n x ∈ A"
proof-
have "x ∈ cartesian_product (carrier (R⇗n⇖)) (carrier (R⇗m⇖))"
using A
by (metis (mono_tags, lifting) DiffD1 cartesian_product_carrier)
then show ?thesis
using A' cartesian_product_memE[of x "(carrier (R⇗n⇖))" "(carrier (R⇗m⇖))" R n]
by blast
qed
then show False
using A cartesian_product_memI[of "(carrier (R⇗n⇖))" R n A m x]
by (meson DiffD1 DiffD2 assms le_add1 order_refl take_closed)
qed
qed
show "cartesian_product (carrier (R⇗n⇖)) ((carrier (R⇗m⇖)) - A) ⊆ carrier (R⇗n + m⇖) - cartesian_product (carrier (R⇗n⇖)) A"
proof fix x assume A: "x ∈ cartesian_product (carrier (R⇗n⇖)) ((carrier (R⇗m⇖)) - A)"
show "x ∈ carrier (R⇗n + m⇖) - cartesian_product (carrier (R⇗n⇖)) A"
apply(rule ccontr)
using A cartesian_product_memE[of x "carrier (R⇗n⇖)" A R n]
using A cartesian_product_memE[of x "(carrier (R⇗n⇖))" "(carrier (R⇗m⇖)) - A" R n]
by (metis (no_types, lifting) DiffD1 DiffD2 DiffI
append_take_drop_id cartesian_product_closed' order_refl)
qed
qed
lemma cartesian_product_car_complement_left:
assumes "A ⊆ carrier (R⇗n⇖)"
shows "carrier (R⇗n + m⇖) - cartesian_product A (carrier (R⇗m⇖)) =
cartesian_product ((carrier (R⇗n⇖)) - A) (carrier (R⇗m⇖)) "
proof
show "carrier (R⇗n + m⇖) - cartesian_product A (carrier (R⇗m⇖)) ⊆
cartesian_product ((carrier (R⇗n⇖)) - A) (carrier (R⇗m⇖)) "
proof fix x assume A: " x ∈ carrier (R⇗n + m⇖) - cartesian_product A (carrier (R⇗m⇖))"
show "x ∈ cartesian_product ((carrier (R⇗n⇖)) - A) (carrier (R⇗m⇖)) "
proof(rule cartesian_product_memI[of _ R n _ m])
show "carrier (R⇗n⇖) - A ⊆ carrier (R⇗n⇖)"
by simp
show "carrier (R⇗m⇖) ⊆ carrier (R⇗m⇖)"
by simp
show "take n x ∈ carrier (R⇗n⇖) - A"
by (metis (no_types, lifting) A DiffD1 DiffD2 DiffI assms
cartesian_product_carrier cartesian_product_memE(2) cartesian_product_memI
le_add1 order_refl take_closed)
show "drop n x ∈ carrier (R⇗m⇖)"
by (metis A DiffD1 cartesian_product_carrier cartesian_product_memE(2) order_refl)
qed
qed
show "cartesian_product ((carrier (R⇗n⇖)) - A) (carrier (R⇗m⇖)) ⊆
carrier (R⇗n + m⇖) - cartesian_product A (carrier (R⇗m⇖)) "
proof fix x assume A: " x ∈ cartesian_product ((carrier (R⇗n⇖)) - A) (carrier (R⇗m⇖))"
show "x ∈ carrier (R⇗n + m⇖) - cartesian_product A (carrier (R⇗m⇖))"
apply(rule ccontr)
using A cartesian_product_memE[of x "((carrier (R⇗n⇖)) - A)" "(carrier (R⇗m⇖))"]
cartesian_product_memE[of x A "(carrier (R⇗m⇖))"]
by (smt DiffD1 DiffD2 DiffI Diff_subset append_take_drop_id assms cartesian_product_closed')
qed
qed
lemma cartesian_product_complement_right:
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "A ⊆ carrier (R⇗n⇖)"
shows "cartesian_product A (carrier (R⇗m⇖)) - (cartesian_product A B) =
cartesian_product A ((carrier (R⇗m⇖)) - B)"
proof
show "cartesian_product A (carrier (R⇗m⇖)) - cartesian_product A B ⊆ cartesian_product A ((carrier (R⇗m⇖)) - B)"
unfolding cartesian_product_def by blast
show "cartesian_product A ((carrier (R⇗m⇖)) - B) ⊆ cartesian_product A ((carrier (R⇗m⇖))) - cartesian_product A B"
proof fix x assume A: "x ∈ cartesian_product A ((carrier (R⇗m⇖)) - B)"
have 0: "x ∈ cartesian_product A (carrier (R⇗m⇖))"
using A unfolding cartesian_product_def by blast
show "x ∈ cartesian_product A (carrier (R⇗m⇖)) - cartesian_product A B "
apply(rule ccontr)
using assms 0 A cartesian_product_memE[of x A "((carrier (R⇗m⇖)) - B)" R n]
cartesian_product_memE[of x A B R n]
by blast
qed
qed
lemma cartesian_product_complement_left:
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "A ⊆ carrier (R⇗n⇖)"
shows "cartesian_product (carrier (R⇗m⇖)) A - (cartesian_product B A) =
cartesian_product ((carrier (R⇗m⇖)) - B) A "
proof
show "cartesian_product (carrier (R⇗m⇖)) A - cartesian_product B A ⊆ cartesian_product ((carrier (R⇗m⇖)) - B) A"
unfolding cartesian_product_def by blast
show "cartesian_product ((carrier (R⇗m⇖)) - B) A ⊆ cartesian_product (carrier (R⇗m⇖)) A - cartesian_product B A"
proof fix x assume A: "x ∈ cartesian_product ((carrier (R⇗m⇖)) - B) A"
have 0: "x ∈ cartesian_product (carrier (R⇗m⇖)) A"
using A unfolding cartesian_product_def by blast
have 1: "take m x ∈ (carrier (R⇗m⇖)) - B"
using A cartesian_product_memE[of x "((carrier (R⇗m⇖)) - B)" A R m]
by blast
have 2: "drop m x ∈ A"
using cartesian_product_memE[of x "((carrier (R⇗m⇖)) - B)" A R m]
by (metis A Diff_subset)
show "x ∈ cartesian_product (carrier (R⇗m⇖)) A - cartesian_product B A"
apply(rule ccontr)
using A 0 1 2 cartesian_product_memE[of x B A R m] assms
by blast
qed
qed
lemma cartesian_product_empty_right:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B = {[]}"
shows "cartesian_product A B = A"
proof
show "cartesian_product A B ⊆ A"
using assms unfolding cartesian_product_def
by (smt append_Nil2 mem_Collect_eq singletonD subsetI)
show "A ⊆ cartesian_product A B"
using assms unfolding cartesian_product_def
by blast
qed
lemma cartesian_product_empty_left:
assumes "B ⊆ carrier (R⇗n⇖)"
assumes "A = {[]}"
shows "cartesian_product A B = B"
proof
show "cartesian_product A B ⊆ B"
using assms unfolding cartesian_product_def
by (smt append.simps(1) mem_Collect_eq singletonD subsetI)
show "B ⊆ cartesian_product A B"
using assms unfolding cartesian_product_def
by blast
qed
subsection‹Cartesian Products at Arbitrary Indices›
definition(in ring) ring_pow_proj :: "nat ⇒ (nat set) ⇒ ('a list) ⇒ ('a list) " ("π⇘_, _⇙") where
"ring_pow_proj n S ≡ restrict (project_at_indices S) (carrier (R⇗n⇖))"
text‹The projection at an arbitrary index set›
lemma project_at_indices_closed:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "S ⊆ indices_of a"
shows "π⇘S⇙ a ∈ carrier (R⇗card S⇖)"
apply(rule cartesian_power_car_memI')
using assms proj_at_index_list_length apply blast
using assms project_at_indices_nth[of S]
by (smt cartesian_power_car_memE cartesian_power_car_memE' indices_of_def lessThan_iff nth_elem_closed subsetD)
lemma(in ring) ring_pow_proj_is_map:
assumes "S ⊆ {..<n}"
shows "π⇘n,S⇙ ∈ struct_maps (R⇗n⇖) (R⇗card S⇖)"
proof(rule struct_maps_memI)
show "⋀x. x ∈ carrier (R⇗n⇖) ⟹ π⇘n,S⇙ x ∈ carrier (R⇗card S⇖)"
using project_at_indices_closed unfolding ring_pow_proj_def
by (metis assms cartesian_power_car_memE indices_of_def restrict_apply')
show " ⋀x. x ∉ carrier (R⇗n⇖) ⟹ π⇘n, S⇙ x = undefined"
by (metis restrict_apply ring_pow_proj_def)
qed
lemma(in ring) project_at_indices_ring_pow_proj:
assumes "x ∈ carrier (R⇗n⇖)"
shows "π⇘S⇙ x = π⇘n,S⇙ x"
unfolding ring_pow_proj_def
by (metis assms restrict_apply')
text‹
Cartesian products where the first factor ‹A› occurs at the entries of some arbitrary index set.
Note that this product isn't completely arbitrary because the entries of the factor of ‹A›
still occurs in ascending order.›
definition twisted_cartesian_product ("Prod⇘_, _⇙") where
"twisted_cartesian_product S S' A B = {a . length a = card S + card S' ∧ π⇘S⇙ a ∈ A ∧ π⇘S'⇙ a ∈ B}"
lemma twisted_cartesian_product_mem_length:
assumes "card S = n"
assumes "card S' = m"
assumes "a ∈ Prod⇘S,S'⇙ A B"
shows "length a = n + m"
using assms unfolding twisted_cartesian_product_def
by blast
lemma twisted_cartesian_product_closed:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "card S = n"
assumes "card S' = m"
assumes "S ∪ S' = {..<n + m}"
shows "twisted_cartesian_product S S' A B ⊆ carrier (R⇗n + m⇖)"
proof(rule subsetI)
fix x assume A: "x ∈ twisted_cartesian_product S S' A B"
show "x ∈ carrier (R⇗n + m⇖)"
proof(rule cartesian_power_car_memI')
show "length x = n + m"
using twisted_cartesian_product_mem_length ‹x ∈ twisted_cartesian_product S S' A B› assms(1) assms(2) assms(3) assms(4) assms(5) by blast
fix i assume A': "i < n + m"
have 0: "indices_of x = {..<n+m}"
by (simp add: ‹length x = n + m› indices_of_def)
show "x ! i ∈ carrier R"
proof(cases "i ∈ S")
case True
have "x!i = π⇘S⇙x ! (set_rank S i)"
using A' 0 assms
by (metis True Un_upper1 project_at_indices_nth')
then show ?thesis
using project_at_indices_closed[of x R "n + m" S] A A'
cartesian_power_car_memE'[of "π⇘S⇙ x" R "card S"]
by (metis (no_types, lifting) True UnI2 Un_upper1 assms(1) assms(3) assms(5)
finite_lessThan finite_subset mem_Collect_eq set_rank_range sup.absorb_iff1
twisted_cartesian_product_def)
next
case False
have "x!i = π⇘S'⇙x ! (set_rank S' i)"
using A' 0 assms
by (metis False UnE lessThan_iff project_at_indices_nth' sup.absorb_iff1 sup.right_idem)
then show ?thesis
using project_at_indices_closed[of x R "n + m" S'] A A'
cartesian_power_car_memE'[of "π⇘S'⇙ x" R "card S'"]
by (metis (no_types, lifting) False UnE UnI2 Un_upper2 assms(2) assms(4) assms(5)
finite_lessThan finite_subset lessThan_iff mem_Collect_eq set_rank_range sup.absorb_iff1
twisted_cartesian_product_def)
qed
qed
qed
lemma twisted_cartesian_product_memE:
assumes "a ∈ twisted_cartesian_product S S' A B"
shows "π⇘S⇙ a ∈ A" "π⇘S'⇙ a ∈ B"
using assms(1) unfolding twisted_cartesian_product_def apply blast
using assms(1) unfolding twisted_cartesian_product_def by blast
lemma twisted_cartesian_product_memI:
assumes "π⇘S⇙ a ∈ A"
assumes "π⇘S'⇙ a ∈ B"
assumes "length a = card S + card S'"
shows "a ∈ twisted_cartesian_product S S' A B"
by (metis (mono_tags, lifting) assms(1) assms(2) assms(3) mem_Collect_eq twisted_cartesian_product_def)
lemma twisted_cartesian_product_empty_left_factor:
assumes "A = {}"
shows "twisted_cartesian_product S S' A B = {}"
by (metis assms emptyE equals0I twisted_cartesian_product_memE(1))
lemma twisted_cartesian_product_empty_right_factor:
assumes "B = {}"
shows "twisted_cartesian_product S S' A B = {}"
by (metis assms emptyE equals0I twisted_cartesian_product_memE(2))
lemma twisted_cartesian_project_left:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "A ≠ {}"
assumes "B ≠ {}"
assumes "card S = n"
assumes "card S' = m"
assumes "S ∪ S' = {..<n + m}"
shows "π⇘S⇙ ` (Prod⇘S,S'⇙ A B) = A"
proof
have f0: "S ∩ S' = {}"
proof-
have "card (S ∪ S') = card S + card S'"
by (simp add: assms(5) assms(6) assms(7))
thus ?thesis
by (metis Nat.add_diff_assoc2 add.right_neutral add_diff_cancel_left' assms(6)
assms(7) card_0_eq card_Un_Int finite_Int finite_Un finite_lessThan le_add1)
qed
show "π⇘S⇙ ` (Prod⇘S,S'⇙ A B) ⊆ A"
unfolding twisted_cartesian_product_def
by blast
show "A ⊆ π⇘S⇙ ` (Prod⇘S,S'⇙ A B)"
proof fix x assume A: "x ∈ A"
obtain y where y_def: "y ∈ B"
using assms(4) by blast
obtain a where a_def:
"a = map (λi. if i ∈ S then (x ! set_rank S i) else (y ! set_rank S' i)) [0..<n+m]"
by blast
have 0: "S ⊆ indices_of a"
by (metis (no_types, lifting) Un_upper1 a_def assms(7) diff_zero indices_of_def length_map length_upt)
have 1: "S' ⊆ indices_of a"
by (metis (no_types, lifting) Un_upper2 a_def assms(7) diff_zero indices_of_def length_map length_upt)
have 2: "π⇘S⇙ a = x"
proof-
have 20: "length (π⇘S⇙ a) = n"
by (metis (no_types, lifting) Un_upper1 a_def assms(5) assms(7) diff_zero indices_of_def length_map length_upt proj_at_index_list_length)
have "⋀i. i < n ⟹ π⇘S⇙ a ! i = x ! i"
proof- fix i assume A: "i < n" show "π⇘S⇙ a ! i = x ! i"
using 0 assms a_def project_at_indices_nth'[of S a "nth_elem S i"] set_rank_nth_elem_inv[of S i]
nth_map[of i "[0..<n+m]"]
by (smt (z3) A add.left_neutral card.infinite diff_zero indices_of_def length_map length_upt lessThan_iff not_less_zero nth_elem_closed nth_map nth_upt subsetD)
qed
thus ?thesis using 20
by (metis A assms(1) cartesian_power_car_memE nth_equalityI subsetD)
qed
have 3: "π⇘S'⇙ a = y"
proof-
have 20: "length (π⇘S'⇙ a) = m"
using "1" assms(6) proj_at_index_list_length by blast
have "⋀i. i < m ⟹ π⇘S'⇙ a ! i = y ! i"
proof- fix i assume A: "i < m"
have "nth_elem S' i ∉ S"
using nth_elem_closed[of i S'] f0 A assms(6) by blast
thus "π⇘S'⇙ a ! i = y ! i"
using 0 assms a_def project_at_indices_nth'[of S' a "nth_elem S' i"] set_rank_nth_elem_inv[of S' i]
nth_map[of i "[0..<n+m]"]
by (smt "1" A add.left_neutral card.infinite diff_zero indices_of_def length_map length_upt lessThan_iff not_less0 nth_elem_closed nth_map nth_upt subsetD)
qed
thus ?thesis
by (metis "20" assms(2) cartesian_power_car_memE nth_equalityI subsetD y_def)
qed
have"a ∈ (Prod⇘S,S'⇙ A B)"
apply(rule twisted_cartesian_product_memI)
apply (simp add: "2" A)
apply (simp add: "3" y_def)
by (metis (no_types, lifting) a_def assms(5) assms(6) diff_zero length_map length_upt)
thus "x ∈ π⇘S⇙ ` (Prod⇘S,S'⇙ A B)"
using "2" by blast
qed
qed
lemma twisted_cartesian_product_swap:
shows "(Prod⇘S,S'⇙ A B) = (Prod⇘S',S⇙ B A)"
unfolding twisted_cartesian_product_def
by (metis add.commute)
lemma twisted_cartesian_project_right:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗m⇖)"
assumes "A ≠ {}"
assumes "B ≠ {}"
assumes "card S = n"
assumes "card S' = m"
assumes "S ∪ S' = {..<n + m}"
shows "π⇘S'⇙ ` (Prod⇘S,S'⇙ A B) = B"
using assms twisted_cartesian_project_left[of B R m A n S' S] twisted_cartesian_product_swap
by (metis add.commute sup_commute)
text ‹
Cartesian products which send points $a = (a_1, \dots, a_{m})$ and $b = (b_1, \dots, b_{n})$ to
the point $(a_1, \dots, a_i, b_1, \dots, b_{n},a_{i+1}, \dots, a_m)$
›
definition splitting_permutation :: "nat ⇒ nat ⇒ nat ⇒
nat ⇒ nat" where
"splitting_permutation l1 l2 i j = (if j < i then j else
(if i ≤ j ∧ j < l1 then (l2 + j) else
(if j < l1 + l2 then j - l1 + i else j)))"
lemma splitting_permutation_case_1_unique:
assumes "i ≤ l1"
assumes "y < i"
assumes "splitting_permutation l1 l2 i j = y"
shows "j = y"
unfolding splitting_permutation_def
using assms(2) assms(3) splitting_permutation_def by auto
lemma splitting_permutation_case_1_exists:
assumes "i ≤ l1"
assumes "y < i"
shows "splitting_permutation l1 l2 i y = y"
unfolding splitting_permutation_def
by (simp add: assms(2))
lemma splitting_permutation_case_2_unique:
assumes "i ≤ l1"
assumes "i ≤ y ∧ y < l2 + i"
assumes "splitting_permutation l1 l2 i j = y"
shows "j = y + l1 - i"
unfolding splitting_permutation_def
using assms(1) assms(2) assms(3) le_add_diff_inverse2 not_less_iff_gr_or_eq
splitting_permutation_def trans_less_add2 by auto
lemma splitting_permutation_case_2_exists:
assumes "i ≤ l1"
assumes "i ≤ y ∧ y < l2 + i"
shows "splitting_permutation l1 l2 i (y + l1 - i) = y"
unfolding splitting_permutation_def
using assms(1) assms(2) less_diff_conv2 by auto
lemma splitting_permutation_case_3_unique:
assumes "i ≤ l1"
assumes "l2 + i ≤ y ∧ y < l1 + l2"
assumes "splitting_permutation l1 l2 i j = y"
shows "j = y - l2"
unfolding splitting_permutation_def
by (smt Nat.le_diff_conv2 add_diff_cancel_left' add_diff_cancel_right' add_leD2
assms(2) assms(3) le_add1 le_diff_iff not_le splitting_permutation_def)
lemma splitting_permutation_case_3_exists:
assumes "i ≤ l1"
assumes "l2 + i ≤ y ∧ y < l1 + l2"
shows "splitting_permutation l1 l2 i (y - l2) = y"
unfolding splitting_permutation_def
by (metis Nat.le_diff_conv2 add.commute add_leD1 assms(2) leD le_add_diff_inverse less_diff_conv2)
lemma splitting_permutation_case_4_unique:
assumes "i ≤ l1"
assumes "l1 + l2 ≤ y"
assumes "splitting_permutation l1 l2 i j = y"
shows "j = y"
using assms(1) assms(2) assms(3) le_add_diff_inverse2 less_le_trans
splitting_permutation_def by auto
lemma splitting_permutation_case_4_exists:
assumes "i ≤ l1"
assumes "l1 + l2 ≤y"
shows "splitting_permutation l1 l2 i y = y"
unfolding splitting_permutation_def
using assms(2) by auto
lemma splitting_permutation_permutes:
assumes "i ≤ l1"
shows "(splitting_permutation l1 l2 i) permutes {..< l1 + l2}"
proof-
have 0: "(∀x. x ∉ {..<l1 + l2} ⟶ splitting_permutation l1 l2 i x = x)"
proof fix x show "x ∉ {..<l1 + l2} ⟶ splitting_permutation l1 l2 i x = x"
proof assume A: "x ∉ {..<l1 + l2}"
then show "splitting_permutation l1 l2 i x = x"
using assms unfolding splitting_permutation_def
by simp
qed
qed
have 1: "(∀y. ∃!x. splitting_permutation l1 l2 i x = y)"
proof fix y
show "∃!x. splitting_permutation l1 l2 i x = y"
proof(cases "y < i")
case True
then show ?thesis
using splitting_permutation_case_1_exists splitting_permutation_case_1_unique assms
by (metis splitting_permutation_def)
next
case F0: False
show ?thesis
proof(cases "i ≤ y ∧ y < l2 + i")
case True
then show ?thesis
using F0 splitting_permutation_case_2_exists splitting_permutation_case_2_unique assms
by metis
next
case F1: False
show ?thesis
proof(cases "l2 + i ≤ y ∧ y < l1 + l2")
case True
then show ?thesis
using F0 F1 splitting_permutation_case_3_exists splitting_permutation_case_3_unique assms
by metis
next
case F2: False
show ?thesis
using F0 F1 F2 splitting_permutation_case_4_exists splitting_permutation_case_4_unique assms
by (metis leI not_less)
qed
qed
qed
qed
show ?thesis
using 0 1 permutes_def
by blast
qed
lemma splitting_permutation_action:
assumes "i ≤l1"
assumes "length a1 = l1"
assumes "length a2 = l2"
shows "permute_list (splitting_permutation l1 l2 i) ((take i a1) @ a2 @ (drop i a1)) =
a1@a2"
proof-
obtain x where x_def: "x = permute_list (splitting_permutation l1 l2 i) ((take i a1) @ a2 @ (drop i a1))"
by blast
obtain y where y_def: "y = a1 @ a2"
by blast
have 0: "length x = length y"
using x_def y_def assms splitting_permutation_permutes[of i l1 l2]
by (smt add.commute add.left_commute le_add_diff_inverse length_append
length_drop length_permute_list length_take min.absorb2)
have 1: "⋀i. i < l1 + l2 ⟹ x ! i = y ! i"
proof- fix j assume A: "j < l1 + l2"
show "x ! j = y ! j"
apply(cases "j < i")
apply (smt "0" A append_take_drop_id assms(1) assms(2) assms(3) length_append length_permute_list length_take less_le_trans min.absorb2 nth_append permute_list_nth splitting_permutation_case_1_exists splitting_permutation_permutes x_def y_def)
apply(cases "i ≤ j ∧ j < l1")
apply (smt "0" A add.left_commute append_take_drop_id assms(1) assms(2) assms(3) le_add_diff_inverse length_append length_permute_list length_take min.absorb2 nth_append nth_append_length_plus permute_list_nth splitting_permutation_def splitting_permutation_permutes x_def y_def)
using x_def y_def assms
by (smt "0" A add.commute add_diff_cancel_left' add_diff_inverse_nat length_append length_permute_list length_take less_diff_conv min.absorb2 not_le nth_append permute_list_nth splitting_permutation_case_1_unique splitting_permutation_def splitting_permutation_permutes)
qed
have 2: "length x = l1 + l2"
by (simp add: x_def assms(2) assms(3))
have 3: "x = y"
using 0 1 2
by (metis nth_equalityI)
then show ?thesis
using x_def y_def
by blast
qed
definition scp_permutation where
"scp_permutation l1 l2 i = fun_inv (splitting_permutation l1 l2 i)"
lemma scp_permutation_action:
assumes "i ≤l1"
assumes "length a1 = l1"
assumes "length a2 = l2"
shows "permute_list (scp_permutation l1 l2 i) (a1@a2) = ((take i a1) @ a2 @ (drop i a1))"
proof-
have "(scp_permutation l1 l2 i) ∘ (splitting_permutation l1 l2 i) = id"
by (metis assms(1) fun_inv_def permutes_inv_o(2) scp_permutation_def splitting_permutation_permutes)
then have "permute_list ((scp_permutation l1 l2 i) ∘ (splitting_permutation l1 l2 i) ) ((take i a1) @ a2 @ (drop i a1)) =
((take i a1) @ a2 @ (drop i a1))"
by (metis permute_list_id)
then show ?thesis using splitting_permutation_action permute_list_compose
by (smt ‹scp_permutation l1 l2 i ∘ splitting_permutation l1 l2 i = id› assms(1)
assms(2) assms(3) fun_inv_def length_append length_permute_list permutes_inv permutes_inv_o(1) scp_permutation_def splitting_permutation_permutes)
qed
lemma scp_permutes:
assumes "i ≤l1"
shows "(scp_permutation l1 l2 i) permutes {..<l1 + l2}"
by (simp add: assms(1) fun_inv_def permutes_inv scp_permutation_def splitting_permutation_permutes)
definition split_cartesian_product where
"split_cartesian_product l1 l2 i A B = permute_list (scp_permutation l1 l2 i) ` (cartesian_product A B)"
lemma split_cartesian_product_memI:
assumes "a1@a2 ∈ A"
assumes "b ∈ B"
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "length a1 = i"
shows "a1@b@a2 ∈ split_cartesian_product l1 l2 i A B"
proof-
have P: "a1@a2@b ∈ cartesian_product A B"
by (metis append.assoc assms(1) assms(2) assms(3) assms(4) cartesian_product_memI')
have 0: "i ≤ l1"
using assms
by (metis cartesian_power_car_memE le_add1 length_append subset_iff)
have 1: "length (a1@a2) = l1"
using assms(1) assms(3) cartesian_power_car_memE
by blast
have 2: "length b = l2"
using assms(2) assms(4) cartesian_power_car_memE
by blast
have 3: "take i (a1 @ a2) = a1"
by (simp add: assms(5))
have 4: "drop i (a1 @ a2) = a2"
by (simp add: assms(5))
have "permute_list (scp_permutation l1 l2 i) ((a1 @ a2) @ b) = take i (a1 @ a2) @ b @ drop i (a1 @ a2)"
using 0 1 2 scp_permutation_action[of i l1 "a1@a2" b l2]
by blast
then have "permute_list (scp_permutation l1 l2 i) ((a1@a2)@b) = a1@b@a2 "
by(simp only: 3 4)
then have "permute_list (scp_permutation l1 l2 i) (a1@a2@b) = a1@b@a2 "
by simp
then show ?thesis
using P unfolding split_cartesian_product_def
by (metis (mono_tags, lifting) image_eqI)
qed
lemma split_cartesian_product_memI':
assumes "a ∈ A"
assumes "b ∈ B"
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "i ≤ l1"
shows "(take i a)@b@(drop i a) ∈ split_cartesian_product l1 l2 i A B"
using assms split_cartesian_product_memI[of "take i a" "drop i a" A b B R l1 l2 i]
by (metis append_take_drop_id cartesian_power_car_memE length_take min.absorb2 subset_iff)
lemma split_cartesian_product_memE:
assumes "a ∈ split_cartesian_product l1 l2 i A B"
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "i ≤ l1"
shows "(take i a)@(drop (i + l2) a) ∈ A"
"(drop i (take (i + l2) a)) ∈ B"
proof-
obtain b where b_def: "b ∈ cartesian_product A B ∧ a = permute_list (scp_permutation l1 l2 i) b"
using assms split_cartesian_product_def
by (metis (mono_tags, lifting) image_iff)
then have 0: "(take l1 b) ∈ A ∧ (drop l1 b) ∈ B"
using assms(2) cartesian_product_memE(1)[of b A B R l1] cartesian_product_memE(2)[of b A B R l1]
by metis
have 1: "a = (take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))"
using "0" append_take_drop_id assms(2) assms(3) assms(4) b_def
cartesian_power_car_memE scp_permutation_action subsetD
by smt
have 2: "(take i a) = (take i (take l1 b))"
using 0 1
by (metis (no_types, lifting) append_eq_append_conv append_take_drop_id
assms(4) b_def length_permute_list length_take min.absorb1 take_take)
have "drop (i + l2) a = drop i (take l1 b)"
proof-
have "drop (i + l2) ( (take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))) = drop i (take l1 b)"
using assms
by (metis "0" "1" "2" add.commute append_eq_conv_conj append_take_drop_id
cartesian_power_car_memE drop_drop subsetD)
then show ?thesis
using 1
by blast
qed
then show "take i a @ drop (i + l2) a ∈ A"
by (metis "0" "2" append_take_drop_id)
have 3: "length b = l1 + l2 "
by (metis "0" append_take_drop_id assms(2) assms(3) cartesian_power_car_memE length_append subsetD)
then have "(drop i (take (i + l2) ((take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))))) = (drop l1 b)"
proof-
have 0: "take (i + l2) ((take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))) =
take (i + l2) ((take i b)@(drop l1 b)@(drop i (take l1 b)))"
using assms(4)
by (metis min.absorb1 take_take)
have 1: "length ((take i b)@(drop l1 b)) = i + l2"
using 3 assms
by (metis (no_types, opaque_lifting) add_diff_cancel_left' b_def length_append length_drop
length_permute_list length_take min.absorb2 trans_le_add1)
have 2: "take (i + l2) (((take i b)@(drop l1 b))@(drop i (take l1 b))) = (take i b)@(drop l1 b)"
using 1
by (metis append_eq_conv_conj)
have 3: "take (i + l2) ((take i b)@(drop l1 b)@(drop i (take l1 b))) = (take i b)@(drop l1 b)"
using 2
by (metis append.assoc)
have 4: "take (i + l2) ((take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))) = (take i b)@(drop l1 b)"
using "0" "3"
by presburger
then have 5: "(drop i (take (i + l2) ((take i (take l1 b))@(drop l1 b)@(drop i (take l1 b))))) =
drop i ((take i b)@(drop l1 b))"
by presburger
have "length (take i b) = i"
by (metis "1" append_take_drop_id assms(4) le_add1 length_take min.absorb2 min.bounded_iff nat_le_linear take_all)
then show ?thesis using 5
by (metis append_eq_conv_conj)
qed
then have "drop i (take (i + l2) a) = drop l1 b"
using 1 by blast
then show "(drop i (take (i + l2) a)) ∈ B"
using 0
by presburger
qed
lemma split_cartesian_product_mem_length:
assumes "a ∈ split_cartesian_product l1 l2 i A B"
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "i ≤ l1"
shows "length a = l1 + l2"
using assms unfolding split_cartesian_product_def
using cartesian_product_closed[of A R l1 B l2] scp_permutes[of i l1 l2]
by (smt cartesian_power_car_memE imageE in_mono length_permute_list scp_permutation_def)
lemma split_cartesian_product_memE':
assumes "a1@b@a2 ∈ split_cartesian_product l1 l2 i A B"
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "i ≤ l1"
assumes "length a1 = i"
assumes "length b = l2"
assumes "length as = (l1 - i)"
shows "a1@a2 ∈ A"
"b ∈ B"
using assms split_cartesian_product_memE(1)[of "a1@b@a2" l1 l2 i A B R]
apply (metis append.assoc append_eq_conv_conj length_append)
using assms split_cartesian_product_memE(2)[of "a1@b@a2" l1 l2 i A B R]
by (metis add_diff_cancel_left' append_eq_conv_conj drop_take)
lemma split_cartesian_product_closed:
assumes "A ⊆ carrier (R⇗l1⇖)"
assumes "B ⊆ carrier (R⇗l2⇖)"
assumes "i ≤ l1"
shows "split_cartesian_product l1 l2 i A B ⊆ carrier (R⇗l1 + l2⇖)"
proof fix x
assume A: "x ∈ split_cartesian_product l1 l2 i A B"
show "x ∈ carrier (R⇗l1 + l2⇖)"
apply(rule cartesian_power_car_memI)
apply (meson ‹x ∈ split_cartesian_product l1 l2 i A B› assms(1)
assms(2) assms(3) split_cartesian_product_mem_length)
using assms A unfolding split_cartesian_product_def
using cartesian_product_closed[of A R l1 B l2]
by (smt A cartesian_power_car_memE'' image_iff length_permute_list
scp_permutes set_permute_list split_cartesian_product_mem_length subsetD)
qed
text‹General function for permuting the elements of a simple cartesian product:›
definition intersperse :: "(nat ⇒ nat) ⇒ 'a tuple ⇒ 'a tuple ⇒ 'a tuple" where
"intersperse σ as bs = permute_list σ (as@bs) "
lemma intersperseE:
assumes "σ permutes ({..<n})"
assumes "length as + length bs = n"
shows "length (intersperse σ as bs) = n"
by (metis assms(2) intersperse_def length_append length_permute_list)
lemma intersperseE':
assumes "σ permutes ({..<n})"
assumes "length as + length bs = n"
assumes "length as = k"
assumes "σ i < k"
shows "(intersperse σ as bs)! i = as ! σ i"
proof-
have "permute_list σ (as @ bs) ! i = (as @ bs) ! σ i"
using assms permute_list_nth[of σ "(as@bs)" i]
unfolding intersperse_def
by (metis length_append lessThan_iff permutes_not_in trans_less_add1)
then show ?thesis using assms
by (metis intersperse_def nth_append)
qed
lemma intersperseE'':
assumes "σ permutes ({..<n})"
assumes "length as + length bs = n"
assumes "length as = k"
assumes "i < n"
assumes "σ i ≥ k"
shows "(intersperse σ as bs)! i = bs ! ((σ i) - k)"
proof-
have 0: "permute_list σ (as @ bs) ! i = (as @ bs) ! σ i"
using assms permute_list_nth[of σ "(as@bs)" i]
unfolding intersperse_def
proof -
have "(as @ bs) ! σ i = (as @ bs) ! σ ([0..<n] ! i)"
by (simp add: ‹i < n›)
then show ?thesis
by (metis (no_types) ‹i < n› ‹length as + length bs = n› diff_zero length_append
length_upt nth_map permute_list_def)
qed
have 1: "σ i < n"
using assms
by (meson lessThan_iff permutes_in_image)
have 2: "(σ i) - k < length bs"
using "1" assms(2) assms(3) assms(5) by linarith
have "(as @ bs) ! (σ i) = bs ! (σ i - length as)"
using assms 1 2 nth_append[of as bs "(σ i)"]
by (meson not_le)
then have 3: "(as @ bs) ! (σ i) = bs ! (σ i - k)"
using assms
by blast
have 4: "permute_list σ (as @ bs) ! i = (as @ bs) ! (σ i)"
using "0" by blast
show ?thesis using 4 3 unfolding intersperse_def
by auto
qed
text‹Some more lemmas about the project\_at\_indices function.›
lemma project_at_indices_consecutive_ind_length:
assumes "(i::nat) < j"
assumes "j ≤ n"
assumes "length a = n"
shows "length (project_at_indices {i..<j} a) = j - i"
using assms proj_at_index_list_length[of "{i..<j}" a]
unfolding indices_of_def
by (metis card_atLeastLessThan ivl_subset le_less_linear lessThan_atLeast0 not_less0)
lemma project_at_indices_consecutive_ind_length':
assumes "(i::nat) < j"
assumes "j ≤ n"
assumes "a ∈ carrier (R⇗n⇖)"
shows "length (project_at_indices {i..<j} a) = j - i"
using assms(1) assms(2) assms(3) cartesian_power_car_memE project_at_indices_consecutive_ind_length by blast
lemma sorted_list_of_set_from_up_to:
assumes "(i::nat) < j"
assumes "k < j - i"
shows "sorted_list_of_set {i..<j} ! k = i + k"
using assms apply(induction k)
apply simp by simp
lemma nth_elem_consecutive_indices:
assumes "(i::nat) < j"
assumes "k < j - i"
shows "nth_elem {i..<j} k = i + k"
using nth_elem.simps[of "{i..<j}" k] sorted_list_of_set_from_up_to assms(2)
by auto
lemma project_at_indices_consecutive_indices:
assumes "(i::nat) < j"
assumes "j ≤ n"
assumes "length a = n"
assumes "k < j - i"
shows "(project_at_indices {i..<j} a) ! k = a! (i + k)"
using assms nth_elem_consecutive_indices[of i j k]
by (metis atLeast0LessThan card_atLeastLessThan indices_of_def ivl_subset linorder_le_less_linear not_less0 project_at_indices_nth)
lemma project_at_indices_consecutive_indices':
assumes "(i::nat) < j"
assumes "j ≤ n"
assumes "a ∈ carrier (R⇗n⇖)"
assumes "k < j - i"
shows "(project_at_indices {i..<j} a) ! k = a! (i + k)"
using assms(1) assms(2) assms(3) assms(4) cartesian_power_car_memE project_at_indices_consecutive_indices by blast
lemma tl_as_projection:
assumes "a ∈ carrier (R⇗n⇖)"
shows "tl a = project_at_indices {1::nat..<n} a"
proof-
have 0: "indices_of a = {..<n}"
using assms cartesian_power_car_memE indices_of_def
by blast
have 1: "length (tl a) = n - 1"
using assms cartesian_power_car_memE length_tl
by blast
have 2: "length (tl a) = length (project_at_indices {1::nat..<n} a)"
using 0 assms cartesian_power_car_memE[of a R n] proj_at_index_list_length[of "{1::nat..<n}" a]
by (metis "1" atLeastLessThan_iff card_atLeastLessThan lessThan_iff subsetI)
have "⋀i. i < n - 1 ⟹ (tl a) ! i = (project_at_indices {1::nat..<n} a) ! i"
using project_at_indices_consecutive_indices'[of 1 n n a R] assms
by (metis "1" One_nat_def Suc_leI le_add_diff_inverse2 le_numeral_extra(4)
linorder_neqE_nat nat_add_left_cancel_le nat_diff_split_asm not_less0 nth_tl plus_1_eq_Suc)
then show ?thesis
by (metis "1" "2" nth_equalityI)
qed
subsection‹Function Rings on Cartesian Powers›
text‹Complement operator›
definition ring_pow_comp :: "('a, 'b) ring_scheme ⇒ arity ⇒ 'a tuple set ⇒ 'a tuple set" where
"ring_pow_comp R n S ≡ carrier (R⇗n⇖) - S"
lemma ring_pow_comp_closed:
"ring_pow_comp R n S ⊆ carrier (R⇗n⇖)"
by (simp add: ring_pow_comp_def)
lemma ring_pow_comp_disjoint:
"ring_pow_comp R n S ∩ S = {}"
by (simp add: ring_pow_comp_def inf_sup_aci(1))
lemma ring_pow_comp_union:
assumes "S ⊆ carrier (R⇗n⇖)"
shows "(ring_pow_comp R n S) ∪ S = carrier (R⇗n⇖)"
by (metis ring_pow_comp_def Un_Diff_cancel2 assms sup.absorb_iff1)
lemma ring_pow_comp_carrier:
"ring_pow_comp R n (carrier (R⇗n⇖)) = {}"
by (simp add: ring_pow_comp_def)
lemma ring_pow_comp_empty:
"ring_pow_comp R n {} = (carrier (R⇗n⇖)) "
by (simp add: ring_pow_comp_def)
lemma ring_pow_comp_demorgans:
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗n⇖)"
shows "ring_pow_comp R n (A ∪ B) = (ring_pow_comp R n A) ∩ (ring_pow_comp R n B)"
by (simp add: ring_pow_comp_def Diff_Un )
lemma ring_pow_comp_demorgans':
assumes "A ⊆ carrier (R⇗n⇖)"
assumes "B ⊆ carrier (R⇗n⇖)"
shows "ring_pow_comp R n (A ∩ B) = (ring_pow_comp R n A) ∪ (ring_pow_comp R n B)"
by (simp add: ring_pow_comp_def Diff_Int)
lemma ring_pow_comp_inv:
assumes "A ⊆ carrier (R⇗n⇖)"
shows "ring_pow_comp R n (ring_pow_comp R n A) = A"
by (simp add: ring_pow_comp_def assms double_diff)
text‹The function ring defined on the powers of a ring:›
abbreviation(input) ring_pow_function_ring ("Fun⇘_⇙ _") where
"ring_pow_function_ring n R ≡ function_ring (carrier (R⇗n⇖)) R"
text ‹
Partial function application. Given a function $f(x_1, \dots, x_{n+1})$, an index $i$ and a
point $a \in \text{carrier R}$ returns the function
$(x_1,..,x_n) \mapsto f(x_1, \dots, x_{i-1}, a, x_i, \dots, x_n)$ ›
lemma ring_pow_function_ring_car_memE:
assumes "f ∈ carrier (Fun⇘n⇙ R)"
shows "f ∈ extensional (carrier (R⇗n⇖))"
"f ∈ carrier (R⇗n⇖) → carrier R"
using ring_functions.function_ring_car_memE[of R f "carrier (R⇗n⇖)"] assms
unfolding ring_functions_def
using function_ring_def partial_object.select_convs(1) apply (metis PiE_iff)
using Int_iff assms PiE_iff function_ring_def partial_object.select_convs(1)
by (simp add: PiE_iff function_ring_def)
definition partial_eval :: "('a, 'b) ring_scheme ⇒ arity ⇒ nat ⇒ ('a list ⇒ 'a) ⇒ 'a ⇒ ('a list ⇒ 'a)" where
"partial_eval R m n f c = restrict (λ as. f (insert_at_index as c n)) (carrier (R⇗m⇖))"
context ring
begin
lemma function_ring_car_mem_closed:
assumes "f ∈ carrier (function_ring S R)"
assumes "s ∈ S"
shows "f s ∈ carrier R"
using assms unfolding function_ring_def ring_record_simps by blast
lemma function_ring_car_mem_closed':
assumes "f ∈ carrier (Fun⇘Suc k⇙ R)"
assumes "s ∈ carrier (R⇗Suc k⇖)"
shows "f s ∈ carrier R"
using assms unfolding function_ring_def ring_record_simps by blast
lemma(in ring) partial_eval_domain:
assumes "f ∈ carrier (Fun⇘Suc k⇙ R)"
assumes "a ∈ carrier R"
assumes "n ≤k"
shows "(partial_eval R k n f a) ∈ carrier (Fun⇘k⇙ R)"
apply(rule ring_functions.function_ring_car_memI)
proof-
show "⋀x. x ∈ carrier (R⇗k⇖) ⟹ (partial_eval R k n f a) x ∈ (carrier R)"
proof-
fix x
assume A: "x ∈ carrier (R⇗k⇖)"
show "(partial_eval R k n f a) x ∈ (carrier R)"
proof(cases "n = k")
case True
then have "(partial_eval R k n f a) x = f (insert_at_index x a n)"
by (metis (no_types, lifting) A restrict_apply' partial_eval_def)
then show "(partial_eval R k n f a) x ∈ carrier R"
using insert_at_index_closed[of x k R a n] assms ring_functions.function_ring_car_memE[of R]
unfolding ring_functions_def
by (smt A cartesian_power_car_memE funcset_carrier ring_pow_function_ring_car_memE(2))
next
case False
then have F0: "(partial_eval R k n f a) x = f (insert_at_index x a n)"
unfolding partial_eval_def
using assms
by (meson A restrict_apply')
have F1: "(insert_at_index x a n) ∈ carrier (R⇗Suc k⇖)"
using A assms insert_at_index_closed[of x k R a n] cartesian_power_car_memE
by blast
show "(partial_eval R k n f a) x ∈ carrier R"
unfolding F0 apply(rule function_ring_car_mem_closed[of f "carrier (R⇗Suc k⇖)"])
apply (simp add: assms(1))
by(rule F1)
qed
qed
show "⋀x. x ∉ carrier (R⇗k⇖) ⟹ (partial_eval R k n f a) x = undefined"
proof-
fix x
assume "x ∉ carrier (R⇗k⇖)"
show "(partial_eval R k n f a) x = undefined"
unfolding partial_eval_def
by (meson ‹x ∉ carrier (R⇗k⇖)› restrict_apply)
qed
show "ring_functions R"
unfolding ring_functions_def
by (simp add: ring_axioms)
qed
text‹Pullbacks preserve ring power functions›
lemma fun_struct_maps:
"struct_maps (R⇗n⇖) R = carrier (Fun⇘n⇙ R)"
proof
show "struct_maps (R⇗n⇖) R ⊆ carrier Fun⇘n⇙ R"
by (smt function_ring_car_memI struct_maps_memE(1) struct_maps_memE(2) subsetI)
show "carrier (Fun⇘n⇙ R) ⊆ struct_maps (R⇗n⇖) R"
using struct_maps_memI ring_functions.function_ring_car_memE
by (smt function_ring_car_mem_closed ring_axioms ring_functions.function_ring_not_car ring_functions.intro subsetI)
qed
lemma pullback_fun_closed:
assumes "f ∈ struct_maps (R⇗n⇖) (R⇗m⇖)"
assumes "g ∈ carrier (Fun⇘m⇙ R)"
shows "pullback (R⇗n⇖) f g ∈ carrier (Fun⇘n⇙ R)"
using assms(1) assms(2) fun_struct_maps pullback_closed by blast
end
text‹Includes $R^{|S|}$ into $R^n$ by pulling back along the projection $R^n \mapsto R^{|S|}$ at indices $S$ ›
context ring
begin
definition(in ring) ring_pow_inc :: " (nat set) ⇒ arity ⇒ ('a tuple ⇒ 'a) => ('a tuple ⇒ 'a) " where
"ring_pow_inc S n f = pullback (R⇗n⇖) (π⇘n,S⇙) f"
lemma ring_pow_inc_is_fun:
assumes "S ⊆ {..<n}"
assumes "f ∈ carrier (Fun⇘card S⇙ R)"
shows "ring_pow_inc S n f ∈ carrier (Fun⇘n⇙ R)"
by (metis assms(1) assms(2) ring_pow_proj_is_map pullback_fun_closed ring_pow_inc_def)
text‹The "standard" inclusion of powers of function rings into one another›
abbreviation(input) std_proj:: "nat ⇒ nat ⇒ ('a list) ⇒ ('a list)" where
"std_proj n m ≡ ring_pow_proj n ({..<m}) "
lemma std_proj_id:
assumes "m ≤ n"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "i < m"
shows "std_proj n m as ! i = as ! i"
proof-
have "{..<m} ⊆ indices_of as"
using assms cartesian_power_car_memE unfolding indices_of_def
by blast
thus ?thesis
unfolding ring_pow_proj_def
using assms nth_elem_upto[of i m]
project_at_indices_nth[of "{..<m}" as i]
by (metis card_lessThan restrict_apply)
qed
abbreviation(input) std_inc:: "nat ⇒ nat ⇒ ('a list ⇒ 'a) => ('a list ⇒ 'a)" where
"std_inc n m f ≡ ring_pow_inc ({..<m}) n f"
lemma std_proj_is_map[simp]:
assumes "m ≤ n"
shows "std_proj n m ∈ struct_maps (R⇗n⇖) (R⇗m⇖)"
by (metis assms card_lessThan lessThan_subset_iff ring_pow_proj_is_map)
end
subsection‹Coordinate Functions›
definition var :: "('a, 'b) ring_scheme ⇒ nat ⇒ nat ⇒ ('a list ⇒ 'a)" where
"var R n i = restrict (λx. x!i) (carrier (R⇗n⇖))"
context ring
begin
lemma var_in_car:
assumes "i < n"
shows "var R n i ∈ carrier (Fun⇘n⇙ R)"
apply(rule function_ring_car_memI)
unfolding var_def
apply (metis assms cartesian_power_car_memE' restrict_apply')
by (meson restrict_apply)
lemma varE[simp]:
assumes "i < n"
assumes "x ∈ carrier (R⇗n⇖)"
shows "var R n i x = x ! i"
unfolding var_def
using assms(2)
by (meson restrict_apply')
lemma std_inc_of_var:
assumes "i < n"
assumes "n ≤m"
shows "std_inc m n (var R n i) = (var R m i)"
apply(rule ext)
proof-
fix x
show "std_inc m n (var R n i) x = var R m i x"
apply(cases "x ∈ carrier (R⇗m⇖ )")
proof-
show "x ∈ carrier (R⇗m⇖) ⟹ std_inc m n (var R n i) x = var R m i x"
proof-
assume A: "x ∈ carrier (R⇗m⇖)"
have "(restrict (project_at_indices ({..<n})) (carrier (R⇗m⇖))) x = ((project_at_indices ({..<n})) x)"
by (meson A restrict_apply')
then have B: "std_inc m n (var R n i) x = (var R n i) ((project_at_indices ({..<n})) x)"
unfolding ring_pow_inc_def ring_pow_proj_def pullback_def
by (metis A compose_eq)
have C: "var R m i x = x ! i"
by (metis A assms(1) assms(2) le_iff_add trans_less_add1 varE)
show "std_inc m n (var R n i) x = var R m i x"
by (metis A B C assms(1) assms(2) project_at_indices_ring_pow_proj std_proj_id std_proj_is_map struct_maps_memE(1) varE)
qed
show "x ∉ carrier (R⇗m⇖) ⟹ std_inc m n (var R n i) x = var R m i x"
by (metis (mono_tags, lifting) assms(1) assms(2) card_lessThan lessThan_subset_iff less_SucI ring_axioms nat_induct_at_least ring.fun_struct_maps ring_pow_inc_is_fun struct_maps_memE(2) var_in_car)
qed
qed
abbreviation variable ("𝔳⇘_⇙") where
"variable n i ≡ var R n i"
end
definition var_set :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a list ⇒ 'a) set" where
"var_set R n = var R n ` {..<n}"
lemma var_setE:
assumes "f ∈ var_set R n"
obtains i where "f = var R n i ∧ i ∈ {..<n}"
by (metis assms imageE that var_set_def)
lemma var_setI:
assumes "i ∈ {..<n}"
assumes "f = var R n i"
shows "f ∈ var_set R n"
using assms(1) assms(2) var_set_def
by blast
context ring
begin
lemma var_set_in_fun_ring_car:
shows "var_set R n ⊆ carrier Fun⇘n⇙ R"
proof
fix x
assume "x ∈ var_set R n"
then obtain i where i_def: "i ∈ {..<n} ∧ x = var R n i"
unfolding var_set_def
by blast
have "i < n"using i_def
using atLeastLessThan_iff by blast
then show "x ∈ carrier Fun⇘n⇙ R"
using i_def var_in_car by blast
qed
end
subsection‹Graphs of functions›
definition fun_graph:: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a list ⇒ 'a) ⇒ 'a list set" where
"fun_graph R n f = {as. (∃x ∈ carrier (R⇗n⇖). as = x @ [f x])}"
context ring
begin
lemma function_ring_car_memE:
assumes "f ∈ carrier (Fun⇘n⇙ R)"
assumes "a ∈ carrier (R⇗n⇖)"
shows "f a ∈ carrier R"
using ring_functions.function_ring_car_memE(1)[of R f]
unfolding ring_functions_def
by (meson assms(1) assms(2) ring_axioms function_ring_car_mem_closed ring_functions_def)
lemma graph_range:
assumes "f ∈ carrier (Fun⇘n⇙ R)"
shows "fun_graph R n f ⊆ carrier (R⇗Suc n⇖ )"
proof
fix x
assume x_def: "x ∈ fun_graph R n f"
obtain a where a_def: "a ∈ carrier (R⇗n⇖) ∧ x = a@[f a]"
using x_def fun_graph_def
by (smt mem_Collect_eq)
have f_closed: "f a ∈ carrier R"
using assms function_ring_car_memE a_def
by blast
show "x ∈ carrier (R⇗Suc n⇖ )"
proof(rule cartesian_power_car_memI)
show "length x = Suc n"
using x_def a_def cartesian_power_car_memE[of a R n]
by (metis length_append_singleton)
have "set x = insert (f a) (set a)"
using a_def
by (metis Un_insert_right append_Nil2 list.simps(15) set_append)
thus "set x ⊆ carrier R"
using a_def
by (metis cartesian_power_car_memE'' f_closed insert_subset)
qed
qed
lemma fun_graph_memE:
assumes "f ∈ carrier (Fun⇘n⇙ R)"
assumes "p ∈ fun_graph R n f"
shows "(take n p) ∈ carrier (R⇗n⇖)"
using assms unfolding fun_graph_def
by (metis (no_types, lifting) assms(2) graph_range le_add2 plus_1_eq_Suc subsetD take_closed)
lemma fun_graph_memE':
assumes "f ∈ carrier (Fun⇘n⇙ R)"
assumes "p ∈ fun_graph R n f"
shows "f (take n p) = p!n"
using assms
unfolding fun_graph_def
by (smt Cons_nth_drop_Suc append_take_drop_id assms(2) butlast_snoc cartesian_power_car_memE
drop_all graph_range last_snoc le_Suc_eq lessI mem_Collect_eq subsetD)
text‹
apply a function f to the tuple consisting of the first n indices, leaving the remaining indices
unchanged
›
definition partial_image :: "arity ⇒ ('c list ⇒ 'c) ⇒ 'c list ⇒ 'c list" where
"partial_image n f as = (f (take n as)) # (drop n as) "
lemma partial_image_range:
assumes "f ∈ carrier (Fun⇘n⇙ R)"
assumes "m ≥ n"
assumes "as ∈ carrier (R⇗m⇖)"
shows "partial_image n f as ∈ carrier (R⇗m - n + 1⇖)"
proof(cases "m = n")
case True
then have "f (take n as) = f as"
by (metis assms(2) assms(3) cartesian_power_car_memE take_all)
then have 0: "f (take n as) ∈ carrier R"
using True assms(1) assms(3) function_ring_car_memE by presburger
have 1: "(drop n as) = []"
using True assms(3) cartesian_power_car_memE drop_all by blast
then show ?thesis
unfolding partial_image_def
using 0 1
by (metis (no_types, lifting) One_nat_def assms(3) cartesian_power_car_memE
cartesian_power_car_memI empty_iff insert_iff length_drop list.set(1)
list.set(2) list.size(4) subsetI)
next
case False
then have 0: "(drop n as) ∈ carrier (R⇗m - n⇖)"
using assms drop_closed[of n m as R] le_neq_implies_less
by blast
have 1: "f (take n as) ∈ carrier R"
using assms(1) assms(2) assms(3) function_ring_car_memE take_closed by blast
show ?thesis
apply(rule cartesian_power_car_memI)
apply (metis "0" One_nat_def cartesian_power_car_memE list.size(4) partial_image_def)
by (smt "1" assms(3) cartesian_power_car_memE cartesian_power_car_memE' in_set_conv_nth
partial_image_def set_ConsD set_drop_subset subsetD subsetI)
qed
end
section‹Coordinate Rings on Cartesian Powers›
subsection‹Basic Facts and Definitions›
locale cring_coord_rings = UP_cring +
assumes one_neq_zero: "𝟭 ≠ 𝟬"
text‹coordinate polynomial ring in n variables over a commutative ring›
definition coord_ring :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a, ('a, nat) mvar_poly) module"
("_ [𝒳⇘_⇙]" 80) where "R[𝒳⇘n⇙] ≡ Pring R {..< n::nat}"
sublocale cring_coord_rings < cring_functions R "carrier (R⇗n⇖)" "Fun⇘n⇙ R"
unfolding cring_functions_def ring_functions_def
apply (simp add: R.ring_axioms R_cring)
by simp
sublocale cring_coord_rings < MP?: cring "R[𝒳⇘n⇙]"
by (simp add: R.Pring_is_cring R_cring coord_ring_def)
sublocale cring_coord_rings < F?: cring "Fun⇘n⇙ R"
by (simp add: function_ring_is_cring)
context cring_coord_rings
begin
lemma coord_cring_cring:
"cring (R[𝒳⇘n⇙])" unfolding coord_ring_def
by (simp add: R.Pring_is_cring R_cring)
text‹coordinate constant functions›
abbreviation(input) coord_const :: "'a ⇒ ('a, nat) mvar_poly" where
"coord_const k ≡ ring.indexed_const R k"
lemma coord_const_ring_hom:
"ring_hom_ring R (R[𝒳⇘n⇙]) coord_const"
unfolding coord_ring_def
apply(rule ring_hom_ringI)
apply (simp add: R.ring_axioms)
apply (simp add: R.Pring_is_ring)
apply (simp add: R.indexed_const_closed)
apply (simp add: R.indexed_const_mult)
apply (simp add: R.Pring_add R.indexed_padd_const)
by (simp add: R.Pring_one)
text‹coordinate functions›
lemma pvar_closed:
assumes "i < n"
shows "pvar R i ∈ carrier (R[𝒳⇘n⇙])"
unfolding var_to_IP_def
proof-
have "set_mset {#i#} ⊆ {..<n}"
using assms
by simp
then show "mset_to_IP R {#i#} ∈ carrier (R[𝒳⇘n⇙])"
by (simp add: R.ring_axioms coord_ring_def R.Pring_car ring.mset_to_IP_closed)
qed
text‹relationship between multiplciation by a variable and index multiplcation›
lemma pvar_indexed_pmult:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "(p ⨂ i) = p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i"
proof-
have "p ∈ Pring_set R {..<(n::nat)} "
using R.Pring_car assms
by (metis coord_ring_def)
then have "p ∈ Pring_set R (UNIV::nat set)"
using R.Pring_set_restrict
by blast
then show ?thesis
using assms R.poly_index_mult[of p UNIV i] unfolding var_to_IP_def
by (metis R.Pring_mult UNIV_I coord_ring_def)
qed
lemma coord_ring_cfs_closed:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "p m ∈ carrier R"
using assms unfolding coord_ring_def
using R.Pring_carrier_coeff' by blast
lemma coord_ring_plus:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "(p ⊕⇘R[𝒳⇘n⇙]⇙ Q) m = p m ⊕ Q m"
using assms unfolding coord_ring_def
by (metis R.Pring_add R.indexed_padd_def)
lemma coord_ring_uminus:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "(⊖⇘R[𝒳⇘n⇙]⇙ p) m = ⊖ (p m)"
using assms unfolding coord_ring_def
using MP.add.inv_closed MP.minus_minus coord_ring_cfs_closed coord_ring_def
coord_ring_plus is_abelian_group R.is_cring
R.ring_axioms
by (metis P_ring_uminus_def R.Pring_a_inv assms)
lemma coord_ring_minus:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "(p ⊖⇘R[𝒳⇘n⇙]⇙ Q) m = p m ⊖ Q m"
using assms R.Pring_add[of _ p Q] coord_ring_cfs_closed
unfolding indexed_padd_def coord_ring_def a_minus_def
by (metis (no_types, lifting) MP.add.inv_closed coord_ring_def coord_ring_plus
cring_coord_rings.coord_ring_uminus cring_coord_rings_axioms)
lemma coord_ring_one:
"𝟭⇘R[𝒳⇘n⇙]⇙ m = (if m = {#} then 𝟭 else 𝟬)"
by (metis R.Pring_one coord_ring_def R.indexed_const_def)
lemma coord_ring_zero:
"𝟬⇘R[𝒳⇘n⇙]⇙ m = 𝟬"
by (metis MP.minus_zero MP.r_zero MP.zero_closed R_cring coord_ring_cfs_closed coord_ring_plus coord_ring_uminus cring.cring_simprules(17))
text‹Evaluation of a polynomial at a point›
end
abbreviation(input) point_to_eval_map where
"point_to_eval_map R as ≡ (λi. (if i< length as then as ! i else 𝟬⇘R⇙))"
definition eval_at_point :: "('a, 'b) ring_scheme ⇒ 'a list ⇒ ('a, nat) mvar_poly ⇒ 'a" where
"eval_at_point R as p ≡ total_eval R (λi. (if i< length as then as ! i else 𝟬⇘R⇙)) p"
lemma(in cring_coord_rings) eval_at_point_factored:
"eval_at_point R as p = total_eval R (point_to_eval_map R as) p"
using eval_at_point_def by blast
subsection‹Total Evaluation of a Polynomial›
abbreviation(input) eval_at_poly where
"eval_at_poly R p as ≡ eval_at_point R as p"
text‹evaluation of coordinate polynomials›
context cring_coord_rings
begin
lemma eval_at_point_closed:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "eval_at_point R a p ∈ carrier R"
proof-
have 0: "R.indexed_pset ({..<n}- UNIV) (carrier R) ⊆ carrier (R[𝒳⇘n⇙])"
unfolding coord_ring_def
by (simp add: R.Pring_car R.Pring_carrier_subset)
have 1 : "poly_eval R UNIV (λi. if i < length a then a ! i else 𝟬) p ∈ R.indexed_pset ({..<n}- UNIV) (carrier R)"
by (smt R.Pring_car R.closed_funI R.poly_eval_closed R.zero_closed assms(1) assms(2) cartesian_power_car_memE cartesian_power_car_memE' coord_ring_def)
hence 2: "poly_eval R UNIV (λi. if i < length a then a ! i else 𝟬) p ∈carrier (R[𝒳⇘n⇙])"
using 0 by blast
show ?thesis
unfolding eval_at_point_def total_eval_def eval_in_ring_def
using 1 R.Pring_car R.Pring_cfs_closed cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def R.zero_closed
by blast
qed
lemma eval_pvar:
assumes "i < (n::nat)"
assumes "a ∈ carrier (R⇗n⇖)"
shows "eval_at_point R a (pvar R i) = a!i"
unfolding eval_at_point_def
proof-
have "pvar R i = 𝟭⇘R[𝒳⇘n⇙]⇙ ⨂ i"
unfolding var_to_IP_def
by (metis R.Pring_one coord_ring_def R.monom_add_mset R.one_mset_to_IP)
then show "total_eval R (λi. if i < length a then a ! i else 𝟬) (pvar R i) = a ! i"
using assms R.total_eval_var[of "(λi. (if i< length a then a ! i else 𝟬⇘R⇙))" i ]
by (smt cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI var_to_IP_def R.zero_closed)
qed
lemma eval_at_point_const:
assumes "k ∈ carrier R"
assumes "a ∈ carrier (R⇗n⇖)"
shows "eval_at_point R a (R.indexed_const k) = k"
unfolding eval_at_point_def
using assms(1) R.total_eval_const by blast
lemma eval_at_point_add:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (coord_ring R n)"
shows "eval_at_point R a (A ⊕⇘coord_ring R n⇙ B) =
eval_at_point R a A ⊕⇘R⇙ eval_at_point R a B"
unfolding eval_at_point_def
using R.total_eval_add[of A "{..<n}" B]
by (smt assms(1) assms(2) assms(3) cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def R.zero_closed)
lemma eval_at_point_mult:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier ((R[𝒳⇘n⇙]))"
shows "eval_at_point R a (A ⊗⇘R[𝒳⇘n⇙]⇙ B) =
eval_at_point R a A ⊗⇘R⇙ eval_at_point R a B"
unfolding eval_at_point_def
using R.total_eval_mult[of A "{..<n}" B]
by (smt assms(1) assms(2) assms(3) cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def R.zero_closed)
lemma eval_at_point_indexed_pmult:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "i < n"
shows "eval_at_point R a (A ⨂ i) =
eval_at_point R a A ⊗⇘R⇙ (a!i)"
proof-
have "(A ⨂ i) = A ⊗⇘R[𝒳⇘n⇙]⇙ (pvar R i)"
using assms(2) pvar_indexed_pmult by blast
then show ?thesis
using assms eval_at_point_mult eval_pvar pvar_closed
by presburger
qed
lemma eval_at_point_ring_hom:
assumes "a ∈ carrier (R⇗n⇖)"
shows "ring_hom_ring (coord_ring R I) R (eval_at_point R a)"
unfolding eval_at_point_def
using R.total_eval_ring_hom
by (smt assms cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def R.zero_closed)
lemma eval_at_point_scalar_mult:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "k ∈ carrier R"
shows "eval_at_point R a (poly_scalar_mult R k A) = k ⊗⇘R⇙ (eval_at_point R a A)"
using assms unfolding eval_at_point_def total_eval_def eval_in_ring_def
using R.poly_eval_scalar_mult[of k "(λi. if i < length a then a ! i else 𝟬)" A "{..<n}" UNIV]
poly_scalar_mult_def
by (smt R.Pring_car cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def R.zero_closed)
lemma eval_at_point_smult:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "k ∈ carrier R"
shows "eval_at_point R a (k ⊙⇘R[𝒳⇘n⇙]⇙ A) = k ⊗⇘R⇙ (eval_at_point R a A)"
by (metis R.Pring_smult assms(1) assms(2) assms(3) coord_ring_def eval_at_point_scalar_mult)
lemma eval_at_point_subtract:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (coord_ring R n)"
shows "eval_at_point R a (A ⊖⇘coord_ring R n⇙ B) =
eval_at_point R a A ⊖⇘R⇙ eval_at_point R a B"
using assms eval_at_point_add[of a n A "⊖⇘coord_ring R n⇙ B"]
abelian_group.a_inv_closed[of "R[𝒳⇘n⇙]" B]
unfolding a_minus_def
abelian_group.a_inv_closed abelian_group.minus_minus abelian_group.r_neg1 abelian_groupE(1) abelian_groupE(4) coord_cring_cring cring_def eval_at_point_add eval_at_point_closed is_abelian_group ring_def
by (smt MP.add.inv_closed MP.l_neg MP.r_zero MP.zero_closed R.add.inv_closed R.add.m_assoc R.l_neg R.r_zero R.zero_closed eval_at_point_add eval_at_point_closed)
lemma eval_at_point_a_inv:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "B ∈ carrier (coord_ring R n)"
shows "eval_at_point R a (⊖⇘R[𝒳⇘n⇙]⇙ B) = ⊖⇘R⇙ eval_at_point R a B"
using assms eval_at_point_subtract[of a n "𝟬⇘R[𝒳⇘n⇙]⇙" B]
by (smt MP.add.inv_eq_1_iff MP.l_zero MP.minus_add MP.zero_closed R.is_abelian_group R.r_neg R.r_neg2 a_minus_def abelian_group.a_inv_closed abelian_groupE(4) eval_at_point_add eval_at_point_closed)
lemma eval_at_point_nat_pow:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
shows "eval_at_point R a (A[^]⇘R[𝒳⇘n⇙]⇙(k::nat)) = (eval_at_point R a A)[^]k"
apply(induction k)
apply (metis Group.nat_pow_0 R.Pring_one assms(1) coord_ring_def eval_at_point_const R.one_closed)
proof- fix k::nat assume IH: "eval_at_poly R (A [^]⇘R[𝒳⇘n⇙]⇙ k) a = eval_at_poly R A a [^] k"
have "A [^]⇘R[𝒳⇘n⇙]⇙ Suc k = A [^]⇘R[𝒳⇘n⇙]⇙ k ⊗⇘(R[𝒳⇘n⇙])⇙ A"
using MP.nat_pow_Suc by blast
then have "eval_at_poly R (A [^]⇘R[𝒳⇘n⇙]⇙ Suc k) a =
eval_at_poly R (A [^]⇘R[𝒳⇘n⇙]⇙ k) a ⊗ eval_at_poly R A a"
using monoid.nat_pow_closed[of "(R[𝒳⇘n⇙])" A k] eval_at_point_mult[of a n "A [^]⇘R[𝒳⇘n⇙]⇙ k" A] assms
by (metis R.Pring_is_monoid coord_ring_def)
then show " eval_at_poly R (A [^]⇘R[𝒳⇘n⇙]⇙ Suc k) a = eval_at_poly R A a [^] Suc k"
using IH R.nat_pow_Suc
by auto
qed
end
subsection‹Partial Evaluation of a Polynomial›
definition coord_partial_eval ::
"('a, 'b) ring_scheme ⇒ nat set ⇒ 'a list ⇒ ('a, nat) mvar_poly ⇒ ('a, nat) mvar_poly" where
"coord_partial_eval R S as = poly_eval R S (point_to_eval_map R as)"
context cring_coord_rings
begin
lemma point_to_eval_map_closed:
assumes "as ∈ carrier (R⇗n⇖)"
shows "closed_fun R (point_to_eval_map R as)"
using assms
by (smt cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI R.zero_closed)
lemma coord_partial_eval_hom:
assumes "as ∈ carrier (R⇗n⇖)"
shows "coord_partial_eval R S as ∈ ring_hom (R[𝒳⇘n⇙]) (R[𝒳⇘n⇙])"
unfolding coord_partial_eval_def
using point_to_eval_map_closed[of as n] assms
R.poly_eval_ring_hom[of "{..<n}" "{..<n}" "point_to_eval_map R as" S]
by (metis (mono_tags, lifting) Diff_subset coord_ring_def order_refl ring_hom_ring.homh)
lemma coord_partial_eval_hom':
assumes "as ∈ carrier (R⇗n⇖)"
shows "coord_partial_eval R S as ∈ ring_hom (R[𝒳⇘n⇙]) (Pring R ({..<n} - S))"
unfolding coord_partial_eval_def
using point_to_eval_map_closed[of as n] assms
R.poly_eval_ring_hom[of "{..<n} - S" "{..<n}" "point_to_eval_map R as" S]
by (metis (no_types, lifting) Diff_subset coord_ring_def order_refl ring_hom_ring.homh)
lemma coord_partial_eval_closed:
assumes "S ⊆ {..<n}"
assumes "{..<n} - S ⊆ I"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "coord_partial_eval R S as p ∈ carrier (Pring R I)"
unfolding coord_partial_eval_def
using R.poly_eval_closed[of "point_to_eval_map R as" p "{..<n}" S ] R.Pring_car[of I] R.Pring_carrier_subset
by (smt R.Pring_car assms(2) assms(3) assms(4) cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI coord_ring_def subsetD R.zero_closed)
lemma coord_partial_eval_add:
assumes "as ∈ carrier (R⇗n⇖)"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "coord_partial_eval R S as (p ⊕⇘(R[𝒳⇘n⇙])⇙ Q) =
(coord_partial_eval R S as p) ⊕⇘(R[𝒳⇘n⇙])⇙ (coord_partial_eval R S as Q)"
using assms R.poly_eval_add[of p "{..<n}" Q "(point_to_eval_map R as)" S] Pring_def[of R "{..<n}"]
point_to_eval_map_closed[of as n]
unfolding coord_partial_eval_def
by (metis R.Pring_add R.Pring_car coord_ring_def)
lemma coord_partial_eval_mult:
assumes "as ∈ carrier (R⇗n⇖)"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "coord_partial_eval R S as (p ⊗⇘(R[𝒳⇘n⇙])⇙ Q) =
(coord_partial_eval R S as p) ⊗⇘(R[𝒳⇘n⇙])⇙ (coord_partial_eval R S as Q)"
using assms R.poly_eval_mult[of p "{..<n}" Q "(point_to_eval_map R as)" S] Pring_def[of R "{..<n}"]
point_to_eval_map_closed[of as n]
unfolding coord_partial_eval_def
by (metis R.Pring_car R.Pring_mult coord_ring_def)
lemma coord_partial_eval_pvar:
assumes "𝟭 ≠ 𝟬"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "i ∈ S ∩ {..<n}"
shows "coord_partial_eval R S as (pvar R i) = coord_const (as!i)"
proof-
have 0: "i ∈ S" using assms
by blast
have "i < length as"
by (metis IntD2 assms(2) assms(3) cartesian_power_car_memE lessThan_iff)
then have "(point_to_eval_map R as i) = as!i"
by presburger
then show ?thesis
unfolding coord_partial_eval_def var_to_IP_def
using 0 assms point_to_eval_map_closed[of as n]
R.poly_eval_index[of "point_to_eval_map R as" S i ]
by presburger
qed
lemma coord_partial_eval_pvar':
assumes "𝟭 ≠ 𝟬"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "i ∉ S"
shows "coord_partial_eval R S as (pvar R i) = (pvar R i)"
unfolding coord_partial_eval_def
using R.poly_eval_index[of "point_to_eval_map R as" S i ]
by (smt assms(1) assms(2) assms(3) cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI var_to_IP_def R.zero_closed)
subsection‹An induction rule for coordinate rings›
lemma coord_ring_induct:
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "⋀a. a ∈ carrier R ⟹ p (coord_const a)"
assumes "⋀i Q. Q ∈ carrier (R[𝒳⇘n⇙]) ⟹ p Q ⟹ i < n ⟹ p (Q ⊗⇘R[𝒳⇘n⇙]⇙pvar R i)"
assumes "⋀Q0 Q1. Q0 ∈ carrier (R[𝒳⇘n⇙]) ⟹ Q1 ∈ carrier (R[𝒳⇘n⇙]) ⟹ p Q0 ⟹ p Q1 ⟹ p (Q0 ⊕⇘R[𝒳⇘n⇙]⇙ Q1)"
shows "p A"
apply(rule R.indexed_pset.induct[of A "{..<n}" "carrier R"])
using R.Pring_car assms(1)
apply (metis coord_ring_def)
using assms(2) apply blast
apply (metis (full_types) R.Pring_add R.Pring_car assms(4) coord_ring_def)
proof-
fix a i
assume "a ∈ Pring_set R {..<n}"
then have 0: "a ∈ carrier (R[𝒳⇘n⇙])"
using R.Pring_car
by (simp add: ‹⋀I. carrier (Pring R I) = Pring_set R I› ‹a ∈ Pring_set R {..<n}› coord_ring_def)
assume 1: "p a"
assume "i ∈ {..< n}"
then have 2: "i < n"
using assms
by blast
have "p (a ⊗⇘R[𝒳⇘n⇙]⇙pvar R i)"
using "0" "1" "2" assms(3) by blast
then show "p (a ⨂ i)"
using "0" pvar_indexed_pmult
by presburger
qed
end
subsection‹Algebraic Sets in Cartesian Powers›
subsubsection‹The Zero Set of a Single Polynomial›
definition zero_set :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a, nat) mvar_poly ⇒ 'a list set"
("Vı") where
"zero_set R n p = {a ∈ carrier (R⇗n⇖). eval_at_point R a p =𝟬⇘R⇙}"
context cring_coord_rings
begin
lemma zero_setI:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "eval_at_point R a p =𝟬⇘R⇙"
shows "a ∈ zero_set R n p"
using assms
by (metis (mono_tags, lifting) mem_Collect_eq zero_set_def)
lemma zero_setE:
assumes "a ∈ zero_set R n p"
shows "a ∈ carrier (R⇗n⇖)"
"eval_at_point R a p =𝟬⇘R⇙"
using assms zero_set_def
apply blast
by (metis (mono_tags, lifting) assms mem_Collect_eq zero_set_def)
lemma zero_set_closed:
"zero_set R n p ⊆ carrier (R⇗n⇖)"
unfolding zero_set_def
by blast
end
subsubsection‹The Zero Set of a Collection of Polynomials›
definition affine_alg_set :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a, nat) mvar_poly set ⇒ 'a list set"
where "affine_alg_set R n as = {a ∈ carrier (R⇗n⇖). ∀ b ∈ as. a ∈ (zero_set R n b)}"
context cring_coord_rings
begin
lemma affine_alg_set_empty:
"affine_alg_set R n {} = carrier (R⇗n⇖)"
unfolding affine_alg_set_def by blast
lemma affine_alg_set_subset_zero_set:
assumes "b ∈ as"
shows " affine_alg_set R n as ⊆ (zero_set R n b)"
using assms affine_alg_set_def
by blast
lemma(in cring_coord_rings) affine_alg_set_memE:
assumes "b ∈ as"
assumes "a ∈ affine_alg_set R n as"
shows "eval_at_poly R b a = 𝟬"
using affine_alg_set_subset_zero_set zero_set_def assms(1) assms(2)
by blast
lemma affine_alg_set_subset:
assumes "as ⊆ bs"
shows " affine_alg_set R n bs ⊆ affine_alg_set R n as "
using assms affine_alg_set_def
by blast
lemma affine_alg_set_empty_set:
assumes "as = {}"
shows " affine_alg_set R n as = carrier (R⇗n⇖)"
unfolding affine_alg_set_def
using assms by blast
lemma affine_alg_set_closed:
shows "affine_alg_set R n as ⊆ carrier (R⇗n⇖)"
unfolding affine_alg_set_def
by blast
lemma affine_alg_set_singleton:
"affine_alg_set R n {a} = zero_set R n a"
unfolding affine_alg_set_def using zero_set_closed
by blast
lemma affine_alg_set_insert:
"affine_alg_set R n (insert a A) = zero_set R n a ∩ (affine_alg_set R n A)"
proof
show "affine_alg_set R n (insert a A) ⊆ V⇘R⇙ n a ∩ affine_alg_set R n A"
using affine_alg_set_subset
by (metis Int_greatest affine_alg_set_subset_zero_set insertI1 subset_insertI)
show "V⇘R⇙ n a ∩ affine_alg_set R n A ⊆ affine_alg_set R n (insert a A)"
unfolding affine_alg_set_def
by blast
qed
lemma affine_alg_set_intersect:
"affine_alg_set R n (A ∪ B) = (affine_alg_set R n A) ∩ (affine_alg_set R n B)"
unfolding affine_alg_set_def by blast
lemma affine_alg_set_memI:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "⋀p. p ∈ B ⟹ eval_at_point R a p = 𝟬"
shows "a ∈ (affine_alg_set R n B)"
unfolding affine_alg_set_def zero_set_def
using assms
by blast
lemma affine_alg_set_not_memE:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "a ∉ (affine_alg_set R n B)"
shows "∃b ∈ B. eval_at_poly R b a ≠ 𝟬"
using assms affine_alg_set_memI by blast
subsubsection‹Finite Unions and Intersections of Algebraic Sets are Algebraic›
text‹The product set of two sets in an arbitrary ring. That is, the set $\{ xy \mid x \in A \land y \in B \}$ for two sets $A$, $B$.›
definition(in ring) prod_set :: "'a set ⇒ 'a set ⇒ 'a set" where
"prod_set as bs = (λx. fst x ⊗ snd x) ` (as × bs)"
lemma(in ring) prod_setI:
assumes "c ∈ prod_set as bs"
shows "∃a ∈ as. ∃b ∈ bs. c = a ⊗ b"
proof-
obtain p where p_def: "p ∈ (as × bs) ∧ c = fst p ⊗ snd p"
using assms prod_set_def[of as bs]
by (metis (no_types, lifting) image_iff)
then show ?thesis
using mem_Times_iff by blast
qed
lemma(in ring) prod_set_closed:
assumes "as ⊆ carrier R"
assumes "bs ⊆ carrier R"
shows "prod_set as bs ⊆ carrier R"
proof
fix x
assume " x ∈ prod_set as bs"
then obtain a b where "a ∈ as ∧ b ∈ bs ∧ x = a ⊗ b"
by (meson ring_axioms ring.prod_setI)
then have "a ∈ carrier R ∧ b ∈ carrier R ∧ x = a ⊗ b"
using assms
by blast
then show "x ∈ carrier R"
by blast
qed
text‹The set of products of elements from two finite sets is again finite.›
lemma(in ring) prod_set_finite:
assumes "finite as"
assumes "finite bs"
shows "finite (prod_set as bs)" "card (prod_set as bs) ≤ card as * card bs"
proof-
have "finite (as × bs)"
using assms
by blast
then show "finite (prod_set as bs)"
using prod_set_def
by (metis (no_types, lifting) finite_imageI)
have "card (prod_set as bs) ≤ card (as × bs)"
using assms
unfolding prod_set_def
using ‹finite (as × bs)› card_image_le by blast
then show "card (prod_set as bs) ≤ card as * card bs"
by (simp add: card_cartesian_product)
qed
definition poly_prod_set where
"poly_prod_set n as bs = ring.prod_set (R[𝒳⇘n⇙]) as bs"
lemma poly_prod_setE:
assumes "c ∈ poly_prod_set n as bs"
shows "∃a ∈ as. ∃b ∈ bs. c = a ⊗⇘R[𝒳⇘n⇙]⇙ b"
using ring.prod_setI[of "R[𝒳⇘n⇙]"] R.Pring_is_ring assms poly_prod_set_def coord_cring_cring cring.axioms(1)
by blast
lemma poly_prod_setI:
assumes "a ∈ as"
assumes "b ∈ bs"
shows "a ⊗⇘R[𝒳⇘n⇙]⇙ b ∈ poly_prod_set n as bs"
proof-
have 0: "(a,b) ∈ (as × bs)"
using assms by blast
have 1: "(λx. fst x ⊗⇘R[𝒳⇘n⇙]⇙ snd x) (a, b) = a ⊗⇘R[𝒳⇘n⇙]⇙ b"
by (metis fst_conv snd_conv)
have 2: "(λx. fst x ⊗⇘R[𝒳⇘n⇙]⇙ snd x) (a, b) ∈ ((λx. fst x ⊗⇘R[𝒳⇘n⇙]⇙ snd x) ` (as × bs))"
using 0 by blast
have 3: "ring (R[𝒳⇘n⇙])"
by (simp add: R.Pring_is_ring coord_ring_def)
then show ?thesis
unfolding poly_prod_set_def using 0 1 2 3 ring.prod_set_def[of "R[𝒳⇘n⇙]" as bs]
by presburger
qed
lemma poly_prod_set_closed:
assumes "as ⊆ carrier (R[𝒳⇘n⇙])"
assumes "bs ⊆ carrier (R[𝒳⇘n⇙])"
shows "poly_prod_set n as bs ⊆ carrier (R[𝒳⇘n⇙])"
using ring.prod_set_closed[of "R[𝒳⇘n⇙]"] R.Pring_is_ring assms(1) assms(2) poly_prod_set_def
by (simp add: coord_cring_cring cring.axioms(1))
lemma poly_prod_set_finite:
assumes "finite as"
assumes "finite bs"
shows "finite (poly_prod_set n as bs)" "card (poly_prod_set n as bs) ≤ card as * card bs"
using ring.prod_set_finite[of "R[𝒳⇘n⇙]"]
apply (simp add: R.Pring_is_ring assms(1) assms(2) poly_prod_set_def)
using ring.prod_set_finite[of "R[𝒳⇘n⇙]"]
apply (simp add: assms(1) assms(2) coord_cring_cring cring.axioms(1))
by (simp add: assms(1) assms(2) coord_cring_cring cring.axioms(1) poly_prod_set_def ring.prod_set_finite(2))
end
locale domain_coord_rings = cring_coord_rings + domain
lemma(in domain_coord_rings) poly_prod_set_algebraic_set:
assumes "as ⊆ carrier (R[𝒳⇘n⇙])"
assumes "bs ⊆ carrier (R[𝒳⇘n⇙])"
shows "affine_alg_set R n as ∪ affine_alg_set R n bs = affine_alg_set R n (poly_prod_set n as bs)"
proof
show "affine_alg_set R n as ∪ affine_alg_set R n bs ⊆ affine_alg_set R n (poly_prod_set n as bs)"
proof fix x
assume A: "x ∈ affine_alg_set R n as ∪ affine_alg_set R n bs"
show "x ∈ affine_alg_set R n (poly_prod_set n as bs)"
proof(rule affine_alg_set_memI)
show "x ∈ carrier (R⇗n⇖)"
using A affine_alg_set_closed
by blast
show "⋀p. p ∈ poly_prod_set n as bs ⟹ eval_at_poly R p x = 𝟬"
proof- fix p
assume B: "p ∈ poly_prod_set n as bs"
show "eval_at_poly R p x = 𝟬"
proof-
obtain p0 p1 where C: "p0 ∈ as ∧ p1 ∈ bs ∧ p = p0 ⊗⇘R[𝒳⇘n⇙]⇙ p1"
using B poly_prod_setE by blast
then have D: "eval_at_poly R p x = (eval_at_poly R p0 x) ⊗ (eval_at_poly R p1 x)"
using ‹x ∈ carrier (R⇗n⇖)› assms(1) assms(2) eval_at_point_mult
by blast
show ?thesis proof(cases "x ∈ affine_alg_set R n as")
case True
then have "(eval_at_poly R p0 x) = 𝟬"
using C affine_alg_set_memE by blast
then show ?thesis
by (smt C D ‹x ∈ carrier (R⇗n⇖)› assms(2) eval_at_point_closed R.semiring_axioms semiring.l_null subsetD)
next
case False
then have "x ∈ affine_alg_set R n bs"
using A
by blast
then have "(eval_at_poly R p1 x) = 𝟬"
using C affine_alg_set_memE by blast
then show ?thesis
using C A False
by (smt D ‹x ∈ carrier (R⇗n⇖)› assms(1) eval_at_point_closed R.r_null subsetD)
qed
qed
qed
qed
qed
show "affine_alg_set R n (poly_prod_set n as bs) ⊆ affine_alg_set R n as ∪ affine_alg_set R n bs"
proof fix x
assume A: "x ∈ affine_alg_set R n (poly_prod_set n as bs)"
have x_car: "x ∈ carrier (R⇗n⇖)"
using A affine_alg_set_closed
by blast
show "x ∈ affine_alg_set R n as ∪ affine_alg_set R n bs"
proof(cases "x ∈ affine_alg_set R n as")
case True
then show ?thesis by blast
next
case False
have "x ∈ affine_alg_set R n bs"
proof(rule affine_alg_set_memI)
show "x ∈ carrier (R⇗n⇖)"
using A affine_alg_set_closed by blast
show "⋀p. p ∈ bs ⟹ eval_at_poly R p x = 𝟬"
proof-
fix p assume p_def: "p ∈ bs"
obtain a where a_def: "a ∈ as ∧ eval_at_poly R a x ≠ 𝟬"
using False affine_alg_set_not_memE ‹x ∈ carrier (R⇗n⇖)›
by blast
then have "a ⊗⇘R[𝒳⇘n⇙]⇙ p ∈ (poly_prod_set n as bs)"
using poly_prod_setI[of a as p bs] p_def
by blast
then have "eval_at_poly R (a ⊗⇘R[𝒳⇘n⇙]⇙ p) x = 𝟬"
using A affine_alg_set_memE
by blast
then have "eval_at_poly R a x ⊗ eval_at_poly R p x = 𝟬"
using eval_at_point_mult[of x n a p]
by (metis (no_types, lifting) ‹x ∈ carrier (R⇗n⇖)› a_def assms(1) assms(2) p_def subsetD)
then show "eval_at_poly R p x = 𝟬"
using a_def p_def
by (meson assms(1) assms(2) eval_at_point_closed integral_iff subsetD x_car)
qed
qed
then show ?thesis
by blast
qed
qed
qed
definition is_algebraic :: "('a, 'b) ring_scheme ⇒ nat ⇒ 'a list set ⇒ bool" where
"is_algebraic R n S = (∃ps. finite ps ∧ ps ⊆ carrier (R[𝒳⇘n⇙]) ∧ S = affine_alg_set R n ps)"
context cring_coord_rings
begin
lemma is_algebraicE:
assumes "is_algebraic R n S"
obtains ps where "finite ps" "ps ⊆ carrier (R[𝒳⇘n⇙])" "S = affine_alg_set R n ps"
using assms
by (meson is_algebraic_def)
lemma is_algebraicI:
assumes "finite ps"
assumes "ps ⊆ carrier (R[𝒳⇘n⇙])"
assumes "S = affine_alg_set R n ps"
shows "is_algebraic R n S"
using is_algebraic_def assms
by blast
lemma is_algebraicI':
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "S = zero_set R n p"
shows "is_algebraic R n S"
by (metis affine_alg_set_singleton assms(1) assms(2) empty_subsetI finite.emptyI finite.intros(2) insert_subset is_algebraic_def)
end
definition alg_sets :: "arity ⇒ ('a, 'b) ring_scheme ⇒ ('a list set) set" where
"alg_sets n R = {S. is_algebraic R n S}"
context cring_coord_rings
begin
lemma intersection_is_alg:
assumes "is_algebraic R n A"
assumes "is_algebraic R n B"
shows "is_algebraic R n (A ∩ B)"
proof-
obtain as where as_def: "finite as ∧ as ⊆ carrier (R[𝒳⇘n⇙]) ∧ A = affine_alg_set R n as"
by (meson assms(1) is_algebraicE)
obtain bs where bs_def: "finite bs ∧ bs ⊆ carrier (R[𝒳⇘n⇙]) ∧ B = affine_alg_set R n bs"
by (meson assms(2) is_algebraicE)
show ?thesis apply(rule is_algebraicI[of "as ∪ bs"])
using as_def bs_def apply blast
using as_def bs_def apply blast
by (simp add: affine_alg_set_intersect as_def bs_def)
qed
lemma(in domain_coord_rings) union_is_alg:
assumes "is_algebraic R n A"
assumes "is_algebraic R n B"
shows "is_algebraic R n (A ∪ B)"
proof-
obtain as where as_def: "finite as ∧ as ⊆ carrier (R[𝒳⇘n⇙]) ∧ A = affine_alg_set R n as"
by (meson assms(1) is_algebraicE)
obtain bs where bs_def: "finite bs ∧ bs ⊆ carrier (R[𝒳⇘n⇙]) ∧ B = affine_alg_set R n bs"
by (meson assms(2) is_algebraicE)
show ?thesis apply(rule is_algebraicI[of "poly_prod_set n as bs"])
using as_def bs_def
apply (simp add: poly_prod_set_finite(1))
using as_def bs_def poly_prod_set_closed apply blast
using as_def bs_def poly_prod_set_algebraic_set
by simp
qed
lemma zero_set_zero:
"zero_set R n 𝟬⇘R[𝒳⇘n⇙]⇙ = carrier (R⇗n⇖)"
by (metis R.add.r_cancel_one cring.cring_simprules(2) cring.cring_simprules(8)
coord_cring_cring cring_coord_rings.eval_at_point_add cring_coord_rings.eval_at_point_closed
cring_coord_rings_axioms subsetI subset_antisym zero_setI zero_set_closed)
lemma affine_alg_set_set:
"affine_alg_set R n {𝟬⇘R[𝒳⇘n⇙]⇙} = carrier (R⇗n⇖)"
using affine_alg_set_singleton zero_set_zero
by blast
lemma car_is_alg:
"is_algebraic R n (carrier (R⇗n⇖))"
apply(rule is_algebraicI[of "{𝟬⇘R[𝒳⇘n⇙]⇙}"])
apply blast
using R.Pring_zero_closed
apply blast
using affine_alg_set_set by blast
lemma zero_set_nonzero_constant:
assumes "a ≠ 𝟬"
assumes "a ∈ carrier R"
shows "zero_set R n (coord_const a) = {}"
proof(rule ccontr)
assume "V n (coord_const a) ≠ {}"
then obtain x where "x ∈ V n (coord_const a)"
by blast
then show False
by (metis assms(1) assms(2) cring_coord_rings.eval_at_point_const cring_coord_rings.zero_setE(1) cring_coord_rings.zero_setE(2) cring_coord_rings_axioms)
qed
lemma zero_set_one:
assumes "a ≠ 𝟬"
assumes "a ∈ carrier R"
shows "zero_set R n 𝟭⇘R[𝒳⇘n⇙]⇙ = {}"
using zero_set_nonzero_constant
by (metis R.Pring_one coord_ring_def one_neq_zero R.one_closed)
lemma empty_set_as_affine_alg_set:
"affine_alg_set R n {𝟭⇘R[𝒳⇘n⇙]⇙} = {}"
using affine_alg_set_singleton local.one_neq_zero zero_set_one by blast
lemma empty_is_alg:
"is_algebraic R n {}"
apply(rule is_algebraicI'[of "𝟭⇘R[𝒳⇘n⇙]⇙"])
apply blast
using local.one_neq_zero zero_set_one by blast
subsubsection‹Finite Sets Are Algebraic›
text‹the function mapping a point in $R^n$ to the unique linear polynomial vanishing exclusively at that point›
definition pvar_trans :: "nat ⇒ nat ⇒ 'a ⇒ ('a, nat) mvar_poly" where
"pvar_trans n i a = (pvar R i) ⊖⇘R[𝒳⇘n⇙]⇙ coord_const a"
lemma pvar_trans_closed:
assumes "a ∈ carrier R"
assumes "i < n"
shows "pvar_trans n i a ∈ carrier (R[𝒳⇘n⇙])"
unfolding pvar_trans_def using assms
by (metis MP.minus_closed coord_ring_def R.indexed_const_closed local.pvar_closed)
lemma pvar_trans_eval:
assumes "a ∈ carrier R"
assumes "b ∈ carrier (R⇗n⇖)"
assumes "i < n"
shows "eval_at_point R b (pvar_trans n i a) = (b!i) ⊖ a"
proof-
have "eval_at_point R b (pvar_trans n i a) =
(eval_at_point R b (pvar R i)) ⊕ (eval_at_point R b (⊖⇘R[𝒳⇘n⇙]⇙ (coord_const a)))"
unfolding pvar_trans_def a_minus_def using assms
by (metis MP.add.inv_closed coord_ring_def eval_at_point_add R.indexed_const_closed local.pvar_closed)
then show ?thesis
by (metis a_minus_def assms(1) assms(2) assms(3) coord_ring_def eval_at_point_a_inv eval_at_point_const eval_pvar R.indexed_const_closed)
qed
definition point_to_polys :: "'a list ⇒ ('a, nat) mvar_poly list" where
"point_to_polys as = map (λ x. pvar_trans (length as) (snd x) (fst x)) (zip as (index_list (length as)))"
lemma point_to_polys_length:
"length (point_to_polys as) = length as"
unfolding point_to_polys_def
by (smt index_list_length length_map list.map_ident map_eq_imp_length_eq zip_eq_conv)
lemma point_to_polysE:
assumes "i < length as"
shows "(point_to_polys as) ! i = (pvar_trans (length as) i (as ! i))"
proof-
have " (zip as (index_list (length as)))!i = ((as!i), i)"
by (metis assms index_list_indices index_list_length nth_zip)
then have 0: "(point_to_polys as) ! i = (λ x. pvar_trans (length as) (snd x) (fst x)) ((as!i), i)"
unfolding point_to_polys_def
using assms nth_map[of i "(zip as (index_list (length as)))" "(λx. pvar_trans (length as) (snd x) (fst x))" ]
by (metis index_list_length length_map map_fst_zip)
then show ?thesis
by (metis fst_conv snd_conv)
qed
lemma point_to_polysE':
assumes "as ∈ carrier (R⇗n⇖)"
assumes "i < n"
shows "eval_at_point R as ((point_to_polys as) ! i) = 𝟬"
by (metis assms(1) assms(2) cartesian_power_car_memE cartesian_power_car_memE' point_to_polysE pvar_trans_eval R.r_right_minus_eq)
lemma point_to_polysE'':
assumes "as ∈ carrier (R⇗n⇖)"
assumes "b ∈ set (point_to_polys as)"
shows "eval_at_point R as b = 𝟬"
using point_to_polysE'
by (metis assms(1) assms(2) cartesian_power_car_memE in_set_conv_nth point_to_polys_length)
lemma point_to_polys_zero_set:
assumes "as ∈ carrier (R⇗n⇖)"
assumes "b ∈ set (point_to_polys as)"
shows "as ∈ zero_set R n b"
using assms(1) assms(2) point_to_polysE'' zero_setI by blast
lemma point_to_polys_closed:
assumes "as ∈ carrier (R⇗n⇖)"
shows "set (point_to_polys as) ⊆ carrier (R[𝒳⇘n⇙])"
using assms point_to_polysE pvar_trans_closed
by (smt cartesian_power_car_memE cartesian_power_car_memE' in_set_conv_nth point_to_polys_length subsetI)
lemma point_to_polys_affine_alg_set:
assumes "as ∈ carrier (R⇗n⇖)"
shows "affine_alg_set R n (set (point_to_polys as)) = {as}"
proof
show "affine_alg_set R n (set (point_to_polys as)) ⊆ {as}"
proof
fix x
assume A0: "x ∈ affine_alg_set R n (set (point_to_polys as))"
then have 0: "length x = n" using affine_alg_set_closed[of n " (set (point_to_polys as))"]
using cartesian_power_car_memE by blast
have "⋀i. i < n ⟹ x!i = as!i"
proof-
fix i
assume A1: "i < n"
show " x!i = as!i"
using A0
by (smt A1 affine_alg_set_closed affine_alg_set_memE assms cartesian_power_car_memE
cartesian_power_car_memE' nth_mem point_to_polysE point_to_polys_length
pvar_trans_eval R.r_right_minus_eq subsetD)
qed
then have "x = as"
by (metis "0" assms cartesian_power_car_memE nth_equalityI)
then show "x ∈ {as}"
by blast
qed
show "{as} ⊆ affine_alg_set R n (set (point_to_polys as))"
proof-
have "as ∈ affine_alg_set R n (set (point_to_polys as))"
using affine_alg_set_not_memE assms point_to_polysE''
by blast
then show ?thesis
by blast
qed
qed
lemma singleton_is_algebraic:
assumes "as ∈ carrier (R⇗n⇖)"
shows "is_algebraic R n {as}"
apply(rule is_algebraicI[of "(set (point_to_polys as))"])
apply blast
using point_to_polys_affine_alg_set
using assms point_to_polys_closed apply blast
by (simp add: assms point_to_polys_affine_alg_set)
lemma(in domain_coord_rings) finite_sets_are_algebraic:
assumes "finite F"
shows "F ⊆ carrier (R⇗n⇖) ⟶ is_algebraic R n F"
apply(rule finite.induct)
apply (simp add: assms)
using empty_is_alg apply blast
using singleton_is_algebraic
by (metis union_is_alg insert_is_Un insert_subset)
subsection‹Polynomial Maps›
subsection‹The Action of Index Permutations on Polynomials›
definition permute_poly_args ::
"nat ⇒ (nat ⇒ nat) ⇒ ('a, nat) mvar_poly ⇒ ('a, nat) mvar_poly" where
"permute_poly_args (n::nat) σ p = indexed_poly_induced_morphism {..<n} (R[𝒳⇘n⇙]) coord_const (λi. pvar R (σ i)) p"
lemma permute_poly_args_characterization:
assumes "σ permutes {..< n}"
shows "(ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘n⇙]) (permute_poly_args (n::nat) σ))"
"(∀i ∈ {..<n}. (permute_poly_args (n::nat) σ) (pvar R i) = pvar R (σ i))"
"(∀a ∈ carrier R. permute_poly_args (n::nat) σ (coord_const a) = (coord_const a))"
proof-
have 0: "cring (R[𝒳⇘n⇙])"
by (simp add: MP.is_cring)
have 1: "(λi. pvar R (σ i)) ∈ {..<n} → carrier (R[𝒳⇘n⇙])"
proof
fix x
assume A: "x ∈ {..<n}"
then have 0: "σ x ∈ {..<n}"
using assms
by (meson permutes_in_image)
then have "σ x < n"
using assms
by auto
then show "pvar R (σ x) ∈ carrier (R[𝒳⇘n⇙]) "
using pvar_closed[of "σ x" n]
by blast
qed
have 2: " ring_hom_ring R (R[𝒳⇘n⇙]) coord_const"
using R.indexed_const_ring_hom unfolding coord_ring_def
by blast
have 3: " indexed_poly_induced_morphism {..<n} (R[𝒳⇘n⇙]) coord_const (λi. pvar R (σ i)) =
indexed_poly_induced_morphism {..<n} (R[𝒳⇘n⇙]) coord_const (λi. pvar R (σ i))"
by blast
show "ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘n⇙]) (permute_poly_args n σ)"
using 0 1 2 3
R.Pring_universal_prop[of "(R[𝒳⇘n⇙])" " (λi. pvar R (σ i))" "{..<n}" coord_const "permute_poly_args (n::nat) σ" ]
unfolding permute_poly_args_def
by (metis coord_ring_def)
show "∀i∈{..<n}. permute_poly_args n σ (pvar R i) = pvar R (σ i)"
using 0 1 2 3
R.Pring_universal_prop(2)[of "(R[𝒳⇘n⇙])" " (λi. pvar R (σ i))" "{..<n}" coord_const "permute_poly_args (n::nat) σ" ]
unfolding permute_poly_args_def var_to_IP_def
by blast
show "∀a∈carrier R. permute_poly_args n σ (coord_const a) = coord_const a"
using 0 1 2 3
R.Pring_universal_prop[of "(R[𝒳⇘n⇙])" " (λi. pvar R (σ i))" "{..<n}" coord_const "permute_poly_args (n::nat) σ" ]
unfolding permute_poly_args_def var_to_IP_def
by blast
qed
lemma permute_poly_args_closed:
assumes "σ permutes {..<n}"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "permute_poly_args n σ p ∈ carrier (R[𝒳⇘n⇙])"
proof-
have "(ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘n⇙]) (permute_poly_args (n::nat) σ))"
using assms permute_poly_args_characterization(1)
by blast
then have "(permute_poly_args (n::nat) σ) ∈ carrier (R[𝒳⇘n⇙]) → carrier (R[𝒳⇘n⇙])"
unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def
by blast
then show ?thesis
using assms
by blast
qed
lemma permute_poly_args_constant:
assumes "a ∈ carrier R"
assumes "σ permutes {..<n}"
shows "permute_poly_args n σ (coord_const a) = (coord_const a)"
using assms permute_poly_args_characterization(3)
by blast
lemma permute_poly_args_add:
assumes "σ permutes {..<n}"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "q ∈ carrier (R[𝒳⇘n⇙])"
shows "permute_poly_args n σ (p ⊕⇘R[𝒳⇘n⇙]⇙ q) = (permute_poly_args n σ p) ⊕⇘R[𝒳⇘n⇙]⇙ (permute_poly_args n σ q)"
using permute_poly_args_characterization(1)[of σ] assms
unfolding ring_hom_ring_def ring_hom_ring_axioms_def
by (metis (no_types, lifting) ring_hom_add)
lemma permute_poly_args_mult:
assumes "σ permutes {..<n}"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "q ∈ carrier (R[𝒳⇘n⇙])"
shows "permute_poly_args n σ (p ⊗⇘R[𝒳⇘n⇙]⇙ q) = (permute_poly_args n σ p) ⊗⇘R[𝒳⇘n⇙]⇙ (permute_poly_args n σ q)"
using permute_poly_args_characterization(1)[of σ] assms
unfolding ring_hom_ring_def ring_hom_ring_axioms_def
using ring_hom_mult
by (metis (mono_tags, lifting))
lemma permute_poly_args_indexed_pmult:
assumes "σ permutes {..<n}"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "i ∈ {..<n}"
shows "(permute_poly_args n σ (p ⨂ i)) = (permute_poly_args n σ p) ⨂ (σ i)"
proof
fix x
show "permute_poly_args n σ (p ⨂ i) x = (permute_poly_args n σ p ⨂ σ i) x"
proof-
have 0: "(p ⨂ i) = (p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i)"
using assms pvar_indexed_pmult
by blast
have 1: "(permute_poly_args n σ p) ⨂ (σ i) = (permute_poly_args n σ p) ⊗⇘R[𝒳⇘n⇙]⇙ pvar R (σ i)"
using assms permute_poly_args_closed pvar_indexed_pmult by blast
have 2: "permute_poly_args n σ (p ⨂ i) x = permute_poly_args n σ (p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) x"
using ‹p ⨂ i = p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i› by presburger
then show ?thesis using 1 R.Pring_var_closed assms(1) assms(2) assms(3) assms
permute_poly_args_mult R.is_cring permute_poly_args_characterization(2) R.zero_closed
by (metis coord_ring_def)
qed
qed
lemma permute_list_closed:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "σ permutes {..<n}"
shows "(permute_list σ a) ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI)
using assms cartesian_power_car_memE length_permute_list apply blast
proof-
have 0: "set a ⊆ carrier R"
using assms(1) cartesian_power_car_memE'' by blast
have "σ permutes {..<length a}"
proof-
have 0: "length a = n"
using assms cartesian_power_car_memE by blast
have "{..<n} = {..<length a}"
using 0 by blast
then show ?thesis
using assms by presburger
qed
have 1: "set (permute_list σ a) = set a"
using assms set_permute_list[of σ a] ‹σ permutes {..<length a}›
by blast
then show "set (permute_list σ a) ⊆ carrier R"
by (simp add: "1" "0")
qed
lemma permute_list_set:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "σ permutes {..<n}"
shows "set (permute_list σ a) = set a"
proof-
have "σ permutes {..<length a}"
proof-
have 0: "length a = n"
using assms cartesian_power_car_memE by blast
have "{..<n} = {..<length a}"
using 0 by blast
then show ?thesis
using assms by presburger
qed
then show 1: "set (permute_list σ a) = set a"
using assms set_permute_list[of σ a]
by blast
qed
end
definition perm_map :: "('a, 'b) ring_scheme ⇒ nat ⇒ (nat ⇒ nat) ⇒ 'a list ⇒ 'a list" where
"perm_map R n σ = restrict (permute_list σ) (carrier (R⇗n⇖))"
context cring_coord_rings
begin
lemma perm_map_is_struct_map:
assumes "σ permutes {..<n}"
shows "perm_map R n σ ∈ struct_maps (R⇗n⇖) (R⇗n⇖)"
apply(rule struct_maps_memI)
unfolding perm_map_def restrict_def using assms permute_list_closed[of _ n σ]
apply metis
by metis
lemma permute_poly_args_eval:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "σ permutes {..<n}"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "eval_at_point R a (permute_poly_args n σ p) = eval_at_point R (permute_list σ a) p"
apply(rule R.indexed_pset.induct[of p "{..<n}" "carrier R"])
using R.Pring_car assms apply (metis coord_ring_def)
apply (metis assms(1) assms(2) eval_at_point_const permute_list_closed permute_poly_args_constant)
proof-
show "⋀p Q. p ∈ Pring_set R {..<n} ⟹
eval_at_point R a (permute_poly_args n σ p) = eval_at_point R (permute_list σ a) p ⟹
Q ∈ Pring_set R {..<n} ⟹
eval_at_point R a (permute_poly_args n σ Q) = eval_at_point R (permute_list σ a) Q ⟹
eval_at_point R a (permute_poly_args n σ (p ⨁ Q)) = eval_at_point R (permute_list σ a) (p ⨁ Q)"
proof-
fix p Q assume A0: "p ∈ Pring_set R {..<n} "
assume A1: "eval_at_point R a (permute_poly_args n σ p) = eval_at_point R (permute_list σ a) p "
assume A2: "Q ∈ Pring_set R {..<n}"
assume A3: "eval_at_point R a (permute_poly_args n σ Q) = eval_at_point R (permute_list σ a) Q"
have A0': "p ∈ carrier (R[𝒳⇘n⇙]) "
using A0 R.Pring_car unfolding coord_ring_def by blast
have A2': "Q ∈ carrier (R[𝒳⇘n⇙]) "
using A2 R.Pring_car unfolding coord_ring_def by blast
have A4: "(permute_poly_args n σ (p ⨁ Q)) = (permute_poly_args n σ p) ⨁ (permute_poly_args n σ Q)"
proof-
have "(permute_poly_args n σ (p ⊕⇘R[𝒳⇘n⇙]⇙ Q)) = (permute_poly_args n σ p) ⊕⇘R[𝒳⇘n⇙]⇙ (permute_poly_args n σ Q)"
using A0' A2' assms permute_poly_args_add by blast
then show ?thesis
unfolding coord_ring_def
by (metis R.Pring_add)
qed
show A5: "eval_at_point R a (permute_poly_args n σ (p ⨁ Q)) = eval_at_point R (permute_list σ a) (p ⨁ Q)"
using eval_at_point_add[of a n "permute_poly_args n σ p" "permute_poly_args n σ Q" ]
permute_poly_args_add[of σ n p Q] A0' A1 A2' A3 A4 permute_poly_args_closed assms
by (metis R.Pring_add cartesian_power_car_memE cartesian_power_car_memE''
cartesian_power_car_memI coord_ring_def eval_at_point_add length_permute_list permute_list_set)
qed
show "⋀p i. p ∈ Pring_set R {..<n} ⟹
eval_at_point R a (permute_poly_args n σ p) = eval_at_point R (permute_list σ a) p ⟹
i ∈ {..<n} ⟹ eval_at_point R a (permute_poly_args n σ (p ⨂ i)) = eval_at_point R (permute_list σ a) (p ⨂ i)"
proof-
fix p i
assume A0: "p ∈ Pring_set R {..<n}"
assume A1: "eval_at_point R a (permute_poly_args n σ p) = eval_at_point R (permute_list σ a) p "
assume A2: "i ∈ {..<n}"
have LHS: "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) = eval_at_point R a (permute_poly_args n σ p ⨂ σ i)"
using permute_poly_args_indexed_pmult[of σ n p i ] A0 A1 A2 assms
by (metis R.Pring_car coord_ring_def)
then have LHS' : "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) =
eval_at_point R a (permute_poly_args n σ p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R (σ i))"
using A0 R.Pring_car assms(1) assms permute_poly_args_closed pvar_indexed_pmult
by (metis coord_ring_def)
have "eval_at_point R a (permute_poly_args n σ p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R (σ i)) =
eval_at_point R a (permute_poly_args n σ p) ⊗ eval_at_point R a (pvar R (σ i))"
proof-
have 1: "permute_poly_args n σ p ∈ carrier (R[𝒳⇘n⇙])"
using A0 R.Pring_car assms(1) assms permute_poly_args_closed
by (metis coord_ring_def)
have "pvar R (σ i) ∈ carrier (R[𝒳⇘n⇙])"
proof-
have "σ i ∈ {..<n}"
using A2 assms
by (meson permutes_in_image)
then have "(σ i) < n"
by blast
then show ?thesis
using pvar_closed[of "σ i" n]
by blast
qed
then have LHS'' : "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) =
(eval_at_point R a (permute_poly_args n σ p)) ⊗⇘R⇙ eval_at_point R a (pvar R (σ i))"
using LHS' "1" eval_at_point_mult assms
by presburger
then show ?thesis
using LHS' by presburger
qed
then have LHS'': "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) =
eval_at_point R a (permute_poly_args n σ p) ⊗ eval_at_point R a (pvar R (σ i))"
using LHS' by presburger
have 0: "eval_at_point R a (pvar R (σ i)) = a! (σ i)"
proof-
have "σ i ∈ {..<n}"
using A2 assms
by (meson permutes_in_image)
then have 0: "σ i < n"
by blast
have 1: "permute_list σ a ∈ carrier (R⇗n⇖)"
using assms(1) assms(2) assms(3) permute_list_closed by blast
show ?thesis
using 0 1 eval_pvar[of "σ i" n a] assms
by blast
qed
have 1: "(permute_list σ a)! i = a! σ i"
proof-
have "length a = n"
using assms cartesian_power_car_memE
by blast
then have "{..<length a} = {..<n}"
by blast
then have 0: " σ permutes {..<length a}"
using assms
by presburger
have 1: "i < length a"
using A2 ‹{..<length a} = {..<n}›
by blast
show ?thesis using 0 1 permute_list_nth[of σ a i]
by blast
qed
have LHS''': "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) =
eval_at_point R (permute_list σ a) p ⊗ a! (σ i)"
using 0 LHS'' A1
by presburger
have RHS: "eval_at_point R (permute_list σ a) (p ⨂ i) =
(eval_at_point R (permute_list σ a) p) ⊗⇘R⇙ (eval_at_point R (permute_list σ a) (pvar R i))"
proof-
have "(p ⨂ i) = p ⊗⇘R[𝒳⇘n⇙]⇙ (pvar R i)"
using A0 R.Pring_car pvar_indexed_pmult unfolding coord_ring_def
by blast
then show ?thesis
using eval_at_point_mult[of "(permute_list σ a)" n p "(pvar R i)" ]
A0 A2 R.Pring_car R.Pring_var_closed assms(1) assms(2) assms(3) permute_list_closed
by (metis coord_ring_def)
qed
then have RHS': "eval_at_point R (permute_list σ a) (p ⨂ i) =
(eval_at_point R (permute_list σ a) p) ⊗⇘R⇙ (permute_list σ a)! i"
proof-
have 0: "i < n"
using A2 assms
by blast
have 1: "permute_list σ a ∈ carrier (R⇗n⇖)"
using assms permute_list_closed
by blast
show ?thesis
using 0 1 eval_pvar[of i n "(permute_list σ a)" ] RHS
by presburger
qed
then show "eval_at_point R a (permute_poly_args n σ (p ⨂ i)) = eval_at_point R (permute_list σ a) (p ⨂ i)"
using LHS''' A1 1
by presburger
qed
qed
subsection‹Inverse Images of Sets by Tuples of Polynomials›
definition is_poly_tuple :: "nat ⇒ ('a, nat) mvar_poly list ⇒ bool" where
"is_poly_tuple (n::nat) fs = (set (fs) ⊆ carrier (R[𝒳⇘n⇙]))"
lemma is_poly_tupleE:
assumes "is_poly_tuple n fs"
assumes "j < length fs"
shows "fs ! j ∈ carrier (R[𝒳⇘n⇙])"
using assms is_poly_tuple_def nth_mem
by blast
lemma is_poly_tuple_Cons:
assumes "is_poly_tuple n fs"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
shows "is_poly_tuple n (f#fs)"
using assms unfolding is_poly_tuple_def
by (metis (no_types, lifting) set_ConsD subset_iff)
lemma is_poly_tuple_append:
assumes "is_poly_tuple n fs"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
shows "is_poly_tuple n (fs@[f])"
using assms set_append unfolding is_poly_tuple_def
by (metis (no_types, lifting) Un_subset_iff append_Nil2 set_ConsD subset_code(1))
definition poly_tuple_eval :: "('a, nat) mvar_poly list ⇒ 'a list ⇒ 'a list" where
"poly_tuple_eval fs as = map (λ f. eval_at_poly R f as) fs "
lemma poly_tuple_evalE:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "j < m"
shows "(poly_tuple_eval fs as)!j ∈ carrier R"
proof-
have 0: "(poly_tuple_eval fs as)!j = (eval_at_poly R (fs!j) as)"
using poly_tuple_eval_def
by (metis assms(2) assms(4) nth_map)
have 1: "(fs!j) ∈ carrier (R[𝒳⇘n⇙])"
using assms is_poly_tupleE
by blast
show ?thesis
using assms 0 1 eval_at_point_closed
by presburger
qed
lemma poly_tuple_evalE':
shows "length (poly_tuple_eval fs as) = length fs"
unfolding poly_tuple_eval_def
using length_map by blast
lemma poly_tuple_evalE'':
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "j < m"
shows "(poly_tuple_eval fs as)!j = (eval_at_poly R (fs!j) as)"
using assms
unfolding poly_tuple_eval_def
using nth_map
by blast
lemma poly_tuple_eval_closed:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "as ∈ carrier (R⇗n⇖)"
shows "(poly_tuple_eval fs as) ∈ carrier (R⇗m⇖)"
proof(rule cartesian_power_car_memI)
show "length (poly_tuple_eval fs as) = m"
using assms
by (simp add: assms poly_tuple_evalE')
show "set (poly_tuple_eval fs as) ⊆ carrier R"
proof fix x
assume "x ∈ set (poly_tuple_eval fs as)"
then obtain j where j_def: "j< m ∧ x = (poly_tuple_eval fs as)!j"
using assms
by (metis ‹length (poly_tuple_eval fs as) = m› in_set_conv_nth)
then show "x ∈ carrier R"
using assms(1) assms(2) assms(3) poly_tuple_evalE assms by blast
qed
qed
lemma poly_tuple_eval_Cons:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
shows "(poly_tuple_eval (f#fs) as) = (eval_at_point R as f)#(poly_tuple_eval fs as)"
using assms poly_tuple_eval_def
by (metis list.simps(9))
definition poly_tuple_pullback ::
"nat ⇒ 'a list set ⇒ ('a, nat) mvar_poly list ⇒ 'a list set" where
"poly_tuple_pullback n S fs = ((poly_tuple_eval fs) -` S) ∩ (carrier (R⇗n⇖)) "
lemma poly_pullbackE:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "S ⊆ carrier (R⇗m⇖)"
shows "poly_tuple_pullback n S fs ⊆ carrier (R⇗n⇖)"
using poly_tuple_pullback_def assms
by blast
lemma poly_pullbackE':
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "S ⊆ carrier (R⇗m⇖)"
assumes "as ∈ poly_tuple_pullback n S fs"
shows "as ∈ carrier (R⇗n⇖)"
"poly_tuple_eval fs as ∈ S"
using assms
apply (meson poly_pullbackE subsetD)
proof-
have "as ∈ poly_tuple_eval fs -` S"
using assms unfolding poly_tuple_pullback_def
by blast
then show "poly_tuple_eval fs as ∈ S"
by blast
qed
lemma poly_pullbackI:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "S ⊆ carrier (R⇗m⇖)"
assumes "as ∈ carrier (R⇗n⇖)"
assumes "poly_tuple_eval fs as ∈ S"
shows "as ∈ poly_tuple_pullback n S fs"
using assms
unfolding poly_tuple_pullback_def
by blast
end
text‹coordinate permutations as pullbacks. The point here is to realize that permutations of
indices are just pullbacks (or pushforwards) by particular polynomial maps›
abbreviation pvar_list where
"pvar_list R n ≡ map (pvar R) (index_list n)"
lemma pvar_list_elements:
assumes "i < n"
shows "pvar_list R n ! i = pvar R i"
by (simp add: assms index_list_indices index_list_length)
lemma pvar_list_length:
"length (pvar_list R n) = n"
by (simp add: index_list_length)
context cring_coord_rings
begin
lemma pvar_list_is_poly_tuple:
shows "is_poly_tuple n (pvar_list R n)"
unfolding is_poly_tuple_def
proof fix x
assume A: "x ∈ set (pvar_list R n)"
have "set (index_list n) = {..<n}"
by (simp add: index_list_set)
obtain i where "i < n ∧ x = pvar R i"
using A pvar_list_elements[of _ n R] pvar_list_length[of R n]
by (metis in_set_conv_nth)
then show "x ∈ carrier (R[𝒳⇘n⇙])"
using pvar_closed
by blast
qed
lemma permutation_of_poly_list_is_poly_list:
assumes "is_poly_tuple k fs"
assumes "σ permutes {..< length fs}"
shows "is_poly_tuple k (permute_list σ fs)"
unfolding is_poly_tuple_def
proof-
show "set (permute_list σ fs) ⊆ carrier (coord_ring R k)"
using assms is_poly_tuple_def set_permute_list
by blast
qed
lemma permutation_of_poly_listE:
assumes "is_poly_tuple k fs"
assumes "σ permutes {..< length fs}"
assumes "i < length fs"
shows "(permute_list σ fs) ! i = fs ! (σ i)"
using assms permute_list_nth
by blast
lemma pushforward_by_permutation_of_poly_list:
assumes "is_poly_tuple k fs"
assumes "σ permutes {..< length fs}"
assumes "as ∈ carrier (R⇗k⇖)"
shows "poly_tuple_eval (permute_list σ fs) as = permute_list σ (poly_tuple_eval fs as)"
using assms unfolding poly_tuple_eval_def
by (metis permute_list_map)
lemma pushforward_by_pvar_list:
assumes "as ∈ carrier (R⇗n⇖)"
shows "poly_tuple_eval (pvar_list R n) as = as"
using assms pvar_list_elements[of _ n R] unfolding poly_tuple_eval_def using eval_pvar[of _ n as]
by (metis (mono_tags, lifting) cartesian_power_car_memE length_map nth_equalityI nth_map pvar_list_length)
lemma pushforward_by_permuted_pvar_list:
assumes "σ permutes {..< n}"
assumes "as ∈ carrier (R⇗n⇖)"
shows "poly_tuple_eval (permute_list σ (pvar_list R n)) as = permute_list σ as"
by (metis assms pushforward_by_permutation_of_poly_list
pushforward_by_pvar_list pvar_list_is_poly_tuple pvar_list_length)
lemma pullback_by_permutation_of_poly_list:
assumes "σ permutes {..< n}"
assumes "S ⊆ carrier (R⇗n⇖)"
shows "poly_tuple_pullback n S (permute_list σ (pvar_list R n)) =
permute_list (fun_inv σ) ` S"
proof
show "poly_tuple_pullback n S (permute_list σ (pvar_list R n)) ⊆ permute_list (fun_inv σ) ` S"
proof fix x
assume A: " x ∈ poly_tuple_pullback n S (permute_list σ (pvar_list R n))"
then obtain y where y_def: "y ∈ S ∧ poly_tuple_eval (permute_list σ (pvar_list R n)) x = y"
by (metis assms length_permute_list
permutation_of_poly_list_is_poly_list poly_pullbackE'(2) pvar_list_is_poly_tuple
pvar_list_length)
then have 0: "y = permute_list σ x"
by (metis A assms length_permute_list
permutation_of_poly_list_is_poly_list poly_pullbackE'(1) pushforward_by_permuted_pvar_list pvar_list_is_poly_tuple pvar_list_length)
have 1: "length x = n"
using A
by (metis "0" length_permute_list poly_tuple_evalE' pvar_list_length y_def)
then have "{..<length x} = {..<n}"
by blast
then have "permute_list (fun_inv σ) y = x"
using 0 permutes_inv_o(1)[of σ "{..< n}"] permute_list_id[of x] permutes_inv[of σ "{..<n}"]
assms permute_list_compose[of "(fun_inv σ)" x σ ]
unfolding fun_inv_def
by metis
then show " x ∈ permute_list (fun_inv σ) ` S"
using y_def by blast
qed
show "permute_list (fun_inv σ) ` S ⊆ poly_tuple_pullback n S (permute_list σ (pvar_list R n))"
proof fix x assume A: "x ∈ permute_list (fun_inv σ) ` S"
then obtain y where y_def: "y ∈ S ∧ x = permute_list (fun_inv σ) y"
by blast
have 0: "(fun_inv σ) permutes {..<n}"
using assms unfolding fun_inv_def
by (simp add: permutes_inv)
have 1: "permute_list σ x = permute_list σ (permute_list (fun_inv σ) y)"
by (simp add: y_def)
have 2: "length y = n"
using y_def A assms cartesian_power_car_memE
by blast
have 3: "σ permutes {..<length y}"
by (simp add: "2" assms)
have 4: "permute_list σ x = y"
using assms(2) permute_list_id[of y] permute_list_compose[of σ y "(fun_inv σ)" ]
3 2 1 0 permutes_inv_o(2)[of σ "{..< n}"]
unfolding fun_inv_def
by metis
have 5: "x ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI)
using A 0 assms
apply (metis "2" "4" length_permute_list)
using A 0 assms
by (smt "2" in_set_conv_nth neq0_conv poly_tuple_evalE pushforward_by_pvar_list
pvar_list_is_poly_tuple pvar_list_length set_permute_list subset_iff y_def)
then have 6: "poly_tuple_eval (permute_list σ (pvar_list R n)) x = y"
using 4 assms pushforward_by_permuted_pvar_list[of σ n x]
by blast
then show "x ∈ poly_tuple_pullback n S (permute_list σ (pvar_list R n))"
using 5 y_def unfolding poly_tuple_pullback_def
by blast
qed
qed
lemma pullback_by_permutation_of_poly_list':
assumes "σ permutes {..< n}"
assumes "S ⊆ carrier (R⇗n⇖)"
shows "poly_tuple_pullback n S (permute_list (fun_inv σ) (pvar_list R n)) =
permute_list σ ` S"
proof-
have 0: "(fun_inv (fun_inv σ)) = σ"
using assms unfolding fun_inv_def
using permutes_inv_inv
by blast
have 1: "fun_inv σ permutes {..<n}"
unfolding fun_inv_def
using assms permutes_inv by blast
then show ?thesis using 0 assms pullback_by_permutation_of_poly_list[of "fun_inv σ" n S]
by presburger
qed
subsection‹Composing Polynomial Tuples With Polynomials›
text‹composition of a multivaribale polynomial by a list of polynomials›
definition poly_compose ::
"nat ⇒ nat ⇒ ('a, nat) mvar_poly list ⇒ ('a, nat) mvar_poly ⇒ ('a, nat) mvar_poly" where
"poly_compose n m fs = indexed_poly_induced_morphism {..<n} (coord_ring R m) (λ s. R.indexed_const s) (λi. fs!i) "
lemma poly_compose_var:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "j < n"
shows "poly_compose n m fs (pvar R j) = (fs!j)"
proof-
have 0: "cring (coord_ring R m)"
using R.Pring_is_cring R.is_cring
unfolding coord_ring_def by blast
have 1: "(!) fs ∈ {..<n} → carrier (coord_ring R m)"
using assms is_poly_tuple_def
by auto
have 2: "ring_hom_ring R (coord_ring R m) coord_const"
using indexed_const_ring_hom coord_const_ring_hom by blast
have "∀i∈{..<n}. indexed_poly_induced_morphism {..<n} (coord_ring R m) coord_const ((!) fs) (mset_to_IP R {#i#}) = fs ! i"
using assms 0 1 2 R.Pring_universal_prop(2)[of "(coord_ring R m)" "(λi. fs!i)" "{..<n}" "(λ s. R.indexed_const s)" "poly_compose n m fs"]
poly_compose_def
by (metis var_to_IP_def)
then show ?thesis
using assms
unfolding poly_compose_def var_to_IP_def
by blast
qed
lemma Pring_universal_prop_assms:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
shows "(λi. fs!i) ∈ {..<n} → carrier (coord_ring R m)"
"ring_hom_ring R (coord_ring R m) coord_const"
proof
show "⋀x. x ∈ {..<n} ⟹ fs ! x ∈ carrier (coord_ring R m)"
using assms is_poly_tupleE by blast
show "ring_hom_ring R (coord_ring R m) coord_const"
using R.indexed_const_ring_hom coord_const_ring_hom by blast
qed
lemma poly_compose_ring_hom:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
shows "(ring_hom_ring (R[𝒳⇘n⇙]) (coord_ring R m) (poly_compose n m fs))"
using Pring_universal_prop_assms[of n fs] assms
R.Pring_universal_prop(1)[of "(coord_ring R m)" "(λi. fs!i)" "{..<n}" coord_const "(poly_compose n m fs)"]
unfolding poly_compose_def
using R.Pring_is_cring R.is_cring
by (metis Pi_I Pring_universal_prop_assms(2) coord_ring_def is_poly_tupleE lessThan_iff)
lemma poly_compose_closed:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
shows "(poly_compose n m fs f) ∈ carrier (coord_ring R m)"
proof-
have "poly_compose n m fs ∈ carrier (R[𝒳⇘n⇙]) → carrier (R [𝒳⇘m⇙])"
using poly_compose_ring_hom[of m fs n] assms
unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def
by blast
then show ?thesis using assms by blast
qed
lemma poly_compose_add:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
assumes "g ∈ carrier (R[𝒳⇘n⇙])"
shows "poly_compose n m fs (f ⊕⇘R[𝒳⇘n⇙]⇙ g) = (poly_compose n m fs f) ⊕⇘coord_ring R m⇙ (poly_compose n m fs g)"
using assms poly_compose_ring_hom ring_hom_add
by (metis (mono_tags, lifting) ring_hom_ring.homh)
lemma poly_compose_mult:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
assumes "g ∈ carrier (R[𝒳⇘n⇙])"
shows "poly_compose n m fs (f ⊗⇘R[𝒳⇘n⇙]⇙ g) = (poly_compose n m fs f) ⊗⇘coord_ring R m⇙ (poly_compose n m fs g)"
using assms poly_compose_ring_hom ring_hom_mult
by (metis (mono_tags, lifting) ring_hom_ring.homh)
lemma poly_compose_indexed_pmult:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
assumes "i < n"
shows "poly_compose n m fs (f ⨂ i) = (poly_compose n m fs f) ⊗⇘coord_ring R m⇙ (fs!i)"
proof-
have "(f ⨂ i) = f ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i"
using assms pvar_indexed_pmult
by blast
then show ?thesis using poly_compose_mult poly_compose_var assms
by (metis pvar_closed)
qed
lemma poly_compose_const:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "a ∈ carrier R"
shows "poly_compose n m fs (coord_const a) = coord_const a"
using R.Pring_universal_prop(3)[of "(coord_ring R m)" "(λi. fs!i)" "{..<n}" coord_const "(poly_compose n m fs)"]
Pring_universal_prop_assms assms
unfolding poly_compose_def
using R.Pring_is_cring coord_cring_cring by blast
text‹evaluating polynomial compositions›
lemma poly_compose_eval:
assumes "is_poly_tuple m fs"
assumes "length fs = n"
assumes "f ∈ carrier (R[𝒳⇘n⇙])"
assumes "as ∈ carrier (R⇗m⇖)"
shows "eval_at_point R (poly_tuple_eval fs as) f = eval_at_point R as (poly_compose n m fs f)"
apply(rule R.indexed_pset.induct[of f "{..<n}" "carrier R"])
using R.Pring_car assms
apply (metis coord_ring_def)
proof-
show "⋀k. k ∈ carrier R ⟹ eval_at_poly R (coord_const k) (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs (coord_const k)) as"
using assms
by (metis (no_types, lifting) eval_at_point_factored poly_compose_const R.total_eval_const)
show " ⋀p Q. p ∈ Pring_set R {..<n} ⟹
eval_at_poly R p (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs p) as ⟹
Q ∈ Pring_set R {..<n} ⟹
eval_at_poly R Q (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs Q) as ⟹
eval_at_poly R (p ⨁ Q) (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs (p ⨁ Q)) as"
proof-
fix p Q
assume A0: "p ∈ Pring_set R {..<n}"
assume A1: "eval_at_poly R p (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs p) as"
assume A2: "Q ∈ Pring_set R {..<n}"
assume A3: " eval_at_poly R Q (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs Q) as"
have A4: "eval_at_poly R (p ⨁ Q) (poly_tuple_eval fs as) = eval_at_poly R p (poly_tuple_eval fs as) ⊕ eval_at_poly R Q (poly_tuple_eval fs as)"
using A0 A1 A2 A3
eval_at_point_add[of "(poly_tuple_eval fs as)" n p Q]
by (metis R.Pring_add R.Pring_car assms(2) assms(3) assms(4) assms coord_ring_def neq0_conv poly_tuple_eval_closed)
have A5: "poly_compose n m fs (p ⨁ Q) = poly_compose n m fs p ⊕⇘coord_ring R m⇙ poly_compose n m fs Q"
using assms poly_compose_add
by (metis A0 A2 R.Pring_add R.Pring_car coord_ring_def)
have A6: " eval_at_poly R (poly_compose n m fs (p ⨁ Q)) as = eval_at_poly R (poly_compose n m fs p) as ⊕ eval_at_poly R (poly_compose n m fs Q) as"
proof-
have 0: " as ∈ carrier (R⇗m⇖)"
by (simp add: assms)
have 1: "poly_compose n m fs p ∈ carrier (coord_ring R m)"
using A0 R.Pring_car assms(1) assms(2) assms(3) assms(4) poly_compose_closed
by (metis coord_ring_def)
have 2: "poly_compose n m fs Q ∈ carrier (coord_ring R m)"
using A2 R.Pring_car assms(1) assms(2) assms(3) assms(4) poly_compose_closed
by (metis coord_ring_def)
show ?thesis
using 0 1 2 eval_at_point_add[of as m "(poly_compose n m fs p)" "(poly_compose n m fs Q)"]
A5
by presburger
qed
show "eval_at_poly R (p ⨁ Q) (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs (p ⨁ Q)) as"
using A5 A6 A3 A1 A4
by presburger
qed
show "⋀p i. p ∈ Pring_set R {..<n} ⟹
eval_at_poly R p (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs p) as ⟹
i ∈ {..<n} ⟹ eval_at_poly R (p ⨂ i) (poly_tuple_eval fs as) = eval_at_poly R (poly_compose n m fs (p ⨂ i)) as"
using assms poly_compose_indexed_pmult eval_at_point_indexed_pmult
by (smt R.Pring_car coord_ring_def eval_at_point_mult is_poly_tupleE lessThan_iff neq0_conv poly_compose_closed poly_tuple_evalE'' poly_tuple_eval_closed)
qed
subsection‹Extensional Polynomial Maps›
text‹Polynomial Maps between powers of a ring›
definition poly_map :: "nat ⇒ ('a, nat) mvar_poly list ⇒ 'a list ⇒ 'a list" where
"poly_map n fs = (λa ∈ carrier (R⇗n⇖). poly_tuple_eval fs a)"
lemma poly_map_is_struct_map:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
shows "poly_map n fs ∈ struct_maps (R⇗n⇖) (R⇗m⇖)"
apply(rule struct_maps_memI)
unfolding poly_map_def using assms
apply (metis poly_tuple_eval_closed restrict_apply')
by (meson restrict_apply)
lemma poly_map_closed:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "as ∈ carrier (R⇗n⇖)"
shows "poly_map n fs as ∈ carrier (R⇗m⇖)"
using assms
by (meson poly_map_is_struct_map struct_maps_memE(1))
definition poly_maps :: "nat ⇒ nat ⇒ ('a list ⇒ 'a list) set" where
"poly_maps n m = {F. (∃ fs. length fs = m ∧ is_poly_tuple n fs ∧ F = poly_map n fs)}"
lemma poly_maps_memE:
assumes "F ∈ poly_maps n m"
obtains fs where "length fs = m ∧ is_poly_tuple n fs ∧ F = poly_map n fs"
using assms unfolding poly_maps_def by blast
lemma poly_maps_memI:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "F = poly_map n fs"
shows "F ∈ poly_maps n m"
using assms unfolding poly_maps_def by blast
lemma poly_map_compose_closed:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "is_poly_tuple k gs"
assumes "length gs = n"
shows "is_poly_tuple k (map (poly_compose n k gs) fs)"
unfolding is_poly_tuple_def
proof fix y assume A: "y ∈ set (map (poly_compose n k gs) fs)"
then obtain f where f_def: "f ∈ set fs ∧ y = poly_compose n k gs f"
by (smt in_set_conv_nth length_map nth_map)
then show "y ∈ carrier (coord_ring R k)"
using assms poly_compose_closed
by (metis in_set_conv_nth is_poly_tupleE )
qed
lemma poly_map_compose_closed':
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "is_poly_tuple k gs"
assumes "length gs = n"
shows "poly_map k (map (poly_compose n k gs) fs) ∈ poly_maps k m"
apply(rule poly_maps_memI[of _ "map (poly_compose n k gs) fs"])
using poly_map_compose_closed[of n fs m k gs] assms apply blast
apply (simp add: assms)
by auto
lemma poly_map_pullback_char:
assumes "is_poly_tuple n fs"
assumes "length fs = m"
assumes "is_poly_tuple k gs"
assumes "length gs = n"
shows "(pullback (R⇗k⇖) (poly_map k gs) (poly_map n fs)) =
poly_map k (map (poly_compose n k gs) fs)"
proof(rule ext)
fix x
show "pullback (R⇗k⇖) (poly_map k gs) (poly_map n fs) x =
poly_map k (map (poly_compose n k gs) fs) x"
proof(cases "x ∈ carrier (R⇗k⇖)")
case True
have 0: "length (pullback (R⇗k⇖) (poly_map k gs) (poly_map n fs) x) = m"
using True assms poly_map_closed cartesian_power_car_memE
unfolding pullback_def
by (metis (mono_tags, lifting) compose_eq)
have 1: "is_poly_tuple k (map (poly_compose n k gs) fs)"
by (simp add: assms poly_map_compose_closed)
have 2: "length (map (poly_compose n k gs) fs) = m"
using assms length_map by auto
have 3: "⋀i. i < m ⟹
(pullback (R⇗k⇖) (poly_map k gs) (poly_map n fs) x)! i =
eval_at_point R (poly_map k gs x) (fs ! i)"
unfolding pullback_def poly_map_def poly_tuple_eval_def
using assms True
by (smt compose_eq nth_map poly_tuple_eval_closed poly_tuple_eval_def restrict_apply')
have 4: "⋀i. i < m ⟹
poly_map k (map (poly_compose n k gs) fs) x ! i =
eval_at_point R (poly_map k gs x) (fs ! i)"
unfolding poly_map_def poly_tuple_eval_def using True assms
by (smt "2" cring_coord_rings.is_poly_tuple_def cring_coord_rings_axioms neq0_conv
nth_map nth_mem poly_compose_eval poly_tuple_eval_def restrict_apply' subset_code(1))
show ?thesis using 0 1 2 3 4 assms True
by (metis cartesian_power_car_memE nth_equalityI poly_map_closed)
next
case False
then show ?thesis
unfolding poly_map_def pullback_def
by (metis affine_alg_set_empty compose_extensional extensional_restrict poly_map_def restrict_def)
qed
qed
lemma poly_map_pullback_closed:
assumes "F ∈ poly_maps n m"
assumes "G ∈ poly_maps k n"
shows "(pullback (R⇗k⇖) G F) ∈ poly_maps k m"
by (metis assms poly_map_compose_closed'
poly_map_pullback_char poly_maps_memE)
lemma poly_map_cons:
assumes "a ∈ carrier (R⇗n⇖)"
shows "poly_map n (f#fs) a = (eval_at_point R a f)#poly_map n fs a"
unfolding poly_map_def poly_tuple_eval_def
by (metis (mono_tags, lifting) assms list.simps(9) restrict_apply')
lemma poly_map_append:
assumes "a ∈ carrier (R⇗n⇖)"
shows "poly_map n (fs@gs) a = (poly_map n fs a) @ (poly_map n gs a)"
proof(induction fs)
case Nil
then show ?case
using assms unfolding poly_map_def poly_tuple_eval_def
by (metis (no_types, lifting) map_append restrict_apply')
next
case (Cons f fs)
have "poly_map n ((f # fs) @ gs) a = (eval_at_point R a f)#(poly_map n (fs@gs) a)"
using poly_map_cons
by (metis append_Cons assms)
hence "poly_map n ((f # fs) @ gs) a = (eval_at_point R a f)#(poly_map n fs a)@(poly_map n gs a)"
using Cons.IH by metis
thus ?case
by (metis Cons_eq_appendI assms poly_map_cons)
qed
section‹Nesting of Polynomial Rings›
lemma poly_ring_car_mono:
assumes "n ≤ m"
shows "carrier (R[𝒳⇘n⇙]) ⊆ carrier (coord_ring R m)"
using R.Pring_carrier_subset
unfolding coord_ring_def
by (simp add: R.Pring_car R.Pring_carrier_subset assms)
lemma poly_ring_car_mono'[simp]:
shows "carrier (R[𝒳⇘n⇙]) ⊆ carrier (R[𝒳⇘Suc n⇙])"
"carrier (R[𝒳⇘n⇙]) ⊆ carrier (R[𝒳⇘n+m⇙])"
using poly_ring_car_mono
apply simp
using poly_ring_car_mono
by simp
lemma poly_ring_add_mono:
assumes "n ≤ m"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (R[𝒳⇘n⇙])"
shows "A ⊕⇘R[𝒳⇘n⇙]⇙ B = A ⊕⇘coord_ring R m⇙ B"
using assms unfolding coord_ring_def
by (metis R.Pring_add_eq)
lemma poly_ring_add_mono':
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (R[𝒳⇘n⇙])"
shows "A ⊕⇘R[𝒳⇘n⇙]⇙ B = A ⊕⇘R[𝒳⇘Suc n⇙]⇙ B"
"A ⊕⇘R[𝒳⇘n⇙]⇙ B = A ⊕⇘R[𝒳⇘n+m⇙]⇙ B"
using assms unfolding coord_ring_def
apply (metis R.Pring_add_eq)
by (metis R.Pring_add_eq)
lemma poly_ring_times_mono:
assumes "n ≤ m"
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (R[𝒳⇘n⇙])"
shows "A ⊗⇘R[𝒳⇘n⇙]⇙ B = A ⊗⇘coord_ring R m⇙ B"
using assms unfolding coord_ring_def
by (metis R.Pring_mult_eq)
lemma poly_ring_times_mono':
assumes "A ∈ carrier (R[𝒳⇘n⇙])"
assumes "B ∈ carrier (R[𝒳⇘n⇙])"
shows "A ⊗⇘R[𝒳⇘n⇙]⇙ B = A ⊗⇘R[𝒳⇘Suc n⇙]⇙ B"
"A ⊗⇘R[𝒳⇘n⇙]⇙ B = A ⊗⇘R[𝒳⇘n+m⇙]⇙ B"
using assms unfolding coord_ring_def
apply (metis R.Pring_mult_eq)
by (metis R.Pring_mult_eq)
lemma poly_ring_one_mono:
assumes "n ≤ m"
shows "𝟭⇘R[𝒳⇘n⇙]⇙ = 𝟭⇘coord_ring R m⇙"
by (metis R.Pring_one coord_ring_def)
lemma poly_ring_zero_mono:
assumes "n ≤ m"
shows "𝟬⇘R[𝒳⇘n⇙]⇙ = 𝟬⇘coord_ring R m⇙"
using R.Pring_zero_eq
by (metis coord_ring_def)
text‹replacing the variables in a polynomial with new variables›
definition shift_vars :: "nat ⇒ nat ⇒ ('a, nat) mvar_poly ⇒ ('a, nat) mvar_poly" where
"shift_vars n m p = indexed_poly_induced_morphism {..<n} (R[𝒳⇘n+m⇙]) coord_const (λi. pvar R (i + m)) p"
lemma shift_vars_char:
shows "(ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘n+m⇙]) (shift_vars n m))"
"(∀i ∈ {..<n}. (shift_vars n m) (pvar R i) = pvar R (i + m))"
"(∀a ∈ carrier R. (shift_vars n m) (R.indexed_const a) = (coord_const a))"
proof-
have 1: "(λi. pvar R (i + m)) ∈ {..<n} → carrier (R[𝒳⇘n+m⇙])"
proof fix x
assume "x ∈ {..<n}"
then have "x + m < n + m"
using add_less_mono1 by blast
then show "pvar R (x + m) ∈ carrier (R[𝒳⇘n+m⇙])"
using pvar_closed by blast
qed
have 2: "ring_hom_ring R (R[𝒳⇘n+m⇙]) coord_const"
using R.indexed_const_ring_hom unfolding coord_ring_def
by blast
have 3: "shift_vars n m = indexed_poly_induced_morphism {..<n} (R[𝒳⇘n+m⇙]) coord_const (λi. pvar R (i + m))"
unfolding shift_vars_def
by blast
show "(ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘n+m⇙]) (shift_vars n m))"
using 1 2 3 R.Pring_universal_prop[of "(R[𝒳⇘n+m⇙])" "(λi. pvar R (i + m))" "{..<n}" "coord_const" "(shift_vars n m)"]
using MP.is_cring by (metis coord_ring_def)
show "(∀i ∈ {..<n}. (shift_vars n m) (pvar R i) = pvar R (i + m))"
using 1 2 3 R.Pring_universal_prop[of "(R[𝒳⇘n+m⇙])" "(λi. pvar R (i + m))" "{..<n}" "coord_const" "(shift_vars n m)"]
by (metis R.Pring_is_cring MP.is_cring var_to_IP_def)
show "(∀a ∈ carrier R. (shift_vars n m) (R.indexed_const a) = (coord_const a))"
using 1 2 3 R.Pring_universal_prop[of "(R[𝒳⇘n+m⇙])" "(λi. pvar R (i + m))" "{..<n}" "coord_const" "(shift_vars n m)"]
by (meson MP.is_cring)
qed
lemma shift_vars_constant:
assumes "a ∈ carrier R"
shows "shift_vars n m (coord_const a) = coord_const a"
using assms(1) shift_vars_char(3) by blast
lemma shift_vars_pvar:
assumes "i ∈ {..<n}"
shows "shift_vars n m (pvar R i) = pvar R (i + m)"
using assms shift_vars_char(2) by blast
lemma shift_vars_add:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "shift_vars n m (p ⊕⇘R[𝒳⇘n⇙]⇙ Q) = shift_vars n m p ⊕⇘R[𝒳⇘n+m⇙]⇙ shift_vars n m Q"
using assms shift_vars_char(1)[of n m]
unfolding ring_hom_ring_def ring_hom_ring_axioms_def
using ring_hom_add
by (metis (no_types, lifting))
lemma shift_vars_mult:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
shows "shift_vars n m (p ⊗⇘R[𝒳⇘n⇙]⇙ Q) = shift_vars n m p ⊗⇘R[𝒳⇘n+m⇙]⇙ shift_vars n m Q"
using assms shift_vars_char(1)[of n m]
unfolding ring_hom_ring_def ring_hom_ring_axioms_def unfolding coord_ring_def
using ring_hom_mult
by metis
lemma shift_vars_indexed_pmult:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "i ∈ {..<n}"
shows "shift_vars n m (p ⨂ i) = (shift_vars n m p) ⊗⇘R[𝒳⇘n+m⇙]⇙ (pvar R (i + m))"
proof-
have "(p ⨂ i) = p ⊗⇘R[𝒳⇘n⇙]⇙ (pvar R i)"
using assms pvar_indexed_pmult by blast
then show ?thesis
using shift_vars_mult shift_vars_pvar assms unfolding coord_ring_def
by (metis R.Pring_var_closed)
qed
lemma shift_vars_closed:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "shift_vars n m p ∈ carrier (R[𝒳⇘n+m⇙])"
using assms shift_vars_char(1)[of n m] ring_hom_closed[of "shift_vars n m"]
unfolding ring_hom_ring_def ring_hom_ring_axioms_def
by blast
lemma shift_vars_eval:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "a ∈ carrier (R⇗m⇖)"
assumes "b ∈ carrier (R⇗n⇖)"
shows "eval_at_point R (a@b) (shift_vars n m p) = eval_at_point R b p"
apply(rule R.indexed_pset.induct[of p "{..<n}" "carrier R"])
using R.Pring_car assms apply (metis coord_ring_def)
proof-
show "⋀k. k ∈ carrier R ⟹ eval_at_poly R (shift_vars n m (coord_const k)) (a @ b) = eval_at_poly R (coord_const k) b"
proof-
fix k
have 0: "(a @ b) ∈ carrier (R⇗n + m⇖)"
using assms
by (metis add.commute cartesian_product_closed')
assume A: "k ∈ carrier R"
then show "eval_at_poly R (shift_vars n m (coord_const k)) (a @ b) = eval_at_poly R (coord_const k) b"
using assms shift_vars_constant
eval_at_point_const[of k "(a @ b)" "m + n"]
eval_at_point_const[of k "b" n] 0
by (metis eval_at_point_const)
qed
show "⋀p Q. p ∈ Pring_set R {..<n} ⟹
eval_at_poly R (shift_vars n m p) (a @ b) = eval_at_poly R p b ⟹
Q ∈ Pring_set R {..<n} ⟹
eval_at_poly R (shift_vars n m Q) (a @ b) = eval_at_poly R Q b ⟹
eval_at_poly R (shift_vars n m (p ⨁ Q)) (a @ b) = eval_at_poly R (p ⨁ Q) b"
proof- fix p Q
assume A0: " p ∈ Pring_set R {..<n}"
assume A1: "eval_at_poly R (shift_vars n m p) (a @ b) = eval_at_poly R p b"
assume A2: "Q ∈ Pring_set R {..<n}"
assume A3: "eval_at_poly R (shift_vars n m Q) (a @ b) = eval_at_poly R Q b"
have A4: "eval_at_poly R (p ⨁ Q) b = eval_at_poly R p b ⊕ eval_at_poly R Q b"
using A0 A2 assms eval_at_point_add[of b n p Q]
by (metis R.Pring_add R.Pring_car coord_ring_def)
have A5: "(shift_vars n m (p ⨁ Q)) = (shift_vars n m p) ⊕⇘R[𝒳⇘n⇙]⇙ (shift_vars n m Q)"
using A0 A2 R.Pring_add R.Pring_car assms(1) shift_vars_add unfolding coord_ring_def
by metis
have A6: " eval_at_poly R (shift_vars n m (p ⨁ Q)) (a @ b) =
eval_at_poly R (shift_vars n m p) (a @ b) ⊕ eval_at_poly R (shift_vars n m Q) (a @ b) "
using A5 eval_at_point_add shift_vars_closed A0 A2 R.Pring_car add.commute
assms unfolding coord_ring_def
by (metis R.Pring_add cartesian_power_concat(1))
have A7: " eval_at_poly R (shift_vars n m (p ⨁ Q)) (a @ b) =
eval_at_poly R p b ⊕ eval_at_poly R Q b "
using A6 A1 A3 by presburger
then show " eval_at_poly R (shift_vars n m (p ⨁ Q)) (a @ b) = eval_at_poly R (p ⨁ Q) b "
using A4
by presburger
qed
show "⋀p i. p ∈ Pring_set R {..<n} ⟹
eval_at_poly R (shift_vars n m p) (a @ b) = eval_at_poly R p b ⟹
i ∈ {..<n} ⟹ eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) = eval_at_poly R (p ⨂ i) b"
proof- fix p i
assume A0: "p ∈ Pring_set R {..<n}"
then have A0': "p ∈ carrier (R[𝒳⇘n⇙])"
using R.Pring_car unfolding coord_ring_def
by blast
assume A1: " eval_at_poly R (shift_vars n m p) (a @ b) = eval_at_poly R p b"
assume A2: "i ∈ {..<n}"
have A3: "(shift_vars n m (p ⨂ i)) = (shift_vars n m p) ⊗⇘R[𝒳⇘n+m⇙]⇙ (pvar R (i + m))"
using A0' shift_vars_indexed_pmult A2 assms(1)
by blast
have A4: "eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) =
eval_at_poly R ( (shift_vars n m p) ⊗⇘R[𝒳⇘n+m⇙]⇙ (pvar R (i + m))) (a@b)"
using A3
by presburger
have A5: "a@b ∈ carrier (R⇗n+m⇖)"
using assms(2) assms(3) cartesian_power_concat(2) by blast
have A6: "eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) =
eval_at_poly R p b ⊗ eval_at_poly R (pvar R (i + m)) (a @ b)"
using A5 A0' eval_at_point_mult[of "a@b" "n+m" "shift_vars n m p" "pvar R (i + m)"]
unfolding A4 by (metis A1 A2 Groups.add_ac(2) lessThan_iff local.pvar_closed nat_add_left_cancel_less shift_vars_closed)
have A7: " eval_at_poly R (pvar R (i + m)) (a @ b) = (a@b)!(i+m)"
proof-
have "i < n"
using assms A2 by blast
then have "i + m < n + m "
using add_less_cancel_right
by blast
then show ?thesis
using A5 eval_pvar[of "i+m" "n+m" "a@b"]
by blast
qed
then have A8: "eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) = eval_at_poly R p b ⊗ ((a @ b)!(i+m))"
using A6 by presburger
have A9: "eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) = eval_at_poly R p b ⊗ (b!i)"
proof-
have "length a = m"
using assms cartesian_power_car_memE by blast
then have "(a @ b)!(i+m) = b!i"
by (metis add.commute nth_append_length_plus)
then show ?thesis
using A8
by presburger
qed
show " eval_at_poly R (shift_vars n m (p ⨂ i)) (a @ b) = eval_at_poly R (p ⨂ i) b"
proof-
have "i < n"
using A2 assms
by blast
then have "eval_at_poly R (p ⨂ i) b = eval_at_poly R p b ⊗ (b!i)"
using assms A0' eval_at_point_indexed_pmult
by blast
then show ?thesis using A9
by presburger
qed
qed
qed
text‹Evaluating a polynomial from a lower poly ring in a higher power:›
lemma poly_eval_cartesian_prod:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "b ∈ carrier (R⇗m⇖)"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "eval_at_point R a p = eval_at_point R (a@b) p"
apply(rule coord_ring_induct[of p n])
using assms apply blast
proof-
have 0: "a@b ∈ carrier (R⇗n + m⇖)"
using assms cartesian_product_closed' by blast
show "⋀aa. aa ∈ carrier R ⟹ eval_at_poly R (coord_const aa) a = eval_at_poly R (coord_const aa) (a @ b)"
proof- fix c assume "c ∈ carrier R"
show "eval_at_poly R (coord_const c) a = eval_at_poly R (coord_const c) (a @ b)"
using eval_at_point_const[of c a n] eval_at_point_const[of c "a@b" "n+m"] 0
‹c ∈ carrier R› assms(2) assms(1) by presburger
qed
show "⋀i Q. Q ∈ carrier (R[𝒳⇘n⇙]) ⟹
eval_at_poly R Q a = eval_at_poly R Q (a @ b) ⟹
i < n ⟹ eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) a = eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) (a @ b)"
proof-
fix i Q
assume A0: "Q ∈ carrier (R[𝒳⇘n⇙])"
assume A1: "eval_at_poly R Q a = eval_at_poly R Q (a @ b)"
assume A2: "i < n"
have LHS: "eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) a = eval_at_poly R Q a ⊗ (a!i)"
by (metis A0 A2 assms eval_at_point_indexed_pmult pvar_indexed_pmult)
have RHS: "eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) (a @ b) = eval_at_poly R Q (a@b) ⊗ ((a@b)!i)"
by (smt "0" A0 A2 add.commute eval_at_point_indexed_pmult le_add1 poly_ring_car_mono
pvar_indexed_pmult subsetD trans_less_add2)
show "eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) a = eval_at_poly R (Q ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i) (a @ b)"
proof-
have "length a > i" using A2 assms
using cartesian_power_car_memE by blast
then have "a!i = (a@b)!i"
by (metis nth_append)
then show ?thesis
using LHS RHS A1
by presburger
qed
qed
show "⋀Q0 Q1.
Q0 ∈ carrier (R[𝒳⇘n⇙]) ⟹
Q1 ∈ carrier (R[𝒳⇘n⇙]) ⟹
eval_at_poly R Q0 a = eval_at_poly R Q0 (a @ b) ⟹
eval_at_poly R Q1 a = eval_at_poly R Q1 (a @ b) ⟹
eval_at_poly R (Q0 ⊕⇘R[𝒳⇘n⇙]⇙ Q1) a = eval_at_poly R (Q0 ⊕⇘R[𝒳⇘n⇙]⇙ Q1) (a @ b)"
proof-
fix Q0 Q1
assume A0: "eval_at_poly R Q0 a = eval_at_poly R Q0 (a @ b)"
assume A1: "eval_at_poly R Q1 a = eval_at_poly R Q1 (a @ b)"
assume A2: "Q0 ∈ carrier (R[𝒳⇘n⇙])"
assume A3: "Q1 ∈ carrier (R[𝒳⇘n⇙])"
show "eval_at_poly R (Q0 ⊕⇘R[𝒳⇘n⇙]⇙ Q1) a = eval_at_poly R (Q0 ⊕⇘R[𝒳⇘n⇙]⇙ Q1) (a @ b)"
using A0 A1 A2 A3 assms eval_at_point_add[of _ n Q0 Q1] 0 unfolding coord_ring_def
by (metis (no_types, lifting) R.Pring_add_eq basic_trans_rules(31) coord_ring_def eval_at_point_add le_add1 poly_ring_car_mono)
qed
qed
text‹Evaluating polynomials at points in higher powers:›
lemma eval_at_points_higher_pow:
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
assumes "k ≥ n"
assumes "a ∈ carrier (R⇗k⇖)"
shows "eval_at_point R a p = eval_at_point R (take n a) p"
using poly_eval_cartesian_prod[of "take n a" n "drop n a" "k - n" p] assms
by (metis (no_types, lifting) append_take_drop_id cartesian_power_car_memE cartesian_power_car_memE''
cartesian_power_car_memI length_drop set_drop_subset subset_trans take_closed)
subsection‹ Diagonal sets in even powers of ‹R››
text‹
In this section, by a diagonal set in $R^(2m)$ we will mean the set of points $(x,x)$,
where $x \in R^m$. This is slightly different from the standard definition. Introducing these
sets will be useful for reasoning about multiplicative inverses of functions later on.
›
definition diagonal :: "nat ⇒ 'a list set" where
"diagonal m = {x ∈ carrier (R⇗m+m⇖). take m x = drop m x}"
lemma diagonalE:
assumes "x ∈ diagonal m"
shows "x = (take m x)@(take m x)"
"x ∈ carrier (R⇗m+m⇖)"
"take m x ∈ carrier (R⇗m⇖)"
"⋀i. i < m ⟹ x!i = x!(i + m)"
apply (metis (mono_tags, lifting) append_take_drop_id assms(1) diagonal_def mem_Collect_eq )
using assms diagonal_def
apply blast
apply(rule cartesian_power_car_memI)
using assms unfolding diagonal_def
apply (metis (no_types, lifting) cartesian_power_car_memE le_add2 mem_Collect_eq take_closed)
proof-
show "set (take m x) ⊆ carrier R"
proof fix a
assume "a ∈ set (take m x)"
then have "a ∈ set x"
by (meson in_set_takeD)
then show "a ∈ carrier R"
using assms unfolding diagonal_def using cartesian_power_car_memE'[of x]
by (smt cartesian_power_car_memE in_set_conv_nth mem_Collect_eq)
qed
show "⋀i. i < m ⟹ x!i = x!(i + m)"
proof- fix i
assume A: "i < m"
have 0: "x = (take m x)@(take m x)"
using assms diagonal_def[of m]
by (metis (mono_tags, lifting) append_take_drop_id mem_Collect_eq)
then have 1: "x!i = take m x ! i"
by (metis A nth_take)
have 2: "length x = m + m"
using assms(1) cartesian_power_car_memE diagonal_def by blast
have 3: "take m x = drop m x"
by (metis "0" append_take_drop_id same_append_eq)
have 4: "drop m x ! i = x ! (i + m)"
by (metis "2" add.commute le_add1 nth_drop)
then show "x!i = x!(i + m)"
using "1" "3" by presburger
qed
qed
lemma diagonalI:
assumes "x = (take m x)@(take m x)"
assumes "take m x ∈ carrier (R⇗m⇖)"
shows "x ∈ diagonal m"
unfolding diagonal_def using assms
by (metis (mono_tags, lifting) append_eq_conv_conj cartesian_power_car_memE
cartesian_power_car_memI'' length_append mem_Collect_eq)
definition diag_def_poly :: "nat ⇒ nat ⇒('a, nat) mvar_poly" where
"diag_def_poly n i = pvar R i ⊖⇘coord_ring R (n + n)⇙ pvar R (i + n)"
lemma diag_def_poly_closed:
assumes "i < n"
shows "diag_def_poly n i ∈ carrier (coord_ring R (n + n))"
using assms unfolding diag_def_poly_def coord_ring_def
by (metis (no_types, lifting) MP.minus_closed add.assoc add_leD1 coord_ring_def less_add_eq_less local.pvar_closed nat_less_le not_add_less1)
lemma diag_def_poly_eval:
assumes "i < n"
assumes "x ∈ carrier (R⇗n+n⇖)"
shows "eval_at_point R x (diag_def_poly n i) = (x!i) ⊖ (x!(i + n))"
using assms diag_def_poly_def[of n i]
eval_at_point_subtract[of x "n + n" "pvar R i" "pvar R (i + n)"] eval_pvar[of i "n + n"]
eval_pvar[of "i+n" "n + n"] pvar_closed[of i "n + n"] pvar_closed[of "i + n" "n + n"]
by (metis add_less_cancel_right trans_less_add2)
definition diag_def_poly_set :: "nat ⇒ ('a, nat) mvar_poly set" where
"diag_def_poly_set n = diag_def_poly n ` {..<n}"
lemma diag_def_poly_set_in_coord_ring:
shows "diag_def_poly_set n ⊆ carrier (coord_ring R (n + n))"
proof fix x
assume "x ∈ diag_def_poly_set n"
then obtain i where i_def: "i < n ∧ x = diag_def_poly n i"
unfolding diag_def_poly_set_def
by blast
then show "x ∈ carrier (coord_ring R (n + n))"
using diag_def_poly_closed
by blast
qed
lemma diag_def_poly_set_finite:
"finite (diag_def_poly_set n)"
unfolding diag_def_poly_set_def
by blast
lemma diag_def_poly_eval_at_diagonal:
assumes "x ∈ diagonal n"
assumes "i < n"
shows "eval_at_point R x (diag_def_poly n i) = 𝟬"
proof-
have "x!i = x!(i + n)"
using assms diagonalE(4) by blast
then show ?thesis
by (metis assms(1) assms(2) cartesian_power_car_memE cartesian_power_car_memE' cring_coord_rings.diag_def_poly_eval cring_coord_rings_axioms diagonalE(2) point_to_polysE point_to_polysE' pvar_trans_eval trans_less_add2)
qed
lemma diagonal_as_affine_alg_set:
shows "diagonal n = affine_alg_set R (n + n) (diag_def_poly_set n)"
proof
show "diagonal n ⊆ affine_alg_set R (n + n) (diag_def_poly_set n)"
proof fix x assume A: "x ∈ diagonal n"
show " x ∈ affine_alg_set R (n + n) (diag_def_poly_set n)"
apply(rule affine_alg_set_memI)
using A diagonalE(2) apply blast
using diag_def_poly_eval_at_diagonal[of x] diag_def_poly_set_def[of n]
atLeastAtMost_iff[of _ 0 "n-1"]
by (metis (no_types, lifting) A image_iff lessThan_iff)
qed
show "affine_alg_set R (n + n) (diag_def_poly_set n) ⊆ diagonal n"
proof fix x
assume A: "x ∈ affine_alg_set R (n + n) (diag_def_poly_set n)"
show "x ∈ diagonal n"
proof(rule diagonalI)
show "x = take n x @ take n x"
proof-
have 0: "x = take n x @ drop n x"
by (metis append_take_drop_id)
have "take n x = drop n x"
proof-
have 0: "length x = n + n"
using A unfolding affine_alg_set_def
using cartesian_power_car_memE by blast
then have 1: "length (take n x) = length (drop n x)"
using A
by (metis (no_types, lifting) ‹x = take n x @ drop n x›
add.commute add_right_cancel affine_alg_set_closed cartesian_power_car_memE
le_add1 length_append subsetD take_closed)
have "⋀i::nat. i < n ⟹ (take n x)!i = (drop n x) ! i"
proof- fix i::nat assume A0: "i < n"
then have "i ∈ {..<n}" using atLeastAtMost_iff[of i 0 "n-1"]
by auto
then have "diag_def_poly n i ∈ (diag_def_poly_set n)"
using diag_def_poly_set_def by blast
then have "eval_at_point R x (diag_def_poly n i) = 𝟬"
using A affine_alg_set_memE by blast
then have "x!i = x!(n + i)"
using A0 diag_def_poly_eval[of i n x]
by (metis (no_types, lifting) A add.commute affine_alg_set_closed
cartesian_power_car_memE' nat_add_left_cancel_less R.r_right_minus_eq subsetD trans_less_add2)
then show "take n x ! i =drop n x ! i"
by (metis "0" A0 le_add1 nth_drop nth_take)
qed
then show ?thesis using 0
by (metis "1" ‹x = take n x @ drop n x› add_less_mono
length_append less_not_refl linorder_neqE_nat nth_equalityI)
qed
then show ?thesis
using 0 by metis
qed
show "take n x ∈ carrier (R⇗n⇖)"
using A unfolding affine_alg_set_def
by (meson A affine_alg_set_closed le_add2 subset_eq take_closed)
qed
qed
qed
lemma diagonal_is_algebraic:
shows "is_algebraic R (n + n) (diagonal n)"
apply(rule is_algebraicI[of "diag_def_poly_set n"])
apply (simp add: diag_def_poly_set_finite)
using diag_def_poly_set_in_coord_ring apply blast
by (simp add: diagonal_as_affine_alg_set)
end
subsection‹Tuples of Functions›
definition is_function_tuple :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a list ⇒ 'a) list ⇒ bool" where
"is_function_tuple R n fs = (set fs ⊆ carrier (R⇗n⇖) → carrier R)"
lemma is_function_tupleI:
assumes "(set fs ⊆ carrier (R⇗n⇖) → carrier R)"
shows "is_function_tuple R n fs "
by (simp add: assms is_function_tuple_def)
lemma is_function_tuple_append:
assumes "is_function_tuple R n fs"
assumes "is_function_tuple R n gs"
shows "is_function_tuple R n (fs@gs)"
using assms is_function_tupleI set_append
by (simp add: is_function_tuple_def)
lemma is_function_tuple_Cons:
assumes "is_function_tuple R n fs"
assumes "f ∈ carrier (R⇗n⇖) → carrier R"
shows "is_function_tuple R n (f#fs)"
using assms is_function_tupleI
by (simp add: assms(2) is_function_tuple_def)
lemma is_function_tuple_snoc:
assumes "is_function_tuple R n fs"
assumes "f ∈ carrier (R⇗n⇖) → carrier R"
shows "is_function_tuple R n (fs@[f])"
apply(rule is_function_tupleI)
by (metis (no_types) Un_subset_iff append_Nil assms(1) assms(2) is_function_tuple_Cons is_function_tuple_def set_append)
lemma is_function_tuple_list_update:
assumes "is_function_tuple R n fs"
assumes "f ∈ carrier (R⇗n⇖) → carrier R"
assumes "i < n"
shows "is_function_tuple R n (fs[i := f])"
apply(rule is_function_tupleI)
by (metis assms(1) assms(2) is_function_tuple_def set_update_subsetI)
definition function_tuple_eval :: "'b ⇒ 'c ⇒ ('d ⇒ 'a) list ⇒ 'd ⇒ 'a list" where
"function_tuple_eval R n fs x = map (λf. f x) fs"
lemma function_tuple_eval_closed:
assumes "is_function_tuple R n fs"
assumes "x ∈ carrier (R⇗n⇖)"
shows "function_tuple_eval R n fs x ∈ carrier (R⇗length fs⇖)"
apply(rule cartesian_power_car_memI')
apply (metis function_tuple_eval_def length_map)
proof- fix i assume "i < length fs"
then show "function_tuple_eval R n fs x ! i ∈ carrier R"
unfolding function_tuple_eval_def using assms unfolding is_function_tuple_def
by (metis funcset_carrier nth_map nth_mem subsetD)
qed
definition coord_fun ::
"('a, 'c) ring_scheme ⇒ nat ⇒ ('a list ⇒ 'b list) ⇒ nat ⇒ 'a list ⇒ 'b" where
"coord_fun R n g i = (λx ∈ carrier (R⇗n⇖). (g x) ! i)"
lemma(in cring) map_is_coord_fun_tuple:
assumes "g ∈ carrier (R⇗n⇖) →⇩E carrier (R⇗m⇖)"
shows "g = (λ x ∈ carrier (R⇗n⇖). function_tuple_eval R n (map (coord_fun R n g) [0..<m]) x)"
proof
fix x
show "g x = restrict (function_tuple_eval R n (map (coord_fun R n g) [0..<m])) (carrier (R⇗n⇖)) x"
proof(cases "x ∈ carrier (R⇗n⇖)")
case True
then have T0: "restrict (function_tuple_eval R n (map (coord_fun R n g) [0..<m])) (carrier (R⇗n⇖)) x =
function_tuple_eval R n (map (coord_fun R n g) [0..<m]) x"
by (meson restrict_apply')
have T1: "length (g x) = m"
by (metis PiE_mem True assms cartesian_power_car_memE)
have T2: "⋀i. i < m ⟹ (g x) ! i = (function_tuple_eval R n (map (coord_fun R n g) [0..<m]) x) ! i"
unfolding function_tuple_eval_def coord_fun_def
using restrict_apply True T1 length_map map_nth nth_map by smt
have T3: "length (function_tuple_eval R n (map (coord_fun R n g) [0..<m]) x) = m"
unfolding function_tuple_eval_def using length_map
by (metis T1 map_nth)
show ?thesis using T1 T2 T3
by (metis T0 nth_equalityI)
next
case False
then show ?thesis using assms unfolding restrict_def
by (meson PiE_E)
qed
qed
definition function_tuple_comp ::
"'c ⇒ ('a ⇒ 'd) list ⇒ ('d list ⇒ 'b) ⇒ 'a ⇒ 'b" where
"function_tuple_comp R fs f = f ∘ (function_tuple_eval R (0::nat) fs)"
lemma function_tuple_comp_closed:
assumes "f ∈ carrier (R⇗n⇖) → carrier R"
assumes "length fs = n"
assumes "is_function_tuple R m fs"
shows "function_tuple_comp R fs f ∈ carrier (R⇗m⇖) → carrier R"
unfolding function_tuple_comp_def
using assms
by (smt Pi_iff comp_apply function_tuple_eval_closed function_tuple_eval_def)
fun id_function_tuple where
"id_function_tuple (R::('a,'b) partial_object_scheme) 0 = []"|
"id_function_tuple R (Suc n) = id_function_tuple R n @ [(λ(x::'a list). x! n)] "
lemma id_function_tuple_is_function_tuple:
"⋀k. k ≥ n ⟹ is_function_tuple R k (id_function_tuple R n)"
apply(induction n)
apply (simp add: is_function_tupleI)
proof- fix n k
assume IH: "(⋀k. n ≤ k ⟹ is_function_tuple R k (id_function_tuple R n))"
assume A: "Suc n ≤ k"
have 0: "(λa. a!n) ∈ carrier (R⇗k⇖) → carrier R"
using A cartesian_power_car_memE'
by (metis Pi_I Suc_le_lessD)
have 1: " is_function_tuple R k (id_function_tuple R n)"
using A IH Suc_leD by blast
then show "is_function_tuple R k (id_function_tuple R (Suc n))"
using A 0 id_function_tuple.simps(2)[of R n]
is_function_tuple_snoc[of R k "id_function_tuple R n" "λa. a!n" ]
by (simp add: "0")
qed
lemma id_function_tuple_is_function_tuple':
"is_function_tuple R n (id_function_tuple R n)"
by (simp add: id_function_tuple_is_function_tuple)
lemma id_function_tuple_eval_is_take:
assumes "a ∈ carrier (R⇗n⇖)"
shows "k ≤ n ⟹ function_tuple_eval R n (id_function_tuple R k) a = take k a"
apply(induction k)
using assms
apply (simp add: assms function_tuple_eval_def)
proof- fix k
assume IH: "(k ≤ n ⟹ function_tuple_eval R n (id_function_tuple R k) a = take k a) "
assume A: "Suc k ≤ n"
then have 0: "function_tuple_eval R n (id_function_tuple R k) a = take k a "
using IH Suc_leD
by blast
have "function_tuple_eval R n (id_function_tuple R (Suc k)) a
= function_tuple_eval R n (id_function_tuple R k) a @ [a!k]"
using id_function_tuple.simps(2)[of R k]
by (simp add: function_tuple_eval_def)
then show "function_tuple_eval R n (id_function_tuple R (Suc k)) a = take (Suc k) a"
by (metis "0" A Suc_le_lessD assms cartesian_power_car_memE take_Suc_conv_app_nth)
qed
lemma id_function_tuple_eval_is_id:
assumes "a ∈ carrier (R⇗n⇖)"
shows "function_tuple_eval R n (id_function_tuple R n) a = a"
using assms id_function_tuple_eval_is_take[of a R n n]
by (metis cartesian_power_car_memE order_refl take_all)
text‹Composing a function tuple with a polynomial›
definition poly_function_tuple_comp ::
"('a, 'b) ring_scheme ⇒ nat ⇒ ('a list ⇒ 'a) list ⇒ ('a, nat) mvar_poly ⇒ 'a list ⇒ 'a" where
"poly_function_tuple_comp R n fs f = eval_at_poly R f ∘ function_tuple_eval R n fs"
context cring_coord_rings
begin
lemma poly_function_tuple_comp_closed:
assumes "is_function_tuple R n fs"
assumes "f ∈ carrier (coord_ring R (length fs))"
shows "poly_function_tuple_comp R n fs f ∈ carrier (R⇗n⇖) → carrier R"
proof fix x assume A: "x ∈ carrier (R⇗n⇖)"
then show "poly_function_tuple_comp R n fs f x ∈ carrier R"
using assms function_tuple_eval_closed eval_at_point_closed
unfolding poly_function_tuple_comp_def
by (metis comp_apply)
qed
lemma poly_function_tuple_comp_eq:
assumes "is_function_tuple R n fs"
assumes "f ∈ carrier (coord_ring R (length fs))"
assumes "a ∈ carrier (R⇗n⇖)"
shows "poly_function_tuple_comp R n fs f a = eval_at_poly R f ( function_tuple_eval R n fs a)"
unfolding poly_function_tuple_comp_def
using comp_apply
by metis
lemma poly_function_tuple_comp_constant:
assumes "is_function_tuple R n fs"
assumes "a ∈ carrier R"
assumes "x ∈ carrier (R⇗n⇖)"
shows "poly_function_tuple_comp R n fs (coord_const a) x = a"
unfolding poly_function_tuple_comp_def
using assms comp_apply function_tuple_eval_closed
by (metis eval_at_point_const)
lemma poly_function_tuple_comp_add:
assumes "is_function_tuple R n fs"
assumes "k ≤length fs"
assumes "p ∈ carrier (coord_ring R k)"
assumes "Q ∈ carrier (coord_ring R k)"
assumes "x ∈ carrier (R⇗n⇖)"
shows "poly_function_tuple_comp R n fs (p ⊕⇘R[𝒳⇘n⇙]⇙ Q) x =
(poly_function_tuple_comp R n fs p x) ⊕ (poly_function_tuple_comp R n fs Q x)"
proof-
have 0: "p ∈ carrier (coord_ring R (length fs))"
using assms poly_ring_car_mono[of k "length fs"]
by blast
have 1: "Q ∈ carrier (coord_ring R (length fs))"
using assms poly_ring_car_mono[of k "length fs"]
by blast
show ?thesis
using assms(1) assms(5) 0 1 R.Pring_add_eq[of ]
poly_function_tuple_comp_eq
function_tuple_eval_closed[of R n fs x]
eval_at_point_add[of "function_tuple_eval R n fs x" "length fs" p Q]
unfolding coord_ring_def by (metis R.Pring_add_closed)
qed
lemma poly_function_tuple_comp_mult:
assumes "is_function_tuple R n fs"
assumes "k ≤length fs"
assumes "p ∈ carrier (coord_ring R k)"
assumes "Q ∈ carrier (coord_ring R k)"
assumes "x ∈ carrier (R⇗n⇖)"
shows "poly_function_tuple_comp R n fs (p ⊗⇘R[𝒳⇘n⇙]⇙ Q) x =
(poly_function_tuple_comp R n fs p x) ⊗ (poly_function_tuple_comp R n fs Q x)"
proof-
have 0: "p ∈ carrier (coord_ring R (length fs))"
using assms poly_ring_car_mono[of k "length fs"]
by blast
have 1: "Q ∈ carrier (coord_ring R (length fs))"
using assms poly_ring_car_mono[of k "length fs"]
by blast
show ?thesis
using assms 0 1
poly_function_tuple_comp_eq
function_tuple_eval_closed[of R n fs x]
eval_at_point_mult[of "function_tuple_eval R n fs x" "length fs" p Q]
unfolding coord_ring_def
by (metis MP.m_closed R.Pring_mult_eq coord_ring_def)
qed
lemma poly_function_tuple_comp_pvar:
assumes "is_function_tuple R n fs"
assumes "k < length fs"
assumes "x ∈ carrier (R⇗n⇖)"
shows "poly_function_tuple_comp R n fs (pvar R k) x = (fs ! k) x"
proof-
have "(map (λf. f x) fs) ∈ carrier (R⇗length fs⇖)"
using function_tuple_eval_closed[of R n fs x]
unfolding function_tuple_eval_def
using assms(1) assms(3) by blast
then have "eval_at_poly R (pvar R k) (map (λf. f x) fs) = (fs! k) x"
using eval_pvar[of k "length fs" "(map (λf. f x) fs)"]
by (metis assms(2) nth_map)
then show ?thesis
by (metis (mono_tags, lifting) assms(1) assms(2) assms(3) function_tuple_eval_def
nth_map poly_function_tuple_comp_eq pvar_closed)
qed
end
text‹The coordinate ring of polynomials indexed by natural numbers›
definition Coord_ring :: "('a, 'b) ring_scheme ⇒ ('a, ('a, nat) mvar_poly) module" where
"Coord_ring R = Pring R (UNIV :: nat set)"
text‹Some general closure lemmas for coordinate rings›
context cring_coord_rings
begin
lemma coord_ring_monom_term_closed:
assumes "a ∈ carrier (R[𝒳⇘n⇙])"
assumes "b ∈ carrier (R[𝒳⇘n⇙])"
shows "a ⊗⇘(R[𝒳⇘n⇙])⇙ b[^]⇘(R[𝒳⇘n⇙])⇙(n::nat) ∈ carrier (R[𝒳⇘n⇙])"
using assms monoid.nat_pow_closed[of "(R[𝒳⇘n⇙])"]
unfolding coord_ring_def
by (meson R.Pring_is_monoid monoid.m_closed)
lemma coord_ring_monom_term_plus_closed:
assumes "a ∈ carrier (R[𝒳⇘n⇙])"
assumes "b ∈ carrier (R[𝒳⇘n⇙])"
assumes "c ∈ carrier (R[𝒳⇘n⇙])"
shows "c ⊕⇘(R[𝒳⇘n⇙])⇙ a ⊗⇘(R[𝒳⇘n⇙])⇙ b[^]⇘(R[𝒳⇘n⇙])⇙(n::nat) ∈ carrier (R[𝒳⇘n⇙])"
using assms coord_ring_monom_term_closed R.Pring_add_closed
by blast
end
subsection‹Generic Univariate Polynomials›
text‹
By a generic univariate polynomial, we mean a polynomial in one variable whose coefficients are
coordinate functions over a ring. That is, a polynomial of the form:
\[f(t) = x_0 + x_1t + \dots + x_nt^n\]
Such a polynomial can be construed as an element of $R[x_0,..,x_n](t)$, or as an element of
$R[x_0,..,x_n, x_n{n+1}]$. We will intially define the latter version, and show that it can
easily be cast to the former using the function ``\texttt{IP\_to\_UP"}. Such a polynomial can be
cast to a univariate polynomial over the ring $R$ by substituting a tuple of ring elements for
the coefficients.
›
definition generic_poly_lt :: "('a, 'b) ring_scheme ⇒ nat ⇒ ('a, nat) mvar_poly" where
"generic_poly_lt R n = (pvar R (Suc n)) ⊗⇘coord_ring R (Suc (Suc n))⇙ (pvar R 0)[^]⇘coord_ring R (Suc (Suc n))⇙ n"
fun generic_poly where
"generic_poly R (0::nat) = pvar R 1"|
"generic_poly R (Suc n) = (generic_poly R n) ⊕⇘(coord_ring R (n+3))⇙ generic_poly_lt R (Suc n)"
context cring_coord_rings
begin
lemma generic_poly_lt_closed:
"generic_poly_lt R n ∈ carrier (coord_ring R (Suc (Suc n)))"
proof-
have 0: "(pvar R (Suc n)) ∈ carrier (coord_ring R (Suc (Suc n)))"
using pvar_closed
by blast
have 1: " (pvar R 0) ∈ carrier (coord_ring R (Suc (Suc n)))"
using pvar_closed
by blast
then have "(pvar R 0)[^]⇘coord_ring R (Suc (Suc n))⇙ n ∈ carrier (coord_ring R (Suc (Suc n)))"
using monoid.nat_pow_closed
unfolding coord_ring_def by (metis R.Pring_is_monoid)
then show ?thesis using 0
unfolding coord_ring_def
by (metis R.Pring_mult_closed coord_ring_def generic_poly_lt_def)
qed
lemma generic_poly_lt_eval:
assumes "a ∈ carrier (R⇗n+2⇖)"
shows "eval_at_point R a (generic_poly_lt R n) = a!(Suc n) ⊗ (a!0)[^]n "
proof-
have "(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) ∈ carrier (coord_ring R (n + 2))"
using monoid.nat_pow_closed pvar_closed unfolding coord_ring_def
by (metis R.Pring_is_monoid add_2_eq_Suc' zero_less_Suc)
then have "eval_at_point R a (generic_poly_lt R n) =
eval_at_poly R (pvar R (Suc n)) a ⊗ eval_at_poly R (pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) a"
unfolding generic_poly_lt_def
using assms pvar_closed[of "(Suc n)" "n + 2"] eval_at_point_mult[of a "n + 2" "pvar R (Suc n)" "(pvar R 0)[^]⇘coord_ring R (Suc (Suc n))⇙ n"]
by (metis add_2_eq_Suc' lessI)
then show ?thesis using assms
by (metis add_2_eq_Suc' add_gr_0 eval_at_point_nat_pow eval_pvar lessI pvar_closed zero_less_numeral)
qed
lemma generic_poly_closed:
"generic_poly R n ∈ carrier (coord_ring R (Suc (Suc n)))"
apply(induction n)
using pvar_closed[of 1 "Suc (Suc n)"]
apply (metis One_nat_def generic_poly.simps(1) lessI pvar_closed)
proof-
fix n assume IH: "generic_poly R n ∈ carrier (coord_ring R (Suc (Suc n)))"
have "generic_poly R n ∈ carrier (coord_ring R (Suc (Suc (Suc n))))"
using IH poly_ring_car_mono'[of "Suc (Suc n)"]
by blast
then show " generic_poly R (Suc n) ∈ carrier (coord_ring R (Suc (Suc (Suc n))))"
unfolding coord_ring_def
using generic_poly.simps[of R] generic_poly_lt_closed[of n]
by (metis MP.add.m_closed R.Pring_add_eq coord_ring_def generic_poly_lt_closed)
qed
lemma generic_poly_closed':
assumes "k ≤n"
shows "generic_poly R k ∈ carrier (coord_ring R (Suc (Suc n)))"
by (meson Suc_le_mono assms generic_poly_closed poly_ring_car_mono subsetD)
lemma generic_poly_eval_at_point:
assumes "a ∈ carrier (R⇗n+3⇖)"
shows "eval_at_point R a (generic_poly R (Suc n)) = (eval_at_point R a (generic_poly R n)) ⊕
(a!(n + 2)) ⊗ (a!0)[^](Suc n)"
proof-
have 0: "(generic_poly R n) ∈ carrier (coord_ring R (n + 3))"
using generic_poly_closed'
by (metis Suc3_eq_add_3 add.commute eq_imp_le le_SucI)
then show ?thesis
using generic_poly.simps(2)
generic_poly_closed'[of n "n + 3"]
generic_poly_lt_eval eval_at_point_add[of a "(n + 3)" "generic_poly R n"]
by (metis (no_types, lifting) add.left_commute add_2_eq_Suc' assms
generic_poly_lt_closed numeral_2_eq_2 numeral_3_eq_3 plus_1_eq_Suc)
qed
end
text ‹
We can turn points in $R^{n+1}$ into univariate polynomials with the associated coefficients
via partial evaluation of the generic polynomials of degree $n$. ›
definition ring_cfs_to_poly ::
"('a, 'b) ring_scheme ⇒ nat ⇒ 'a list ⇒ ('a, nat) mvar_poly" where
"ring_cfs_to_poly R n as = coord_partial_eval R {1..<n+2} (𝟬⇘R⇙#as) (generic_poly R n)"
context cring_coord_rings
begin
lemma ring_cfs_to_poly_closed:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "ring_cfs_to_poly R n as ∈ carrier (coord_ring R 1)"
proof-
have 0: "𝟬 # as ∈ carrier (R⇗n+2⇖)"
apply(rule cartesian_power_car_memI)
using assms
apply (metis add_2_eq_Suc' cartesian_power_car_memE length_Cons)
using assms
by (metis cartesian_power_car_memE'' insert_subset list.simps(15) R.zero_closed)
then have 1: "coord_partial_eval R {1..<n + 2} (𝟬 # as) ∈ ring_hom (coord_ring R (n + 2)) (Pring R ({..<n + 2} - {1..<n + 2}))"
using coord_partial_eval_hom' by blast
have "({..<n + 2} - {1..<n + 2}) = {..<1}"
by auto
then have 2: "coord_partial_eval R {1..<n + 2} (𝟬 # as) ∈ ring_hom (coord_ring R (n + 2)) (coord_ring R 1)"
using 1 unfolding coord_ring_def
by presburger
then show ?thesis
unfolding ring_cfs_to_poly_def coord_ring_def
by (metis "0" Diff_subset ‹{..<n + 2} - {1..<n + 2} = {..<1}›
add_2_eq_Suc' coord_partial_eval_closed generic_poly_closed
le_numeral_extra(4) lessThan_minus_lessThan lessThan_subset_iff)
qed
text‹Variant which maps to the univariate polynomial ring›
definition ring_cfs_to_univ_poly :: "nat ⇒ 'a list ⇒ nat ⇒ 'a" where
"ring_cfs_to_univ_poly n as = IP_to_UP (0::nat) (ring_cfs_to_poly R n as)"
lemma ring_cfs_to_univ_poly_closed:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "ring_cfs_to_univ_poly n as ∈ carrier (UP R)"
unfolding ring_cfs_to_univ_poly_def apply(rule R.IP_to_UP_closed, rule R.is_cring)
using ring_cfs_to_poly_closed unfolding coord_ring_def
using assms by (metis One_nat_def lessThan_0 lessThan_Suc)
lemma ring_cfs_to_poly_eq:
assumes "as ∈ carrier (R⇗Suc n⇖)"
assumes "k ≤n"
shows "ring_cfs_to_poly R k as = ring_cfs_to_poly R k (take (Suc k) as) "
unfolding ring_cfs_to_poly_def coord_partial_eval_def
apply(rule R.poly_eval_eval_function_eq[of "(point_to_eval_map R (𝟬 # as))" "(point_to_eval_map R (𝟬 # take (Suc k) as))" "{1..<k + 2}" _ "{..<k + 2}"])
proof-
show "closed_fun R (point_to_eval_map R (𝟬 # as))"
apply(rule R.closed_funI)
using assms cartesian_power_car_memE[of as R "Suc n"]
by (metis cartesian_power_car_memE'' nth_mem set_ConsD subset_code(1) R.zero_closed)
show "closed_fun R (λi. if i < length (𝟬 # take (Suc k) as) then (𝟬 # take (Suc k) as) ! i else 𝟬)"
apply(rule R.closed_funI)
using assms
by (metis cartesian_power_car_memE'' in_set_takeD nth_mem set_ConsD subset_code(1) R.zero_closed)
have 0: "length (𝟬 # as) ≥ k + 2"
using assms
by (metis Suc_le_mono add_2_eq_Suc' cartesian_power_car_memE length_Cons)
have 1: "length (𝟬 # take (Suc k) as) ≥k + 2"
using 0
by (metis add_2_eq_Suc' assms(1) cartesian_power_car_memE
impossible_Cons length_Cons not_less_eq_eq take_closed)
show "restrict (point_to_eval_map R (𝟬 # as)) {1..<k + 2} = restrict (point_to_eval_map R (𝟬 # take (Suc k) as)) {1..<k + 2}"
proof fix x
show "restrict (point_to_eval_map R (𝟬 # as)) {1..<k + 2} x = restrict (point_to_eval_map R (𝟬 # take (Suc k) as)) {1..<k + 2} x"
proof(cases "x ∈ {1..<k + 2}")
case True
have 00: "restrict (point_to_eval_map R (𝟬 # as)) {1..<k + 2} x = (𝟬#as)!x"
unfolding restrict_def
by (metis "0" True atLeastLessThan_iff le_Suc_ex trans_less_add1)
have 11: "restrict (point_to_eval_map R (𝟬 # take (Suc k) as)) {1..<k + 2} x = (𝟬 # take (Suc k) as)!x"
unfolding restrict_def
by (metis "1" True atLeastLessThan_iff le_Suc_ex trans_less_add1)
have 2: "(𝟬 # as) ! x = (𝟬 # take (Suc k) as) ! x"
proof-
obtain l where l_def: "Suc l = x"
using True
by (metis One_nat_def Suc_le_D atLeastLessThan_iff)
have P1: "(𝟬 # as) ! x = as ! l"
using 0 True l_def
by (meson nth_Cons_Suc)
have P0: "(𝟬 # take (Suc k) as) ! x = (take (Suc k) as) ! l"
using 1 True l_def
by (meson nth_Cons_Suc)
have "l < Suc k"
using True l_def
by (metis Suc_1 Suc_eq_plus1 Suc_less_SucD add_Suc_right atLeastLessThan_iff)
then have "(𝟬 # take (Suc k) as) ! x = as ! l"
using P0
by (metis nth_take)
then show ?thesis
using P1 by metis
qed
then show ?thesis using 00 11 True
by presburger
next
case False
then show ?thesis
unfolding restrict_def
by presburger
qed
qed
show " generic_poly R k ∈ Pring_set R {..<k + 2}"
by (metis R.Pring_car add_2_eq_Suc' coord_ring_def generic_poly_closed)
qed
lemma coord_partial_eval_generic_poly_lt:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "coord_partial_eval R {1..<n+2} (𝟬⇘R⇙#as) (generic_poly_lt R n) =
poly_scalar_mult R (as!n) ((pvar R 0)[^]⇘coord_ring R (n+2)⇙ n)"
proof-
have 0: "𝟬 # as ∈ carrier (R⇗Suc (Suc n)⇖)"
using assms cartesian_power_cons
by (metis Suc_eq_plus1 R.zero_closed)
have 1: "pvar R (Suc n) ∈ Pring_set R {..<n + 2}"
using pvar_closed
by (metis R.Pring_car add_2_eq_Suc' coord_ring_def lessI)
have 2: " pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n ∈ Pring_set R {..<n + 2}"
using monoid.nat_pow_closed pvar_closed unfolding coord_ring_def
using R.Pring_car R.Pring_is_monoid add_2_eq_Suc' zero_less_Suc
by (metis)
have 3: "poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R (Suc n) ⊗⇘coord_ring R (Suc (Suc n))⇙ pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
(poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as)) (pvar R (Suc n))) ⊗⇘coord_ring R (Suc (Suc n))⇙
(poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n))"
using 0 1 2 R.poly_eval_mult[of "pvar R (Suc n)" "{..<n+2}" " pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n"
"(point_to_eval_map R (𝟬 # as))" "{1..<n + 2}"] unfolding coord_ring_def
by (smt R.Pring_mult cartesian_power_car_memE cartesian_power_car_memE' R.closed_funI R.zero_closed)
have 4: "poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R (Suc n) ⊗⇘coord_ring R (Suc (Suc n))⇙ pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
(coord_const ((𝟬 # as)! (Suc n))) ⊗⇘coord_ring R (Suc (Suc n))⇙
(poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n))"
using 0 3 point_to_eval_map_closed[of "(𝟬 # as)" "Suc (Suc n)"]
R.poly_eval_index[of "(point_to_eval_map R (𝟬 # as))" "{1..<n + 2}" "Suc n"]
add_2_eq_Suc' atLeastLessThan_iff cartesian_power_car_memE le_neq_implies_less
less_Suc_eq not_less_eq_eq not_less_zero numeral_1_eq_Suc_0 numeral_One var_to_IP_def
by (smt local.one_neq_zero)
have 5: "pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n ∈ Pring_set R ({..<n + 2} - {1..<n + 2}) "
proof-
have "0 ∈ {..<n + 2} - {1..<n + 2}" by auto
then have "pvar R 0 [^]⇘Pring R ({..<n + 2} - {1..<n + 2})⇙ n ∈ carrier (Pring R ({..<n + 2} - {1..<n + 2}))"
using R.Pring_var_closed[of 0 "{..<n + 2} - {1..<n + 2}"] R.Pring_is_monoid[of "{..<n + 2} - {1..<n + 2}"]
monoid.nat_pow_closed[of "Pring R ({..<n + 2} - {1..<n + 2})" "pvar R 0" n ]
by blast
have "⋀k::nat. (pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ k) = (pvar R 0 [^]⇘Pring R ({..<n + 2} - {1..<n + 2})⇙k)"
proof- fix k::nat show "(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ k) = (pvar R 0 [^]⇘Pring R ({..<n + 2} - {1..<n + 2})⇙k)"
apply(induction k)
using R.Pring_var_closed[of 0 "{..<(Suc (Suc n))}"] R.Pring_var_closed[of 0 "{..<n + 2} - {1..<n + 2}"]
unfolding coord_ring_def
apply (metis Group.nat_pow_0 R.ring_axioms R.Pring_one)
using R.Pring_var_closed[of 0 "{..<(Suc (Suc n))}"] R.Pring_var_closed[of 0 "{..<n + 2} - {1..<n + 2}"]
nat_pow_def
by (metis R.Pring_mult_eq R.Pring_one_eq add_2_eq_Suc')
qed
then show ?thesis
by (metis R.Pring_car ‹pvar R 0 [^]⇘Pring R ({..<n + 2} - {1..<n + 2})⇙ n ∈ carrier (Pring R ({..<n + 2} - {1..<n + 2}))›)
qed
have 6: "(poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n)) = (pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n)"
using 5 0 point_to_eval_map_closed[of "(𝟬 # as)" "Suc (Suc n)"]
R.poly_eval_trivial[of "(point_to_eval_map R (𝟬 # as))" "pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n" "{..<n + 2}" "{1..<n + 2}" ]
by blast
have 7: "poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R (Suc n) ⊗⇘coord_ring R (Suc (Suc n))⇙ pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
(coord_const ((𝟬 # as)! (Suc n))) ⊗⇘coord_ring R (Suc (Suc n))⇙
(pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n)"
using 4 6
by presburger
have 8: "(𝟬 # as) ! Suc n = as! n"
by (meson nth_Cons_Suc)
have 88: "(𝟬 # as) ! Suc n ∈ carrier R"
by (metis "8" assms cartesian_power_car_memE' less_Suc_eq)
have 9: "poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R (Suc n) ⊗⇘coord_ring R (Suc (Suc n))⇙ pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
coord_const ((𝟬 # as) ! Suc n) ⨂⇩p pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n "
using R.poly_scalar_mult_eq[of "(𝟬 # as) ! Suc n" "pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n"]
unfolding coord_ring_def
by (metis (no_types, lifting) "7" R.Pring_mult coord_ring_def)
have 10: "poly_scalar_mult R ((𝟬 # as) ! Suc n) (pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
coord_const ((𝟬 # as) ! Suc n) ⨂⇩p pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n"
using 9 8 88 0 5 R.poly_scalar_mult_eq[of "(𝟬 # as) ! Suc n" "pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n" "({..<n + 2} - {1..<n + 2})"]
by blast
have 11: "poly_scalar_mult R (as! n) (pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
coord_const ((𝟬 # as) ! Suc n) ⨂⇩p pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n"
using 10 8
by metis
have 12: "poly_eval R {1..<n + 2} (point_to_eval_map R (𝟬 # as))
(pvar R (Suc n) ⊗⇘coord_ring R (Suc (Suc n))⇙ pvar R 0 [^]⇘coord_ring R (Suc (Suc n))⇙ n) =
poly_scalar_mult R (as ! n) ((pvar R 0) [^]⇘coord_ring R (n + 2)⇙ n)"
using 11 9
by (metis add_2_eq_Suc')
then show ?thesis
unfolding coord_partial_eval_def generic_poly_lt_def
by blast
qed
lemma coord_partial_eval_generic_poly_lt':
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "coord_partial_eval R {1..<n+2} (𝟬⇘R⇙#as) (generic_poly_lt R n) =
poly_scalar_mult R (as!n) ((pvar R 0)[^]⇘coord_ring R 1⇙ n)"
proof-
have 0: "coord_partial_eval R {1..<n+2} (𝟬⇘R⇙#as) (generic_poly_lt R n) =
poly_scalar_mult R (as!n) ((pvar R 0)[^]⇘coord_ring R (n+2)⇙ n)"
using assms coord_partial_eval_generic_poly_lt by blast
have 1: "⋀k::nat. (pvar R 0)[^]⇘coord_ring R (n+2)⇙ k = (pvar R 0)[^]⇘coord_ring R 1⇙ k"
proof- fix k::nat show "(pvar R 0)[^]⇘coord_ring R (n+2)⇙ k = (pvar R 0)[^]⇘coord_ring R 1⇙ k"
apply(induction k)
unfolding coord_ring_def
apply (metis Group.nat_pow_0 R.Pring_one_eq)
using nat_pow_def
by (metis R.Pring_mult_eq R.Pring_one add_2_eq_Suc')
qed
then show ?thesis
using "0" by presburger
qed
lemma ring_cfs_to_poly_decomp:
assumes "as ∈ carrier (R⇗Suc (Suc n)⇖)"
shows "ring_cfs_to_poly R (Suc n) as = ring_cfs_to_poly R n as ⊕⇘coord_ring R 1⇙
poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n))"
proof-
have LHS: "ring_cfs_to_poly R (Suc n) as =
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly R n ⊕⇘coord_ring R (Suc (Suc (Suc n)))⇙ generic_poly_lt R (Suc n))"
by (smt add_2_eq_Suc' add_Suc_right generic_poly.simps(2) numeral_2_eq_2 numeral_3_eq_3 ring_cfs_to_poly_def)
have LHS': "ring_cfs_to_poly R (Suc n) as =
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly R n) ⊕⇘coord_ring R (Suc (Suc (Suc n)))⇙
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly_lt R (Suc n))"
using coord_partial_eval_add[of as "Suc n"]
by (metis LHS add_2_eq_Suc' add_Suc_shift assms cartesian_power_cons
coord_partial_eval_add generic_poly_closed' generic_poly_lt_closed le_add2 plus_1_eq_Suc R.zero_closed)
have LHS'': "ring_cfs_to_poly R (Suc n) as =
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly R n) ⊕⇘coord_ring R (Suc (Suc (Suc n)))⇙
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly_lt R (Suc n))"
using coord_partial_eval_add[of as "Suc n"]
by (metis LHS add_2_eq_Suc' add_Suc_shift assms cartesian_power_cons
coord_partial_eval_add generic_poly_closed' generic_poly_lt_closed le_add2 plus_1_eq_Suc R.zero_closed)
have LHS''': "ring_cfs_to_poly R (Suc n) as =
coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly R n) ⊕⇘coord_ring R (Suc (Suc (Suc n)))⇙
poly_scalar_mult R (as! (Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n))"
using LHS'' coord_partial_eval_generic_poly_lt'[of as "Suc n"] assms
by presburger
have 0: "coord_partial_eval R {1..<Suc n + 2} (𝟬 # as) (generic_poly R n) = ring_cfs_to_poly R n as"
proof-
have 00: "(generic_poly R n) ∈ carrier (coord_ring R (n + 2))"
using add_2_eq_Suc' generic_poly_closed by presburger
have 01: "𝟭 ≠ 𝟬"
using one_neq_zero
by presburger
have 02: "(𝟬 # as) ∈ carrier (R⇗Suc (Suc n) + 1⇖)"
using cartesian_power_cons[of as R "Suc (Suc n)" 𝟬] assms
by blast
have 03: "closed_fun R (point_to_eval_map R (𝟬 # as))"
using point_to_eval_map_closed[of "𝟬#as" "Suc (Suc (Suc n))"]
by (metis "02" Suc_eq_plus1)
have 04: "{1..<Suc n + 2} ∩ {..<n + 2} = {1..<n + 2} ∩ {..<n + 2}"
by auto
show ?thesis
unfolding ring_cfs_to_poly_def coord_partial_eval_def
using 04 03 02 01 00 R.Pring_car[of "{..<n + 2}"] assms
R.poly_eval_eval_set_eq[of "point_to_eval_map R (𝟬 # as)" "{1..<Suc n + 2}"
"{..<n + 2}" "{1..<n + 2}" "(generic_poly R n)" ]
by (metis coord_ring_def)
qed
show ?thesis
using generic_poly.simps(2)[of R n] coord_partial_eval_add LHS''' 0
unfolding ring_cfs_to_poly_def
by (metis R.Pring_add_eq coord_ring_def)
qed
lemma ring_cfs_to_poly_decomp':
assumes "as ∈ carrier (R⇗Suc (Suc n)⇖)"
shows "ring_cfs_to_poly R (Suc n) as =
ring_cfs_to_poly R n (take (Suc n) as) ⊕⇘coord_ring R 1⇙
poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n))"
using assms ring_cfs_to_poly_decomp[of as n]
ring_cfs_to_poly_eq[of as "Suc n" n] le_eq_less_or_eq less_Suc_eq
by presburger
lemma ring_cfs_to_univ_poly_decomp':
assumes "as ∈ carrier (R⇗Suc (Suc n)⇖)"
shows "ring_cfs_to_univ_poly (Suc n) as =
ring_cfs_to_univ_poly n (take (Suc n) as) ⊕⇘UP R⇙
(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))"
proof-
have 00: "(pvar R 0 [^]⇘coord_ring R 1⇙ Suc n) ∈ carrier (Pring R {0})"
using pvar_closed[of 0 1] monoid.nat_pow_closed[of "coord_ring R 1" _ n ]
unfolding coord_ring_def
by (metis One_nat_def R.Pring_is_monoid lessThan_0 lessThan_Suc less_one monoid.nat_pow_closed)
have LHS: "ring_cfs_to_univ_poly (Suc n) as =
IP_to_UP 0 (ring_cfs_to_poly R n (take (Suc n) as) ⊕⇘coord_ring R 1⇙
poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n)))"
using assms ring_cfs_to_poly_decomp'
unfolding ring_cfs_to_univ_poly_def
by presburger
have LHS': "ring_cfs_to_univ_poly (Suc n) as =
IP_to_UP 0 (ring_cfs_to_poly R n (take (Suc n) as)) ⊕⇘UP R⇙
IP_to_UP 0 (poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n)))"
proof-
have 0: " ring_cfs_to_poly R n (take (Suc n) as) ∈ carrier (Pring R {0})"
by (metis One_nat_def assms coord_ring_def le_add2 lessThan_0 lessThan_Suc plus_1_eq_Suc ring_cfs_to_poly_closed take_closed)
have 1: "as ! Suc n ∈ carrier R"
using assms cartesian_power_car_memE'[of as R "Suc (Suc n)"]
by blast
have 2: "poly_scalar_mult R (as ! Suc n) (pvar R 0 [^]⇘coord_ring R 1⇙ Suc n) ∈ carrier (Pring R {0})"
using 1 00 R.Pring_car R.poly_scalar_mult_closed[of "(as ! Suc n)" "(pvar R 0 [^]⇘coord_ring R 1⇙ Suc n)" "{0}"]
by blast
then show ?thesis
using 0 1 2 UP_cring.IP_to_UP_add[of R "(ring_cfs_to_poly R n (take (Suc n) as))" "0"
"poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n))"]
by (metis LHS One_nat_def UP_cring_def coord_ring_def R.is_cring lessThan_0 lessThan_Suc)
qed
have 0: "IP_to_UP 0 (ring_cfs_to_poly R n (take (Suc n) as)) =
ring_cfs_to_univ_poly n (take (Suc n) as)"
using ring_cfs_to_univ_poly_def
by presburger
have 1: "(mset_to_IP R (nat_to_mset 0 (Suc n))) = (pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n)"
unfolding coord_ring_def using lessThan_iff less_one
by (metis UP_cring.intro UP_cring.pvar_pow R.is_cring)
have 2: "as ! Suc n ∈ carrier R"
using cartesian_power_car_memE' assms
by blast
have 3: "IP_to_UP 0 (poly_scalar_mult R (as ! Suc n) (pvar R 0 [^]⇘coord_ring R 1⇙ Suc n)) =
as ! Suc n ⊙⇘UP R⇙ IP_to_UP 0 (pvar R 0 [^]⇘coord_ring R 1⇙ Suc n)"
using UP_cring.IP_to_UP_scalar_mult[of R "as!(Suc n)" "((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n))" 0]
"00" "2" unfolding coord_ring_def
by (metis R.Pring_smult UP_cring.intro R.is_cring)
have 4: "IP_to_UP 0 (poly_scalar_mult R (as!(Suc n)) ((pvar R 0)[^]⇘coord_ring R 1⇙ (Suc n)))
= (as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))"
proof -
have "as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ Suc n = IP_to_UP (0::nat) (Mt (as ! Suc n) (nat_to_mset 0 (Suc n)))"
using 3 1 UP_cring.IP_to_UP_monom
by (metis UP_cring.intro R.is_cring)
then show ?thesis
using ‹mset_to_IP R (nat_to_mset 0 (Suc n)) = pvar R 0 [^]⇘coord_ring R 1⇙ Suc n›
by presburger
qed
then show ?thesis
using "0" LHS'
by presburger
qed
lemma ring_cfs_to_univ_poly_decomp:
assumes "as ∈ carrier (R⇗Suc n⇖)"
assumes "k < n"
shows "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k)) as) = ring_cfs_to_univ_poly k (take (Suc k) as)
⊕⇘UP R⇙ (as!(Suc k)) ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc k)"
proof-
have 0: "(take (Suc (Suc k)) as) ∈ carrier (R⇗Suc (Suc k)⇖)"
using assms
by (meson Suc_leI Suc_mono take_closed)
then show ?thesis using ring_cfs_to_univ_poly_decomp'[of "take (Suc (Suc k)) as" k]
by (metis (no_types, lifting) Suc_leI assms(1) assms(2) cartesian_power_car_memE
lessI less_SucI nth_take nth_take_lemma)
qed
lemma ring_cfs_to_univ_poly_degree:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "deg R (ring_cfs_to_univ_poly n as) ≤ n"
"as!n ≠ 𝟬 ⟹ deg R (ring_cfs_to_univ_poly n as) = n"
proof-
have 0:"⋀as. as ∈ carrier (R⇗Suc n⇖) ⟹
deg R (ring_cfs_to_univ_poly n as) ≤ n ∧ (as!n ≠ 𝟬 ⟶ deg R (ring_cfs_to_univ_poly n as) = n)"
proof(induction n)
case 0
show "⋀as. as ∈ carrier (R⇗Suc 0⇖) ⟹
deg R (ring_cfs_to_univ_poly 0 as) ≤ 0 ∧
(as ! 0 ≠ 𝟬 ⟶ deg R (ring_cfs_to_univ_poly 0 as) = 0)"
proof-
fix as assume A: "as ∈ carrier (R⇗Suc 0⇖)"
have 0:"cring R"
by (simp add: R.is_cring)
have 1:"𝟬 # as ∈ carrier (R⇗2⇖)"
using A cartesian_power_cons[of as R "Suc 0" 𝟬]
by (metis numeral_1_eq_Suc_0 numeral_One one_add_one R.zero_closed)
have 2: "(𝟬 # as) ! 1 = as!0"
using A
by (metis One_nat_def nth_Cons_Suc)
have 3: "1 ∈ {(1::nat)..<0 + 2} ∩ {..<2}"
by auto
have 4: "coord_partial_eval R {1::nat..<0 + 2} (𝟬 # as) (pvar R (1::nat)) =
R.indexed_const (as!0)"
unfolding ring_cfs_to_univ_poly_def ring_cfs_to_poly_def
using 0 1 2 one_neq_zero UP_cring.IP_to_UP_indexed_const[of R "as!0" 0] generic_poly.simps(1)[of R] coord_partial_eval_pvar[of "𝟬#as" 2 "1::nat" "{1..<0+2}" ]
unfolding UP_cring_def
using "3" by presburger
have 5: "ring_cfs_to_univ_poly 0 as = IP_to_UP (0::nat) (R.indexed_const (as ! 0))"
unfolding ring_cfs_to_univ_poly_def ring_cfs_to_poly_def
using 4 generic_poly.simps(1)[of R]
by presburger
hence "ring_cfs_to_univ_poly 0 as = to_polynomial R (as!0)"
by (metis A UP_cring.IP_to_UP_indexed_const UP_cring.intro
cartesian_power_car_memE' R.is_cring lessI)
assume B: "as ∈ carrier (R⇗Suc 0⇖) "
have 0: "(point_to_eval_map R (𝟬 # as) 1) = as!0"
by (metis B One_nat_def cartesian_power_car_memE impossible_Cons le_numeral_extra(4)
linorder_neqE_nat nat_less_le nth_Cons_Suc)
have 1: "closed_fun R ((point_to_eval_map R (𝟬 # as)))"
apply(rule R.closed_funI)
by (metis "0" B One_nat_def cartesian_power_car_memE cartesian_power_car_memE'
length_Suc_conv less_Suc0 less_SucE nth_Cons_0 R.zero_closed)
have 2: "(1::nat) ∈ ({1..<0 + 2}::nat set)"
by simp
have 3: "poly_eval R {1..<0 + 2} (point_to_eval_map R (𝟬 # as)) (mset_to_IP R {#1#}) =
coord_const (point_to_eval_map R (𝟬 # as) 1)"
using generic_poly.simps(1)[of R] one_neq_zero
unfolding ring_cfs_to_poly_def coord_partial_eval_def var_to_IP_def
using 0 1 2 R.poly_eval_index[of "(point_to_eval_map R (𝟬 # as))" "{1..<0 + 2}" 1]
by (metis (no_types, lifting))
have 4: "(ring_cfs_to_poly R 0 as) = coord_const (as! 0)"
using 3 0 generic_poly.simps(1)[of R]
unfolding ring_cfs_to_poly_def coord_partial_eval_def var_to_IP_def
by presburger
have 5: "as! 0 ∈ carrier R"
using assms B cartesian_power_car_memE' by blast
have 6: "(ring_cfs_to_univ_poly 0 as) = to_polynomial R (as! 0)"
unfolding ring_cfs_to_univ_poly_def ring_cfs_to_poly_def
using 3 4 5 UP_cring.IP_to_UP_indexed_const[of R "as!0" "0::nat"]
unfolding coord_partial_eval_def
by (smt "0" ‹ring_cfs_to_univ_poly 0 as = to_polynomial R (as ! 0)› generic_poly.simps(1) ring_cfs_to_univ_poly_def var_to_IP_def)
then show " deg R (ring_cfs_to_univ_poly 0 as) ≤ 0 ∧ (as ! 0 ≠ 𝟬 ⟶ deg R (ring_cfs_to_univ_poly 0 as) = 0)"
using UP_cring.degree_to_poly[of R "as! 0"] 5 UP_cring_def[of R]
using R.is_cring by presburger
qed
next
case (Suc n)
have 0: "(ring_cfs_to_univ_poly (Suc n) as) = ring_cfs_to_univ_poly n (take (Suc n) as) ⊕⇘UP R⇙
(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))"
using ring_cfs_to_univ_poly_decomp' Suc.prems by blast
have 1: "(take (Suc n) as) ∈ carrier (R⇗Suc n⇖)"
using Suc.prems
by (meson le_Suc_eq take_closed)
have 2: "deg R (ring_cfs_to_univ_poly n (take (Suc n) as)) ≤ n"
using "1" Suc.IH
by blast
have 3: "deg R ((as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))) ≤ Suc n"
using UP_cring.degree_monom[of R "as!(Suc n)" "Suc n"] UP_cring_def[of R]
Suc.prems cartesian_power_car_memE' le_Suc_eq lessI less_imp_le_nat zero_less_Suc
by (metis R.is_cring)
have 4: "(X_poly R [^]⇘UP R⇙ (Suc n)) ∈ carrier (UP R)"
proof-
have 40: "Group.monoid (UP R)"
using UP_cring_def[of R] UP_domain_def cring.axioms(1) ring.is_monoid
using UP_cring.UP_cring R.is_cring by blast
have 41: "X_poly R ∈ carrier (UP R)"
using UP_cring.X_closed[of R] UP_cring_def[of R] R.is_cring
by blast
show ?thesis
using monoid.nat_pow_closed[of "UP R" "X_poly R" "Suc n"] 40 41
by blast
qed
have 5: "deg R (ring_cfs_to_univ_poly (Suc n) as) ≤Suc n"
proof(cases "as!(Suc n) = 𝟬")
case True
then have T0: "(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n)) = 𝟬⇘UP R⇙"
using 4 UP_ring.UP_smult_zero[of R "X_poly R [^]⇘UP R⇙ (Suc n)"] UP_ring_def[of R] R.ring_axioms
by presburger
then show ?thesis
using UP_ring.deg_zero[of R] UP_ring_def[of R]
by (metis "0" "1" "2" "3" UP_ring.UP_zero_closed UP_ring.bound_deg_sum le_SucI R.ring_axioms ring_cfs_to_univ_poly_closed)
next
case False
have F0 : "as!(Suc n) ∈ carrier R"
by (metis Suc.prems cartesian_power_car_memE le_simps(1) lessI not_less_eq_eq poly_tuple_evalE poly_tuple_evalE' pushforward_by_pvar_list pvar_list_is_poly_tuple zero_less_Suc)
have F1: "(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n)) ∈ carrier (UP R)"
using F0 4 UP_ring.UP_smult_closed[of R "as!(Suc n)" "X_poly R [^]⇘UP R⇙ Suc n "]
UP_ring_def[of R] assms R.ring_axioms
by blast
have "deg R ((as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))) = Suc n"
using False UP_cring.degree_monom[of R "as!(Suc n)" "Suc n"] UP_cring_def[of R]
cartesian_power_car_memE' lessI
using F0 R.is_cring
by presburger
then show ?thesis
using UP_ring.degree_of_sum_diff_degree[of R "(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))"
"ring_cfs_to_univ_poly n (take (Suc n) as)"] 1 2 4 UP_domain_def[of R] F1
ring_cfs_to_univ_poly_closed[of "take (Suc n) as" "Suc n"] "0" "3"
UP_ring_def[of R] UP_cring_def[of R]
UP_ring.equal_deg_sum less_Suc_eq_le ring_cfs_to_univ_poly_closed
by (metis R.ring_axioms)
qed
have 6: "(as ! (Suc n) ≠ 𝟬 ⟶ deg R (ring_cfs_to_univ_poly (Suc n) as) = Suc n)"
proof
assume F: "as ! (Suc n) ≠ 𝟬 "
have F0 : "as!(Suc n) ∈ carrier R"
by (metis Suc.prems cartesian_power_car_memE le_simps(1) lessI not_less_eq_eq poly_tuple_evalE poly_tuple_evalE' pushforward_by_pvar_list pvar_list_is_poly_tuple zero_less_Suc)
have F1: "(as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n)) ∈ carrier (UP R)"
using F0 4 UP_ring.UP_smult_closed[of R "as!(Suc n)" "X_poly R [^]⇘UP R⇙ Suc n "]
UP_ring_def[of R] assms R.ring_axioms
by blast
then have F2: "deg R ((as!(Suc n))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc n))) = Suc n"
using F0 F UP_cring.degree_monom[of R "as!(Suc n)" "Suc n"] UP_cring_def[of R] R.is_cring
by presburger
have F3: "ring_cfs_to_univ_poly n (take (Suc n) as) ∈ carrier (UP R)"
using "1" ring_cfs_to_univ_poly_closed
by blast
show "deg R (ring_cfs_to_univ_poly (Suc n) as) = Suc n"
using UP_domain_def[of R] 0 F1 F2 F3 1 2
UP_ring.degree_of_sum_diff_degree[of R "ring_cfs_to_univ_poly n (take (Suc n) as)"
"as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ Suc n"]
UP_ring.equal_deg_sum le_imp_less_Suc UP_ring_def[of R] UP_cring_def[of R]
by (metis R.ring_axioms)
qed
show ?case
using "5" "6" by blast
qed
show "deg R (ring_cfs_to_univ_poly n as) ≤ n"
using 0 assms
by blast
show "as ! n ≠ 𝟬 ⟹ deg R (ring_cfs_to_univ_poly n as) = n"
using 0 assms
by blast
qed
lemma ring_cfs_to_univ_poly_constant:
assumes "as ∈ carrier (R⇗1⇖)"
shows "ring_cfs_to_univ_poly 0 as = to_polynomial R (as!0)"
proof-
have 0: "(1::nat) ∈ {1..<0 + 2}"
by simp
have 1: "closed_fun R (point_to_eval_map R (𝟬 # as))"
using assms
by (smt cartesian_power_car_memE'' R.closed_funI nth_mem set_ConsD subset_code(1) R.zero_closed)
have 2: "(point_to_eval_map R (𝟬 # as) (1::nat)) = as!0"
by (metis One_nat_def assms cartesian_power_car_memE impossible_Cons
le_numeral_extra(4) linorder_neqE_nat nat_less_le nth_Cons_Suc)
have 3: "as!0 ∈ carrier R"
using assms cartesian_power_car_memE'
by blast
have "(poly_eval R {1::nat..<0 + 2} (point_to_eval_map R (𝟬 # as)) (generic_poly R 0)) = coord_const (point_to_eval_map R (𝟬 # as) 1)"
using generic_poly.simps(1)[of R] 0 1 one_not_zero
cring.poly_eval_index[of R "point_to_eval_map R (𝟬 # as)" "{1..<0 + 2}" 1]
unfolding var_to_IP_def
using R.is_cring local.one_neq_zero by presburger
then have "(poly_eval R {1..<0 + 2} (point_to_eval_map R (𝟬 # as)) (generic_poly R 0)) = coord_const (as!0)"
using 2
by presburger
then show ?thesis
using 3
unfolding ring_cfs_to_univ_poly_def ring_cfs_to_poly_def coord_partial_eval_def
by (metis UP_cring.IP_to_UP_indexed_const UP_cring.intro R.is_cring)
qed
lemma ring_cfs_to_univ_poly_top_coeff:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "(ring_cfs_to_univ_poly n as) n = as ! n"
proof(cases "n = 0")
case True
have 0: "as ! 0 ∈ carrier R"
using assms cartesian_power_car_memE'
by blast
have 1: "to_polynomial R (as ! 0) 0 = as ! 0"
using assms cartesian_power_car_memE'[of as R "Suc n"] UP_ring.cfs_monom[of R]
unfolding to_polynomial_def UP_ring_def
using "0" R.ring_axioms by presburger
have "ring_cfs_to_univ_poly 0 as = to_polynomial R (as ! 0)"
using One_nat_def True assms ring_cfs_to_univ_poly_constant by presburger
then show ?thesis
using True 1
by presburger
next
case False
obtain k where k_def: "Suc k = n"
using False
by (metis lessI less_Suc_eq_0_disj)
have "ring_cfs_to_univ_poly (Suc k) as (Suc k) = as ! (Suc k)"
proof-
have 0: "ring_cfs_to_univ_poly (Suc k) as n = ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k))as) n"
by (metis assms(1) k_def le_Suc_eq ring_cfs_to_poly_eq ring_cfs_to_univ_poly_def)
have 1: "take (Suc (Suc k)) as ∈ carrier (R⇗Suc (Suc k)⇖)"
using assms k_def take_closed
by blast
have 2: "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k))as) =
ring_cfs_to_univ_poly k (take (Suc k) (take (Suc (Suc k)) as)) ⊕⇘UP R⇙ (as!(Suc k))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc k))"
using 1 ring_cfs_to_univ_poly_decomp'[of "take (Suc (Suc k))as" k] assms
by (metis cartesian_power_car_memE k_def nat_le_linear take_all)
have 3: "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k))as) =
ring_cfs_to_univ_poly k (take (Suc k) as) ⊕⇘UP R⇙ (as!(Suc k))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc k))"
using 2
by (metis assms(1) k_def le_Suc_eq ring_cfs_to_poly_eq ring_cfs_to_univ_poly_decomp' ring_cfs_to_univ_poly_def)
have 4: "deg R (ring_cfs_to_univ_poly k (take (Suc k) as)) ≤ k"
by (metis assms(1) dual_order.refl k_def le_SucI ring_cfs_to_univ_poly_degree(1) take_closed)
have 5: "(ring_cfs_to_univ_poly k (take (Suc k) as)) ∈ carrier (UP R)"
by (metis assms(1) k_def le_Suc_eq le_refl ring_cfs_to_univ_poly_closed take_closed)
have 6: "X_poly R [^]⇘UP R⇙ Suc k ∈ carrier (UP R)"
using monoid.nat_pow_closed[of "UP R" "X_poly R" "Suc k"] domain_def ring.is_monoid[of "UP R"]
UP_cring.X_closed[of R] UP_domain_def[of R] UP_cring_def[of R]
cring.axioms(1) UP_cring.UP_cring
using R.is_cring by blast
have 7: " (as!(Suc k))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc k)) ∈ carrier (UP R)"
using UP_ring.UP_smult_closed[of R "as!(Suc k)" " (X_poly R [^]⇘UP R⇙ (Suc k))"]
UP_ring_def[of R] domain_def 6 cartesian_power_car_memE'[of as R _ "Suc k"]
assms(1) k_def R.ring_axioms by blast
have 8: "ring_cfs_to_univ_poly (Suc k) as (Suc k) = ( (as!(Suc k))⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ (Suc k))) (Suc k)"
using 3 4 k_def
"5" 7 UP_cring_def[of R] UP_ring_def[of R] add.r_cancel_one' assms(1)
cartesian_power_car_memE le_eq_less_or_eq
le_imp_less_Suc take_all R.zero_closed UP_ring.UP_a_comm UP_ring.coeff_of_sum_diff_degree0 R.ring_axioms
by (metis (no_types, lifting))
then show ?thesis using UP_cring_def[of R] UP_cring.monom_coeff assms(1) cartesian_power_car_memE
k_def lessI point_to_eval_map_closed
by (metis (no_types, lifting) cartesian_power_car_memE' R.is_cring)
qed
then show ?thesis
using k_def False
by blast
qed
lemma(in UP_cring) monom_plus_lower_degree_top_coeff:
assumes "degree p < n"
assumes "p ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "(p ⊕⇘UP R⇙ (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ n)) n = a"
proof-
have 0: "(a ⊙⇘UP R⇙ (X_poly R [^]⇘UP R⇙ n)) ∈ carrier (UP R)"
using P.nat_pow_closed P_def X_closed assms(3) smult_closed
by blast
have 1: "( (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ n) ⊕⇘UP R⇙ p) n = (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ n) n"
using "0" UP_ring.coeff_of_sum_diff_degree0[of R] UP_cring_def[of R] assms(1) assms(2)
using is_UP_ring by blast
then show ?thesis
using 0 assms P_def UP_a_comm UP_cring.monom_coeff UP_cring_def[of R]
by (metis R_cring)
qed
lemma(in UP_cring) monom_closed:
assumes "a ∈ carrier R"
shows "a ⊙⇘UP R⇙ ((X_poly R)[^]⇘UP R⇙ (n::nat)) ∈ carrier (UP R)"
using P.nat_pow_closed P_def assms X_closed carrier_is_submodule submoduleE(4)
by blast
lemma(in UP_cring) monom_bottom_coeff:
assumes "a ∈ carrier R"
assumes "n > 0"
shows "(a ⊙⇘UP R⇙ ((X_poly R)[^]⇘UP R⇙ (n::nat))) 0 = 𝟬"
using assms monom_coeff[of a n] P_def local.monom_coeff
by presburger
lemma(in UP_cring) monom_plus_lower_degree_bottom_coeff:
assumes "0 < n"
assumes "p ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "(p ⊕⇘UP R⇙ (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (n::nat))) 0 = p 0"
proof-
have 0: "p 0 ∈ carrier R"
using assms(2) UP_ring_def is_UP_ring P_def cfs_closed by blast
have 1: "(p ⊕⇘UP R⇙ (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (n::nat))) 0 = p 0 ⊕ (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ n) 0"
using assms monom_closed[of a n] cfs_add[of p "(a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (n::nat))" 0]
unfolding P_def
by blast
then have "(a ⊙⇘UP R⇙ ((X_poly R) [^]⇘UP R⇙ n)) 0 = 𝟬"
using monom_bottom_coeff[of a n] P_def assms(1) assms(3) local.monom_coeff
by blast
then have 2: "(p ⊕⇘UP R⇙ (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (n::nat))) 0 = p 0 ⊕ 𝟬"
using 1 by metis
then show ?thesis
using 0 R.add.l_cancel_one[of "p 0"] R.zero_closed
by presburger
qed
lemma ring_cfs_to_univ_poly_bottom_coeff:
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "(ring_cfs_to_univ_poly n as) 0 = as ! 0"
proof-
have "⋀as. as ∈ carrier (R⇗Suc n⇖) ⟹ (ring_cfs_to_univ_poly n as) 0 = as ! 0"
apply(induction n)
using ring_cfs_to_univ_poly_top_coeff apply blast
proof-
fix n as
assume IH: "⋀as. as ∈ carrier (R⇗Suc n⇖) ⟹ (ring_cfs_to_univ_poly n as) 0 = as ! 0"
assume A: "as ∈ carrier (R⇗Suc (Suc n)⇖)"
show "ring_cfs_to_univ_poly (Suc n) as 0 = as ! 0"
proof-
have 0: "ring_cfs_to_univ_poly (Suc n) as = ring_cfs_to_univ_poly n (take (Suc n) as) ⊕⇘UP R⇙ (as!(Suc n))⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc n)"
using A ring_cfs_to_univ_poly_decomp'[of as n]
by blast
have 1: "ring_cfs_to_univ_poly n (take (Suc n) as) ∈ carrier (UP R)"
by (meson A ring_cfs_to_univ_poly_closed R.is_cring le_Suc_eq take_closed)
have 2:"as ! Suc n ∈ carrier R"
using assms cartesian_power_car_memE' A
by blast
have 3: "(ring_cfs_to_univ_poly n (take (Suc n) as) ⊕⇘UP R⇙ as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ (Suc n)) 0 =
ring_cfs_to_univ_poly n (take (Suc n) as) 0"
proof-
have "as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ Suc n ∈ carrier (UP R)"
by (meson "2" UP_cring.monom_closed UP_cring_def R.is_cring)
hence 30: "(ring_cfs_to_univ_poly n (take (Suc n) as) ⊕⇘UP R⇙ as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ (Suc n)) 0 =
(ring_cfs_to_univ_poly n (take (Suc n) as)) 0 ⊕ (as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ (Suc n)) 0"
using A ring_cfs_to_univ_poly_closed[of "take (Suc n) as" "n"] take_closed[of "Suc n" "Suc (Suc n)" as R]
UP_ring.cfs_add[of R "ring_cfs_to_univ_poly n (take (Suc n) as)" "as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ (Suc n)" 0]
unfolding UP_ring_def
using "1" R.ring_axioms by blast
have 31: "(as ! Suc n ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ Suc n) 0 = 𝟬"
by (metis (no_types, lifting) "2" Suc_neq_Zero UP_cring.monom_coeff UP_cring_def R.is_cring)
thus ?thesis using 30 2
by (simp add: "1" UP_car_memE(1))
qed
have 4: "(take (Suc n) as) ∈ carrier (R⇗Suc n⇖)"
by (meson A le_Suc_eq take_closed)
have 5: "ring_cfs_to_univ_poly n (take (Suc n) as) 0 = as!0"
using IH[of "(take (Suc n) as)"] 4 nth_take[of 0 "Suc n" as] less_Suc_eq_0_disj
by presburger
then show ?thesis
using 0 3
by presburger
qed
qed
then show ?thesis
using assms
by blast
qed
lemma ring_cfs_to_univ_poly_chain:
assumes "as ∈ carrier (R⇗Suc n⇖)"
assumes "l ≤ n"
shows "l ≤ k ∧ k ≤ n ⟹ (ring_cfs_to_univ_poly k (take (Suc k) as)) l = (ring_cfs_to_univ_poly l (take (Suc l) as)) l"
apply( induction k)
apply blast
proof-
fix k
assume IH: "(l ≤ k ∧ k ≤ n ⟹ ring_cfs_to_univ_poly k (take (Suc k) as) l = ring_cfs_to_univ_poly l (take (Suc l) as) l)"
assume A: "l ≤ Suc k ∧ Suc k ≤ n"
show "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k)) as) l = ring_cfs_to_univ_poly l (take (Suc l) as) l"
proof(cases "l = Suc k")
case True
then show ?thesis
by blast
next
case False
then have "l ≤ k ∧ k ≤ n "
using A le_Suc_eq
by blast
then have 0: " ring_cfs_to_univ_poly k (take (Suc k) as) l = ring_cfs_to_univ_poly l (take (Suc l) as) l"
using IH
by blast
have 1: "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k)) as) = ring_cfs_to_univ_poly k (take (Suc k) as)
⊕⇘UP R⇙ (as!(Suc k)) ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc k)"
using assms A ring_cfs_to_univ_poly_decomp[of as n k] Suc_le_lessD
by blast
have 2: "ring_cfs_to_univ_poly (Suc k) (take (Suc (Suc k)) as) l = ring_cfs_to_univ_poly k (take (Suc k) as) l
⊕( (as!(Suc k)) ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc k)) l"
proof-
have 21: "ring_cfs_to_univ_poly k (take (Suc k) as) ∈ carrier (UP R)"
by (meson A assms(1) le_SucI ring_cfs_to_univ_poly_closed take_closed)
have 22: "as ! Suc k ⊙⇘UP R⇙ X_poly R [^]⇘UP R⇙ Suc k ∈ carrier (UP R)"
using UP_ring_def[of R] A UP_ring.monom_closed assms(1) cartesian_power_car_memE' less_Suc_eq_le
monoid.nat_pow_closed[of "UP R" "X_poly R" "Suc k"]
unfolding X_poly_def
by (metis UP_ring.UP_ring UP_ring.UP_smult_closed R.ring_axioms R.one_closed ring.is_monoid)
show ?thesis
using 1 21 22 UP_ring.cfs_add[of R "ring_cfs_to_univ_poly k (take (Suc k) as)" "( (as!(Suc k)) ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc k))" l]
UP_ring_def[of R] R.ring_axioms by presburger
qed
have 3: "( (as!(Suc k)) ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙ (Suc k)) l = 𝟬"
using UP_cring.monom_coeff[of R "as!(Suc k)"] A False UP_cring_def assms(1) cartesian_power_car_memE'
by (metis R.is_cring le_imp_less_Suc)
then show ?thesis
using 2
by (metis "0" Suc_le_mono assms(1) assms(2) cartesian_power_car_memE' lessI R.r_zero
ring_cfs_to_univ_poly_top_coeff take_closed)
qed
qed
lemma ring_cfs_to_univ_poly_coeffs:
assumes "as ∈ carrier (R⇗Suc n⇖)"
assumes "l ≤ n"
shows "(ring_cfs_to_univ_poly n as) l = (ring_cfs_to_univ_poly l (take (Suc l) as)) l"
proof-
have "(take (Suc n) as) = as"
using assms
by (metis cartesian_power_car_memE le_refl take_all)
then show ?thesis
using ring_cfs_to_univ_poly_chain[of as n l n]
by (metis assms(1) assms(2) order_refl)
qed
lemma ring_cfs_to_univ_poly_coeffs':
assumes "as ∈ carrier (R⇗Suc n⇖)"
assumes "l ≤ n"
shows "(ring_cfs_to_univ_poly n as) l = as! l"
proof-
have 0: "(ring_cfs_to_univ_poly l (take (Suc l) as)) l = (take (Suc l) as) ! l"
by (meson Suc_le_mono assms(1) assms(2) ring_cfs_to_univ_poly_top_coeff take_closed)
have 1: "(take (Suc l) as) ! l = as! l"
using nth_take[of l "Suc l" as]
by blast
then show ?thesis
using 0 assms ring_cfs_to_univ_poly_coeffs[of as n l]
by presburger
qed
lemma ring_cfs_to_univ_poly_coeffs'':
assumes "as ∈ carrier (R⇗Suc n⇖)"
shows "(ring_cfs_to_univ_poly n as) l = (if l ≤ n then as! l else 𝟬)"
apply(cases "l ≤n")
apply (meson assms ring_cfs_to_univ_poly_coeffs')
proof- assume "¬ l ≤ n " then
have A: "n < l"
by auto
have "deg R (ring_cfs_to_univ_poly n as) ≤ n"
using assms ring_cfs_to_univ_poly_degree(1) by blast
then show ?thesis
using A domain_def[of R] deg_leE assms le_less_trans ring_cfs_to_univ_poly_closed UP_car_memE(2)
by auto
qed
end
definition fun_tuple_to_univ_poly where
"fun_tuple_to_univ_poly R n m fs x = cring_coord_rings.ring_cfs_to_univ_poly R m (function_tuple_eval R n fs x)"
context cring_coord_rings
begin
lemma fun_tuple_to_univ_poly_closed:
assumes "is_function_tuple R n fs"
assumes "x ∈ carrier (R⇗n⇖)"
assumes "length fs = Suc m"
shows "fun_tuple_to_univ_poly R n m fs x ∈ carrier (UP R)"
unfolding fun_tuple_to_univ_poly_def
using assms
ring_cfs_to_univ_poly_closed[of "function_tuple_eval R n fs x" m]
function_tuple_eval_closed[of R n fs x]
by metis
lemma fun_tuple_to_univ_poly_degree_bound:
assumes "is_function_tuple R n fs"
assumes "x ∈ carrier (R⇗n⇖)"
assumes "length fs = Suc m"
shows "deg R (fun_tuple_to_univ_poly R n m fs x) ≤ m"
unfolding fun_tuple_to_univ_poly_def
using ring_cfs_to_univ_poly_degree assms
by (metis function_tuple_eval_closed)
lemma fun_tuple_to_univ_poly_degree:
assumes "is_function_tuple R n fs"
assumes "x ∈ carrier (R⇗n⇖)"
assumes "length fs = Suc m"
assumes "(fs!m) x ≠𝟬"
shows "deg R (fun_tuple_to_univ_poly R n m fs x) = m"
unfolding fun_tuple_to_univ_poly_def
using ring_cfs_to_univ_poly_degree[of "function_tuple_eval R n fs x" m]
assms
function_tuple_eval_def
function_tuple_eval_closed[of R n fs x]
by (metis lessI nth_map)
subsection‹Factoring a Polynomial as a Univariate Polynomial over a Multivariable Polynomial Ring›
definition pre_to_univ_poly_hom :: "nat ⇒ nat ⇒ ('a, (('a, nat) mvar_poly, nat) mvar_poly) ring_hom" where
"pre_to_univ_poly_hom n i= MP.indexed_const (n-1) ∘
R.indexed_const"
lemma pre_to_univ_poly_hom_is_hom:
assumes "i < n"
shows "ring_hom_ring R (Pring (coord_ring R (n-1)) {i}) (pre_to_univ_poly_hom n i)"
using ring_hom_trans[of R.indexed_const R "coord_ring R (n-1)"
"ring.indexed_const(Pring R ({..<n-1}))"
"Pring (coord_ring R (n-1)) {i}"]
R.indexed_const_ring_hom[of "{..<n-1}"]
MP.indexed_const_ring_hom[of n "{..<n-1}"]
ring_hom_ring.homh[of R "coord_ring R (n - 1)" "coord_const"]
unfolding ring_hom_ring_def[of R]
by (smt MP.Pring_is_ring MP.indexed_const_ring_hom coord_ring_def pre_to_univ_poly_hom_def ring_hom_ring.homh ring_hom_ring_axioms_def)
definition pre_to_univ_poly_var_ass ::
"nat ⇒ nat ⇒ nat ⇒ (('a, nat) mvar_poly, nat) mvar_poly" where
"pre_to_univ_poly_var_ass n i j =(if j < i then MP.indexed_const (n-1) (pvar R j) else
(if j = i then pvar (coord_ring R (n-1)) i else
(if j < n then MP.indexed_const (n-1) (pvar R (j - 1)) else
𝟬⇘Pring (coord_ring R (n-1)) {i}⇙)))"
lemma pre_to_univ_poly_var_ass_closed:
assumes "i < n"
shows "closed_fun (Pring (coord_ring R (n-1)) {i}) (pre_to_univ_poly_var_ass n i)"
proof fix j
show "pre_to_univ_poly_var_ass n i j ∈ carrier (Pring (coord_ring R (n - 1)) {i})"
unfolding pre_to_univ_poly_var_ass_def
apply(cases "j < i")
using pvar_closed[of j n] assms cring.indexed_const_closed
apply (metis (no_types, lifting) R.Pring_is_cring Suc_diff_1 Suc_le_eq coord_ring_def diff_diff_cancel R.is_cring less_imp_diff_less local.pvar_closed not_less0 not_less_eq_eq)
apply(cases "j = i")
using assms apply (meson pvar_closed R.Pring_is_cring R.is_cring singletonI)
apply(cases "j < n")
using pvar_closed[of "j-1" n] assms MP.indexed_const_closed R.Pring_is_cring Suc_diff_1 Suc_le_eq coord_ring_def R.is_cring pvar_closed neq0_conv not_le
apply (metis MP.Pring_var_closed singletonI)
using MP.Pring_is_ring[of "n-1" "{i}"] apply blast
by (smt MP.Pring_zero_closed MP.indexed_const_closed Suc_diff_1 Suc_le_eq le_eq_less_or_eq less_Suc_eq local.pvar_closed nat_induct)
qed
lemma pre_to_univ_poly_var_ass_closed':
assumes "i < n"
shows "(pre_to_univ_poly_var_ass n i) ∈ {..<n} → carrier (Pring (coord_ring R (n-1)) {i})"
by (metis (no_types, lifting) Pi_iff UNIV_I assms pre_to_univ_poly_var_ass_closed)
definition pre_to_univ_poly ::
"nat ⇒ nat ⇒ (('a, nat) mvar_poly, (('a, nat) mvar_poly, nat) mvar_poly) ring_hom" where
"pre_to_univ_poly (n::nat) (i::nat) = indexed_poly_induced_morphism {..<n} (Pring (coord_ring R (n-1)) {i})
(pre_to_univ_poly_hom n i)
(pre_to_univ_poly_var_ass n i)"
lemma pre_to_univ_poly_is_hom:
assumes "i < n"
assumes "ψ = pre_to_univ_poly n i"
shows "ring_hom_ring (R[𝒳⇘n⇙]) (Pring (coord_ring R (n-1)) {i}) ψ "
"⋀j. j < i ⟹ ψ (pvar R j) = MP.indexed_const (n-1) (pvar R j)"
"ψ (pvar R i) = pvar (coord_ring R (n-1)) i"
"⋀j. i < j ∧ j < n ⟹ ψ (pvar R j) = MP.indexed_const (n-1) (pvar R (j - 1))"
"⋀a. a ∈ carrier R ⟹ ψ (coord_const a) = MP.indexed_const (n-1) (coord_const a)"
"⋀p. p ∈ carrier (R[𝒳⇘n⇙]) ⟹ pre_to_univ_poly n i p ∈ carrier (Pring (coord_ring R (n-1)) {i})"
proof-
have 0: "cring (Pring (coord_ring R (n - 1)) {i})"
using MP.Pring_is_cring coord_cring_cring by blast
have 1: "pre_to_univ_poly_var_ass n i ∈ {..<n} → carrier (Pring (coord_ring R (n - 1)) {i})"
using Pi_iff assms(1) pre_to_univ_poly_var_ass_closed[of i n]
by blast
have 2: "ring_hom_ring R (Pring (coord_ring R (n - 1)) {i}) (pre_to_univ_poly_hom n i)"
using assms(1) pre_to_univ_poly_hom_is_hom by auto
show 3:"ring_hom_ring (R[𝒳⇘n⇙]) (Pring (coord_ring R (n-1)) {i}) ψ "
using R.Pring_universal_prop(1)[of "(Pring (coord_ring R (n-1)) {i})" "pre_to_univ_poly_var_ass n i"
"{..<n}" "pre_to_univ_poly_hom n i" ψ] assms 0 1 2
unfolding pre_to_univ_poly_def
by (metis coord_ring_def)
show " ⋀j. j < i ⟹
ψ (pvar R j) = MP.indexed_const (n-1) (pvar R j)"
proof-
fix j assume A: "j < i"
then have 00: "MP.indexed_const (n - 1) (pvar R j) = pre_to_univ_poly_var_ass n i j "
unfolding pre_to_univ_poly_var_ass_def by auto
have 01: "j ∈ {..<n}"
using assms A by auto
show "ψ (pvar R j) = MP.indexed_const (n-1) (pvar R j)"
using R.Pring_universal_prop(2)[of "(Pring (coord_ring R (n-1)) {i})" "pre_to_univ_poly_var_ass n i"
"{..<n}" "pre_to_univ_poly_hom n i" ψ] assms 0 1 2 01
MP.is_cring
unfolding pre_to_univ_poly_def 00 unfolding coord_ring_def var_to_IP_def
by blast
qed
show "ψ (pvar R i) = pvar (coord_ring R (n - 1)) i"
using R.Pring_universal_prop[of "(Pring (coord_ring R (n-1)) {i})" "pre_to_univ_poly_var_ass n i"
"{..<n}" "pre_to_univ_poly_hom n i" ψ] assms 0 1 2
unfolding pre_to_univ_poly_def coord_ring_def
using lessThan_iff less_not_refl pre_to_univ_poly_var_ass_def var_to_IP_def
by (metis coord_ring_def)
show "⋀j. i < j ∧ j < n ⟹ ψ (pvar R j) = MP.indexed_const (n - 1) (pvar R (j - 1))"
using R.Pring_universal_prop[of "(Pring (coord_ring R (n-1)) {i})" "pre_to_univ_poly_var_ass n i"
"{..<n}" "pre_to_univ_poly_hom n i" ψ] assms 0 1 2
unfolding pre_to_univ_poly_def
using add_diff_inverse_nat lessThan_iff less_diff_conv less_imp_add_positive
not_add_less1 pre_to_univ_poly_var_ass_def trans_less_add2 var_to_IP_def
by (metis (no_types, lifting) coord_ring_def)
show "⋀a. a ∈ carrier R ⟹ ψ (R.indexed_const a) = MP.indexed_const (n - 1) (R.indexed_const a)"
using R.Pring_universal_prop(3)[of "(Pring (coord_ring R (n-1)) {i})" "pre_to_univ_poly_var_ass n i"
"{..<n}" "pre_to_univ_poly_hom n i" ψ] assms 0 1 2 comp_apply
unfolding pre_to_univ_poly_def pre_to_univ_poly_hom_def
by metis
show "⋀p. p ∈ carrier (R[𝒳⇘n⇙]) ⟹ pre_to_univ_poly n i p ∈ carrier (Pring (coord_ring R (n - 1)) {i})"
proof-
fix p assume A: "p ∈ carrier (R[𝒳⇘n⇙])"
have "ψ ∈ carrier (R[𝒳⇘n⇙]) → carrier (Pring (coord_ring R (n - 1)) {i})"
using 3 unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def by blast
then show " pre_to_univ_poly n i p ∈ carrier (Pring (coord_ring R (n - 1)) {i})"
using A assms
by blast
qed
qed
lemma insert_at_index_closed:
assumes "a ∈ carrier (R⇗n⇖)"
assumes "x ∈ carrier R"
assumes "i ≤ n"
shows "insert_at_index a x i ∈ carrier (R⇗Suc n⇖)"
apply(rule cartesian_power_car_memI')
proof-
have 0: "length (take i a) = i"
using assms(1) assms(3) cartesian_power_car_memE take_closed by blast
have 1: "length (drop i a) = (n - i)"
using assms cartesian_power_car_memE length_drop
by blast
then have "length (x # drop i a) = Suc (n - i)"
by (metis length_Cons)
then show "length (insert_at_index a x i) = Suc n"
using 0 1 assms
by (metis Suc_eq_plus1 cartesian_power_car_memE insert_at_index_length)
show "⋀ia. ia < Suc n ⟹ insert_at_index a x i ! ia ∈ carrier R"
proof- fix j assume A: "j < Suc n"
show "insert_at_index a x i ! j ∈ carrier R"
apply(cases "j < i")
apply (metis A assms(1) assms(3) cartesian_power_car_memE cartesian_power_car_memE' insert_at_index_eq' le_imp_less_Suc less_Suc_eq not_less_eq)
apply(cases "j = i")
apply (metis assms(1) assms(2) assms(3) cartesian_power_car_memE insert_at_index_eq)
proof- assume A1: "¬ j < i " "j ≠i"
then have "i < j" by auto
then have "(take i a @ x # drop i a) ! j = drop i a ! (j - (Suc i))"
by (metis "0" A1(1) Suc_diff_Suc nth_Cons_Suc nth_append)
then show "insert_at_index a x i ! j ∈ carrier R"
by (metis A ‹i < j› assms(1) cartesian_power_car_memE cartesian_power_car_memE' insert_at_index_eq'' less_Suc_eq_0_disj less_Suc_eq_le not_less0)
qed
qed
qed
lemma pre_to_univ_poly_eval:
assumes "i < Suc n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "a ∈ carrier (R⇗n⇖)"
assumes "x ∈ carrier R"
assumes "as = insert_at_index a x i"
shows "eval_at_point R as p = eval_at_point R a (total_eval (R[𝒳⇘n⇙]) (λ i. coord_const x) (pre_to_univ_poly (Suc n) i p))"
apply(rule R.Pring_car_induct''[of p "{..<Suc n}"])
unfolding coord_ring_def
apply (metis assms(2) coord_ring_def)
proof-
have 0: "as ∈ carrier (R⇗Suc n⇖)"
using assms insert_at_index_closed
by (meson less_Suc_eq_le)
show " ⋀c. c ∈ carrier R ⟹
eval_at_point R as (R.indexed_const c) =
eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (R.indexed_const c)))"
proof- fix c assume "c ∈ carrier R"
have 00: "eval_at_poly R (coord_const c) as = c"
using assms eval_at_point_const[of c as "Suc n"] "0" ‹c ∈ carrier R›
by blast
have 01: "closed_fun (R[𝒳⇘n⇙]) (λn. coord_const x)"
using assms(4) R.indexed_const_closed
by (metis Pi_I coord_ring_def)
have 02: "(pre_to_univ_poly (Suc n) i (coord_const c)) = ring.indexed_const (R[𝒳⇘n⇙]) (coord_const c)"
using pre_to_univ_poly_is_hom(5)[of i "Suc n" _ c] ‹c ∈ carrier R› assms(1) diff_Suc_1
by (metis coord_ring_def)
have 03: "(total_eval (R[𝒳⇘n⇙]) (λ i. coord_const x) (pre_to_univ_poly (Suc n) i (coord_const c))) =
coord_const c"
using 01 cring.total_eval_const[of "R[𝒳⇘n⇙]" "coord_const c" ]
by (smt "02" MP.total_eval_const ‹c ∈ carrier R› coord_ring_def cring.indexed_const_closed R.is_cring)
show " eval_at_point R as (R.indexed_const c) =
eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (R.indexed_const c))) "
using assms 00 02 03
by (metis ‹c ∈ carrier R› coord_ring_def eval_at_point_const)
qed
have 01: "closed_fun (R[𝒳⇘n⇙]) (λn. coord_const x)"
using assms(4) R.indexed_const_closed
by (metis Pi_I coord_ring_def)
have 02: "ring_hom_ring (R[𝒳⇘Suc n⇙]) (Pring (R[𝒳⇘n⇙]) {i}) (pre_to_univ_poly (Suc n) i)"
using pre_to_univ_poly_is_hom(1)[of i "Suc n" ]
by (simp add: assms)
show "⋀p q. p ∈ carrier (Pring R {..<Suc n}) ⟹
q ∈ carrier (Pring R {..<Suc n}) ⟹
eval_at_point R as p = eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i p)) ⟹
eval_at_point R as q = eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i q)) ⟹
eval_at_point R as (p ⊕⇘Pring R {..<Suc n}⇙ q) =
eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (p ⊕⇘Pring R {..<Suc n}⇙ q)))"
proof- fix p q assume A: "p ∈ carrier (Pring R {..<Suc n})"
" q ∈ carrier (Pring R {..<Suc n})"
"eval_at_point R as p = eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i p))"
" eval_at_point R as q = eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i q))"
have 0: "eval_at_poly R (p ⊕⇘R[𝒳⇘Suc n⇙]⇙ q) as =
eval_at_poly R p as ⊕⇘R⇙ eval_at_poly R q as"
using "0" A(1) A(2) eval_at_point_add unfolding coord_ring_def
by blast
have 1: "(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (p ⊕⇘R[𝒳⇘Suc n⇙]⇙ q))) =
(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p)) ⊕⇘R[𝒳⇘n⇙]⇙
(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i q))"
proof-
have 10: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(6)[of i "Suc n" _ p]
unfolding coord_ring_def
by (metis A(1) assms(1) diff_Suc_1)
have 11: "pre_to_univ_poly (Suc n) i q ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(6)[of i "Suc n" _ q]
unfolding coord_ring_def
by (metis A(2) assms(1) diff_Suc_1)
have 12: "(pre_to_univ_poly (Suc n) i (p ⊕⇘R[𝒳⇘Suc n⇙]⇙ q)) =
(pre_to_univ_poly (Suc n) i p ⊕⇘Pring (R[𝒳⇘n⇙]) {i}⇙ pre_to_univ_poly (Suc n) i q)"
using ring_hom_ring.homh A 02 ring_hom_add[of "pre_to_univ_poly (Suc n) i" "R[𝒳⇘Suc n⇙] " "Pring (R[𝒳⇘n⇙]) {i}"
p q ]
unfolding coord_ring_def
by blast
show ?thesis
using 01 10 11 12 A cring.total_eval_add[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i p" "{i}"
"pre_to_univ_poly (Suc n) i q" "λi. coord_const x"]
coord_cring_cring
unfolding coord_ring_def
by smt
qed
have 2: "eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (p ⊕⇘R[𝒳⇘Suc n⇙]⇙ q))) a =
eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p)) a ⊕
eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i q)) a"
proof-
have 20: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i}) "
using A(1) 02 unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def unfolding coord_ring_def
by blast
have 21: "pre_to_univ_poly (Suc n) i q ∈ carrier (Pring (R[𝒳⇘n⇙]) {i}) "
using A(2) 02 unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def unfolding coord_ring_def
by blast
have 22: "(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p)) ∈
carrier (R[𝒳⇘n⇙])"
using 21 01 A cring.total_eval_closed[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i p"
"{i}" "λi. coord_const x"] "20" coord_cring_cring
by metis
have 23: "(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i q)) ∈
carrier (R[𝒳⇘n⇙])"
using cring.total_eval_closed[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i q" "{i}"
"λi. coord_const x"]
by (metis "01" "21" coord_cring_cring)
show ?thesis
using "1" "22" "23" assms(3) eval_at_point_add by presburger
qed
show "eval_at_point R as (p ⊕⇘Pring R {..<Suc n}⇙ q) =
eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (p ⊕⇘Pring R {..<Suc n}⇙ q)))"
using eval_at_point_add A 0 1 2
unfolding coord_ring_def
by presburger
qed
fix p j
assume A: "p ∈ carrier (Pring R {..<Suc n})" "j ∈ {..<Suc n}"
"eval_at_point R as p = eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i p))"
show "eval_at_point R as (p ⊗⇘Pring R {..<Suc n}⇙ pvar R j) =
eval_at_point R a
(total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (p ⊗⇘Pring R {..<Suc n}⇙ pvar R j)))"
proof-
have A0: "eval_at_poly R (p ⊗⇘R[𝒳⇘Suc n⇙]⇙ pvar R j) as =
eval_at_poly R p as ⊗ as!j"
proof-
have "eval_at_poly R (pvar R j) as = as!j"
using A(2) 0 eval_pvar
by blast
then show ?thesis using A eval_at_point_mult[of as "Suc n" p "pvar R j" ] 0
by (metis R.Pring_var_closed coord_ring_def)
qed
have A1: "(pre_to_univ_poly (Suc n) i (p ⊗⇘R[𝒳⇘Suc n⇙]⇙ pvar R j)) =
(pre_to_univ_poly (Suc n) i p) ⊗⇘Pring (R[𝒳⇘n⇙]) {i}⇙ pre_to_univ_poly (Suc n) i (pvar R j)"
using A 02 ring_hom_ring.homh ring_hom_mult[of _ "R[𝒳⇘Suc n⇙]" _ p "pvar R j"] R.Pring_var_closed[of j "{..< Suc n}"]
unfolding coord_ring_def
by blast
have A2: "(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (p ⊗⇘R[𝒳⇘Suc n⇙]⇙ pvar R j))) =
(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p ))⊗⇘R[𝒳⇘n⇙]⇙
(total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) ( pre_to_univ_poly (Suc n) i (pvar R j)))"
proof-
have A20: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using 02 A unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def
unfolding coord_ring_def
by blast
have A21: "pre_to_univ_poly (Suc n) i (pvar R j) ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using 02 A unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_hom_def
using R.Pring_var_closed[of j "{..< Suc n}"]
unfolding coord_ring_def
by blast
show ?thesis using A1 cring.total_eval_mult[of _ "pre_to_univ_poly (Suc n) i p"]
by (smt A20 A21 MP.closed_funI MP.total_eval_mult assms(4) coord_ring_def cring.indexed_const_closed R.is_cring)
qed
have A3: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using 02 A ring_hom_ring.homh unfolding ring_hom_def
unfolding coord_ring_def
by blast
have A4: "pre_to_univ_poly (Suc n) i (pvar R j) ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using 02 A ring_hom_ring.homh R.Pring_var_closed[of j "{..< Suc n}"] unfolding ring_hom_def
unfolding coord_ring_def
by blast
have A5: "total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p ) ∈
carrier (R[𝒳⇘n⇙])"
using 01 cring.total_eval_closed[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i p " "{i}"]
A3 coord_cring_cring
unfolding coord_ring_def
by smt
have A6: "total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j) ) ∈
carrier (R[𝒳⇘n⇙])"
using 01 cring.total_eval_closed[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i (pvar R j) " "{i}"]
A4 coord_cring_cring
unfolding coord_ring_def
by smt
have A7: " eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (p ⊗⇘R[𝒳⇘Suc n⇙]⇙ pvar R j))) a
= eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i p)) a ⊗
eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j))) a"
using eval_at_point_mult A5 A6 A2 assms(3) by presburger
have A8: "eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j))) a =
as!j"
proof(cases "j = i")
case True
then have "pre_to_univ_poly (Suc n) i (pvar R j) = pvar (R[𝒳⇘n⇙]) i"
using pre_to_univ_poly_is_hom(3)[of i "Suc n"] assms(1) diff_Suc_1 by presburger
then have "total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j)) =
coord_const x"
using cring.total_eval_var[of "R[𝒳⇘n⇙]" "λi. coord_const x"]
unfolding coord_ring_def
by (smt "01" ‹⋀i. ⟦cring (R [𝒳⇘n⇙]); (λi. R.indexed_const x) ∈ UNIV → carrier (R [𝒳⇘n⇙])⟧ ⟹ total_eval (R [𝒳⇘n⇙]) (λi. R.indexed_const x) (mset_to_IP (R [𝒳⇘n⇙]) {#i#}) = R.indexed_const x› coord_ring_def cring_coord_rings.coord_cring_cring cring_coord_rings_axioms var_to_IP_def)
then have T0: "eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j))) a
= x"
using eval_at_point_const
by (metis assms(3) assms(4))
have T1: "as!j = x"
using assms
by (metis True assms(5) cartesian_power_car_memE insert_at_index_eq le_eq_less_or_eq nat_le_linear
not_less_eq)
then show ?thesis
using T0 by blast
next
case False
then show ?thesis
proof(cases "j < i")
case True
then have "pre_to_univ_poly (Suc n) i (pvar R j) = ring.indexed_const (R[𝒳⇘n⇙]) (pvar R j)"
using pre_to_univ_poly_is_hom(2)[of i "Suc n"] assms(1) diff_Suc_1
unfolding coord_ring_def
by presburger
then have "total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j)) =
pvar R j"
using cring.total_eval_const[of "R[𝒳⇘n⇙]"]
by (smt Suc_less_eq True assms(1) coord_cring_cring less_trans_Suc local.pvar_closed)
then have T0: "eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j))) a
= a!j"
using eval_pvar
by (metis Suc_less_eq True assms(1) assms(3) less_trans_Suc)
have T1: "as!j = a!j"
using assms
by (metis True assms(5) cartesian_power_car_memE insert_at_index_eq' less_Suc_eq_le)
then show ?thesis
using T0 by presburger
next
case F: False
then have "pre_to_univ_poly (Suc n) i (pvar R j) = ring.indexed_const (R[𝒳⇘n⇙]) (pvar R (j-1))"
using pre_to_univ_poly_is_hom(4)[of i "Suc n"] assms(1) diff_Suc_1
unfolding coord_ring_def
by (metis A(2) False lessThan_iff linorder_neqE_nat)
then have "total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j)) =
pvar R (j-1)"
using cring.total_eval_const[of "R[𝒳⇘n⇙]"]
by (smt A(2) F False Suc_less_SucD add_diff_inverse_nat coord_cring_cring
lessThan_iff less_one linorder_neqE_nat local.pvar_closed not_less0 plus_1_eq_Suc)
then have T0: "eval_at_poly R (total_eval (R[𝒳⇘n⇙]) (λi. coord_const x) (pre_to_univ_poly (Suc n) i (pvar R j))) a
= a!(j-1)"
using eval_pvar[of "j-1" n a]
by (metis A(2) F False One_nat_def Suc_diff_Suc Suc_less_eq assms(3)
lessThan_iff linorder_neqE_nat minus_nat.diff_0 not_less0)
have T1: "as!j = a!(j-1)"
proof-
obtain k where k_def: "j = i + 1 + k"
using False F
by (metis Nat.add_0_right less_imp_add_positive less_one
nat_neq_iff semiring_normalization_rules(25))
show "as!j = a!(j-1)"
proof-
have "length (take i a) = i"
using assms
by (meson cartesian_power_car_memE less_Suc_eq_le take_closed)
then have "as!j = ( x # drop i a)!(k+1)"
using k_def assms
unfolding coord_ring_def
by (metis Suc_eq_plus1 add.assoc insert_at_index.simps nth_append_length_plus plus_1_eq_Suc)
have "length (drop i a) ≥ k"
proof-
have "length (drop i a) = n - i"
using assms cartesian_power_car_memE length_drop
by blast
then show ?thesis
using assms k_def A(2)
by (metis Suc_eq_plus1 add.commute diff_Suc_Suc lessThan_iff less_diff_conv less_imp_le_nat)
qed
then have "as!j = (drop i a)! k"
using assms k_def
by (metis Nat.add_0_right One_nat_def ‹as ! j = (x # drop i a) ! (k + 1)› add_Suc_right nth_Cons_Suc)
then show ?thesis using k_def assms
by (metis Nat.add_diff_assoc2 add_diff_cancel_right' cartesian_power_car_memE le_add2 less_Suc_eq_le nth_drop)
qed
qed
then show ?thesis
using T0 by presburger
qed
qed
then show "eval_at_point R as (p ⊗⇘Pring R {..<Suc n}⇙ pvar R j) =
eval_at_point R a (total_eval (Pring R {..<n}) (λi. R.indexed_const x) (pre_to_univ_poly (Suc n) i (p ⊗⇘Pring R {..<Suc n}⇙ pvar R j)))"
using A(3) A0 A7
unfolding coord_ring_def
by presburger
qed
qed
definition pre_to_univ_poly_inv_hom ::
"nat ⇒ nat ⇒ (('a, nat) mvar_poly,('a, nat) mvar_poly) ring_hom" where
"pre_to_univ_poly_inv_hom n i = R.relabel_vars {..<(n-1)} {..<n} (λj. if j < i then j else j + 1)"
lemma pre_to_univ_poly_inv_hom_is_hom:
assumes "i < Suc n"
shows "ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘Suc n⇙]) (pre_to_univ_poly_inv_hom (Suc n) i)"
proof-
have 0: "ring_hom_ring (R[𝒳⇘n⇙]) (R[𝒳⇘Suc n⇙]) (R.relabel_vars {..<n} {..<Suc n} (λj. if j < i then j else j + 1))"
unfolding coord_ring_def
apply(rule R.relabel_vars_is_morphism)
using assms
by (smt Pi_I Suc_eq_plus1 add_less_cancel_right lessThan_iff less_Suc_eq)
then show ?thesis
unfolding pre_to_univ_poly_inv_hom_def
by simp
qed
lemma pre_to_univ_poly_inv_hom_const:
assumes "i < Suc n"
assumes "k ∈ carrier R"
shows "(pre_to_univ_poly_inv_hom (Suc n) i) (R.indexed_const k) = R.indexed_const k"
proof-
have 0: "(R.relabel_vars {..<n} {..<Suc n} (λj. if j < i then j else j + 1)) (R.indexed_const k) = R.indexed_const k"
unfolding coord_ring_def
apply(rule R.relabel_vars_is_morphism)
using assms
apply (smt Pi_I Suc_eq_plus1 add_less_cancel_right lessThan_iff less_Suc_eq)
using assms(2) by blast
then show ?thesis
unfolding pre_to_univ_poly_inv_hom_def
using diff_Suc_1 by presburger
qed
lemma pre_to_univ_poly_inv_hom_pvar_0:
assumes "i < Suc n"
assumes "j < i"
shows "pre_to_univ_poly_inv_hom (Suc n) i (pvar R j) =
pvar R j"
unfolding pre_to_univ_poly_inv_hom_def coord_ring_def
using R.relabel_vars_is_morphism(2)[of "λj. if j < i then j else j + 1" "{..<n}" "{..< Suc n}" j]
by (smt Pi_I add.commute add_diff_cancel_left' assms(1) assms(2)
lessThan_iff less_Suc_eq less_trans_Suc not_less_eq plus_1_eq_Suc)
lemma pre_to_univ_poly_inv_hom_pvar_1:
assumes "i < Suc n"
assumes "i ≤ j"
assumes "j < n"
shows "pre_to_univ_poly_inv_hom (Suc n) i (pvar R j) =
pvar R (j + 1)"
unfolding pre_to_univ_poly_inv_hom_def
using assms R.relabel_vars_is_morphism(2)[of "λj. if j < i then j else j + 1" "{..<n}" "{..< Suc n}" j]
by (smt Pi_I add.commute add_less_cancel_right diff_Suc_1 lessThan_iff less_Suc_eq not_le plus_1_eq_Suc)
definition pre_to_univ_poly_inv_var_ass ::
"nat ⇒ nat ⇒ nat ⇒ ('a, nat) mvar_poly" where
"pre_to_univ_poly_inv_var_ass n i j = pvar R i"
lemma pre_to_univ_poly_inv_var_ass_closed:
assumes "i < Suc n"
shows "pre_to_univ_poly_inv_var_ass (Suc n) i ∈ {i} → carrier (R[𝒳⇘Suc n⇙])"
by (metis Pi_I assms local.pvar_closed pre_to_univ_poly_inv_var_ass_def)
definition pre_to_univ_poly_inv ::
"nat ⇒ nat ⇒ ((('a, nat) mvar_poly, nat) mvar_poly,('a, nat) mvar_poly) ring_hom" where
"pre_to_univ_poly_inv n i = indexed_poly_induced_morphism {i} (R[𝒳⇘n⇙])
(pre_to_univ_poly_inv_hom n i) (pre_to_univ_poly_inv_var_ass n i)"
lemma pre_to_univ_poly_inv_is_hom:
assumes "i < Suc n"
shows "ring_hom_ring (Pring (R[𝒳⇘n⇙]) {i}) (R[𝒳⇘Suc n⇙]) (pre_to_univ_poly_inv (Suc n) i)"
apply(rule cring.Pring_universal_prop[of _ _ "pre_to_univ_poly_inv_var_ass (Suc n) i" "{i}" "pre_to_univ_poly_inv_hom (Suc n) i"])
unfolding coord_ring_def
apply (simp add: R.Pring_is_cring R.is_cring)
apply (simp add: R.Pring_is_cring R.is_cring)
apply (metis Pi_I R.Pring_var_closed assms lessThan_iff pre_to_univ_poly_inv_var_ass_def)
apply (metis assms coord_ring_def pre_to_univ_poly_inv_hom_is_hom)
by (simp add: coord_ring_def pre_to_univ_poly_inv_def)
lemma pre_to_univ_poly_inv_pvar:
assumes "i < Suc n"
shows "(pre_to_univ_poly_inv (Suc n) i) (pvar (R[𝒳⇘n⇙]) i) = pvar R i"
using assms cring.Pring_universal_prop[of "R[𝒳⇘n⇙]" "R[𝒳⇘Suc n⇙]"
"pre_to_univ_poly_inv_var_ass (Suc n) i" "{i}" "pre_to_univ_poly_inv_hom (Suc n) i"]
by (metis Pi_I coord_cring_cring cring_coord_rings.pre_to_univ_poly_inv_var_ass_def
cring_coord_rings_axioms local.pvar_closed pre_to_univ_poly_inv_def
pre_to_univ_poly_inv_hom_is_hom singletonI var_to_IP_def)
lemma pre_to_univ_poly_inv_const:
assumes "i < Suc n"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "(pre_to_univ_poly_inv (Suc n) i) (ring.indexed_const (R[𝒳⇘n⇙]) p) = pre_to_univ_poly_inv_hom (Suc n) i p "
using assms cring.Pring_universal_prop[of "R[𝒳⇘n⇙]" "R[𝒳⇘Suc n⇙]"
"pre_to_univ_poly_inv_var_ass (Suc n) i" "{i}" "pre_to_univ_poly_inv_hom (Suc n) i"]
by (metis Pi_I coord_cring_cring cring_coord_rings.pre_to_univ_poly_inv_var_ass_def
cring_coord_rings_axioms local.pvar_closed pre_to_univ_poly_inv_def pre_to_univ_poly_inv_hom_is_hom)
lemma pre_to_univ_poly_inverse:
assumes "i < Suc n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
shows "pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i p) = p"
apply(rule R.Pring_car_induct''[of p "{..<Suc n}"])
using assms coord_ring_def apply metis
proof-
show 0: " ⋀c. c ∈ carrier R ⟹ pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i (coord_const c)) = coord_const c"
proof-
fix c assume A: "c ∈ carrier R"
have 0: "pre_to_univ_poly (Suc n) i (coord_const c) =
MP.indexed_const n (coord_const c)"
using A assms(1) diff_Suc_1 pre_to_univ_poly_is_hom(5) by presburger
have 1: "(λj. if j < i then j else j + 1) ∈ {..<n} → {..<Suc n}"
by (smt Pi_I Suc_eq_plus1 add_less_cancel_right lessThan_iff less_Suc_eq)
have 2: "pre_to_univ_poly_inv_hom (Suc n) i (coord_const c) = coord_const c"
unfolding pre_to_univ_poly_inv_hom_def
using 1 R.relabel_vars_is_morphism(3)[of "(λj. if j < i then j else j + 1)" "{..<n}" "{..<Suc n}" c]
unfolding coord_ring_def
using A diff_Suc_1 by presburger
show "pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i (coord_const c)) = coord_const c "
using 0 1 2
by (metis (no_types, lifting) A R.indexed_const_closed assms(1) coord_ring_def pre_to_univ_poly_inv_const)
qed
show 1: "⋀p q. p ∈ carrier (Pring R {..<Suc n}) ⟹
q ∈ carrier (Pring R {..<Suc n}) ⟹
pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i p) =
p ⟹
pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i q) =
q ⟹
pre_to_univ_poly_inv (Suc n) i
(pre_to_univ_poly (Suc n) i (p ⊕⇘Pring R {..<Suc n}⇙ q)) =
p ⊕⇘Pring R {..<Suc n}⇙ q"
proof- fix p q assume A: "p ∈ carrier (Pring R {..<Suc n})"
"q ∈ carrier (Pring R {..<Suc n})"
"pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i p) = p"
"pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i q) = q"
have 0: "(pre_to_univ_poly (Suc n) i (p ⊕⇘R[𝒳⇘Suc n⇙]⇙ q)) =
(pre_to_univ_poly (Suc n) i p) ⊕⇘Pring (R[𝒳⇘n⇙]) {i}⇙ pre_to_univ_poly (Suc n) i q"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] ring_hom_ring.homh ring_hom_add A
unfolding coord_ring_def
by (metis (mono_tags, lifting) assms(1) diff_Suc_1)
have 1: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] A
unfolding coord_ring_def
by (metis assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
have 2: "pre_to_univ_poly (Suc n) i q ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] A
unfolding coord_ring_def
by (metis assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
show "pre_to_univ_poly_inv (Suc n) i
(pre_to_univ_poly (Suc n) i (p ⊕⇘Pring R {..<Suc n}⇙ q)) =
p ⊕⇘Pring R {..<Suc n}⇙ q"
using 0 1 2 A pre_to_univ_poly_inv_is_hom[of i n] ring_hom_ring.homh ring_hom_add
unfolding coord_ring_def
by (smt assms(1))
qed
show "⋀p ia.
p ∈ carrier (Pring R {..<Suc n}) ⟹
ia ∈ {..<Suc n} ⟹
pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i p) = p ⟹
pre_to_univ_poly_inv (Suc n) i
(pre_to_univ_poly (Suc n) i (p ⊗⇘Pring R {..<Suc n}⇙ pvar R ia)) =
p ⊗⇘Pring R {..<Suc n}⇙ pvar R ia"
proof- fix p j
assume A: " p ∈ carrier (Pring R {..<Suc n})" "j ∈ {..<Suc n}"
"pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i p) = p "
have 0: "(pre_to_univ_poly (Suc n) i (p ⊗⇘R[𝒳⇘Suc n⇙]⇙ pvar R j))
= (pre_to_univ_poly (Suc n) i p) ⊗⇘Pring (R[𝒳⇘n⇙]) {i}⇙ pre_to_univ_poly (Suc n) i (pvar R j)"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] ring_hom_ring.homh ring_hom_mult A
unfolding coord_ring_def
by (metis R.Pring_var_closed assms(1) diff_Suc_1)
have 1: "pre_to_univ_poly (Suc n) i p ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] A
unfolding coord_ring_def
by (metis assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
have 1: "pre_to_univ_poly (Suc n) i (pvar R j) ∈ carrier (Pring (R[𝒳⇘n⇙]) {i})"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] A
unfolding coord_ring_def
by (metis R.Pring_var_closed assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
have 2: "pre_to_univ_poly_inv (Suc n) i (pre_to_univ_poly (Suc n) i (pvar R j)) = pvar R j"
proof(cases "j = i")
case True
then have "(pre_to_univ_poly (Suc n) i (pvar R j)) = pvar (R[𝒳⇘n⇙]) j"
using pre_to_univ_poly_is_hom(3)[of i "Suc n"] assms(1) diff_Suc_1 by presburger
then show ?thesis
unfolding coord_ring_def
using True ‹pre_to_univ_poly (Suc n) i (pvar R j) = pvar (R[𝒳⇘n⇙]) j› assms(1) pre_to_univ_poly_inv_pvar by presburger
next
case False
show ?thesis
proof(cases "j < i")
case True
then have "(pre_to_univ_poly (Suc n) i (pvar R j)) = ring.indexed_const (R[𝒳⇘n⇙]) (pvar R j)"
using pre_to_univ_poly_is_hom(2) [of i "Suc n"] assms(1) diff_Suc_1
unfolding coord_ring_def
by presburger
then show ?thesis
using pre_to_univ_poly_inv_const[of i n "(pvar R j)"]
pre_to_univ_poly_inv_hom_pvar_0[of i n j]
by (metis Suc_less_eq True assms(1) less_trans_Suc local.pvar_closed)
next
case F: False
then have "(pre_to_univ_poly (Suc n) i (pvar R j)) = ring.indexed_const (R[𝒳⇘n⇙]) (pvar R (j-1))"
using pre_to_univ_poly_is_hom(4)[of i "Suc n"] assms(1) diff_Suc_1
unfolding coord_ring_def
by (metis A(2) False lessThan_iff linorder_neqE_nat)
then show ?thesis
using pre_to_univ_poly_inv_const[of i n "(pvar R (j-1))"]
pre_to_univ_poly_inv_hom_pvar_0[of i n "j-1"]
by (metis (no_types, lifting) A(2) F False One_nat_def Suc_eq_plus1 add_diff_inverse_nat
assms(1) le_neq_implies_less lessThan_iff less_one local.pvar_closed nat_le_linear
not_less_eq plus_1_eq_Suc pre_to_univ_poly_inv_hom_pvar_1)
qed
qed
show "pre_to_univ_poly_inv (Suc n) i
(pre_to_univ_poly (Suc n) i (p ⊗⇘Pring R {..<Suc n}⇙ pvar R j)) =
p ⊗⇘Pring R {..<Suc n}⇙ pvar R j"
using 0 1 2 A pre_to_univ_poly_inv_is_hom[of i n]
ring_hom_ring.homh[of _ _ "pre_to_univ_poly_inv (Suc n) i "]
ring_hom_mult[of "pre_to_univ_poly_inv (Suc n) i "]
unfolding coord_ring_def
by (smt assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
qed
qed
lemma coord_ring_car_induct:
assumes "Q ∈ carrier (R[𝒳⇘n⇙])"
assumes "⋀c. c ∈ carrier R ⟹ A (R.indexed_const c)"
assumes "⋀p q. p ∈ carrier (R[𝒳⇘n⇙]) ⟹ q ∈ carrier (R[𝒳⇘n⇙]) ⟹ A p ⟹ A q ⟹ A (p ⊕⇘R[𝒳⇘n⇙]⇙ q)"
assumes "⋀p i. p ∈ carrier (R[𝒳⇘n⇙]) ⟹ i < n ⟹ A p ⟹ A (p ⊗⇘R[𝒳⇘n⇙]⇙ pvar R i)"
shows "A Q"
unfolding coord_ring_def apply(rule R.Pring_car_induct''[of _ "{..<n}"])
apply (metis assms(1) coord_ring_def)
using assms(2) apply auto[1]
apply (metis assms(3) coord_ring_def)
by (metis assms(4) coord_ring_def lessThan_iff)
lemma pre_to_univ_poly_inverse':
assumes "i < Suc n"
assumes "p ∈ carrier (R[𝒳⇘n⇙])"
shows "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) = MP.indexed_const n p"
apply(rule coord_ring_car_induct[of _ n])
using assms(2) apply blast
proof-
show "⋀c. c ∈ carrier R ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (R.indexed_const c))) =
MP.indexed_const n (R.indexed_const c)"
proof- fix k assume A: "k ∈ carrier R"
have 0: "R.indexed_const k ∈ carrier (R [𝒳⇘n⇙])"
using A
by (metis coord_ring_def R.indexed_const_closed)
have 1: "pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (R.indexed_const k)) = pre_to_univ_poly_inv_hom (Suc n) i (R.indexed_const k)"
using 0 assms pre_to_univ_poly_inv_const[of i n "R.indexed_const k"]
by linarith
have "pre_to_univ_poly_inv_hom (Suc n) i (R.indexed_const k) = R.indexed_const k"
using A pre_to_univ_poly_inv_hom_const[of i n k] assms
by blast
thus "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (R.indexed_const k))) = MP.indexed_const n (R.indexed_const k) "
using 1
by (metis A assms(1) coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(5))
qed
show "⋀p q. p ∈ carrier (R [𝒳⇘n⇙]) ⟹
q ∈ carrier (R [𝒳⇘n⇙]) ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) = MP.indexed_const n p ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n q)) = MP.indexed_const n q ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ q))) = MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ q)"
proof- fix p Q
assume A: "p ∈ carrier (R [𝒳⇘n⇙]) "
"pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) = MP.indexed_const n p"
"Q ∈ carrier (R [𝒳⇘n⇙])"
"pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n Q)) = MP.indexed_const n Q "
have 0: "p ⨁ Q = p ⊕⇘R[𝒳⇘n⇙]⇙ Q"
by (metis R.Pring_add coord_ring_def)
have 1: "MP.indexed_const n (p ⨁ Q) = (MP.indexed_const n p) ⊕⇘Pring (R[𝒳⇘n⇙]) {i}⇙(MP.indexed_const n Q)"
by (metis "0" MP.Pring_add MP.indexed_padd_const)
have 2: "MP.indexed_const n p ∈ carrier (Pring (R [𝒳⇘n⇙]) {i})"
using A unfolding coord_ring_def
by (metis MP.indexed_const_closed R.Pring_car coord_ring_def)
have 3: "MP.indexed_const n Q ∈ carrier (Pring (R [𝒳⇘n⇙]) {i})"
using A(3) MP.indexed_const_closed by blast
have 4: "(pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ Q))) =
pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p) ⊕⇘R[𝒳⇘Suc n⇙]⇙ pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n Q)"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"]
pre_to_univ_poly_inv_is_hom(1)[of i n]
ring_hom_add[of "pre_to_univ_poly_inv (Suc n) i" "(Pring (R [𝒳⇘n⇙]) {i})"
"(R [𝒳⇘Suc n⇙])" "MP.indexed_const n p" "MP.indexed_const n Q"]
ring_hom_ring.homh
MP.indexed_const_closed[of p n "{i}"]
MP.indexed_const_closed[of Q n "{i}"] A R.Pring_car[of "{..<n}"] unfolding coord_ring_def
by (metis "0" "1" assms(1) coord_ring_def)
have 5: "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ Q))) =
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) ⊕⇘Pring (R[𝒳⇘n⇙]) {i}⇙
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n Q))"
proof-
have 50: "pre_to_univ_poly (Suc n) i ∈ ring_hom (R [𝒳⇘Suc n⇙]) (Pring (R [𝒳⇘Suc n - 1⇙]) {i})"
using pre_to_univ_poly_is_hom(1)[of i "Suc n"] ring_hom_ring.homh
by (metis assms(1))
have 51: "pre_to_univ_poly_inv (Suc n) i ∈ ring_hom (Pring (R [𝒳⇘Suc n - 1⇙]) {i}) (R [𝒳⇘Suc n⇙]) "
using pre_to_univ_poly_inv_is_hom ring_hom_ring.homh
by (metis assms(1) diff_Suc_1)
have 52: " pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p) ∈ carrier (R [𝒳⇘Suc n⇙])"
using 51 ring_hom_closed[of "pre_to_univ_poly_inv (Suc n) i" ]
by (smt "2" diff_Suc_1)
have 53: " pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n Q) ∈ carrier (R [𝒳⇘Suc n⇙]) "
using 51 ring_hom_closed[of "pre_to_univ_poly_inv (Suc n) i" ]
by (smt 3 diff_Suc_1)
show ?thesis using 50 51 52 53
using pre_to_univ_poly_is_hom(1)[of i "Suc n"]
ring_hom_add[of "pre_to_univ_poly (Suc n) i" "R [𝒳⇘Suc n⇙]" "Pring (R [𝒳⇘Suc n - 1⇙]) {i}"
"pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)"
"pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n Q)"] 4
by (metis diff_Suc_1)
qed
show "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ Q))) = MP.indexed_const n (p ⊕⇘R [𝒳⇘n⇙]⇙ Q)"
using 5 A "0" "1" by metis
qed
show "⋀p ia.
p ∈ carrier (R [𝒳⇘n⇙]) ⟹
ia < n ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) = MP.indexed_const n p ⟹
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R ia))) = MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R ia)"
proof- fix p j
assume A: "p ∈ carrier (R [𝒳⇘n⇙])" "j < n"
"pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) = MP.indexed_const n p"
show "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R j))) = MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R j)"
proof-
have 0: "pre_to_univ_poly_inv (Suc n) i ∈ ring_hom (Pring (R [𝒳⇘Suc n - 1⇙]) {i}) (R [𝒳⇘Suc n⇙]) "
using pre_to_univ_poly_inv_is_hom(1)[of i n] ring_hom_ring.homh
by (metis assms(1) diff_Suc_1)
have 1: "MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ (pvar R j)) = MP.indexed_const n p ⊗⇘Pring (R[𝒳⇘n⇙]) {i}⇙ MP.indexed_const n (pvar R j)"
by (metis A(1) A(2) MP.indexed_const_mult local.pvar_closed)
have 2: "(pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R j))) =
pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p) ⊗⇘(R [𝒳⇘Suc n⇙])⇙ pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j))"
using 0 1 ring_hom_mult A
by (metis (no_types, lifting) MP.indexed_const_closed diff_Suc_1 local.pvar_closed)
have 3: "pre_to_univ_poly(Suc n) i ∈ ring_hom (R [𝒳⇘Suc n⇙]) (Pring (R [𝒳⇘Suc n - 1⇙]) {i}) "
using assms(1) pre_to_univ_poly_is_hom(1) ring_hom_ring.homh by blast
have 4: "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R j))) =
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n p)) ⊗⇘Pring (R [𝒳⇘n⇙]) {i}⇙
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j)))"
using 2 3 ring_hom_mult
by (smt "0" A(1) A(2) MP.indexed_const_closed diff_Suc_1 local.pvar_closed ring_hom_closed)
have 5: "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (p ⊗⇘R [𝒳⇘n⇙]⇙ pvar R j))) =
MP.indexed_const n p ⊗⇘Pring (R [𝒳⇘n⇙]) {i}⇙
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j)))"
using A "4" by presburger
have 6: "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j))) = (MP.indexed_const n (pvar R j))"
proof-
have "(pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j))) = pre_to_univ_poly_inv_hom (Suc n) i (pvar R j)"
using A(2) assms(1) local.pvar_closed pre_to_univ_poly_inv_const by blast
hence "pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j))) =
pre_to_univ_poly (Suc n) i (pre_to_univ_poly_inv_hom (Suc n) i (pvar R j))"
by presburger
show ?thesis
proof(cases "j < i")
case True
then have "(pre_to_univ_poly_inv_hom (Suc n) i (pvar R j)) = (pvar R j)"
using pre_to_univ_poly_inv_hom_pvar_0[of i n j] assms(1) by blast
thus ?thesis using pre_to_univ_poly_is_hom
by (metis True ‹pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j)) = pre_to_univ_poly_inv_hom (Suc n) i (pvar R j)› assms(1) coord_ring_def diff_Suc_1)
next
case False
have "pre_to_univ_poly_inv_hom (Suc n) i (pvar R j) = pvar R (j + 1)"
using pre_to_univ_poly_inv_hom_pvar_1[of i n j] A(2) False assms(1) not_le
by blast
thus ?thesis using pre_to_univ_poly_is_hom
by (metis A(2) False Suc_eq_plus1 ‹pre_to_univ_poly_inv (Suc n) i (MP.indexed_const n (pvar R j)) = pre_to_univ_poly_inv_hom (Suc n) i (pvar R j)›
assms(1) coord_ring_def diff_Suc_1 not_less_eq)
qed
qed
show ?thesis using 6 A
using "1" "5" by presburger
qed
qed
qed
definition to_univ_poly :: "nat ⇒ nat ⇒
(('a, nat) mvar_poly , ('a, nat) mvar_poly u_poly) ring_hom" where
"to_univ_poly n i = IP_to_UP i ∘ (pre_to_univ_poly n i) "
definition from_univ_poly :: "nat ⇒ nat ⇒
(('a, nat) mvar_poly u_poly , ('a, nat) mvar_poly) ring_hom" where
"from_univ_poly n i = pre_to_univ_poly_inv n i ∘ (UP_to_IP (coord_ring R (n-1)) i)"
lemma to_univ_poly_is_hom:
assumes "i ≤ n"
shows "(to_univ_poly (Suc n) i) ∈ ring_hom (R[𝒳⇘Suc n⇙]) (UP (R[𝒳⇘n⇙])) "
unfolding to_univ_poly_def
apply(rule ring_hom_trans[of _ _ "Pring (R[𝒳⇘n⇙]) {i}"])
using assms pre_to_univ_poly_is_hom ring_hom_ring.homh
apply (metis diff_Suc_1 le_imp_less_Suc)
using UP_cring.IP_to_UP_ring_hom[of "(Pring R {..<n})" i] assms ring_hom_ring.homh
unfolding coord_ring_def UP_cring_def
using R.Pring_is_cring R.is_cring by blast
lemma from_univ_poly_is_hom:
assumes "i ≤ n"
shows "(from_univ_poly (Suc n) i) ∈ ring_hom (UP (R[𝒳⇘n⇙])) (R[𝒳⇘Suc n⇙]) "
unfolding from_univ_poly_def
apply(rule ring_hom_trans[of _ _ "Pring (R[𝒳⇘n⇙]) {i}"])
using assms UP_cring.UP_to_IP_ring_hom[of "coord_ring R (Suc n - 1)" i]
ring_hom_ring.homh[of "UP (coord_ring R (Suc n - 1))" "Pring (coord_ring R (Suc n - 1)) {i}" "UP_to_IP (coord_ring R (Suc n - 1)) i"]
unfolding coord_ring_def UP_cring_def
apply (metis R.Pring_is_cring diff_Suc_1 R.is_cring)
using assms ring_hom_ring.homh le_imp_less_Suc pre_to_univ_poly_inv_is_hom
unfolding coord_ring_def UP_cring_def
by blast
lemma to_univ_poly_inverse:
assumes "i ≤ n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
shows "from_univ_poly (Suc n) i (to_univ_poly (Suc n) i p) = p"
proof-
have 0: "pre_to_univ_poly (Suc n) i p ∈ Pring_set (R[𝒳⇘n⇙]) {i}"
using pre_to_univ_poly_is_hom(6)[of i "Suc n" _ p] assms ring.Pring_car
unfolding coord_ring_def UP_domain_def
by (metis R.Pring_is_ring diff_Suc_1 le_imp_less_Suc)
have 1: "UP_to_IP (R[𝒳⇘n⇙]) i
(IP_to_UP i (pre_to_univ_poly (Suc n) i p)) =
pre_to_univ_poly (Suc n) i p"
using 0 UP_cring.UP_to_IP_inv[of "R[𝒳⇘n⇙]" "pre_to_univ_poly (Suc n) i p" i ]
R.Pring_is_cring
unfolding coord_ring_def UP_cring_def
using R.is_cring by blast
have 2: "from_univ_poly (Suc n) i (to_univ_poly (Suc n) i p) =
(pre_to_univ_poly_inv (Suc n) i (
(UP_to_IP (coord_ring R (Suc n - 1)) i) (
(IP_to_UP i (
(pre_to_univ_poly (Suc n) i) p)))))"
unfolding from_univ_poly_def to_univ_poly_def
unfolding coord_ring_def
by (metis comp_eq_dest_lhs)
have 3: "from_univ_poly (Suc n) i (to_univ_poly (Suc n) i p) =
(pre_to_univ_poly_inv (Suc n) i (
pre_to_univ_poly (Suc n) i p))"
using 0 1 2
unfolding coord_ring_def
using diff_Suc_1 by presburger
then show ?thesis
using pre_to_univ_poly_inverse assms(1) assms(2) less_Suc_eq_le
by presburger
qed
lemma to_univ_poly_closed:
assumes "i ≤ n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
shows "to_univ_poly (Suc n) i p ∈ carrier (UP (R[𝒳⇘n⇙]))"
using to_univ_poly_is_hom[of i n] assms unfolding ring_hom_def
by blast
lemma to_univ_poly_add:
assumes "i ≤ n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘Suc n⇙])"
shows "to_univ_poly (Suc n) i (p ⊕⇘R[𝒳⇘Suc n⇙]⇙Q) =
to_univ_poly (Suc n) i p ⊕⇘UP (R[𝒳⇘n⇙])⇙ to_univ_poly (Suc n) i Q"
using to_univ_poly_is_hom ring_hom_add
by (metis assms(1) assms(2) assms(3))
lemma to_univ_poly_mult:
assumes "i ≤ n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "Q ∈ carrier (R[𝒳⇘Suc n⇙])"
shows "to_univ_poly (Suc n) i (p ⊗⇘R[𝒳⇘Suc n⇙]⇙Q) =
to_univ_poly (Suc n) i p ⊗⇘UP (R[𝒳⇘n⇙])⇙ to_univ_poly (Suc n) i Q"
using to_univ_poly_is_hom ring_hom_mult
by (metis assms(1) assms(2) assms(3))
lemma from_univ_poly_closed:
assumes "i ≤ n"
assumes "p ∈ carrier (UP (R[𝒳⇘n⇙])) "
shows "from_univ_poly (Suc n) i p ∈ carrier (R[𝒳⇘Suc n⇙])"
using from_univ_poly_is_hom[of i n] assms unfolding ring_hom_def
by blast
lemma from_univ_poly_add:
assumes "i ≤ n"
assumes "p ∈ carrier (UP (R[𝒳⇘n⇙])) "
assumes "Q ∈ carrier (UP (R[𝒳⇘n⇙])) "
shows "from_univ_poly (Suc n) i (p ⊕⇘UP (R[𝒳⇘n⇙])⇙Q) =
from_univ_poly (Suc n) i p ⊕⇘R[𝒳⇘Suc n⇙]⇙ from_univ_poly (Suc n) i Q"
using from_univ_poly_is_hom ring_hom_add
by (metis assms(1) assms(2) assms(3))
lemma from_univ_poly_mult:
assumes "i ≤ n"
assumes "p ∈ carrier (UP (R[𝒳⇘n⇙])) "
assumes "Q ∈ carrier (UP (R[𝒳⇘n⇙])) "
shows "from_univ_poly (Suc n) i (p ⊗⇘UP (R[𝒳⇘n⇙])⇙Q) =
from_univ_poly (Suc n) i p ⊗⇘R[𝒳⇘Suc n⇙]⇙ from_univ_poly (Suc n) i Q"
using from_univ_poly_is_hom ring_hom_mult
by (metis assms(1) assms(2) assms(3))
lemma(in UP_cring) monom_as_mult:
assumes "a ∈ carrier R"
shows "up_ring.monom (UP R) a n = to_poly a ⊗⇘ UP R⇙ up_ring.monom (UP R) 𝟭 n"
by (metis One_nat_def P_def R.one_closed R.r_one UP_cring.poly_shift_monom add_Suc assms is_UP_cring local.monom_mult plus_1_eq_Suc to_polynomial_def)
lemma cring_coord_rings_coord_ring:
"cring_coord_rings (R[𝒳⇘n⇙])"
unfolding cring_coord_rings_def
cring_coord_rings_axioms_def coord_ring_def
apply(rule conjI)
unfolding UP_cring_def
apply (metis coord_cring_cring coord_ring_def)
using cring_coord_rings_axioms
unfolding cring_coord_rings_def cring_coord_rings_axioms_def
by (metis coord_ring_def coord_ring_one coord_ring_zero)
lemma from_univ_poly_monom_inverse:
assumes "i < Suc n"
assumes "a ∈ carrier (R[𝒳⇘n⇙])"
shows "to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) a m)) = up_ring.monom (UP (R [𝒳⇘n⇙])) a m"
proof-
have 0: "up_ring.monom (UP (R [𝒳⇘n⇙])) a m = (to_polynomial (R[𝒳⇘n⇙]) a) ⊗⇘UP (R[𝒳⇘n⇙])⇙ (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m)"
using UP_cring.monom_as_mult[of "R[𝒳⇘n⇙]" a m] unfolding UP_ring_def
using UP_cring_def assms coord_cring_cring by blast
have 1 : "(UP_to_IP (R [𝒳⇘Suc n - 1⇙]) i) (to_polynomial (R[𝒳⇘n⇙]) a) = ring.indexed_const (R[𝒳⇘n⇙]) a"
using UP_cring.UP_to_IP_const[of "R [𝒳⇘Suc n - 1⇙]" a i] unfolding UP_cring_def
by (simp add: assms coord_cring_cring)
have 2: "(from_univ_poly (Suc n) i (to_polynomial (R[𝒳⇘n⇙]) a))
= pre_to_univ_poly_inv (Suc n) i (ring.indexed_const (R[𝒳⇘n⇙]) a)"
unfolding from_univ_poly_def using 1
by (metis comp_apply)
have 3: "from_univ_poly (Suc n) i (to_polynomial (R [𝒳⇘n⇙]) a) = pre_to_univ_poly_inv_hom (Suc n) i a"
using pre_to_univ_poly_inv_const[of i n a] assms 2
by presburger
have 4: "to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (to_polynomial (R [𝒳⇘n⇙]) a)) =
IP_to_UP i ((pre_to_univ_poly (Suc n) i) (pre_to_univ_poly_inv_hom (Suc n) i a))"
using 3 unfolding to_univ_poly_def from_univ_poly_def
by (metis comp_apply)
have 5: "(pre_to_univ_poly (Suc n) i) (pre_to_univ_poly_inv (Suc n) i (ring.indexed_const (R[𝒳⇘n⇙]) a)) = (ring.indexed_const (R[𝒳⇘n⇙]) a)"
using assms(1) assms(2) pre_to_univ_poly_inverse' by blast
have "(to_univ_poly (Suc n) i) (from_univ_poly (Suc n) i (to_polynomial (R[𝒳⇘n⇙]) a)) = IP_to_UP i (ring.indexed_const (R[𝒳⇘n⇙]) a)"
unfolding to_univ_poly_def
by (metis "2" "5" comp_apply)
hence 6: "(to_univ_poly (Suc n) i) (from_univ_poly (Suc n) i (to_polynomial (R[𝒳⇘n⇙]) a)) = to_polynomial (R[𝒳⇘n⇙]) a"
using UP_cring.IP_to_UP_indexed_const[of "R[𝒳⇘n⇙]"]
by (smt UP_cring_def assms(2) coord_cring_cring)
have 7: "(to_univ_poly (Suc n) i) (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m)) = up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m"
proof-
have 70: "pvar (R [𝒳⇘n⇙]) i [^]⇘Pring (R [𝒳⇘n⇙]) {i}⇙ m ∈ carrier (Pring (R [𝒳⇘n⇙]) {i})"
using Cring_Multivariable_Poly.pvar_closed[of "R[𝒳⇘n⇙]" i "{i}"] monoid.nat_pow_closed[of "R[𝒳⇘n⇙]"]
by (meson MP.Pring_is_monoid coord_cring_cring equalityD2 insert_subset monoid.nat_pow_closed)
have 71: "(UP_to_IP (R [𝒳⇘Suc n - 1⇙]) i) (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R [𝒳⇘n⇙]⇙ m) =
(pvar (R[𝒳⇘n⇙]) i)[^]⇘Pring (R[𝒳⇘n⇙]) {i}⇙m"
using 70 UP_cring.UP_to_IP_monom[of "R[𝒳⇘n⇙]" "𝟭⇘R[𝒳⇘n⇙]⇙" i m ] cring.Pring_smult_one[of "R[𝒳⇘n⇙]" "pvar (R [𝒳⇘n⇙]) i [^]⇘Pring (R [𝒳⇘n⇙]) {i}⇙ m" "{i}"]
unfolding UP_cring_def
using MP.one_closed coord_cring_cring diff_Suc_1 by presburger
hence 72: "from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m) =
pre_to_univ_poly_inv (Suc n) i ((pvar (R[𝒳⇘n⇙]) i)[^]⇘Pring (R[𝒳⇘n⇙]) {i}⇙m)"
unfolding from_univ_poly_def
using comp_apply[of "pre_to_univ_poly_inv (Suc n) i" "UP_to_IP (R [𝒳⇘Suc n - 1⇙]) i" "up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R [𝒳⇘n⇙]⇙ m"]
by presburger
have 73: " pre_to_univ_poly_inv (Suc n) i ∈ ring_hom (Pring (R [𝒳⇘n⇙]) {i}) (R [𝒳⇘Suc n⇙]) "
using pre_to_univ_poly_inv_is_hom[of i n] assms(1) ring_hom_ring.homh by blast
hence 74: "from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m) = (pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙m"
unfolding from_univ_poly_def
using 70 71 72 pre_to_univ_poly_inv_pvar[of i n]
ring_hom_nat_pow[of "(Pring (R [𝒳⇘n⇙]) {i})" "R [𝒳⇘Suc n⇙]" "pre_to_univ_poly_inv (Suc n) i" "(pvar (R[𝒳⇘n⇙]) i)" m]
by (metis MP.Pring_is_ring MP.Pring_var_closed MP.ring_axioms assms(1) from_univ_poly_def singletonI)
hence 75: "(to_univ_poly (Suc n) i) (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m))
= (to_univ_poly (Suc n) i) ((pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙m)"
by metis
have 76: "pre_to_univ_poly (Suc n) i (pvar R i) = pvar (R [𝒳⇘Suc n - 1⇙]) i"
using pre_to_univ_poly_is_hom(3)[of i "Suc n" ] assms(1) by blast
have "pre_to_univ_poly (Suc n) i ∈ ring_hom (R [𝒳⇘Suc n⇙]) (Pring (R [𝒳⇘Suc n - 1⇙]) {i}) "
apply(rule ring_hom_ring.homh)
using pre_to_univ_poly_is_hom(1)[of i "Suc n"]
using assms(1) by blast
hence "pre_to_univ_poly (Suc n) i (pvar R i [^]⇘R [𝒳⇘Suc n⇙]⇙ m) = pvar (R [𝒳⇘Suc n - 1⇙]) i [^]⇘Pring (R [𝒳⇘Suc n - 1⇙]) {i}⇙ m"
using 76 ring_hom_nat_pow[of "R[𝒳⇘Suc n⇙]" "Pring (R [𝒳⇘Suc n - 1⇙]) {i}" "pre_to_univ_poly (Suc n) i" "pvar R i" m]
by (metis MP.Pring_is_ring MP.ring_axioms assms(1) local.pvar_closed)
hence 77: "(to_univ_poly (Suc n) i) (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m))
=IP_to_UP i (pvar (R [𝒳⇘Suc n - 1⇙]) i [^]⇘Pring (R [𝒳⇘Suc n - 1⇙]) {i}⇙ m)"
unfolding to_univ_poly_def using comp_apply[of "IP_to_UP i" " pre_to_univ_poly (Suc n) i"]
using "74" by presburger
have 78: "IP_to_UP i (pvar (R [𝒳⇘Suc n - 1⇙]) i) = X_poly (R[𝒳⇘n⇙])"
using cring.IP_to_UP_var[of "R[𝒳⇘n⇙]"]
by (simp add: MP.IP_to_UP_var var_to_IP_def)
have 79: "IP_to_UP i ∈ ring_hom (Pring (R [𝒳⇘n⇙]) {i}) (UP (R [𝒳⇘n⇙]))"
using UP_cring.IP_to_UP_ring_hom[of "R[𝒳⇘n⇙]" i] ring_hom_ring.homh[of "Pring (R [𝒳⇘n⇙]) {i}"]
unfolding UP_cring_def
using coord_cring_cring by blast
have 80: "pvar (R [𝒳⇘Suc n - 1⇙]) i ∈ carrier (Pring (R [𝒳⇘n⇙]) {i})"
by (metis "76" assms(1) diff_Suc_1 local.pvar_closed pre_to_univ_poly_is_hom(6))
have 81: "ring (UP (R[𝒳⇘n⇙]))"
using UP_ring.UP_ring[of "R[𝒳⇘n⇙]"] unfolding UP_ring_def
using MP.ring_axioms by blast
hence 82: "IP_to_UP i (pvar (R [𝒳⇘Suc n - 1⇙]) i [^]⇘Pring (R[𝒳⇘n⇙]) {i}⇙ m) = X_poly (R[𝒳⇘n⇙]) [^]⇘UP (R [𝒳⇘n⇙])⇙ m"
using 78 79 80 ring_hom_nat_pow[of "Pring (R [𝒳⇘n⇙]) {i}" "UP (R [𝒳⇘n⇙])" "IP_to_UP i" "pvar (R [𝒳⇘Suc n - 1⇙]) i" m]
by (metis MP.Pring_is_ring)
have 83: "𝟭⇘R [𝒳⇘n⇙]⇙ ⊙⇘UP (R [𝒳⇘n⇙])⇙ X_poly (R [𝒳⇘n⇙]) [^]⇘UP (R [𝒳⇘n⇙])⇙ m = X_poly (R [𝒳⇘n⇙]) [^]⇘UP (R [𝒳⇘n⇙])⇙ m"
using UP_ring.UP_smult_one[of "R[𝒳⇘n⇙]" "X_poly (R [𝒳⇘n⇙]) [^]⇘UP (R [𝒳⇘n⇙])⇙ m"]
UP_cring.X_closed[of "R[𝒳⇘n⇙]"] monoid.nat_pow_closed[of "UP (R[𝒳⇘n⇙])" "X_poly (R[𝒳⇘n⇙])" m]
unfolding UP_ring_def UP_cring_def
using 81 MP.ring_axioms coord_cring_cring ring.is_monoid by blast
have 84: "X_poly (R[𝒳⇘n⇙]) [^]⇘UP (R [𝒳⇘n⇙])⇙ m = up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R [𝒳⇘n⇙]⇙ m"
using 83 UP_cring.monom_rep_X_pow[of "R[𝒳⇘n⇙]" "𝟭⇘R[𝒳⇘n⇙]⇙" m]
monoid.nat_pow_closed[of "UP (R[𝒳⇘n⇙])" "X_poly (R[𝒳⇘n⇙])" m] 81
unfolding UP_cring_def
using MP.one_closed coord_cring_cring by presburger
thus ?thesis using 77
by (metis "82" diff_Suc_1)
qed
have 8: "to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) a m)) =
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (to_polynomial (R[𝒳⇘n⇙]) a)) ⊗⇘UP (R[𝒳⇘n⇙])⇙
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m))"
proof-
have 80: "to_polynomial (R [𝒳⇘n⇙]) a ∈ carrier (UP (R [𝒳⇘n⇙]))"
using UP_cring.to_poly_closed[of "R[𝒳⇘n⇙]" a] UP_cring_def assms(2) coord_cring_cring
by blast
have 81: "up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R [𝒳⇘n⇙]⇙ m ∈ carrier (UP (R [𝒳⇘n⇙])) "
apply(rule UP_ring.monom_closed[of "R[𝒳⇘n⇙]"]) unfolding UP_ring_def using MP.one_closed
apply (simp add: MP.ring_axioms)
using MP.one_closed by blast
have 82: "(from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) a m)) =
(from_univ_poly (Suc n) i (to_polynomial (R[𝒳⇘n⇙]) a)) ⊗⇘(R[𝒳⇘Suc n⇙])⇙
(from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m))"
using 80 81 from_univ_poly_mult[of i n "to_polynomial (R [𝒳⇘n⇙]) a" "(up_ring.monom (UP (R [𝒳⇘n⇙])) 𝟭⇘R[𝒳⇘n⇙]⇙ m)"] 0
by (metis assms(1) less_Suc_eq_le)
thus ?thesis using to_univ_poly_mult 80 81
by (metis assms(1) from_univ_poly_closed less_Suc_eq_le)
qed
thus ?thesis
using "0" "6" "7" by metis
qed
lemma from_univ_poly_inverse:
assumes "i ≤ n"
assumes "p ∈ carrier (UP (R[𝒳⇘n⇙]))"
shows "to_univ_poly (Suc n) i (from_univ_poly (Suc n) i p) = p"
proof(rule UP_ring.poly_induct3[of "R[𝒳⇘n⇙]"])
show "UP_ring (R [𝒳⇘n⇙])"
unfolding UP_ring_def
by (simp add: MP.ring_axioms)
show "p ∈ carrier (UP (R [𝒳⇘n⇙]))"
using assms by blast
show "⋀p q. q ∈ carrier (UP (R [𝒳⇘n⇙])) ⟹
p ∈ carrier (UP (R [𝒳⇘n⇙])) ⟹
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i p) = p ⟹
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i q) = q ⟹
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (p ⊕⇘UP (R [𝒳⇘n⇙])⇙ q)) = p ⊕⇘UP (R [𝒳⇘n⇙])⇙ q"
proof- fix p q
assume A: "q ∈ carrier (UP (R [𝒳⇘n⇙]))" "p ∈ carrier (UP (R [𝒳⇘n⇙]))"
"to_univ_poly (Suc n) i (from_univ_poly (Suc n) i p) = p"
"to_univ_poly (Suc n) i (from_univ_poly (Suc n) i q) = q"
show "to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (p ⊕⇘UP (R [𝒳⇘n⇙])⇙ q)) = p ⊕⇘UP (R [𝒳⇘n⇙])⇙ q"
using A assms
from_univ_poly_add[of i n p q]
to_univ_poly_add[of i n "from_univ_poly (Suc n) i p" "from_univ_poly (Suc n) i q"]
from_univ_poly_closed[of i n p] from_univ_poly_closed[of i n q]
by presburger
qed
show "⋀a na. a ∈ carrier (R [𝒳⇘n⇙]) ⟹
to_univ_poly (Suc n) i (from_univ_poly (Suc n) i (up_ring.monom (UP (R [𝒳⇘n⇙])) a na)) = up_ring.monom (UP (R [𝒳⇘n⇙])) a na"
using from_univ_poly_monom_inverse[of i ] assms(1) le_imp_less_Suc by presburger
qed
lemma to_univ_poly_eval:
assumes "i < Suc n"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "a ∈ carrier (R⇗n⇖)"
assumes "x ∈ carrier R"
assumes "as = insert_at_index a x i"
shows "eval_at_point R as p = eval_at_point R a (to_function (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p) (coord_const x))"
proof-
have 0: "pre_to_univ_poly (Suc n) i p ∈ Pring_set (R[𝒳⇘n⇙]) {i}"
using assms pre_to_univ_poly_is_hom(1)[of i "Suc n"] unfolding ring_hom_ring_def
unfolding coord_ring_def UP_domain_def coord_ring_def UP_domain_def
by (metis MP.Pring_car coord_ring_def diff_Suc_1 pre_to_univ_poly_is_hom(6))
have 1: " closed_fun (R[𝒳⇘n⇙]) (λn. coord_const x)"
using assms(4) R.indexed_const_closed
unfolding coord_ring_def UP_domain_def
by blast
have "(to_function (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p) (coord_const x)) =
to_function (R[𝒳⇘n⇙]) (IP_to_UP i ((pre_to_univ_poly (Suc n) i) p)) (coord_const x)"
unfolding to_univ_poly_def
unfolding coord_ring_def UP_domain_def
by (metis comp_apply)
then have 2: "(to_function (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p) (coord_const x)) =
(total_eval (R[𝒳⇘n⇙]) (λ i. coord_const x) (pre_to_univ_poly (Suc n) i p))"
using 0 1 UP_cring.IP_to_UP_poly_eval[of "R[𝒳⇘n⇙]"
"(pre_to_univ_poly (Suc n) i) p" i "λ i. coord_const x"]
unfolding coord_ring_def UP_cring_def
using assms(4) cring.indexed_const_closed R.Pring_is_cring R.cring_axioms
by smt
then show ?thesis using pre_to_univ_poly_eval[of i n p a x as]
using assms(1) assms(2) assms(3) assms(4) assms(5) by presburger
qed
text‹
The function \texttt{one\_over\_poly}, introduced in the theory \texttt{Cring\_Poly}, maps a
polynomial $p(x)$ to the unique polynomial $q(x)$ which satisfies the relation
$q(x) = x^n p(1/x)$. This will be used later to show that the function $f(x) = 1/x$ is
semialgebraic over the field $\mathbb{Q}_p$.›
lemma to_univ_poly_one_over_poly:
assumes "field R"
assumes "i < (Suc n)"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "Q = from_univ_poly (Suc n) i (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))"
assumes "a ∈ carrier (R⇗n⇖)"
assumes "x ∈ carrier R"
assumes "x ≠ 𝟬"
assumes "b = insert_at_index a x i"
assumes "c = insert_at_index a (inv x) i"
assumes "N = UP_ring.degree (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)"
shows "Q ∈ carrier (R[𝒳⇘Suc n⇙])"
"eval_at_point R b Q = (x[^]N) ⊗ (eval_at_point R c p)"
proof-
have 0: "(to_univ_poly (Suc n) i p) ∈ carrier (UP (R[𝒳⇘n⇙]))"
using assms(2) assms(3) less_Suc_eq_le to_univ_poly_closed by blast
have 1: "(UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)) ∈ carrier (UP (R[𝒳⇘n⇙]))"
using 0 assms UP_domain_def UP_cring.one_over_poly_closed UP_cring_def coord_cring_cring by blast
show "Q ∈ carrier (R[𝒳⇘Suc n⇙])"
using 1 assms from_univ_poly_closed[of i n] less_Suc_eq_le
by blast
have 2: "coord_const x ∈ Units (R[𝒳⇘n⇙])"
proof-
have 20: "inv x ∈ carrier R"
using assms(1) assms(6) assms(7) field.field_Units by blast
have 21: "x ⊗ (inv x) = 𝟭 "
using assms field.field_Units R.Units_r_inv
by blast
have 22: "coord_const x ∈ carrier (R[𝒳⇘n⇙])"
using assms(6) R.indexed_const_closed
unfolding coord_ring_def
by blast
have 23: "coord_const (inv x) ∈ carrier (R[𝒳⇘n⇙])"
using "20" R.indexed_const_closed
unfolding coord_ring_def
by blast
have 24: "coord_const x ⊗⇘R[𝒳⇘n⇙]⇙ coord_const (inv x) = coord_const (x ⊗ (inv x))"
using assms(6) 20 R.indexed_const_mult unfolding coord_ring_def
by blast
have 25: "coord_const x ⊗⇘R[𝒳⇘n⇙]⇙ coord_const (inv x) = 𝟭⇘coord_ring R n⇙"
unfolding coord_ring_def
by (metis "20" "21" R.Pring_one assms(6) R.indexed_const_mult)
have 26: "coord_const (inv x) ⊗⇘R[𝒳⇘n⇙]⇙ coord_const x = 𝟭⇘coord_ring R n⇙"
unfolding coord_ring_def
by (metis "21" "22" "23" "24" MP.m_comm R.Pring_one coord_ring_def)
then show ?thesis
using 23 Units_def[of "R[𝒳⇘n⇙]"] "22" "25"
by blast
qed
have 3: "inv⇘R[𝒳⇘n⇙]⇙ (coord_const x) = coord_const (inv x)"
proof-
have 20: "inv x ∈ carrier R"
using assms(1) assms(6) assms(7) field.field_Units by blast
have 21: "x ⊗ (inv x) = 𝟭 "
using assms field.field_Units R.Units_r_inv
by blast
have 22: "coord_const x ∈ carrier (R[𝒳⇘n⇙])"
using assms(6) R.indexed_const_closed
unfolding coord_ring_def
by blast
have 23: "coord_const (inv x) ∈ carrier (R[𝒳⇘n⇙])"
using "20" R.indexed_const_closed unfolding coord_ring_def
by blast
have 24: "coord_const x ⊗⇘R[𝒳⇘n⇙]⇙ coord_const (inv x) = coord_const (x ⊗ (inv x))"
using assms(6) 20 R.indexed_const_mult unfolding coord_ring_def
by blast
have 25: "coord_const x ⊗⇘R[𝒳⇘n⇙]⇙ coord_const (inv x) = 𝟭⇘coord_ring R n⇙"
unfolding coord_ring_def
by (metis "20" "21" R.Pring_one assms(6) R.indexed_const_mult)
show ?thesis
using 22 23 25 R.Pring_is_cring[of "{..<n}"]
monoid.inv_char[of "R[𝒳⇘n⇙]"]
unfolding coord_ring_def
by (metis R.Pring_is_monoid R.Pring_mult_comm R.is_cring)
qed
have 4: "to_function (R[𝒳⇘n⇙]) (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))
(coord_const x) = (coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N ⊗⇘R[𝒳⇘n⇙]⇙
(to_function (R[𝒳⇘n⇙]) ( (to_univ_poly (Suc n) i p)) (coord_const (inv⇘R⇙ x)))"
using 3 assms UP_cring_def UP_cring.one_over_poly_eval[of "R[𝒳⇘n⇙]" " (to_univ_poly (Suc n) i p)" "coord_const x"]
unfolding coord_ring_def
by (metis "0" "2" MP.Units_closed R.Pring_is_cring UP_cring.to_fun_def coord_ring_def R.is_cring)
have 5: "eval_at_point R a (to_function (R[𝒳⇘n⇙]) (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))
(coord_const x))
= eval_at_point R a ((coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N ⊗⇘R[𝒳⇘n⇙]⇙
(to_function (R[𝒳⇘n⇙]) ( (to_univ_poly (Suc n) i p)) (coord_const (inv⇘R⇙ x))) ) "
using 4
by presburger
have 6: "to_univ_poly (Suc n) i Q = (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))"
using assms from_univ_poly_inverse
by (meson "1" less_Suc_eq_le)
have 7: "eval_at_point R a (to_function (R[𝒳⇘n⇙]) (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))
(coord_const x)) = eval_at_point R b Q"
using 6 to_univ_poly_eval[of i n Q a x b] assms ‹Q ∈ carrier (R[𝒳⇘Suc n⇙])›
by smt
have 8: "(coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N ∈ carrier (R[𝒳⇘n⇙])"
using monoid.nat_pow_closed[of "R[𝒳⇘n⇙]"]
unfolding coord_ring_def
using R.Pring_is_monoid assms(6) R.indexed_const_closed by blast
have 9: "to_function (R[𝒳⇘n⇙]) ( (to_univ_poly (Suc n) i p)) (coord_const (inv⇘R⇙ x))
∈ carrier (R[𝒳⇘n⇙])"
proof-
have 91: "to_univ_poly (Suc n) i p ∈ carrier (UP (R[𝒳⇘n⇙]))"
by (simp add: "0")
have " coord_const (inv x) ∈ carrier (R[𝒳⇘n⇙])"
proof-
have "inv x ∈ carrier R"
using assms(1) assms(6) assms(7) field.field_Units by blast
then show ?thesis
using R.indexed_const_closed[of "inv x"] assms
unfolding coord_ring_def
by blast
qed
then show ?thesis
using 91 UP_cring_def[of "R[𝒳⇘n⇙]" ] UP_cring.to_fun_closed[of "R[𝒳⇘n⇙]" "to_univ_poly (Suc n) i p" "coord_const (inv⇘R⇙ x)"]
to_univ_poly_closed[of i n p] UP_domain_def[of "R[𝒳⇘n⇙]"]
unfolding coord_ring_def
using R.Pring_is_cring R.is_cring
by (metis UP_cring.to_fun_def)
qed
have 10: " eval_at_point R b Q = (eval_at_point R a ((coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N)) ⊗
(eval_at_point R a (to_function (R[𝒳⇘n⇙]) ( (to_univ_poly (Suc n) i p)) (coord_const (inv⇘R⇙ x))))"
using 7 5 eval_at_point_mult[of a n "(coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N"
"(to_function (R[𝒳⇘n⇙]) ( (to_univ_poly (Suc n) i p)) (coord_const (inv⇘R⇙ x)))"]
"8" "9" assms(5)
by presburger
have 11: "inv x ∈ carrier R"
using assms(1) assms(6) assms(7) field.field_Units by blast
have 12: " eval_at_point R b Q = (eval_at_point R a ((coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N)) ⊗
(eval_at_point R c p)"
using 10 11 to_univ_poly_eval[of i n p a "inv x" c] assms(2) assms(3) assms(5) assms(9)
by presburger
show 12: " eval_at_point R b Q = (x[^]N) ⊗
(eval_at_point R c p)"
proof-
have 0: "(coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N = coord_const (x[^]N)"
proof(induction N)
case 0
have 00: "coord_const x [^]⇘R[𝒳⇘n⇙]⇙ (0::nat) = 𝟭⇘R[𝒳⇘n⇙]⇙"
using nat_pow_def[of "R[𝒳⇘n⇙]" _ "(0::nat)"]
unfolding coord_ring_def
by (meson Group.nat_pow_0)
then show ?case
unfolding coord_ring_def
by (metis Group.nat_pow_0 R.Pring_one)
next
case (Suc N) fix N::nat assume IH: "coord_const x [^]⇘R[𝒳⇘n⇙]⇙ N = coord_const (x [^] N)"
then show ?case
using R.indexed_const_mult Group.nat_pow_Suc Suc.IH assms(6) R.nat_pow_closed
unfolding coord_ring_def
by (metis )
qed
have 1: "(eval_at_point R a ((coord_const x)[^]⇘R[𝒳⇘n⇙]⇙N)) = x[^]N"
using 0
by (metis assms(5) assms(6) eval_at_point_const R.nat_pow_closed)
show ?thesis using 0 1 "12"
by presburger
qed
qed
lemma to_univ_poly_one_over_poly':
assumes "field R"
assumes "i < (Suc n)"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "Q = from_univ_poly (Suc n) i (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))"
assumes "a ∈ carrier (R⇗n⇖)"
assumes "x ∈ carrier R"
assumes "x ≠ 𝟬"
assumes "b = insert_at_index a x i"
assumes "c = insert_at_index a (inv x) i"
assumes "N = UP_ring.degree (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)"
assumes "q = (pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙(k::nat)⊗⇘R[𝒳⇘Suc n⇙]⇙ Q"
shows "q ∈ carrier (R[𝒳⇘Suc n⇙])"
"eval_at_point R b q = (x[^](N + k)) ⊗ (eval_at_point R c p)"
proof-
have 0: "(pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙k ∈ carrier (R[𝒳⇘Suc n⇙])"
using pvar_closed[of i "Suc n"] monoid.nat_pow_closed[]
unfolding coord_ring_def
by (metis R.Pring_is_monoid assms(2))
have 1: "b ∈ carrier (R⇗Suc n⇖)"
using assms(2) assms(5) assms(6) assms(8) insert_at_index_closed less_Suc_eq_le
by blast
have 11 : "c ∈ carrier (R⇗Suc n⇖)"
proof-
have "inv x ∈ carrier R"
using assms field.field_Units
by blast
then show ?thesis
using assms insert_at_index_closed less_Suc_eq_le
by blast
qed
have 2: "eval_at_point R b q = eval_at_point R b ((pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙(k::nat))
⊗ eval_at_point R b Q"
using assms 0 1 unfolding coord_ring_def
by (metis R.Pring_mult coord_ring_def eval_at_point_mult to_univ_poly_one_over_poly(1))
have 3: "eval_at_point R b ((pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙(k::nat)) =
x[^](k::nat)"
proof(induction k)
case 0
have T0: "eval_at_point R b ((pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙(0::nat)) =
eval_at_point R b (𝟭⇘R[𝒳⇘Suc n⇙]⇙)"
using nat_pow_def[of "R[𝒳⇘Suc n⇙]" "pvar R i" "0::nat"]
by (metis Group.nat_pow_0)
then show ?case
by (metis "1" assms(2) eval_at_point_nat_pow R.nat_pow_0 local.pvar_closed)
next
case (Suc k) fix k::nat
assume IH: "eval_at_poly R (pvar R i [^]⇘R[𝒳⇘Suc n⇙]⇙ k) b = x [^] k "
have 0: "eval_at_poly R (pvar R i) b = b!i"
using eval_pvar[of i "Suc n"] assms "1"
by blast
have "length a = n"
using assms(5) cartesian_power_car_memE by blast
then have "eval_at_poly R (pvar R i) b = x"
using 0 assms(8) insert_at_index_eq[of i a x]
by (metis assms(2) less_Suc_eq_le)
then show ?case
using "1" assms(2) eval_at_point_nat_pow local.pvar_closed
by blast
qed
have 4: "eval_at_point R b Q = (x[^]N) ⊗ (eval_at_point R c p)"
using to_univ_poly_one_over_poly(2)[of i n p Q a x b c N] assms(1) assms(10) assms(2)
assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9)
by blast
have 5: "eval_at_point R b q = x[^](k::nat) ⊗ ((x[^]N) ⊗ (eval_at_point R c p))"
using 4 3 2
by presburger
show 6: "eval_at_point R b q = x[^](N + k) ⊗ (eval_at_point R c p)"
proof-
have 60: "x[^](k::nat) ∈ carrier R"
using assms(6) by blast
have 61: "x[^]N ∈ carrier R"
using assms(6) by blast
have 62: "eval_at_point R c p ∈ carrier R"
using eval_at_point_closed[of c "Suc n" p] ‹c ∈ carrier (R⇗Suc n⇖)› assms(3)
by blast
show ?thesis using 5 60 61 62
by (metis assms(6) R.m_assoc R.m_comm R.nat_pow_mult)
qed
show "q ∈ carrier (R[𝒳⇘Suc n⇙])"
using assms
unfolding coord_ring_def
using 0 R.Pring_mult_closed to_univ_poly_one_over_poly(1)
by (metis coord_ring_def)
qed
lemma to_univ_poly_one_over_poly'':
assumes "field R"
assumes "i < (Suc n)"
assumes "p ∈ carrier (R[𝒳⇘Suc n⇙])"
assumes "N ≥ UP_ring.degree (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)"
shows "∃ q ∈ carrier (R[𝒳⇘Suc n⇙]). ( ∀ x ∈ carrier R - {𝟬}. ( ∀ a ∈ carrier (R⇗n⇖).
eval_at_point R (insert_at_index a x i) q = (x[^]N) ⊗ (eval_at_point R (insert_at_index a (inv x) i) p)))"
proof-
obtain Q where Q_def:
"Q = from_univ_poly (Suc n) i (UP_cring.one_over_poly (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))"
by blast
obtain k where k_def: "k = (N - UP_ring.degree (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p))"
by blast
obtain q where q_def: "q = (pvar R i)[^]⇘R[𝒳⇘Suc n⇙]⇙(k::nat)⊗⇘R[𝒳⇘Suc n⇙]⇙ Q"
by blast
have 0: " ( ∀ x ∈ carrier R - {𝟬}.( ∀ a ∈ carrier (R⇗n⇖).
eval_at_point R (insert_at_index a x i) q = (x[^]N) ⊗ (eval_at_point R (insert_at_index a (inv x) i) p)))"
proof fix x
assume A0: " x ∈ carrier R - {𝟬}"
show " ∀a∈carrier (R⇗n⇖). eval_at_poly R q (insert_at_index a x i) = x [^] N ⊗ eval_at_poly R p (insert_at_index a (inv x) i)"
proof fix a assume A1: "a ∈ carrier (R⇗n⇖)"
obtain l where l_def: "l = UP_ring.degree (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)"
by blast
have "eval_at_poly R q (insert_at_index a x i) = x [^] (l + k) ⊗ eval_at_poly R p (insert_at_index a (inv x) i)"
using assms A1 A0 to_univ_poly_one_over_poly'(2)[of i n p Q a x "insert_at_index a x i" "insert_at_index a (inv x) i" l q k]
Q_def l_def q_def
by blast
then show " eval_at_poly R q (insert_at_index a x i) = x [^] N ⊗ eval_at_poly R p (insert_at_index a (inv x) i)"
using k_def assms l_def add_diff_inverse_nat less_Suc_eq not_less_eq
by (metis diff_diff_cancel diff_less_Suc)
qed
qed
have 1: "q ∈ carrier (R[𝒳⇘Suc n⇙])"
proof-
obtain a where a_def: "a = map (λi. 𝟭) [(0::nat)..<n] "
by blast
have a_car: "a ∈ carrier (R⇗n⇖)"
apply(rule cartesian_power_car_memI')
using a_def
apply (metis Ex_list_of_length coeff_list length_map length_rev)
proof- fix i assume A: "i < n"
then have "a!i = 𝟭"
using a_def
by (metis R_list_length length_map map_nth nth_map)
then show "a ! i ∈ carrier R"
using a_def R.one_closed
by metis
qed
then show "q ∈ carrier (R[𝒳⇘Suc n⇙])"
using assms q_def k_def Q_def to_univ_poly_one_over_poly'(1)[of i n p Q a 𝟭 _ _ "deg (R[𝒳⇘n⇙])
(to_univ_poly (Suc n) i p)" q "N -deg (R[𝒳⇘n⇙]) (to_univ_poly (Suc n) i p)" ]
using one_closed local.one_neq_zero by blast
qed
show ?thesis
using 0 1 by blast
qed
section‹Restricted Inverse Images and Complements›
text‹
This section introduces some versions of basic set operations for extensional functions and sets.
We would like a version of the inverse image which intersects the inverse image of a function
with the set \texttt{carrier }$(R^n)$, and a version of the complement of a set which takes the
comeplement relative to \texttt{carrier }$(R^n)$. These will have to be defined in parametrized
families, with one such object for each natural number $n$.›
definition evimage (infixr "¯ı" 90) where
"evimage n f S = ((f -` S) ∩ carrier (R⇗n⇖))"
definition euminus_set :: "nat ⇒ 'a list set ⇒ 'a list set" ("_ ⇧cı" 70) where
"S⇧c⇘n⇙ = carrier (R⇗n⇖) - S"
lemma extensional_vimage_closed:
"f ¯⇘n⇙ S ⊆ carrier (R⇗n⇖)"
unfolding evimage_def by blast
subsection ‹Inverse image of a function›
lemma evimage_eq [simp]: "a ∈ f ¯⇘n⇙ B ⟷ a ∈ carrier (R⇗n⇖) ∧ f a ∈ B"
unfolding evimage_def
by blast
lemma evimage_singleton_eq: "a ∈ f ¯⇘n⇙ {b} ⟷ a ∈ carrier (R⇗n⇖) ∧ f a = b"
unfolding evimage_def
by blast
lemma evimageI [intro]: "a ∈ carrier (R⇗n⇖) ⟹ f a = b ⟹ b ∈ B ⟹ a ∈ f ¯⇘n⇙ B"
unfolding vimage_def
using evimage_eq by blast
lemma evimageI2: "a ∈ carrier (R⇗n⇖) ⟹ f a ∈ A ⟹ a ∈ f ¯⇘n⇙ A"
unfolding vimage_def by fast
lemma evimageE [elim!]: "a ∈ f ¯⇘n⇙ B ⟹ (⋀x. f a = x ⟹ x ∈ B ⟹ p) ⟹ p"
unfolding evimage_def
by blast
lemma evimageD: "a ∈ f¯⇘n⇙ A ⟹ f a ∈ A"
unfolding vimage_def by fast
lemma evimage_empty [simp]: "f ¯⇘n⇙ {} = {}"
by blast
lemma evimage_Compl:
assumes "f ∈ carrier (R⇗n⇖) → carrier (R⇗m⇖)"
shows "(f ¯⇘n⇙(A⇧c⇘m⇙)) = ((f -` A)⇧c⇘n⇙) "
proof-
have "(f ¯⇘n⇙(A⇧c⇘m⇙)) = ((f -` (carrier (R⇗m⇖)) - (f -` A))) ∩ carrier (R⇗n⇖)"
unfolding evimage_def euminus_set_def by blast
hence 0: "(f ¯⇘n⇙(A⇧c⇘m⇙)) = (f -` (carrier (R⇗m⇖)) ∩ carrier (R⇗n⇖)) - (f -` A)"
by (simp add: Int_Diff Int_commute)
have "(f -` (carrier (R⇗m⇖)) ∩ carrier (R⇗n⇖)) = carrier (R⇗n⇖)"
proof
show "f -` carrier (R⇗m⇖) ∩ carrier (R⇗n⇖) ⊆ carrier (R⇗n⇖)"
by auto
show "carrier (R⇗n⇖) ⊆ f -` carrier (R⇗m⇖) ∩ carrier (R⇗n⇖)"
using assms by blast
qed
thus ?thesis using 0
by (simp add: euminus_set_def)
qed
lemma evimage_Un [simp]: "f ¯⇘n⇙ (A ∪ B) = (f ¯⇘n⇙ A) ∪ (f ¯⇘n⇙ B)"
unfolding evimage_def by blast
lemma evimage_Int [simp]: "f ¯⇘n⇙ (A ∩ B) = (f ¯⇘n⇙ A) ∩ (f ¯⇘n⇙ B)"
unfolding evimage_def by blast
lemma evimage_Collect_eq [simp]: "f ¯⇘n⇙ Collect p = {y ∈ carrier (R⇗n⇖). p (f y)}"
unfolding evimage_def by blast
lemma evimage_Collect: "(⋀x. x ∈ carrier (R⇗n⇖) ⟹ p (f x) = Q x) ⟹ f ¯⇘n⇙ (Collect p) = Collect Q ∩ carrier (R⇗n⇖)"
unfolding evimage_def by blast
lemma evimage_insert: "f ¯⇘n⇙ (insert a B) = (f ¯⇘n⇙ {a}) ∪ (f ¯⇘n⇙ B)"
unfolding evimage_def by blast
lemma evimage_Diff: "f ¯⇘n⇙ (A - B) = (f ¯⇘n⇙ A) - (f ¯⇘n⇙ B)"
unfolding evimage_def by blast
lemma evimage_UNIV [simp]: "f ¯⇘n⇙ UNIV = carrier (R⇗n⇖)"
unfolding evimage_def by blast
lemma evimage_mono: "A ⊆ B ⟹ f ¯⇘n⇙ A ⊆ f ¯⇘n⇙ B"
unfolding evimage_def by blast
lemma evimage_image_eq: "(f ¯⇘n⇙ (f ` A)) = {y ∈ carrier (R⇗n⇖). ∃x∈A. f x = f y}"
unfolding evimage_def by (blast intro: sym)
lemma image_evimage_subset: "f ` (f ¯⇘n⇙ A) ⊆ A"
by blast
lemma image_evimage_eq [simp]: "f ` (f ¯⇘n⇙ A) = A ∩ (f ` carrier (R⇗n⇖))"
unfolding evimage_def by blast
lemma image_subset_iff_subset_evimage: "A ⊆ carrier (R⇗n⇖) ⟹ f ` A ⊆ B ⟷ A ⊆ f ¯⇘n⇙ B"
by blast
lemma evimage_const [simp]: "((λx. c) ¯⇘n⇙ A) = (if c ∈ A then carrier (R⇗n⇖) else {})"
unfolding evimage_def using vimage_const[of c A]
by (smt Int_commute inf_bot_right inf_top.right_neutral)
lemma evimage_if [simp]: "((λx. if x ∈ B then c else d) ¯⇘n⇙ A) =
(if c ∈ A then (if d ∈ A then carrier (R⇗n⇖) else B ∩ carrier (R⇗n⇖) )
else if d ∈ A then B⇧c⇘n⇙ else {})"
unfolding evimage_def euminus_set_def using vimage_if[of B c d A]
by (metis Diff_Compl Diff_UNIV Diff_empty Int_commute double_compl)
lemma evimage_inter_cong: "(⋀ w. w ∈ S ⟹ f w = g w) ⟹ f ¯⇘n⇙ y ∩ S = g ¯⇘n⇙ y ∩ S"
unfolding evimage_def
by (smt Int_assoc Int_commute vimage_inter_cong)
lemma evimage_ident [simp]: "(λx. x) ¯⇘n⇙ Y = Y ∩ carrier (R⇗n⇖)"
unfolding evimage_def
by blast
end
end