(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
(*  A <X1,...,Xn>: non commutative polynomials on a commutative ring A *)
Set Implicit Arguments.
Require Export Ring_polynom. (* n'utilise que PExpr *)
Require Export Ncring.
#[local] Create HintDb rsimpl.
Section MakeRingPol.
Context (C R:Type) `{Rh:Ring_morphism C R}.
Variable phiCR_comm: forall (c:C)(x:R), x * [c] == [c] * x.
Ltac rsimpl := repeat (gen_rewrite || rewrite phiCR_comm).
Ltac add_push := gen_add_push .
#[local] Hint Rewrite
ring_opp_zero ring_opp_add
ring_add_0_l ring_add_0_r
ring_mul_1_l ring_mul_1_r
ring_mul_0_l ring_mul_0_r
ring_distr_l ring_distr_r
ring_add_assoc ring_mul_assoc
: rsimpl.
(* Definition of non commutative multivariable polynomials with coefficients in C : *)
Inductive Pol : Type :=
| Pc : C -> Pol
| PX : Pol -> positive -> positive -> Pol -> Pol.
(* PX P i n Q represents P * X_i^n + Q *)
Definition cO:C . exact ring0. Defined.
Definition cI:C . exact ring1. Defined.
Definition P0 := Pc 0.
Definition P1 := Pc 1.
Variable Ceqb:C->C->bool.
#[universes(template)]
Class Equalityb (A : Type):= {equalityb : A -> A -> bool}.
Notation "x =? y" := (equalityb x y) (at level 70, no associativity).
Variable Ceqb_eq: forall x y:C, Ceqb x y = true -> (x == y).
Instance equalityb_coef : Equalityb C :=
{equalityb x y := Ceqb x y}.
Fixpoint Peq (P P' : Pol) {struct P'} : bool :=
match P, P' with
| Pc c, Pc c' => c =? c'
| PX P i n Q, PX P' i' n' Q' =>
match Pos.compare i i', Pos.compare n n' with
| Eq, Eq => if Peq P P' then Peq Q Q' else false
| _,_ => false
end
| _, _ => false
end.
Instance equalityb_pol : Equalityb Pol :=
{equalityb x y := Peq x y}.
(* Q a ses variables de queue < i *)
Definition mkPX P i n Q :=
match P with
| Pc c => if c =? 0 then Q else PX P i n Q
| PX P' i' n' Q' =>
match Pos.compare i i' with
| Eq => if Q' =? P0 then PX P' i (n + n') Q else PX P i n Q
| _ => PX P i n Q
end
end.
Definition mkXi i n := PX P1 i n P0.
Definition mkX i := mkXi i 1.
(** Opposite of addition *)
Fixpoint Popp (P:Pol) : Pol :=
match P with
| Pc c => Pc (- c)
| PX P i n Q => PX (Popp P) i n (Popp Q)
end.
Notation "-- P" := (Popp P)(at level 30).
(** Addition et subtraction *)
Fixpoint PaddCl (c:C)(P:Pol) {struct P} : Pol :=
match P with
| Pc c1 => Pc (c + c1)
| PX P i n Q => PX P i n (PaddCl c Q)
end.
(* Q quelconque *)
Section PaddX.
Variable Padd:Pol->Pol->Pol.
Variable P:Pol.
(* Xi^n * P + Q les variables de tete de Q ne sont pas forcement < i mais Q est normalisé : variables de tete decroissantes *)
Fixpoint PaddX (i n:positive)(Q:Pol){struct Q}:=
match Q with
| Pc c => mkPX P i n Q
| PX P' i' n' Q' =>
match Pos.compare i i' with
| (* i > i' *)
Gt => mkPX P i n Q
| (* i < i' *)
Lt => mkPX P' i' n' (PaddX i n Q')
| (* i = i' *)
Eq => match Z.pos_sub n n' with
| (* n > n' *)
Zpos k => mkPX (PaddX i k P') i' n' Q'
| (* n = n' *)
Z0 => mkPX (Padd P P') i n Q'
| (* n < n' *)
Zneg k => mkPX (Padd P (mkPX P' i k P0)) i n Q'
end
end
end.
End PaddX.
Fixpoint Padd (P1 P2: Pol) {struct P1} : Pol :=
match P1 with
| Pc c => PaddCl c P2
| PX P' i' n' Q' =>
PaddX Padd P' i' n' (Padd Q' P2)
end.
Notation "P ++ P'" := (Padd P P').
Definition Psub(P P':Pol):= P ++ (--P').
Notation "P -- P'" := (Psub P P')(at level 50).
(** Multiplication *)
Fixpoint PmulC_aux (P:Pol) (c:C)  {struct P} : Pol :=
match P with
| Pc c' => Pc (c' * c)
| PX P i n Q => mkPX (PmulC_aux P c) i n (PmulC_aux Q c)
end.
Definition PmulC P c :=
if c =? 0 then P0 else
if c =? 1 then P else PmulC_aux P c.
Fixpoint Pmul (P1 P2 : Pol) {struct P2} : Pol :=
match P2 with
| Pc c => PmulC P1 c
| PX P i n Q =>
PaddX Padd (Pmul P1 P) i n (Pmul P1 Q)
end.
Notation "P ** P'" := (Pmul P P')(at level 40).
Definition Psquare (P:Pol) : Pol := P ** P.
(** Evaluation of a polynomial towards R *)
Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R :=
match P with
| Pc c => [c]
| PX P i n Q =>
let x := nth 0 i l in
let xn := pow_pos x n in
(Pphi l P) * xn + (Pphi l Q)
end.
Reserved Notation "P @ l " (at level 10, no associativity).
Notation "P @ l " := (Pphi l P).
(** Proofs *)
Ltac destr_pos_sub H :=
match goal with |- context [Z.pos_sub ?x ?y] =>
assert (H := Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
end.

(* Specifications: *)
Lemma Peq_ok : forall P P',
(P =? P') = true -> forall l, P@l == P'@ l.
Lemma Pphi0 : forall l, P0@l == 0.
Lemma Pphi1 : forall l,  P1@l == 1.
Lemma mkPX_ok : forall l P i n Q,
(mkPX P i n Q)@l == P@l * (pow_pos (nth 0 i l) n) + Q@l.