(* $Id: CPolynomials.v,v 1.78 2000/11/10 11:27:29 freek Exp $ *)

Require Export CRings.

(* Tex_Prose
\section{Polynomials}
The first section only proves the polynomials form a ring, and nothing more
interesting.
Section~\ref{section:poly-equality} gives some basic properties of
equality and induction of polynomials.
\subsection{Definition of polynomials; they form a ring}
\label{section:poly-ring}
*)

Section CPoly_CRing.
(* Tex_Prose
\begin{convention}
Let \verb!CR! be a ring.
\end{convention}
*)

Variable CR:CRing.

(* Tex_Prose
\verb!(cpoly CR)! is $R[X]$;
\verb!cpoly_zero! is the `empty' polynomial with no coefficients;
\verb!(cpoly_linear c p)! is $c + X * p$
*)

(* Begin_Tex_Verb *)
Inductive cpoly : Set :=
    cpoly_zero : cpoly
  | cpoly_linear : (s:CR)(c:cpoly)cpoly.

Definition cpoly_constant [c:CR]: cpoly := (cpoly_linear c cpoly_zero).
Definition cpoly_one: cpoly := (cpoly_constant One).
(* End_Tex_Verb *)

(* Tex_Prose
Some useful induction lemmas for doubly quantified propositions.
*)
(* Begin_Tex_Verb *)
Lemma cpoly_double_ind0 : (P:cpoly->cpoly->Prop)
   ((p:cpoly)(P p cpoly_zero)) ->
   ((p:cpoly)(P cpoly_zero p)) ->
   ((p,q:cpoly)(c,d:CR)(P p q)->(P (cpoly_linear c p) (cpoly_linear d q))) ->
   (p,q:cpoly)(P p q).
(* End_Tex_Verb *)
Induction p; Auto.
Induction q; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_sym_ind0 : (P:cpoly->cpoly->Prop)
   (Symmetric P) ->
   ((p:cpoly)(P p cpoly_zero)) ->
   ((p,q:cpoly)(c,d:CR)(P p q)->(P (cpoly_linear c p) (cpoly_linear d q))) ->
   (p,q:cpoly)(P p q).
(* End_Tex_Verb *)
Intros.
Apply cpoly_double_ind0; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_ind0' : (P:cpoly->cpoly->Prop)
   ((p:cpoly)(P cpoly_zero p)) ->
   ((p:cpoly)(c:CR)(P (cpoly_linear c p) cpoly_zero)) ->
   ((p,q:cpoly)(c,d:CR)(P p q)->(P (cpoly_linear c p) (cpoly_linear d q))) ->
   (p,q:cpoly)(P p q).
(* End_Tex_Verb *)
Induction p; Auto.
Induction q; Auto.
Qed.

(* Tex_Prose
\subsubsection{The polynomials form a setoid}
*)
(* Begin_Tex_Verb *)
Fixpoint cpoly_eq_zero [p:cpoly] : Prop :=
  Cases p of
    cpoly_zero => True
  | (cpoly_linear c p1) => (c [=] Zero) /\ (cpoly_eq_zero p1)
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint cpoly_eq [p:cpoly] : cpoly->Prop := [q:cpoly]
  Cases p of
    cpoly_zero => (cpoly_eq_zero q)
  | (cpoly_linear c p1) =>
      Cases q of
        cpoly_zero => (cpoly_eq_zero p)
      | (cpoly_linear d q1) => (c [=] d) /\ (cpoly_eq p1 q1)
      end
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_eq_p_zero : (p:cpoly)(cpoly_eq p cpoly_zero) == (cpoly_eq_zero p).
Induction p; Auto.
Qed.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint cpoly_ap_zero [p:cpoly] : Prop :=
  Cases p of
    cpoly_zero => False
  | (cpoly_linear c p1) => (c [#] Zero) \/ (cpoly_ap_zero p1)
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint cpoly_ap [p:cpoly] : cpoly->Prop := [q:cpoly]
  Cases p of
    cpoly_zero => (cpoly_ap_zero q)
  | (cpoly_linear c p1) =>
      Cases q of
        cpoly_zero => (cpoly_ap_zero p)
      | (cpoly_linear d q1) => (c [#] d) \/ (cpoly_ap p1 q1)
      end
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_ap_p_zero : (p:cpoly)(cpoly_ap_zero p) == (cpoly_ap p cpoly_zero).
(* End_Tex_Verb *)
Induction p; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma irreflexive_cpoly_ap : (irreflexive cpoly_ap).
(* End_Tex_Verb *)
Unfold irreflexive.
Induction x.
Simpl.
Auto.
Intros.
Simpl.
Intro.
Elim H0.
Change ~(s[#]s).
Apply ap_irreflexive_unfolded.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma symmetric_cpoly_ap : (symmetric ? cpoly_ap).
(* End_Tex_Verb *)
Unfold symmetric.
Intros x y.
Pattern x y.
Apply cpoly_double_ind0'.
Simpl.
Induction p.
Auto.
Auto.
Simpl.
Auto.
Simpl.
Intros.
Elim H0; Intro.
Left.
Apply ap_symmetric_unfolded.
Assumption.
Right.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cotransitive_cpoly_ap : (cotransitive cpoly_ap).
(* End_Tex_Verb *)
Unfold cotransitive.
Intros x y.
Pattern x y.
Apply cpoly_double_sym_ind0.
Unfold symmetric.
Intros.
Generalize (symmetric_cpoly_ap ?? H0); Intro.
Elim (H H1 z); Intro.
Right.
Apply symmetric_cpoly_ap.
Assumption.
Left.
Apply symmetric_cpoly_ap.
Assumption.
Simpl.
Intros p H z.
Generalize H.
Pattern p z.
Apply cpoly_double_ind0'.
Simpl.
Tauto.
Simpl.
Tauto.
Simpl.
Intros.
Elim H1; Intro.
Generalize (ap_cotransitive_unfolded ??? H2 d); Intro.
Elim H3; Auto.
Rewrite cpoly_ap_p_zero in H2.
Elim (H0 H2); Intro.
Auto.
Right.
Right.
Rewrite cpoly_ap_p_zero.
Assumption.

Intros.
Simpl in H0.
Elim H0; Intro.
Elim z.
Simpl.
Generalize (ap_cotransitive_unfolded ??? H1 Zero); Intro.
Elim H2; Intro.
Auto.
Right.
Left.
Apply ap_symmetric_unfolded.
Assumption.
Simpl.
Intros.
Generalize (ap_cotransitive_unfolded ??? H1 s); Intro.
Elim H3; Auto.
Elim z.
Simpl.
Cut (cpoly_ap_zero p)\/(cpoly_ap_zero q).
Intro; Elim H2; Auto.
Generalize H1; Pattern p q; Apply cpoly_double_ind0.
Simpl.
Intros.
Left.
Rewrite cpoly_ap_p_zero.
Assumption.
Intros.
Right.
Assumption.
Simpl.
Intros.
Elim H3; Intro.
Elim (ap_cotransitive_unfolded ??? H4 Zero); Intro.
Auto.Right.
Left.
Apply ap_symmetric_unfolded.
Assumption.
Elim (H2 H4); Intro.
Auto.
Auto.
Intros.
Simpl.
Elim (H H1 c0); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma tight_apart_cpoly_ap : (tight_apart cpoly_eq cpoly_ap).
(* End_Tex_Verb *)
Unfold tight_apart.
Intros.
Pattern x y.
Apply cpoly_double_ind0'.
Induction p.
Simpl.
Tauto.
Simpl.
Intros.
Cut ~(s[#]Zero) <-> s[=]Zero.
Tauto.
Apply (ap_tight CR).
Induction p.
Simpl.
Intro.
Cut ~(c[#]Zero) <-> c[=]Zero.
Tauto.
Apply (ap_tight CR).
Simpl.
Intros.
Generalize (H c0).
Generalize (ap_tight CR c0 Zero).
Generalize (ap_tight CR s Zero).
Tauto.
Simpl.
Intros.
Generalize (ap_tight CR c d).
Tauto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_is_CSetoid : (is_CSetoid ? cpoly_eq cpoly_ap).
(* End_Tex_Verb *)
Apply Build_is_CSetoid.
Exact irreflexive_cpoly_ap.
Exact symmetric_cpoly_ap.
Exact cotransitive_cpoly_ap.
Exact tight_apart_cpoly_ap.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_csetoid :=
                    (Build_CSetoid cpoly cpoly_eq cpoly_ap cpoly_is_CSetoid).
(* End_Tex_Verb *)

(* Tex_Prose
Now that we know that the polynomials form a setoid, we can use the
notation with \verb![#]! and \verb![=]!. In order to use this notation,
we introduce \verb!cpoly_zero_cs! and \verb!cpoly_linear_cs!, so that Coq
recognizes we are talking about a setoid.
We formulate the induction properties and
the most basic properties of equality and apartness
in terms of these generators.
*)

(* Begin_Tex_Verb *)
Local cpoly_zero_cs := cpoly_zero : cpoly_csetoid.

Local cpoly_linear_cs [c:CR; p:cpoly_csetoid] : cpoly_csetoid :=
                      (cpoly_linear c p).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_ind_cs : (P:cpoly_csetoid->Prop)
   (P cpoly_zero_cs) ->
   ((p:cpoly_csetoid)(c:CR)(P p)->(P (cpoly_linear_cs c p))) ->
   (p:cpoly_csetoid)(P p).
(* End_Tex_Verb *)
Induction p; Auto.
Unfold cpoly_linear_cs in H0.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_ind0_cs : (P:cpoly_csetoid->cpoly_csetoid->Prop)
   ((p:cpoly_csetoid)(P p cpoly_zero_cs)) ->
   ((p:cpoly_csetoid)(P cpoly_zero_cs p)) ->
   ((p,q:cpoly_csetoid)(c,d:CR)
                 (P p q)->(P (cpoly_linear_cs c p) (cpoly_linear_cs d q))) ->
   (p,q:cpoly_csetoid)(P p q).
(* End_Tex_Verb *)
Induction p.
Auto.
Induction q.
Auto.
Simpl in H1.
Unfold cpoly_linear_cs in H1.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_sym_ind0_cs : (P:cpoly_csetoid->cpoly_csetoid->Prop)
   (Symmetric P) ->
   ((p:cpoly_csetoid)(P p cpoly_zero_cs)) ->
   ((p,q:cpoly_csetoid)(c,d:CR)(P p q)->
                       (P (cpoly_linear_cs c p) (cpoly_linear_cs d q))) ->
   (p,q:cpoly_csetoid)(P p q).
(* End_Tex_Verb *)
Intros.
Apply cpoly_double_ind0; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_eq_zero : (p:cpoly_csetoid)(c:CR)
     ((cpoly_linear_cs c p) [=] cpoly_zero_cs) ==
     ((c [=] Zero) /\ (p [=] (cpoly_zero_cs))).
(* End_Tex_Verb *)
Intros.
Simpl.
Unfold cpoly_zero_cs.
Rewrite cpoly_eq_p_zero.
Reflexivity.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_zero_eq_lin : (p:cpoly_csetoid)(c:CR)
     (cpoly_zero_cs [=] (cpoly_linear_cs c p)) ==
     ((c [=] Zero) /\ ((cpoly_zero_cs) [=] p)).
(* End_Tex_Verb *)
Intros.
Simpl.
Reflexivity.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_eq_lin : (p,q:cpoly_csetoid)(c,d:CR)
     ((cpoly_linear_cs c p) [=] (cpoly_linear_cs d q)) ==
     ((c [=] d) /\ (p [=] q)).
(* End_Tex_Verb *)
Intros.
Simpl.
Reflexivity.
Qed.


(* Begin_Tex_Verb *)
Lemma cpoly_lin_ap_zero : (p:cpoly_csetoid)(c:CR)
     ((cpoly_linear_cs c p) [#] cpoly_zero_cs) ==
     ((c [#] Zero) \/ (p [#] (cpoly_zero_cs))).
(* End_Tex_Verb *)
Intros.
Simpl.
Unfold cpoly_zero_cs.
Rewrite cpoly_ap_p_zero.
Reflexivity.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_zero_ap_lin : (p:cpoly_csetoid)(c:CR)
     (cpoly_zero_cs [#] (cpoly_linear_cs c p)) ==
     ((c [#] Zero) \/ ((cpoly_zero_cs) [#] p)).
(* End_Tex_Verb *)
Intros.
Simpl.
Reflexivity.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_ap_lin : (p,q:cpoly_csetoid)(c,d:CR)
     ((cpoly_linear_cs c p) [#] (cpoly_linear_cs d q)) ==
     ((c [#] d) \/ (p [#] q)).
(* End_Tex_Verb *)
Intros.
Simpl.
Reflexivity.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_linear_strext : (bin_fun_strong_ext ??? cpoly_linear_cs).
(* End_Tex_Verb *)
Unfold bin_fun_strong_ext.
Do 4 Intro.
Rewrite cpoly_lin_ap_lin.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_linear_wd : (bin_fun_well_def ??? cpoly_linear_cs).
(* End_Tex_Verb *)
Apply bin_fun_strong_ext_imp_well_def.
Exact cpoly_linear_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_linear_fun :=
  (Build_CSetoid_bin_fun ???? cpoly_linear_wd cpoly_linear_strext).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_double_comp_ind : (P : cpoly_csetoid -> cpoly_csetoid -> Prop)
 ((p1,p2,q1,q2:cpoly_csetoid)((p1[=]p2)->(q1[=]q2)->(P p1 q1)->(P p2 q2))) ->
 (P cpoly_zero_cs cpoly_zero_cs) ->
 ((p,q:cpoly_csetoid)(c,d:CR)(P p q)->
                           (P (cpoly_linear_cs c p) (cpoly_linear_cs d q))) ->
 (p,q:cpoly_csetoid)(P p q).
(* End_Tex_Verb *)
Intros.
Apply cpoly_double_ind0_cs.
Intro p0; Pattern p0; Apply cpoly_ind_cs.
Assumption.
Intros.
Apply H with (cpoly_linear_cs c p1) (cpoly_linear_cs Zero cpoly_zero_cs).
Algebra.
Rewrite cpoly_lin_eq_zero.
Split; Algebra.
Apply H1.
Assumption.

Intro p0; Pattern p0; Apply cpoly_ind_cs.
Assumption.
Intros.
Apply H with (cpoly_linear_cs Zero cpoly_zero_cs) (cpoly_linear_cs c p1).
Rewrite cpoly_lin_eq_zero.
Split; Algebra.
Algebra.
Apply H1.
Assumption.
Intros.
Apply H1.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_triple_comp_ind :
 (P : cpoly_csetoid -> cpoly_csetoid -> cpoly_csetoid -> Prop)
 ((p1,p2,q1,q2,r1,r2:cpoly_csetoid)((p1[=]p2)->(q1[=]q2)->(r1[=]r2)->
                    (P p1 q1 r1)->(P p2 q2 r2))) ->
 (P cpoly_zero_cs cpoly_zero_cs cpoly_zero_cs) ->
 ((p,q,r:cpoly_csetoid)(c,d,e:CR)(P p q r)->
     (P (cpoly_linear_cs c p) (cpoly_linear_cs d q) (cpoly_linear_cs e r))) ->
 (p,q,r:cpoly_csetoid)(P p q r).
(* End_Tex_Verb *)
Do 6 Intro.
Pattern p q.
Apply cpoly_double_comp_ind.
Intros.
Apply H with p1 q1 r.
Assumption.
Assumption.
Algebra.
Apply H4.

Intro r; Pattern r; Apply cpoly_ind_cs.
Assumption.
Intros.
Apply H with (cpoly_linear_cs Zero cpoly_zero_cs)
             (cpoly_linear_cs Zero cpoly_zero_cs)
             (cpoly_linear_cs c p0).
Rewrite cpoly_lin_eq_zero; Split; Algebra.
Rewrite cpoly_lin_eq_zero; Split; Algebra.
Algebra.
Apply H1.
Assumption.

Do 6 Intro.
Pattern r; Apply cpoly_ind_cs.
Apply H with (cpoly_linear_cs c p0)
             (cpoly_linear_cs d q0)
             (cpoly_linear_cs Zero cpoly_zero_cs).
Algebra.
Algebra.
Rewrite cpoly_lin_eq_zero; Split; Algebra.
Apply H1.
Apply H2.
Intros.
Apply H1.
Apply H2.
Qed.

(* Tex_Prose
\subsubsection{The polynomials form a semi-group and a monoid}
*)
(* Begin_Tex_Verb *)
Fixpoint cpoly_plus [p:cpoly] : cpoly -> cpoly := [q:cpoly]
  Cases p of
    cpoly_zero => q
  | (cpoly_linear c p1) =>
      Cases q of
        cpoly_zero => p
      | (cpoly_linear d q1) => (cpoly_linear c[+]d (cpoly_plus p1 q1))
      end
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition cpoly_plus_cs [p,q:cpoly_csetoid] : cpoly_csetoid
                                             := (cpoly_plus p q).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_zero_plus : (p:cpoly_csetoid)(cpoly_plus_cs cpoly_zero_cs p) = p.
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_plus_zero : (p:cpoly_csetoid)(cpoly_plus_cs p cpoly_zero_cs) = p.
(* End_Tex_Verb *)
Induction p.
Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_plus_lin : (p,q:cpoly_csetoid)(c,d:CR)
             (cpoly_plus_cs (cpoly_linear_cs c p) (cpoly_linear_cs d q)) =
             (cpoly_linear_cs (c[+]d) (cpoly_plus_cs p q)).
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_plus_commutative :
               (p,q:cpoly_csetoid)(cpoly_plus_cs p q) [=] (cpoly_plus_cs q p).
(* End_Tex_Verb *)
Intros.
Pattern p q.
Apply cpoly_double_sym_ind0_cs.
Unfold symmetric.
Intros.
Algebra.
Intro p0.
Rewrite cpoly_zero_plus.
Rewrite cpoly_plus_zero.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_plus_q_ap_q : (p,q:cpoly_csetoid)
              ((cpoly_plus_cs p q) [#] q) ->
              (p [#] cpoly_zero_cs).
(* End_Tex_Verb *)
Intro p; Pattern p; Apply cpoly_ind_cs.
Intro.
Rewrite cpoly_zero_plus.
Intro.
Simpl.
Apply (ap_irreflexive ?? H).
Do 4 Intro.
Pattern q; Apply cpoly_ind_cs.
Rewrite cpoly_plus_zero.
Auto.
Do 3 Intro.
Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_ap_lin.
Intro.
Rewrite cpoly_lin_ap_zero.
Elim H1; Intro.
Left.
Apply cg_ap_cancel_rht with c0.
Step_ap_rht c0.
Right.
Generalize (H ? H2); Intro.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_p_plus_ap_p : (p,q:cpoly_csetoid)
              ((cpoly_plus_cs p q) [#] p) -> (q [#] cpoly_zero).
(* End_Tex_Verb *)
Intros.
Apply cpoly_plus_q_ap_q with p.
Apply ap_well_def_lft_unfolded  with (cpoly_plus_cs p q).
Assumption.
Apply cpoly_plus_commutative.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_ap_zero_plus : (p,q:cpoly_csetoid)
              ((cpoly_plus_cs p q) [#] cpoly_zero_cs) ->
              (p [#] cpoly_zero_cs) \/ (q [#] cpoly_zero_cs).
(* End_Tex_Verb *)
Intros p q; Pattern p q; Apply cpoly_double_sym_ind0_cs.
Unfold symmetric.
Intros.
Elim H.
Auto.Auto.
Step_ap_lft (cpoly_plus_cs y x).
Apply cpoly_plus_commutative.
Intros.
Left.
Rewrite cpoly_plus_zero in H.
Assumption.
Intros p0 q0 c d.
Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_ap_zero.
Intros.
Elim H0; Intro.
Cut c[+]d [#] Zero[+]Zero.
Intro.
Elim (bin_op_strext ?????? H2); Intro.
Left.
Simpl.
Left.
Assumption.
Right.
Rewrite cpoly_lin_ap_zero.
Left.
Assumption.
Step_ap_rht Zero::CR.
Elim (H H1); Intro.
Left.
Rewrite cpoly_lin_ap_zero.
Right.
Assumption.
Right.
Rewrite cpoly_lin_ap_zero.
Right.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_plus_op_strext : (bin_op_strong_ext cpoly_csetoid cpoly_plus_cs).
(* End_Tex_Verb *)
Unfold bin_op_strong_ext.
Unfold bin_fun_strong_ext.
Intros x1 x2.
Pattern x1 x2.
Apply cpoly_double_sym_ind0_cs.
Unfold symmetric.
Intros.
Generalize (ap_symmetric_unfolded ??? H0); Intro.
Generalize (H ?? H1); Intro.
Elim H2; Intro; Generalize (ap_symmetric_unfolded ??? H3); Auto.
Intro p; Pattern p; Apply cpoly_ind_cs.
Intro; Intro.
Repeat Rewrite cpoly_zero_plus.
Auto.
Intros s c H y1 y2.
Pattern y1 y2.
Apply cpoly_double_ind0_cs.
Intro.
Rewrite cpoly_plus_zero.
Intro.
Apply cpoly_ap_zero_plus.
Assumption.
Intro.
Rewrite cpoly_plus_zero.
Rewrite cpoly_zero_plus.
Intro.
Elim (ap_cotransitive ??? H0 cpoly_zero_cs); Auto.
Do 4 Intro.
Repeat Rewrite cpoly_lin_plus_lin.
Repeat Rewrite cpoly_zero_plus.
Repeat Rewrite cpoly_lin_ap_zero.
Repeat Rewrite cpoly_lin_ap_lin.
Repeat Rewrite cpoly_zero_ap_lin.
Intros.
Elim H1; Intro.
Cut c[+]c0 [#] Zero[+]d.
Intro.
Elim (bin_op_strext ?????? H3); Auto.
Step_ap_rht d.
Elim (H ?? H2); Auto.
Do 7 Intro.
Pattern y1 y2.
Apply cpoly_double_ind0_cs.
Intro p0; Pattern p0; Apply cpoly_ind_cs.
Repeat Rewrite cpoly_plus_zero.
Auto.
Do 2 Intro.
Repeat Rewrite cpoly_lin_plus_lin.
Repeat Rewrite cpoly_plus_zero.
Repeat Rewrite cpoly_lin_ap_zero.
Repeat Rewrite cpoly_lin_ap_lin.
Repeat Rewrite cpoly_zero_ap_lin.
Intros.
Elim H1; Intro.
Cut c[+]c0 [#] d [+] Zero.
Intro.
Elim (bin_op_strext ?????? H3); Auto.
Step_ap_rht d.
Elim H with p1 cpoly_zero_cs.
Auto.
Auto.
Rewrite cpoly_plus_zero.
Assumption.
Intro p0; Pattern p0; Apply cpoly_ind_cs.
Repeat Rewrite cpoly_plus_zero.
Auto.
Do 2 Intro.
Repeat Rewrite cpoly_lin_plus_lin.
Repeat Rewrite cpoly_plus_zero.
Repeat Rewrite cpoly_lin_ap_lin.
Repeat Rewrite cpoly_zero_ap_lin.
Intros.
Elim H1; Intro.
Cut c[+]Zero [#] d [+] c0.
Intro.
Elim (bin_op_strext ?????? H3); Auto.
Intro.
Right.
Left.
Apply ap_symmetric_unfolded.
Assumption.
Step_ap_lft c.
Elim H with cpoly_zero_cs p1.
Auto.
Auto.
Rewrite cpoly_plus_zero.
Assumption.
Do 4 Intro.
Repeat Rewrite cpoly_lin_plus_lin.
Repeat Rewrite cpoly_lin_ap_lin.
Intros.
Elim H1; Intro.
Elim (bin_op_strext ?????? H2); Auto.
Elim (H p0 q0).
Auto.
Auto.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_plus_op_proof : (bin_op_well_def cpoly_csetoid cpoly_plus_cs).
(* End_Tex_Verb *)
Unfold bin_op_well_def.
Apply bin_fun_strong_ext_imp_well_def.
Exact cpoly_plus_op_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_plus_op :=
  (Build_CSetoid_bin_op ?? cpoly_plus_op_proof cpoly_plus_op_strext).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_plus_associative : (Associative cpoly_plus_op).
(* End_Tex_Verb *)
Unfold associative.
Intros p q r.
Change (cpoly_plus_cs p (cpoly_plus_cs q r)) [=]
       (cpoly_plus_cs (cpoly_plus_cs p q) r).
Pattern p q r; Apply cpoly_triple_comp_ind.
Intros.
Apply eq_transitive_unfolded with (cpoly_plus_cs p1 (cpoly_plus_cs q1 r1)).
Apply eq_symmetric_unfolded.
Apply cpoly_plus_op_proof.
Assumption.
Apply cpoly_plus_op_proof.
Assumption.
Assumption.
Step_lft (cpoly_plus_cs (cpoly_plus_cs p1 q1) r1).
Apply cpoly_plus_op_proof.
Apply cpoly_plus_op_proof.
Assumption.
Assumption.
Assumption.
Simpl.
Auto.
Intros.
Repeat Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_csemi_grp :=
       (Build_CSemi_grp cpoly_csetoid cpoly_zero cpoly_plus_op
                        cpoly_plus_associative).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_cm_proof : (is_CMonoid cpoly_csemi_grp).
(* End_Tex_Verb *)
Apply Build_is_CMonoid.
Unfold is_rht_unit.
Intro.
Rewrite cpoly_plus_zero.
Algebra.
Unfold commutes.
Intros.
Apply cpoly_plus_commutative.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_cmonoid := (Build_CMonoid ? cpoly_cm_proof).
(* End_Tex_Verb *)

(* Tex_Prose
\subsubsection{The polynomials form a group}
*)
(* Begin_Tex_Verb *)
Fixpoint cpoly_min [p:cpoly] : cpoly :=
  Cases p of
    cpoly_zero => cpoly_zero
  | (cpoly_linear c p1) => (cpoly_linear [--]c (cpoly_min p1))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition cpoly_min_cs [p:cpoly_csetoid] : cpoly_csetoid := (cpoly_min p).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_min_zero : (cpoly_min_cs cpoly_zero_cs) = cpoly_zero_cs.
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_min_lin : (p:cpoly_csetoid)(c:CR)
    (cpoly_min_cs (cpoly_linear_cs c p)) =
    (cpoly_linear_cs ([--]c) (cpoly_min_cs p)).
(* End_Tex_Verb *)
Induction p.
Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_min_op_strext : (un_op_strong_ext cpoly_csetoid cpoly_min_cs).
(* End_Tex_Verb *)
Unfold un_op_strong_ext.
Unfold fun_strong_ext.
Intros x y.
Pattern x y.
Apply cpoly_double_sym_ind0_cs.
Unfold symmetric.
Intros.
Apply ap_symmetric_unfolded.
Apply H.
Apply ap_symmetric_unfolded.
Assumption.
Intro p; Pattern p; Apply cpoly_ind_cs.
Auto.
Do 2 Intro.
Repeat Rewrite cpoly_min_zero.
Repeat Rewrite cpoly_min_lin.
Repeat Rewrite cpoly_lin_ap_zero.
Intros.
Elim H0; Intros.
Left.
Step_ap_lft [--][--]c.
Right.
Apply H.
Assumption.
Do 4 Intro.
Repeat Rewrite cpoly_min_lin.
Repeat Rewrite cpoly_lin_ap_lin.
Intros.
Elim H0; Intro.
Left.
Step_ap_lft [--][--]c.
Step_ap_rht [--][--]d.
Apply min_resp_ap.
Assumption.
Right.
Apply H.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_min_op_proof : (un_op_well_def cpoly_csetoid cpoly_min_cs).
(* End_Tex_Verb *)
Unfold un_op_well_def.
Apply fun_strong_ext_imp_well_def.
Exact cpoly_min_op_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_min_op :=
  (Build_CSetoid_un_op ?? cpoly_min_op_proof cpoly_min_op_strext).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_cg_proof : (is_CGroup cpoly_cmonoid cpoly_min_op).
(* End_Tex_Verb *)
Unfold is_CGroup.
Intro.
Unfold is_inverse.
Change x[+](cpoly_min_cs x) [=] Zero.
Pattern x; Apply cpoly_ind_cs.
Rewrite cpoly_min_zero.
Rewrite cpoly_plus_zero.
Simpl.
Auto.
Intros.
Rewrite cpoly_min_lin.
Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_eq_zero.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_cgroup := (Build_CGroup ?? cpoly_cg_proof).
(* End_Tex_Verb *)

(* Tex_Prose
\subsubsection{The polynomials form a ring}
*)
(* Begin_Tex_Verb *)
Fixpoint cpoly_mult_cr [q:cpoly] : CR -> cpoly := [c:CR]
  Cases q of
    cpoly_zero => cpoly_zero
  | (cpoly_linear d q1) => (cpoly_linear c[*]d (cpoly_mult_cr q1 c))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint cpoly_mult [p:cpoly] : cpoly -> cpoly := [q:cpoly]
  Cases p of
    cpoly_zero => cpoly_zero
  | (cpoly_linear c p1) =>
      (cpoly_plus (cpoly_mult_cr q c)
                  (cpoly_linear Zero (cpoly_mult p1 q)))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition cpoly_mult_cr_cs [p:cpoly_csetoid; c:CR] : cpoly_csetoid
                                                    := (cpoly_mult_cr p c).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_zero_mult_cr : (c:CR)
                            (cpoly_mult_cr_cs cpoly_zero_cs c)=cpoly_zero_cs.
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_mult_cr : (c,d:CR)(q:cpoly_csetoid)
                              (cpoly_mult_cr_cs (cpoly_linear_cs d q) c) =
                              (cpoly_linear_cs c[*]d (cpoly_mult_cr_cs q c)).
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_zero : (p:cpoly_csetoid)
                           (cpoly_mult_cr_cs p Zero) [=] cpoly_zero_cs.
(* End_Tex_Verb *)
Intro; Pattern p; Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult_cr.
Algebra.
Intros.
Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_eq_zero.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_strext :
          (bin_fun_strong_ext cpoly_cgroup CR cpoly_cgroup cpoly_mult_cr_cs).
(* End_Tex_Verb *)
Unfold bin_fun_strong_ext.
Do 4 Intro.
Pattern x1 x2.
Apply cpoly_double_ind0_cs.
Intro.
Rewrite cpoly_zero_mult_cr.
Intro.
Left.
Generalize H.
Pattern p.
Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult_cr.
Auto.
Do 2 Intro.
Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_ap_zero.
Intros.
Elim H1; Intro.
Generalize (cring_mult_ap_zero_op ??? H2); Intro.
Rewrite cpoly_lin_ap_zero.
Auto.
Rewrite cpoly_lin_ap_zero.
Right.
Auto.

Rewrite cpoly_zero_mult_cr.
Intros.
Left.
Generalize H.
Pattern p; Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult_cr.
Auto.
Do 2 Intro.
Rewrite cpoly_lin_mult_cr.
Repeat Rewrite cpoly_zero_ap_lin.
Intros.
Elim H1; Intro.
Generalize (cring_mult_ap_zero_op ??? H2); Auto.
Right.
Auto.

Do 4 Intro.
Repeat Rewrite cpoly_lin_mult_cr.
Repeat Rewrite cpoly_lin_ap_lin.
Intros.
Elim H0; Intro.
Generalize (bin_op_strext ?????? H1); Tauto.
Elim H; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_wd :
           (bin_fun_well_def cpoly_cgroup CR cpoly_cgroup cpoly_mult_cr_cs).
(* End_Tex_Verb *)
Apply bin_fun_strong_ext_imp_well_def.
Exact cpoly_mult_cr_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_mult_cs [p,q:cpoly_csetoid] : cpoly_csetoid
                                             := (cpoly_mult p q).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_zero_mult : (q:cpoly_csetoid)
                        (cpoly_mult_cs cpoly_zero_cs q)=cpoly_zero_cs.
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin_mult : (c:CR)(p,q:cpoly_csetoid)
                         (cpoly_mult_cs (cpoly_linear_cs c p) q) =
                         (cpoly_plus_cs (cpoly_mult_cr_cs q c)
                             (cpoly_linear_cs Zero (cpoly_mult_cs p q))).
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_op_strext : (bin_op_strong_ext cpoly_csetoid cpoly_mult_cs).
(* End_Tex_Verb *)
Unfold bin_op_strong_ext.
Unfold bin_fun_strong_ext.
Do 4 Intro.
Pattern x1 x2.
Apply cpoly_double_ind0_cs.
Rewrite cpoly_zero_mult.
Intro; Pattern p; Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult.
Auto.
Do 2 Intro.
Rewrite cpoly_lin_mult.
Repeat Rewrite cpoly_lin_ap_zero.
Intros.
Cut (cpoly_plus_cs (cpoly_mult_cr_cs y1 c)
         (cpoly_linear_cs Zero (cpoly_mult_cs p0 y1))) [#]
    (cpoly_plus_cs (cpoly_mult_cr_cs y2 Zero)
         (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y2))).
Intro.
Elim (cpoly_plus_op_strext ???? H1); Intro.
Elim (cpoly_mult_cr_strext ???? H2); Auto.
Rewrite cpoly_lin_ap_lin in H2.
Elim H2; Intro.
Elim (ap_irreflexive ?? H3).
Rewrite cpoly_zero_mult in H3.
Elim H; Auto.
Rewrite cpoly_zero_mult.
Apply ap_well_def_rht_unfolded with cpoly_zero_cs.
Assumption.
Apply eq_transitive_unfolded with (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs).
Algebra.
Apply cpoly_plus_op_proof.
Apply eq_symmetric_unfolded.
Apply cpoly_mult_cr_zero.
Rewrite cpoly_zero_eq_lin.
Split; Algebra.

Rewrite cpoly_zero_mult.
Intro; Pattern p; Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult.
Auto.
Do 2 Intro.
Rewrite cpoly_lin_mult.
Repeat Rewrite cpoly_zero_ap_lin.
Intros.
Cut (cpoly_plus_cs (cpoly_mult_cr_cs y1 Zero)
         (cpoly_linear_cs Zero (cpoly_mult_cs cpoly_zero_cs y1))) [#]
    (cpoly_plus_cs (cpoly_mult_cr_cs y2 c)
         (cpoly_linear_cs Zero (cpoly_mult_cs p0 y2))).
Intro.
Elim (cpoly_plus_op_strext ???? H1); Intro.
Elim (cpoly_mult_cr_strext ???? H2); Auto.
Intro.
Left.Left.
Apply ap_symmetric_unfolded.
Assumption.
Rewrite cpoly_lin_ap_lin in H2.
Elim H2; Intro.
Elim (ap_irreflexive ?? H3).
Rewrite cpoly_zero_mult in H3.
Elim H; Auto.
Rewrite cpoly_zero_mult.
Apply ap_well_def_lft_unfolded with cpoly_zero_cs.
Assumption.
Apply eq_transitive_unfolded with (cpoly_plus_cs cpoly_zero_cs cpoly_zero_cs).
Algebra.
Apply cpoly_plus_op_proof.
Apply eq_symmetric_unfolded.
Apply cpoly_mult_cr_zero.
Rewrite cpoly_zero_eq_lin.
Split; Algebra.

Do 4 Intro.
Repeat Rewrite cpoly_lin_mult.
Repeat Rewrite cpoly_lin_ap_lin.
Intros.
Elim (cpoly_plus_op_strext ???? H0); Intro.
Elim (cpoly_mult_cr_strext ???? H1); Auto.
Rewrite cpoly_lin_ap_lin in H1.
Elim H1; Intro.
Elim (ap_irreflexive ?? H2).
Elim H; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_op_proof : (bin_op_well_def cpoly_csetoid cpoly_mult).
(* End_Tex_Verb *)
Unfold bin_op_well_def.
Apply bin_fun_strong_ext_imp_well_def.
Exact cpoly_mult_op_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_mult_op :=
  (Build_CSetoid_bin_op ?? cpoly_mult_op_proof cpoly_mult_op_strext).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_dist : (p,q:cpoly_csetoid)(c:CR)
               (cpoly_mult_cr_cs (cpoly_plus_cs p q) c) [=]
               (cpoly_plus_cs (cpoly_mult_cr_cs p c) (cpoly_mult_cr_cs q c)).
(* End_Tex_Verb *)
Intros.
Pattern p q.
Apply cpoly_double_comp_ind.
Intros.
Apply eq_transitive_unfolded  with (cpoly_mult_cr_cs (cpoly_plus_cs p1 q1) c).
Apply eq_symmetric_unfolded.
Apply cpoly_mult_cr_wd.
Apply cpoly_plus_op_proof.
Assumption.
Assumption.
Algebra.
Step_lft  (cpoly_plus_cs (cpoly_mult_cr_cs p1 c) (cpoly_mult_cr_cs q1 c)).
Apply cpoly_plus_op_proof.
Apply cpoly_mult_cr_wd; Algebra.
Apply cpoly_mult_cr_wd; Algebra.
Repeat Rewrite cpoly_zero_plus.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_mult_cr.
Repeat Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_cr_dist : (Distributive cpoly_mult_op cpoly_plus_op).
(* End_Tex_Verb *)
Unfold distributive.
Intros p q r.
Change (cpoly_mult_cs p (cpoly_plus_cs q r)) [=]
       (cpoly_plus_cs (cpoly_mult_cs p q) (cpoly_mult_cs p r)).
Pattern p. Apply cpoly_ind_cs.
Repeat Rewrite cpoly_zero_mult.
Rewrite cpoly_zero_plus.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_mult.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs
            (cpoly_plus_cs (cpoly_mult_cr_cs q c)
              (cpoly_mult_cr_cs r c))
            (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 r)))).
Apply cpoly_plus_op_proof.
Apply cpoly_mult_cr_dist.
Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Clear H.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_mult_cr_cs q c)
     (cpoly_plus_cs (cpoly_mult_cr_cs r c)
     (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))
       (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))).
Apply eq_symmetric_unfolded.
Apply cpoly_plus_associative.
Apply eq_transitive_unfolded with
(cpoly_plus_cs (cpoly_mult_cr_cs q c)
            (cpoly_plus_cs
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))
            (cpoly_plus_cs (cpoly_mult_cr_cs r c)
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))))).
Apply cpoly_plus_op_proof.
Algebra.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_plus_cs (cpoly_mult_cr_cs r c)
     (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)))
       (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))).
Apply cpoly_plus_associative.
Apply eq_transitive_unfolded with
(cpoly_plus_cs (cpoly_plus_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))
             (cpoly_mult_cr_cs r c))
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 r))).
Apply cpoly_plus_op_proof.
Apply cpoly_plus_commutative.
Algebra.
Apply eq_symmetric_unfolded.
Apply cpoly_plus_associative.
Apply cpoly_plus_associative.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_assoc_mult_cr : (p:cpoly_csetoid)(c,d:CR)
   (cpoly_mult_cr_cs (cpoly_mult_cr_cs p c) d)
      [=] (cpoly_mult_cr_cs p d[*]c).
(* End_Tex_Verb *)
Intros.
Pattern p; Apply cpoly_ind_cs.
Repeat Rewrite cpoly_zero_mult_cr.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_assoc_mult : (p,q:cpoly_csetoid)(c:CR)
          (cpoly_mult_cr_cs (cpoly_mult_cs p q) c)
      [=] (cpoly_mult_cs (cpoly_mult_cr_cs p c) q).
(* End_Tex_Verb *)
Intros.
Pattern p; Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult.
Repeat Rewrite cpoly_zero_mult_cr.
Rewrite cpoly_zero_mult.
Algebra.
Intros.
Rewrite cpoly_lin_mult.
Repeat Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_mult.
Apply eq_transitive_unfolded with
(cpoly_plus_cs (cpoly_mult_cr_cs (cpoly_mult_cr_cs q c0) c)
            (cpoly_mult_cr_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) c)).
Apply cpoly_mult_cr_dist.
Apply cpoly_plus_op_proof.
Apply cpoly_mult_cr_assoc_mult_cr.
Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_zero :
   (p:cpoly_csetoid)(cpoly_mult_cs p cpoly_zero_cs) [=] (cpoly_zero_cs).
(* End_Tex_Verb *)
Intros.
Pattern p; Apply cpoly_ind_cs.
Algebra.
Intros.
Rewrite cpoly_lin_mult.
Rewrite cpoly_zero_mult_cr.
Rewrite cpoly_zero_plus.
Rewrite cpoly_lin_eq_zero.
Split.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_lin : (c:CR)(p,q:cpoly_csetoid)
                         (cpoly_mult_cs p (cpoly_linear_cs c q)) [=]
                         (cpoly_plus_cs (cpoly_mult_cr_cs p c)
                             (cpoly_linear_cs Zero (cpoly_mult_cs p q))).
(* End_Tex_Verb *)
Intros.
Pattern p; Apply cpoly_ind_cs.
Repeat Rewrite cpoly_zero_mult.
Rewrite cpoly_zero_mult_cr.
Rewrite cpoly_zero_plus.
Rewrite cpoly_zero_eq_lin.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_mult.
Repeat Rewrite cpoly_lin_mult_cr.
Repeat Rewrite cpoly_lin_plus_lin.
Rewrite cpoly_lin_eq_lin.Split.
Algebra.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_plus_cs (cpoly_mult_cr_cs p0 c)
            (cpoly_mult_cr_cs q c0))
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))).
2: Apply eq_symmetric_unfolded.
2: Apply cpoly_plus_associative.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_plus_cs (cpoly_mult_cr_cs q c0)
            (cpoly_mult_cr_cs p0 c))
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 q))).
2: Apply cpoly_plus_op_proof.
3: Algebra.
2: Apply cpoly_plus_commutative.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_mult_cr_cs q c0)
            (cpoly_plus_cs (cpoly_mult_cr_cs p0 c)
              (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)))).
2: Apply cpoly_plus_associative.
Apply cpoly_plus_op_proof.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_commutative :
   (p,q:cpoly_csetoid)(cpoly_mult_cs p q) [=] (cpoly_mult_cs q p).
(* End_Tex_Verb *)
Intros.
Pattern p.
Apply cpoly_ind_cs.
Rewrite cpoly_zero_mult.
Apply eq_symmetric_unfolded.
Apply cpoly_mult_zero.
Intros.
Rewrite cpoly_lin_mult.
Apply eq_transitive_unfolded with
                         (cpoly_plus_cs (cpoly_mult_cr_cs q c)
                             (cpoly_linear_cs Zero (cpoly_mult_cs q p0))).
2: Apply eq_symmetric_unfolded; Apply cpoly_mult_lin.
Apply cpoly_plus_op_proof.
Algebra.
Apply cpoly_linear_wd.
Algebra.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_dist_rht :
   (p,q,r:cpoly_csetoid)
   (cpoly_mult_cs (cpoly_plus_cs p q) r) [=]
   (cpoly_plus_cs (cpoly_mult_cs p r) (cpoly_mult_cs q r)).
(* End_Tex_Verb *)
Intros.
Apply eq_transitive_unfolded with
 (cpoly_mult_cs r (cpoly_plus_cs p q)).
Apply cpoly_mult_commutative.
Apply eq_transitive_unfolded with
 (cpoly_plus_cs (cpoly_mult_cs r p) (cpoly_mult_cs r q)).
Generalize cpoly_cr_dist; Intro.
Unfold distributive in H.
Simpl in H.
Simpl.
Unfold cpoly_mult_cs.
Apply H.
Apply cpoly_plus_op_proof.
Apply cpoly_mult_commutative.
Apply cpoly_mult_commutative.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_assoc : (Associative cpoly_mult_op).
(* End_Tex_Verb *)
Unfold associative.
Intros p q r.
Change (cpoly_mult_cs p (cpoly_mult_cs q r)) [=]
       (cpoly_mult_cs (cpoly_mult_cs p q) r).
Pattern p; Apply cpoly_ind_cs.
Repeat Rewrite cpoly_zero_mult.
Algebra.
Intros.
Repeat Rewrite cpoly_lin_mult.
Apply eq_transitive_unfolded with
(cpoly_plus_cs (cpoly_mult_cs (cpoly_mult_cr_cs q c) r)
               (cpoly_mult_cs (cpoly_linear_cs Zero (cpoly_mult_cs p0 q)) r)).
Apply cpoly_plus_op_proof.
Apply cpoly_mult_cr_assoc_mult.
Rewrite cpoly_lin_mult.
Apply eq_transitive_unfolded with
(cpoly_plus_cs cpoly_zero_cs
            (cpoly_linear_cs Zero
              (cpoly_mult_cs (cpoly_mult_cs p0 q) r))).
Rewrite cpoly_zero_plus.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Assumption.
Apply cpoly_plus_op_proof.
Apply eq_symmetric_unfolded.
Apply cpoly_mult_cr_zero.
Rewrite cpoly_lin_eq_lin.
Split.
Algebra.
Algebra.
Apply eq_symmetric_unfolded.
Apply cpoly_mult_dist_rht.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_cr_one : (p:cpoly_csetoid)(cpoly_mult_cr_cs p One)[=]p.
(* End_Tex_Verb *)
Intro.
Pattern p; Apply cpoly_ind_cs.
Algebra.
Intros.
Rewrite cpoly_lin_mult_cr.
Rewrite cpoly_lin_eq_lin.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_one_mult : (p:cpoly_csetoid)(cpoly_mult_cs cpoly_one p)[=]p.
(* End_Tex_Verb *)
Intro.
Unfold cpoly_one.
Unfold cpoly_constant.
Replace (cpoly_linear One cpoly_zero) with (cpoly_linear_cs One cpoly_zero).
2: Reflexivity.
Rewrite cpoly_lin_mult.
Rewrite cpoly_zero_mult.
Apply eq_transitive_unfolded with (cpoly_plus_cs p cpoly_zero_cs).
Apply cpoly_plus_op_proof.
Apply cpoly_mult_cr_one.
Rewrite cpoly_lin_eq_zero; Algebra.
Rewrite cpoly_plus_zero; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_one : (p:cpoly_csetoid)(cpoly_mult_cs p cpoly_one)[=]p.
(* End_Tex_Verb *)
Intro.
Apply eq_transitive_unfolded with (cpoly_mult_cs cpoly_one p).
Apply cpoly_mult_commutative.
Apply cpoly_one_mult.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_mult_monoid: (is_CMonoid
   (Build_CSemi_grp cpoly_csetoid cpoly_one cpoly_mult_op cpoly_mult_assoc)).
(* End_Tex_Verb *)
Apply Build_is_CMonoid.
Exact cpoly_mult_one.
Exact cpoly_mult_commutative.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_cr_non_triv : (cpoly_ap cpoly_one cpoly_zero).
(* End_Tex_Verb *)
Change (cs_ap cpoly_csetoid (cpoly_linear_cs One cpoly_zero_cs) cpoly_zero_cs).
Rewrite cpoly_lin_ap_zero.
Left.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_is_CRing : (is_CRing cpoly_cgroup cpoly_one cpoly_mult_op).
(* End_Tex_Verb *)
Apply Build_is_CRing with cpoly_mult_assoc.
Exact cpoly_mult_monoid.
Exact cpoly_cr_dist.
Exact cpoly_cr_non_triv.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_cring :=
  (Build_CRing cpoly_cgroup cpoly_one cpoly_mult_op cpoly_is_CRing) : CRing.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_constant_strext : (fun_strong_ext CR cpoly_cring  cpoly_constant).
(* End_Tex_Verb *)
Unfold fun_strong_ext.
Unfold cpoly_constant.
Simpl.
Tauto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_constant_wd : (fun_well_def CR cpoly_cring cpoly_constant).
(* End_Tex_Verb *)
Apply fun_strong_ext_imp_well_def.
Exact cpoly_constant_strext.
Qed.

(* Begin_Tex_Verb *)
Definition _c_ :=
  (Build_CSetoid_fun CR cpoly_cring cpoly_constant
                        cpoly_constant_wd cpoly_constant_strext).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition _x_ : cpoly_cring := (cpoly_linear_cs Zero One::cpoly_cring).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition cpoly_x_minus_c : CR -> cpoly_cring
                           := [c:CR](cpoly_linear_cs ([--]c) One::cpoly_cring).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_x_minus_c_strext : (fun_strong_ext CR cpoly_cring cpoly_x_minus_c).
(* End_Tex_Verb *)
Unfold fun_strong_ext.
Unfold cpoly_x_minus_c.
Simpl.
Intros.
Elim H; Intro.
Apply (un_op_strext ???? H0).
Elim H0; Intro.
Elim (ap_irreflexive_unfolded ?? H1).
Elim H1.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_x_minus_c_wd : (fun_well_def CR cpoly_cring cpoly_x_minus_c).
(* End_Tex_Verb *)
Apply fun_strong_ext_imp_well_def.
Exact cpoly_x_minus_c_strext.
Qed.

End CPoly_CRing.

Syntactic Definition _C_ := (_c_ ?).
Syntactic Definition _X_ := (_x_ ?).

(* Tex_Prose
\begin{notation}
\verb!cpoly_linear_fun ? c p! is denoted with \verb!c [+X*] p!.
\end{notation}
*)

Definition cpoly_linear_fun'[CR:CRing]
           :  (CSetoid_bin_fun CR (cpoly_cring CR) (cpoly_cring CR))
           := (cpoly_linear_fun CR).

Syntactic Definition Cpoly_linear_fun := (cpoly_linear_fun' ?).
Infix 7 "[+X*]" Cpoly_linear_fun.
Syntax constr level 7:
  cpoly_linear_infix [<<(csbf_fun $_ $_ $_ (cpoly_linear_fun' $_) $e1 $e2)>>] ->
    [[<hov 1> $e1:E [0 1] "[+X*]" $e2:L]].

(* Tex_Prose
\subsection{Apartness, equality, and induction}
\label{section:poly-equality}
*)

Section CPoly_CRing_ctd.

Variable CR: CRing.

Syntactic Definition Cpoly_cring := (cpoly_cring CR).

(* Begin_Tex_Verb *)
Lemma linear_eq_zero : (p:Cpoly_cring)(c:CR)
     ((c [+X*] p) [=] Zero) == ((c [=] Zero) /\ (p [=] Zero)).
(* End_Tex_Verb *)
Exact (cpoly_lin_eq_zero CR).
Qed.

(* Begin_Tex_Verb *)
Lemma zero_eq_linear : (p:Cpoly_cring)(c:CR)
     (Zero [=] c [+X*] p) == ((c [=] Zero) /\ (Zero [=] p)).
(* End_Tex_Verb *)
Exact (cpoly_zero_eq_lin CR).
Qed.

(* Begin_Tex_Verb *)
Lemma linear_eq_linear : (p,q:Cpoly_cring)(c,d:CR)
     (c [+X*] p [=] d [+X*] q) == ((c [=] d) /\ (p [=] q)).
(* End_Tex_Verb *)
Exact (cpoly_lin_eq_lin CR).
Qed.

(* Begin_Tex_Verb *)
Lemma linear_ap_zero : (p:Cpoly_cring)(c:CR)
     (c [+X*] p [#] Zero) == ((c [#] Zero) \/ (p [#] Zero)).
(* End_Tex_Verb *)
Exact (cpoly_lin_ap_zero CR).
Qed.

(* Begin_Tex_Verb *)
Lemma zero_ap_linear : (p:Cpoly_cring)(c:CR)
     (Zero [#] c [+X*] p) == ((c [#] Zero) \/ (Zero [#] p)).
(* End_Tex_Verb *)
Exact (cpoly_zero_ap_lin CR).
Qed.

(* Begin_Tex_Verb *)
Lemma linear_ap_linear : (p,q:Cpoly_cring)(c,d:CR)
     (c [+X*] p [#] d [+X*] q) == ((c [#] d) \/ (p [#] q)).
(* End_Tex_Verb *)
Exact (cpoly_lin_ap_lin CR).
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_induc : (P:Cpoly_cring->Prop)
   (P Zero) ->
   ((p:Cpoly_cring)(c:CR)(P p)->(P (c [+X*] p))) ->
   (p:Cpoly_cring)(P p).
(* End_Tex_Verb *)
Exact (cpoly_ind_cs CR).
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_ind : (P:Cpoly_cring->Cpoly_cring->Prop)
   ((p:Cpoly_cring)(P p Zero)) ->
   ((p:Cpoly_cring)(P Zero p)) ->
   ((p,q:Cpoly_cring)(c,d:CR)(P p q)->(P (c [+X*] p) (d [+X*] q))) ->
   (p,q:Cpoly_cring)(P p q).
(* End_Tex_Verb *)
Exact (cpoly_double_ind0_cs CR).
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_double_sym_ind : (P:Cpoly_cring->Cpoly_cring->Prop)
   (Symmetric P) ->
   ((p:Cpoly_cring)(P p Zero)) ->
   ((p,q:Cpoly_cring)(c,d:CR)(P p q)->(P (c [+X*] p) (d [+X*] q))) ->
   (p,q:Cpoly_cring)(P p q).
(* End_Tex_Verb *)
Exact (cpoly_double_sym_ind0_cs CR).
Qed.

(* Begin_Tex_Verb *)
Lemma poly_double_comp_ind : (P : Cpoly_cring -> Cpoly_cring -> Prop)
 ((p1,p2,q1,q2:Cpoly_cring)((p1[=]p2)->(q1[=]q2)->(P p1 q1)->(P p2 q2))) ->
 (P Zero Zero) ->
 ((p,q:Cpoly_cring)(c,d:CR)(P p q)->(P (c [+X*] p) (d [+X*] q))) ->
 (p,q:Cpoly_cring)(P p q).
(* End_Tex_Verb *)
Exact (cpoly_double_comp_ind CR).
Qed.

(* Begin_Tex_Verb *)
Lemma poly_triple_comp_ind :
 (P : Cpoly_cring -> Cpoly_cring -> Cpoly_cring -> Prop)
 ((p1,p2,q1,q2,r1,r2:Cpoly_cring)((p1[=]p2)->(q1[=]q2)->(r1[=]r2)->
                    (P p1 q1 r1)->(P p2 q2 r2))) ->
 (P Zero Zero Zero) ->
 ((p,q,r:Cpoly_cring)(c,d,e:CR)(P p q r)->
         (P (c [+X*] p) (d [+X*] q) (e [+X*] r))) ->
 (p,q,r:Cpoly_cring)(P p q r).
(* End_Tex_Verb *)
Exact (cpoly_triple_comp_ind CR).
Qed.

Transparent cpoly_cring.
Transparent cpoly_cgroup.
Transparent cpoly_csetoid.

(* !!! INSTEAD OF Step_rht *)
Tactic Definition Step_right [$y] :=
  [<:tactic:<Apply eq_transitive_unfolded with $y;
    [Idtac | Algebra]>>].

(* Begin_Tex_Verb *)
Fixpoint cpoly_apply [p:Cpoly_cring] : CR -> CR := [x:CR]
  Cases p of
    cpoly_zero => Zero
  | (cpoly_linear c p1) =>
      (c [+](x [*] (cpoly_apply p1 x)))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma cpoly_apply_strext : (bin_fun_strong_ext ??? cpoly_apply).
(* End_Tex_Verb *)
Unfold bin_fun_strong_ext.
Do 2 Intro.
Pattern x1 x2.
Apply cpoly_double_sym_ind.
Unfold symmetric.
Intros.
Generalize (ap_symmetric ??? H0); Intro.
Elim (H ?? H1); Intro.
Left.
Apply ap_symmetric_unfolded.
Assumption.
Right.
Apply ap_symmetric_unfolded.
Assumption.
Do 3 Intro.
Pattern p.
Apply cpoly_induc.
Simpl.
Intro.
Elim (ap_irreflexive ?? H).
Intros.
Simpl in H0.
Simpl in H.
Cut c[+]y1[*](cpoly_apply p0 y1) [#] Zero[+]y1[*]Zero.
Intro.
Elim (bin_op_strext ?????? H1); Intro.
Left.
Rewrite linear_ap_zero.
Left.
Assumption.
Elim (bin_op_strext ?????? H2); Intro.
Elim (ap_irreflexive ?? H3).
Elim (H H3); Intro.
Left.
Rewrite linear_ap_zero.
Right.
Exact H4.
Auto.
Step_ap_rht Zero[+]Zero::CR.
Step_ap_rht Zero::CR.
Simpl.
Intros.
Elim (bin_op_strext ?????? H0); Intro.
Auto.
Elim (bin_op_strext ?????? H1); Intro.
Auto.
Elim (H ?? H2); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_apply_wd : (bin_fun_well_def ??? cpoly_apply).
(* End_Tex_Verb *)
Apply bin_fun_strong_ext_imp_well_def.
Exact cpoly_apply_strext.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_apply_fun :=
  (Build_CSetoid_bin_fun ???? cpoly_apply_wd cpoly_apply_strext).
(* End_Tex_Verb *)


End CPoly_CRing_ctd.

(* Tex_Prose
\begin{notation}
\verb!cpoly_apply_fun! is denoted infix by {\tt !}.
The first argument is left implicit.
In the names of lemmas, we write \verb!apply!.
\end{notation}
*)

Syntactic Definition Cpoly_apply_fun :=(cpoly_apply_fun ?).
Infix 1 "!" Cpoly_apply_fun.
Syntax constr level 1:
  cpoly_apply_infix [<<(csbf_fun $_ $_ $_ (cpoly_apply_fun $_) $e1 $e2)>>] ->
    [[<hov 1> $e1:E [0 1] "!" $e2:L]].

(* Tex_Prose
\subsection{Basic properties of polynomials}
\begin{convention}
Let \verb!R! be a ring and write \verb!RX! for the ring of polynomials
over \verb!R!.
\end{convention}
*)

Section Poly_properties.
Variable R : CRing.

Syntactic Definition RX := (cpoly_cring R).

(* Tex_Prose
\subsubsection{Constant and identity}
*)

(* Begin_Tex_Verb *)
(* BELONGS IN CSETOIDS ! *)
Lemma csetoid_fun_wd_unfolded : (S1,S2:CSetoid)(f:(CSetoid_fun S1 S2))
                           (x,x':S1)(x[=]x')->(f x)[=](f x').
(* End_Tex_Verb *)
Intros.
Apply (csf_wd ?? f x x').
Assumption.
Qed.

(* Begin_Tex_Verb *)
(* BELONGS IN CSETOIDS ! *)
Lemma csetoid_bin_fun_wd_unfolded :
       (S1,S2,S3:CSetoid)(f:(CSetoid_bin_fun S1 S2 S3))
               (x,x':S1;y,y':S2)(x[=]x')->(y[=]y')->(f x y)[=](f x' y').
(* End_Tex_Verb *)
Intros.
Apply (csbf_wd ??? f x x' y y'); Assumption.
Qed.

Hints Resolve csetoid_fun_wd_unfolded csetoid_bin_fun_wd_unfolded : algebra_c.

(* Begin_Tex_Verb *)
Lemma cpoly_X_ : (_X_ [=] ((Zero::RX) [+X*] One)).
(* End_Tex_Verb *)
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_C_ : (c:RX)((_C_ c) [=] (c [+X*] Zero)).
(* End_Tex_Verb *)
Algebra.
Qed.

Hints Resolve cpoly_X_ cpoly_C_ : algebra.

(* Begin_Tex_Verb *)
Lemma cpoly_const_eq : (c,d:R)(c[=]d)->(_C_ c)[=](_C_ d).
(* End_Tex_Verb *)
Intros.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma _c_zero : Zero [=] (_C_ Zero::R).
(* End_Tex_Verb *)
Simpl.
Split; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma _c_one : One [=] (_C_ One::R).
(* End_Tex_Verb *)
Simpl; Split; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma _c_mult : (a,b:R)((_C_ a[*]b) [=] (_C_ a)[*](_C_ b)).
(* End_Tex_Verb *)
Simpl; Split; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_lin : (p:RX)(c:R)
                  (c [+X*] p) [=] ((_C_ c) [+] (_X_ [*] p)).
(* End_Tex_Verb *)
Intros.
Tactic Definition Step_right [$y] :=
  [<:tactic:<Apply eq_transitive_unfolded with $y;
    [Idtac | Algebra]>>].
Step_right (c [+X*] Zero) [+] (((cpoly_mult_cr_cs ? p Zero)::RX) [+]
 ((cpoly_linear ? (Zero :: R) (cpoly_mult_cs ? (cpoly_one R) p::(cpoly_csetoid R))):: (cpoly_csetoid R))).
Cut (cpoly_mult_cr_cs R p Zero) [=] ((Zero)::RX).
Intro.
Step_right (c [+X*] Zero) [+] (((Zero)::RX) [+]
 ((cpoly_linear ? (Zero :: R) (cpoly_mult_cs ? (cpoly_one R) p::(cpoly_csetoid R))):: (cpoly_csetoid R))).
2: Apply (cpoly_mult_cr_zero R p).
Cut (cpoly_mult_cs ? (cpoly_one R) p::(cpoly_csetoid R)):: (cpoly_csetoid R) [=] p.
Intro.
Apply eq_transitive_unfolded with
 (c [+X*] Zero) [+] (((Zero)::RX) [+]
 ((cpoly_linear ? (Zero :: R) (p::(cpoly_csetoid R))))).
2: Apply bin_op_wd_unfolded.
2: Algebra.
2: Apply bin_op_wd_unfolded.
2: Algebra.
2: Apply (cpoly_linear_wd R).
2: Algebra.
2: Apply eq_symmetric_unfolded.
2: Apply cpoly_one_mult.
Step_right (c [+X*] Zero) [+]
        (((cpoly_linear ? (Zero :: R) (p::(cpoly_csetoid R))))).
Step_right ((c[+]Zero) [+X*] (Zero[+]p)).
Step_right c [+X*] p.
Algebra.
Apply cpoly_one_mult.
Qed.

Hints Resolve cpoly_lin : algebra.

(* Begin_Tex_Verb *)
(* SUPERFLUOUS *)
Lemma poly_linear : (c:R)(f:RX)
  ((cpoly_linear ? c f) [=] _X_[*]f[+](_C_ c)).
(* End_Tex_Verb *)
Intros.
Step_rht (_C_ c)[+] _X_ [*] f.
Exact (cpoly_lin f c).
Qed.

(* Begin_Tex_Verb *)
Lemma poly_c_apzero : (a:R)((_C_ a) [#] Zero) -> (a [#] Zero).
(* End_Tex_Verb *)
Intros.
Cut (_C_ a) [#] (_C_ Zero).
Intro.
Generalize (csf_strext ????? H0); Auto.
Hints Resolve _c_zero : algebra.
Step_ap_rht Zero::RX.
Qed.

(* Begin_Tex_Verb *)
Lemma _c_mult_lin : (p:RX)(c,d:R)
                      (_C_ c) [*] (d [+X*] p) [=] c[*]d [+X*] ((_C_ c) [*] p).
(* End_Tex_Verb *)
Intros.
Pattern p.
Apply cpoly_induc.
Simpl.
Repeat Split; Algebra.
Intros.Simpl.
Repeat Split; Algebra.
Change (cpoly_mult_cr R p0 c)::RX [=] (cpoly_mult_cr R p0 c)::RX [+] Zero.
Algebra.
Qed.

(* Begin_Tex_Verb *)
(* SUPERFLUOUS ? *)
Lemma lin_mult : (p,q:RX)(c:R)
 ((c [+X*] p) [*] q) [=] (_C_ c) [*] q [+] _X_ [*] (p [*] q).
(* End_Tex_Verb *)
Intros.
Step_lft ((_C_ c) [+] (_X_ [*] p)) [*] q.
Step_lft ((_C_ c) [*] q) [+] ((_X_ [*] p) [*] q).
Algebra.
Qed.

Hints Resolve lin_mult : algebra.

(* Tex_Prose
\subsubsection{Application}
*)

(* Begin_Tex_Verb *)
(* !!! SUPERFLUOUS *)
Lemma poly_eq_zero :(p:RX)(p[=](cpoly_zero R)) -> (x:R)(p!x [=] Zero).
(* End_Tex_Verb *)
Intros.
Step_lft (cpoly_zero R)!x.
Change Zero!x [=] Zero.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma apply_wd : (p,p':RX)(x,x':R)(p [=] p')->(x [=] x')->(p!x [=] p'!x').
(* End_Tex_Verb *)
Intros.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpolyap_pres_eq :(f:RX;x,y:R)(x[=]y)->(f!x)[=](f!y).
(* End_Tex_Verb *)
Intros.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma cpolyap_strext :(f:RX;x,y:R)((f!x)[#](f!y))->(x[#]y).
(* End_Tex_Verb *)
Intros.
Elim (csbf_strext ???????? H); Intro.
Elim (ap_irreflexive_unfolded ?? H0).
Assumption.
Qed.

(* Begin_Tex_Verb *)
Definition cpoly_csetoid_op : RX -> (CSetoid_un_op R) :=
[f:RX](Build_CSetoid_fun ??[x:R](f!x) (cpolyap_pres_eq f)(cpolyap_strext f)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma _c_apply : (c,x:R)((_C_ c)!x [=] c).
(* End_Tex_Verb *)
Intros.
Simpl.
Step_lft c[+]Zero.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma _x_apply : (x:R)(_X_!x [=] x).
(* End_Tex_Verb *)
Intros.
Simpl.
Step_lft x[*](One[+]x[*]Zero).
Step_lft x[*](One[+]Zero).
Step_lft x[*]One.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma plus_apply : (p,q:RX)(x:R)((p [+] q)!x [=] p!x [+] q!x).
(* End_Tex_Verb *)
Intros.
Unfold RX in p.
Unfold RX in q.
Pattern p q; Apply poly_double_comp_ind.
Intros.
Step_lft (p1[+]q1)!x.
Step_rht p1!x [+] q1!x.
Algebra.
Simpl.
Algebra.
Intros.
Step_lft c[+]d[+]x[*]((p0[+]q0)!x).
Step_rht (c[+] x [*] (p0!x)) [+] (d [+] x [*] (q0!x)).
Step_lft  c[+]d[+]x[*] (p0!x[+]q0!x).
Step_lft  c[+]d[+] (x[*] (p0!x) [+] x[*](q0!x)).
Step_lft  c[+] (d[+] (x[*] (p0!x) [+] x[*](q0!x))).
Step_rht c[+](x[*]p0!x[+](d[+]x[*]q0!x)).
Step_lft  c[+] (d[+] x[*] (p0!x) [+] x[*](q0!x)).
Step_rht c[+](x[*]p0!x[+]d[+]x[*]q0!x).
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma min_apply : (p:RX)(x:R)(([--]p)!x [=] [--](p!x)).
(* End_Tex_Verb *)
Intros.
Pattern p.
Unfold RX in p.
Apply cpoly_induc.
Simpl.
Algebra.
Intros.
Step_lft ([--]c) [+] x [*] ([--]p0)!x.
Step_rht [--](c [+] x [*] (p0!x)).
Step_rht [--]c [+] [--](x [*] (p0!x)).
Step_rht [--]c [+] x[*][--](p0!x).
Algebra.
Qed.

Hints Resolve plus_apply min_apply : algebra.

(* Begin_Tex_Verb *)
Lemma minus_apply : (p,q:RX)(x:R)((p [-] q)!x [=] p!x [-] q!x).
(* End_Tex_Verb *)
Intros.
Step_lft (p[+][--]q)!x.
Step_rht (p!x)[+][--](q!x).
Step_lft (p!x)[+]([--]q)!x.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma _c_mult_apply : (q:RX)(c,x:R)(((_C_ c) [*] q)!x [=] c [*] q!x).
(* End_Tex_Verb *)
Intros.
Step_lft ((cpoly_mult_cr R q c) [+] ((Zero [+X*] Zero)))!x.
Step_lft (cpoly_mult_cr R q c)!x [+] (Zero [+X*] Zero)!x.
Step_lft (cpoly_mult_cr R q c)!x [+] (Zero [+] x [*]Zero).
Step_lft (cpoly_mult_cr R q c)!x [+] (Zero [+] Zero).
Step_lft (cpoly_mult_cr R q c)!x [+] Zero.
Step_lft (cpoly_mult_cr R q c)!x.
Unfold RX in q.
Pattern q.
Apply cpoly_induc.
Simpl.
Algebra.
Intros.
Step_lft  ((c[*]c0) [+X*] (cpoly_mult_cr R p c))!x.
Step_lft (c[*]c0) [+] x [*] (cpoly_mult_cr R p c)!x.
Step_lft (c[*]c0) [+] x [*] (c[*]p!x).
Step_rht c[*](c0[+] x[*] (p!x)).
Step_rht c[*]c0 [+] c[*](x[*] (p!x)).
Apply bin_op_wd_unfolded.
Algebra.
Step_lft  x[*]c[*]p!x.
Step_rht c[*]x[*]p!x.
Algebra.
Qed.

Hints Resolve _c_mult_apply : algebra.

(* Begin_Tex_Verb *)
Lemma mult_apply : (p,q:RX)(x:R)((p [*] q)!x [=] p!x [*] q!x).
(* End_Tex_Verb *)
Intros.
Pattern p.
Apply cpoly_induc.
Simpl.
Algebra.
Intros.
Step_lft ((_C_ c)[*]q [+] _X_ [*] (p0[*]q))!x.
Step_lft ((_C_ c)[*]q)!x [+] (_X_ [*] (p0[*]q))!x.
Step_lft ((_C_ c)[*]q)!x [+] (Zero [+] _X_ [*] (p0[*]q))!x.
Step_lft ((_C_ c)[*]q)!x [+] ((_C_ Zero) [+] _X_ [*] (p0[*]q))!x.
Step_lft ((_C_ c)[*]q)!x [+] (Zero [+X*] (p0[*]q))!x.
Step_lft ((_C_ c)[*]q)!x [+] (Zero [+] x[*] (p0[*]q)!x).
Step_lft c[*](q!x) [+] (x[*] (p0[*]q)!x).
Step_lft c[*](q!x) [+] (x[*] ((p0!x)[*](q!x))).
Step_rht (c[+]x[*]p0!x)[*]q!x.
Step_rht c[*]q!x [+] (x[*]p0!x)[*]q!x.
Algebra.
Qed.

Hints Resolve mult_apply : algebra.

(* Begin_Tex_Verb *)
Lemma one_apply : (x:R)(One!x [=] One).
(* End_Tex_Verb *)
Intro.
Step_lft (_C_ One)!x.
Apply _c_apply.
Qed.

Hints Resolve one_apply : algebra.

(* Begin_Tex_Verb *)
Lemma nexp_apply : (p:RX)(n:nat)(x:R)((p[^]n)!x [=] (p!x)[^]n).
(* End_Tex_Verb *)
Intros.
Induction n.
Step_lft (One::RX)!x.
Step_lft One::R.
Algebra.
Step_lft (p[*](p[^]n))!x.
Step_lft p!x [*] (p[^]n)!x.
Step_lft  p!x [*] (p!x)[^]n.
Algebra.
Qed.

(* Begin_Tex_Verb *)
(* SUPERFLUOUS *)
Lemma poly_min_apply :
  (p:RX)(x:R)((cpoly_min ? p)!x [=] [--](p!x)).
(* End_Tex_Verb *)
Exact min_apply.
Qed.

(* Begin_Tex_Verb *)
Lemma sum0_cpoly_ap : (f:nat->RX)(a:R)(k:nat)
  ((Sum0 k f)!a [=] (Sum0 k [i:nat](f i)!a)).
(* End_Tex_Verb *)
Intros.
Induction k.
Simpl.
Algebra.
Step_lft ((Sum0 k f) [+] (f k))!a.
Step_lft (Sum0 k f)!a [+] (f k)!a.
Step_lft (Sum0 k [i:nat](f i)!a) [+] (f k)!a.
Simpl.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma sum_cpoly_ap : (f:nat->RX)(a:R)(k,l:nat)
  ((Sum k l f)!a [=] (Sum k l [i:nat](f i)!a)).
(* End_Tex_Verb *)
Unfold sum.
Unfold sum1.
Intros.
Unfold cg_minus.
Step_lft  ((Sum0 (S l) f)!a) [+] ([--](Sum0 k f))!a.
Step_lft  ((Sum0 (S l) f)!a) [+] [--]((Sum0 k f)!a).
Apply bin_op_wd_unfolded.
Apply sum0_cpoly_ap.
Apply un_op_wd_unfolded.
Apply sum0_cpoly_ap.
Qed.

End Poly_properties.

Hints Resolve poly_linear cpoly_lin : algebra.
Hints Resolve apply_wd cpoly_const_eq : algebra_c.
Hints Resolve _c_apply _x_apply min_apply plus_apply minus_apply mult_apply nexp_apply : algebra.
Hints Resolve one_apply _c_zero _c_one _c_mult : algebra.
Hints Resolve poly_min_apply : algebra.
Hints Resolve _c_mult_lin : algebra.


