(* Fpolynomial.v *)

(* polynomials on a ring *)

Set Nested Proofs Allowed.
Require Import Utf8 Arith.
Import List ListNotations.

Require Import Misc deprecat_Ring2 deprecat_Rsummation.

(* definition of a polynomial *)

Definition rng_eqb {A} {ro : ring_op A} {rp : ring_prop} (a b : A) :=
  if rng_eq_dec a b then true else false.

(* (lap : list as polynomial) *)
Record poly A {ro : ring_op A} {rp : ring_prop} := mkpoly
  { lap : list A;
    lap_prop : rng_eqb (last lap 1%Rng) 0%Rng = false }.

Arguments lap {A} {ro} {rp}.

Theorem eq_poly_eq {A} {ro : ring_op A} {rp : ring_prop} :
  ∀ p1 p2, p1 = p2 ↔ lap p1 = lap p2.
Proof.
intros.
split; [ now intros; subst p1 | ].
intros Hll.
destruct p1 as (la, lapr).
destruct p2 as (lb, lbpr).
cbn in Hll; subst la; f_equal.
apply (Eqdep_dec.UIP_dec Bool.bool_dec).
Qed.

Theorem eq_poly_prop {A} {ro : ring_op A} {rp : ring_prop} : ∀ la,
  rng_eqb (last la 1%Rng) 0%Rng = false ↔ last la 1%Rng ≠ 0%Rng.
Proof.
intros.
unfold rng_eqb.
now destruct (rng_eq_dec (last la 1%Rng) 0%Rng).
Qed.

Arguments mkpoly {_} {_} {_}.

Theorem lap_1_0_prop {A} {ro : ring_op A} {rp : ring_prop} :
  rng_eqb (last [] 1%Rng) 0%Rng = false.
Proof.
cbn.
unfold rng_eqb.
destruct (rng_eq_dec 1%Rng 0%Rng); [ | easy ].
now apply rng_1_neq_0 in e.
Qed.

Definition poly_zero {α} {ro : ring_op α} {rp : ring_prop} :=
  mkpoly [] lap_1_0_prop.
Definition poly_one {α} {ro : ring_op α} {rp : ring_prop} :=
  mkpoly [1%Rng] lap_1_0_prop.

(* normalization *)

Fixpoint strip_0s {A} {ro : ring_op A} {rp : ring_prop} la :=
  match la with
  | [] => []
  | a :: la' => if rng_eq_dec a 0%Rng then strip_0s la' else la
  end.

Lemma strip_0s_app {A} {ro : ring_op A} {rp : ring_prop} : ∀ la lb,
  strip_0s (la ++ lb) =
  match strip_0s la with
  | [] => strip_0s lb
  | lc => lc ++ lb
  end.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | cbn ].
destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]; [ apply IHla | easy ].
Qed.

Definition lap_norm {A} {ro : ring_op A} {rp : ring_prop} la := rev (strip_0s (rev la)).

Theorem poly_norm_prop {A} {ro : ring_op A} {rp : ring_prop} : ∀ la,
  last (lap_norm la) 1%Rng ≠ 0%Rng.
Proof.
intros.
unfold lap_norm.
induction la as [| a]; [ apply rng_1_neq_0 | cbn ].
rewrite strip_0s_app.
remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
destruct lb as [| b]; cbn. {
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]; [ apply rng_1_neq_0 | easy ].
}
cbn in IHla.
rewrite List_last_app.
now rewrite List_last_app in IHla.
Qed.

Definition poly_norm {A} {ro : ring_op A} {rp : ring_prop} la :=
  mkpoly (lap_norm la) (proj2 (eq_poly_prop _) (poly_norm_prop la)).

(**)
Require Import ZArith.

Theorem Z_1_neq_0 : (1 ≠ 0)%Z.
Proof. easy. Qed.

Definition Z_ring_op : ring_op Z :=
  {| rng_zero := 0%Z;
     rng_one := 1%Z;
     rng_add := Z.add;
     rng_mul := Z.mul;
     rng_opp := Z.opp |}.

Definition Z_ring_prop :=
  let _ := Z_ring_op in
  {| rng_1_neq_0 := Z_1_neq_0;
     rng_eq_dec := Z.eq_dec;
     rng_add_comm := Z.add_comm;
     rng_add_assoc := Z.add_assoc;
     rng_add_0_l := Z.add_0_l;
     rng_add_opp_l := Z.add_opp_diag_l;
     rng_mul_comm := Z.mul_comm;
     rng_mul_assoc := Z.mul_assoc;
     rng_mul_1_l := Z.mul_1_l;
     rng_mul_add_distr_l := Z.mul_add_distr_l |}.

(* allows to use ring theorems on Z *)
Canonical Structure Z_ring_op.
Canonical Structure Z_ring_prop.

(*
Compute (@lap_norm Z Z_ring [3; 4; 0; 5; 0; 0; 0]%Z).
*)
(**)

(* addition *)

Fixpoint lap_add {α} {ro : ring_op α} {rp : ring_prop} al1 al2 :=
  match al1 with
  | [] => al2
  | a1 :: bl1 =>
      match al2 with
      | [] => al1
      | a2 :: bl2 => (a1 + a2)%Rng :: lap_add bl1 bl2
      end
  end.

Definition lap_opp {α} {ro : ring_op α} {rp : ring_prop} la := List.map rng_opp la.
Definition lap_sub {A} {ro : ring_op A} {rp : ring_prop} la lb := lap_add la (lap_opp lb).

Definition poly_add {A} {ro : ring_op A} {rp : ring_prop} p1 p2 :=
  poly_norm (lap_add (lap p1) (lap p2)).

Definition poly_opp {α} {ro : ring_op α} {rp : ring_prop} pol :=
  poly_norm (lap_opp (lap pol)).

Definition poly_sub {α} {ro : ring_op α} {rp : ring_prop} p1 p2 :=
  poly_add p1 (poly_opp p2).

(*
Compute (@poly_add Z Z_ring (poly_norm [3;4;5]%Z) (poly_norm [2;3;-4;5]%Z)).
Compute (@poly_add Z Z_ring (poly_norm [3;4;5]%Z) (poly_norm [2;3;-5]%Z)).
*)

(* multiplication *)

Fixpoint lap_convol_mul {α} {ro : ring_op α} {rp : ring_prop} al1 al2 i len :=
  match len with
  | O => []
  | S len1 =>
      (Σ (j = 0, i), List.nth j al1 0 * List.nth (i - j) al2 0)%Rng ::
      lap_convol_mul al1 al2 (S i) len1
  end.

Definition lap_mul {α} {ro : ring_op α} {rp : ring_prop} la lb :=
  match la with
  | [] => []
  | _ =>
      match lb with
      | [] => []
      | _ => lap_convol_mul la lb 0 (length la + length lb - 1)
      end
  end.

Definition poly_mul {A} {ro : ring_op A} {rp : ring_prop} p1 p2 :=
  poly_norm (lap_mul (lap p1) (lap p2)).

(*
Compute (@lap_mul Z Z_ring [3;4;5]%Z [2;3;-4;5]%Z).
Compute (@poly_mul Z Z_ring (poly_norm [3;4;5]%Z) (poly_norm [2;3;-4;5]%Z)).
*)

(* power *)

Fixpoint lap_power {α} {ro : ring_op α} {rp : ring_prop} la n :=
  match n with
  | O => [1%Rng]
  | S m => lap_mul la (lap_power la m)
  end.

Definition poly_power {A} {ro : ring_op A} {rp : ring_prop} pol n :=
  poly_norm (lap_power (lap pol) n).

(*
Compute (@poly_power Z Z_ring (poly_norm [1; -1]%Z) 4).
*)

(* composition *)

Definition lap_compose {α} {ro : ring_op α} {rp : ring_prop} la lb :=
  List.fold_right (λ c accu, lap_add (lap_mul accu lb) [c]) [] la.

Definition lap_compose2 {α} {ro : ring_op α} {rp : ring_prop} la lb :=
  List.fold_right
    (λ i accu,
     lap_add accu (lap_mul [List.nth i la 0] (lap_power lb i)))%Rng
    [] (List.seq 0 (length la)).

(* *)

Fixpoint list_pad {α} n (zero : α) rem :=
  match n with
  | O => rem
  | S n1 => zero :: list_pad n1 zero rem
  end.

Theorem xpow_norm {A} {ro : ring_op A} {rp : ring_prop} : ∀ i,
  rng_eqb (last (repeat 0%Rng i ++ [1%Rng]) 1%Rng) 0%Rng = false.
Proof.
intros.
rewrite List_last_app.
unfold rng_eqb.
destruct (rng_eq_dec 1 0) as [H| H]; [ | easy ].
now apply rng_1_neq_0 in H.
Qed.

Definition xpow {α} {ro : ring_op α} {rp : ring_prop} i :=
  mkpoly (repeat 0%Rng i ++ [1%Rng]) (xpow_norm i).

Declare Scope lap_scope.
Delimit Scope lap_scope with lap.
Notation "1" := [1%Rng] : lap_scope.
Notation "- a" := (lap_opp a) : lap_scope.
Notation "a + b" := (lap_add a b) : lap_scope.
Notation "a - b" := (lap_sub a b) : lap_scope.
Notation "a * b" := (lap_mul a b) : lap_scope.
Notation "a ^ b" := (lap_power a b) : lap_scope.

Definition list_nth_def_0 {α} {ro : ring_op α} {rp : ring_prop} n l := List.nth n l 0%Rng.

Declare Scope poly_scope.
Delimit Scope poly_scope with pol.
Notation "0" := poly_zero : poly_scope.
Notation "1" := poly_one : poly_scope.
Notation "- a" := (poly_opp a) : poly_scope.
Notation "a + b" := (poly_add a b) : poly_scope.
Notation "a - b" := (poly_sub a b) : poly_scope.
Notation "a * b" := (poly_mul a b) : poly_scope.
Notation "'ⓧ' ^ a" := (xpow a) (at level 30, format "'ⓧ' ^ a") : poly_scope.
Notation "'ⓧ'" := (xpow 1) (at level 30, format "'ⓧ'") : poly_scope.

(* *)

Theorem lap_convol_mul_comm : ∀ α {ro : ring_op α} {rp : ring_prop} l1 l2 i len,
  lap_convol_mul l1 l2 i len = lap_convol_mul l2 l1 i len.
Proof.
intros.
revert i.
induction len; intros; [ reflexivity | simpl ].
rewrite IHlen; f_equal.
rewrite summation_rtl.
apply summation_compat; intros j (_, Hj).
rewrite Nat.add_0_r.
rewrite rng_mul_comm.
apply rng_mul_compat; [ idtac | reflexivity ].
rewrite Nat_sub_sub_distr; [ idtac | easy ].
rewrite Nat.sub_diag, Nat.add_0_l; reflexivity.
Qed.

Theorem lap_convol_mul_nil_l : ∀ α {ro : ring_op α} {rp : ring_prop} l i len,
  lap_norm (lap_convol_mul [] l i len) = [].
Proof.
intros.
unfold lap_norm.
revert i.
induction len; intros; [ reflexivity | ].
cbn - [ summation ].
rewrite all_0_summation_0. {
  rewrite strip_0s_app; cbn.
  specialize (IHlen (S i)).
  apply List_eq_rev_nil in IHlen.
  rewrite IHlen.
  now destruct (rng_eq_dec 0%Rng 0%Rng).
}
intros k (_, Hk).
now rewrite match_id, rng_mul_0_l.
Qed.

Theorem lap_convol_mul_nil_r : ∀ α {ro : ring_op α} {rp : ring_prop} l i len,
  lap_norm (lap_convol_mul l [] i len) = [].
Proof.
intros.
rewrite lap_convol_mul_comm.
apply lap_convol_mul_nil_l.
Qed.

Theorem list_nth_lap_eq : ∀ α {ro : ring_op α} {rp : ring_prop} la lb,
  (∀ i, (List.nth i la 0 = List.nth i lb 0)%Rng)
  → lap_norm la = lap_norm lb.
Proof.
intros * Hi.
unfold lap_norm; f_equal.
revert lb Hi.
induction la as [| a]; intros. {
  induction lb as [| b]; [ reflexivity | ].
  specialize (Hi 0) as H; cbn in H.
  subst b; cbn.
  rewrite strip_0s_app; cbn.
  remember (strip_0s (rev lb)) as lc eqn:Hlc; symmetry in Hlc.
  destruct lc as [| c]; [ now destruct (rng_eq_dec _ _) | ].
  assert (H : lap_norm [] = lap_norm lb). {
    unfold lap_norm; cbn.
    cbn in IHlb.
    change (rev [] = rev (strip_0s (rev lb))).
    f_equal.
    rewrite Hlc.
    apply IHlb.
    intros i; cbn; rewrite match_id.
    now specialize (Hi (S i)); cbn in Hi.
  }
  cbn in H.
  unfold lap_norm in H.
  rewrite Hlc in H.
  symmetry in H.
  now apply List_eq_rev_nil in H.
} {
  cbn.
  rewrite strip_0s_app.
  remember (strip_0s (rev la)) as lc eqn:Hlc; symmetry in Hlc.
  destruct lc as [| c]. {
    assert (Hla : ∀ i, nth i la 0%Rng = 0%Rng). {
      intros i.
      clear - Hlc.
      revert i.
      induction la as [| a]; intros; [ now cbn; rewrite match_id | cbn ].
      destruct i. {
        cbn in Hlc.
        rewrite strip_0s_app in Hlc; cbn in Hlc.
        remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
        destruct lb as [| b]; [ now destruct (rng_eq_dec a 0%Rng) | easy ].
      }
      apply IHla.
      cbn in Hlc.
      rewrite strip_0s_app in Hlc; cbn in Hlc.
      remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
      destruct lb as [| b]; [ now destruct (rng_eq_dec a 0%Rng) | easy ].
    }
    cbn.
    destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
      assert (Hlb : ∀ i, nth i lb 0%Rng = 0%Rng). {
        intros.
        rewrite <- Hi; cbn.
        destruct i; [ easy | ].
        apply Hla.
      }
      clear - Hlb.
      induction lb as [| b]; [ easy | cbn ].
      specialize (Hlb 0) as H1; cbn in H1; subst b.
      rewrite strip_0s_app; cbn.
      rewrite <- IHlb; [ now destruct (rng_eq_dec 0%Rng 0%Rng) | ].
      intros i.
      now specialize (Hlb (S i)).
    }
    destruct lb as [| b]; [ now specialize (Hi 0); cbn in Hi | cbn ].
    rewrite strip_0s_app; cbn.
    remember (strip_0s (rev lb)) as ld eqn:Hld; symmetry in Hld.
    destruct ld as [| d]. {
      destruct (rng_eq_dec b 0%Rng) as [Hbz| Hbz]. {
        subst b.
        now specialize (Hi 0).
      }
      f_equal.
      now specialize (Hi 0).
    }
    specialize (IHla lb).
    assert (H : ∀ i : nat, nth i la 0%Rng = nth i lb 0%Rng). {
      intros i.
      now specialize (Hi (S i)); cbn in Hi.
    }
    specialize (IHla H); clear H.
    now rewrite Hld in IHla.
  }
  destruct lb as [| b]. {
    specialize (IHla []).
    assert (H : ∀ i : nat, nth i la 0%Rng = nth i [] 0%Rng). {
      intros i; cbn; rewrite match_id.
      now specialize (Hi (S i)).
    }
    now specialize (IHla H).
  }
  cbn.
  rewrite strip_0s_app; cbn.
  remember (strip_0s (rev lb)) as ld eqn:Hld; symmetry in Hld.
  destruct ld as [| d]. {
    destruct (rng_eq_dec b 0%Rng) as [Hbz| Hbz]. {
      subst b.
      specialize (IHla lb).
      assert (H : ∀ i : nat, nth i la 0%Rng = nth i lb 0%Rng). {
        intros i.
        now specialize (Hi (S i)); cbn in Hi.
      }
      specialize (IHla H); clear H.
      now rewrite Hld in IHla.
    }
    specialize (IHla lb).
    assert (H : ∀ i : nat, nth i la 0%Rng = nth i lb 0%Rng). {
      intros i.
      now specialize (Hi (S i)); cbn in Hi.
    }
    specialize (IHla H); clear H.
    now rewrite Hld in IHla.
  }
  specialize (Hi 0) as H1; cbn in H1; subst b.
  do 2 rewrite app_comm_cons; f_equal.
  rewrite <- Hld.
  apply IHla.
  now intros i; specialize (Hi (S i)).
}
Qed.

Theorem fold_lap_norm {A} {ro : ring_op A} {rp : ring_prop} :
  ∀ la, rev (strip_0s (rev la)) = lap_norm la.
Proof. easy. Qed.

Theorem lap_add_0_l {α} {ro : ring_op α} {rp : ring_prop} : ∀ la, lap_add [] la = la.
Proof. easy. Qed.

Theorem lap_add_0_r {α} {ro : ring_op α} {rp : ring_prop} : ∀ la, lap_add la [] = la.
Proof. intros; now destruct la. Qed.

Theorem poly_add_0_l {α} {ro : ring_op α} {rp : ring_prop} : ∀ p, (0 + p)%pol = p.
Proof.
intros (la, lapr).
apply eq_poly_eq; cbn.
apply eq_poly_prop in lapr.
induction la as [| a]; [ easy | cbn ].
rewrite strip_0s_app.
rewrite <- (rev_involutive (strip_0s _)).
rewrite IHla; cbn. {
  remember (rev la) as lb eqn:Hlb; symmetry in Hlb.
  destruct lb as [| b]. {
    apply List_eq_rev_nil in Hlb; subst la.
    now destruct (rng_eq_dec a 0).
  }
  cbn.
  rewrite rev_app_distr; cbn; f_equal.
  now rewrite <- rev_involutive, Hlb.
} {
  destruct la as [| a2]; [ | easy ].
  apply rng_1_neq_0.
}
Qed.

Theorem lap_mul_0_l {α} {ro : ring_op α} {rp : ring_prop} : ∀ la, lap_norm (lap_mul [] la) = [].
Proof. easy. Qed.

Theorem lap_mul_0_r {α} {ro : ring_op α} {rp : ring_prop} : ∀ la, lap_norm (lap_mul la []) = [].
Proof. now intros; destruct la. Qed.

Section lap.

Context {α : Type}.
Context {ro : ring_op α} {rp : ring_prop}.

Theorem strip_0s_idemp : ∀ la, strip_0s (strip_0s la) = strip_0s la.
Proof.
intros.
induction la as [| a]; [ easy | cbn ].
destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]; [ easy | cbn ].
now destruct (rng_eq_dec a 0%Rng).
Qed.

Theorem lap_norm_idemp : ∀ la, lap_norm (lap_norm la) = lap_norm la.
Proof.
intros.
unfold lap_norm.
rewrite rev_involutive.
now rewrite strip_0s_idemp.
Qed.

Theorem eq_lap_convol_mul_nil : ∀ la lb i len,
  lap_convol_mul la lb i len = [] → len = 0.
Proof. now intros; induction len. Qed.

(* addition theorems *)

Theorem lap_add_comm : ∀ al1 al2,
  lap_add al1 al2 = lap_add al2 al1.
Proof.
intros al1 al2.
revert al2.
induction al1; intros; [ now destruct al2 | ].
destruct al2; [ easy | cbn ].
now rewrite rng_add_comm, IHal1.
Qed.

Theorem poly_add_comm : ∀ a b, (a + b)%pol = (b + a)%pol.
Proof.
intros.
unfold "+"%pol.
now rewrite lap_add_comm.
Qed.

Theorem lap_add_norm_idemp_l : ∀ la lb,
  lap_norm (lap_norm la + lb)%lap = lap_norm (la + lb)%lap.
Proof.
intros.
unfold lap_norm; f_equal.
revert la.
induction lb as [| b]; intros. {
  do 2 rewrite lap_add_0_r.
  now rewrite rev_involutive, strip_0s_idemp.
}
cbn.
destruct la as [| a]; [ easy | cbn ].
do 2 rewrite strip_0s_app; cbn.
rewrite <- IHlb.
remember (strip_0s (rev la)) as lc eqn:Hlc; symmetry in Hlc.
destruct lc as [| c]. {
  cbn.
  destruct (rng_eq_dec a 0) as [Haz| Haz]. {
    subst a; rewrite rng_add_0_l; cbn.
    now rewrite strip_0s_app.
  }
  cbn.
  now rewrite strip_0s_app.
}
cbn.
rewrite rev_app_distr; cbn.
now rewrite strip_0s_app.
Qed.

Theorem lap_add_norm_idemp_r : ∀ la lb,
  lap_norm (la + lap_norm lb)%lap = lap_norm (la + lb)%lap.
Proof.
intros.
rewrite lap_add_comm, lap_add_norm_idemp_l.
now rewrite lap_add_comm.
Qed.

Theorem lap_add_assoc : ∀ al1 al2 al3,
  lap_add al1 (lap_add al2 al3) = lap_add (lap_add al1 al2) al3.
Proof.
intros al1 al2 al3.
revert al2 al3.
induction al1; intros; [ easy | ].
destruct al2; [ easy | cbn ].
destruct al3; [ easy | cbn ].
rewrite rng_add_assoc.
now rewrite IHal1.
Qed.

Theorem lap_add_add_swap : ∀ la lb lc,
  lap_add (lap_add la lb) lc = lap_add (lap_add la lc) lb.
Proof.
intros la lb lc.
do 2 rewrite <- lap_add_assoc.
now rewrite (lap_add_comm lb).
Qed.

Theorem poly_add_assoc : ∀ pa pb pc,
  (pa + (pb + pc) = (pa + pb) + pc)%pol.
Proof.
intros (la, lapr) (lb, lbpr) (lc, lcpr).
apply eq_poly_eq.
cbn - [ lap_norm ].
rewrite lap_add_norm_idemp_l.
rewrite lap_add_norm_idemp_r.
now rewrite lap_add_assoc.
Qed.

(* multiplication theorems *)

Theorem lap_mul_comm : ∀ a b, lap_mul a b = lap_mul b a.
Proof.
intros la lb.
unfold lap_mul.
destruct la as [| a]; [ now destruct lb | cbn ].
rewrite <- Nat.add_succ_comm; cbn.
rewrite (Nat.add_comm (length lb)).
now rewrite lap_convol_mul_comm.
Qed.

Theorem poly_mul_comm : ∀ pa pb, (pa * pb)%pol = (pb * pa)%pol.
Proof.
intros.
apply eq_poly_eq; cbn.
now rewrite lap_mul_comm.
Qed.

Theorem list_nth_lap_convol_mul_aux : ∀ la lb n i len,
  List.length la + List.length lb - 1 = (i + len)%nat
  → (List.nth n (lap_convol_mul la lb i len) 0%Rng =
     Σ (j = 0, n + i),
     List.nth j la 0 * List.nth (n + i - j) lb 0)%Rng.
Proof.
intros la lb n i len Hlen.
revert la lb i n Hlen.
induction len; intros.
 simpl.
 rewrite Nat.add_0_r in Hlen.
 rewrite all_0_summation_0; [ destruct n; reflexivity | idtac ].
 intros j (_, Hj).
 destruct (le_dec (length la) j) as [H1| H1].
  rewrite List.nth_overflow; [ idtac | assumption ].
  rewrite rng_mul_0_l; reflexivity.

  destruct (le_dec (length lb) (n + i - j)) as [H2| H2].
   rewrite rng_mul_comm.
   rewrite List.nth_overflow; [ idtac | assumption ].
   rewrite rng_mul_0_l; reflexivity.

   exfalso; apply H2; clear Hj H2.
   apply Nat.nle_gt in H1; subst i.
   flia H1.

 simpl.
 destruct n; [ reflexivity | idtac ].
 rewrite Nat.add_succ_r, <- Nat.add_succ_l in Hlen.
 rewrite IHlen; [ idtac | assumption ].
 rewrite Nat.add_succ_r, <- Nat.add_succ_l; reflexivity.
Qed.

(* to be unified perhaps with list_nth_convol_mul below *)
Theorem list_nth_lap_convol_mul : ∀ la lb i len,
  len = length la + length lb - 1
  → (List.nth i (lap_convol_mul la lb 0 len) 0 =
     Σ (j = 0, i), List.nth j la 0 * List.nth (i - j) lb 0)%Rng.
Proof.
intros la lb i len Hlen.
symmetry in Hlen.
rewrite list_nth_lap_convol_mul_aux; [ idtac | assumption ].
rewrite Nat.add_0_r; reflexivity.
Qed.

Theorem summation_mul_list_nth_lap_convol_mul : ∀ la lb lc k,
  (Σ (i = 0, k),
     List.nth i la 0 *
     List.nth (k - i)
       (lap_convol_mul lb lc 0 (length lb + length lc - 1))
       0 =
   Σ (i = 0, k),
     List.nth i la 0 *
     Σ (j = 0, k - i),
       List.nth j lb 0 * List.nth (k - i - j) lc 0)%Rng.
Proof.
intros la lb lc k.
apply summation_compat; intros i (_, Hi).
f_equal.
rewrite list_nth_lap_convol_mul; reflexivity.
Qed.

Theorem summation_mul_list_nth_lap_convol_mul_2 : ∀ la lb lc k,
   (Σ (i = 0, k),
      List.nth i lc 0 *
      List.nth (k - i)
        (lap_convol_mul la lb 0 (length la + length lb - 1))  0 =
    Σ (i = 0, k),
      List.nth (k - i) lc 0 *
      Σ (j = 0, i),
        List.nth j la 0 * List.nth (i - j) lb 0)%Rng.
Proof.
intros la lb lc k.
rewrite summation_rtl.
apply summation_compat; intros i (_, Hi).
rewrite Nat.add_0_r.
f_equal.
rewrite Nat_sub_sub_distr; [ idtac | easy ].
rewrite Nat.sub_diag.
apply list_nth_lap_convol_mul; reflexivity.
Qed.

Lemma lap_norm_mul_assoc : ∀ la lb lc,
  lap_norm (la * (lb * lc))%lap = lap_norm (la * lb * lc)%lap.
Proof.
intros la lb lc.
symmetry; rewrite lap_mul_comm.
unfold lap_mul.
destruct lc as [| c]. {
  destruct la as [| a]; [ easy | now destruct lb ].
}
destruct la as [| a]; [ easy | ].
destruct lb as [| b]; [ easy | ].
move b before a; move c before b.
remember (a :: la) as la' eqn:Hla'.
remember (b :: lb) as lb' eqn:Hlb'.
remember (c :: lc) as lc' eqn:Hlc'.
apply list_nth_lap_eq; intros k.
remember (lap_convol_mul la' lb' 0 (length la' + length lb' - 1)) as ld
  eqn:Hld.
remember (lap_convol_mul lb' lc' 0 (length lb' + length lc' - 1)) as le
  eqn:Hle.
symmetry in Hld, Hle.
destruct ld as [| d]. {
  destruct le as [| e]; [ easy | cbn ].
  rewrite match_id.
  move e before c.
  apply eq_lap_convol_mul_nil in Hld.
  apply Nat.sub_0_le in Hld.
  remember (length la' + length lb') as len eqn:Hlen.
  symmetry in Hlen.
  destruct len. {
    apply Nat.eq_add_0 in Hlen.
    now subst la'.
  }
  destruct len; [ clear Hld | flia Hld ].
  apply Nat.eq_add_1 in Hlen.
  destruct Hlen as [Hlen| Hlen]; [ now rewrite Hlb' in Hlen | ].
  now rewrite Hla' in Hlen.
}
destruct le as [| e]. {
  cbn; rewrite match_id.
  move d before c.
  apply eq_lap_convol_mul_nil in Hle.
  apply Nat.sub_0_le in Hle.
  remember (length lb' + length lc') as len eqn:Hlen.
  symmetry in Hlen.
  destruct len. {
    apply Nat.eq_add_0 in Hlen.
    now subst lb'.
  }
  destruct len; [ clear Hle | flia Hle ].
  apply Nat.eq_add_1 in Hlen.
  destruct Hlen as [Hlen| Hlen]; [ now rewrite Hlc' in Hlen | ].
  now rewrite Hlb' in Hlen.
}
rewrite list_nth_lap_convol_mul; [ idtac | reflexivity ].
rewrite list_nth_lap_convol_mul; [ idtac | reflexivity ].
rewrite <- Hld, <- Hle.
rewrite summation_mul_list_nth_lap_convol_mul_2; symmetry.
rewrite summation_mul_list_nth_lap_convol_mul; symmetry.
rewrite <- summation_summation_mul_swap.
rewrite <- summation_summation_mul_swap.
rewrite summation_summation_exch.
rewrite summation_summation_shift.
apply summation_compat; intros i Hi.
apply summation_compat; intros j Hj.
rewrite rng_mul_comm, rng_mul_assoc.
rewrite Nat.add_comm, Nat.add_sub.
rewrite Nat.add_comm, Nat.sub_add_distr.
reflexivity.
Qed.

Theorem eq_lap_norm_eq_length : ∀ la lb,
  lap_norm la = lap_norm lb
  → length la = length lb
  → la = lb.
Proof.
intros * Hll Hlen.
unfold lap_norm in Hll.
apply (f_equal (@rev α)) in Hll.
do 2 rewrite rev_involutive in Hll.
setoid_rewrite <- rev_length in Hlen.
enough (H : rev la = rev lb). {
  apply (f_equal (@rev α)) in H.
  now do 2 rewrite rev_involutive in H.
}
remember (rev la) as l; clear la Heql; rename l into la.
remember (rev lb) as l; clear lb Heql; rename l into lb.
revert la Hll Hlen.
induction lb as [| b]; intros. {
  now apply length_zero_iff_nil in Hlen.
}
destruct la as [| a]; [ easy | ].
cbn in Hll, Hlen.
apply Nat.succ_inj in Hlen.
destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
  destruct (rng_eq_dec b 0%Rng) as [Hbz| Hbz]. {
    subst a b; f_equal.
    now apply IHlb.
  }
  exfalso; clear - Hbz Hll Hlen.
  assert (H : length la ≤ length lb) by flia Hlen.
  clear Hlen; rename H into Hlen.
  induction la as [| a]; [ easy | ].
  cbn in Hll.
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
    cbn in Hlen.
    clear a Haz.
    apply IHla; [ easy | flia Hlen ].
  }
  rewrite Hll in Hlen; cbn in Hlen.
  flia Hlen.
}
destruct (rng_eq_dec b 0%Rng) as [Hbz| Hbz]. {
  exfalso; clear b Hbz.
  clear - Haz Hll Hlen.
  assert (H : length lb ≤ length la) by flia Hlen.
  clear Hlen; rename H into Hlen.
  induction lb as [| b]; [ easy | ].
  cbn in Hll.
  destruct (rng_eq_dec b 0%Rng) as [Hbz| Hbz]. {
    cbn in Hlen.
    clear b Hbz.
    apply IHlb; [ easy | flia Hlen ].
  }
  rewrite <- Hll in Hlen; cbn in Hlen.
  flia Hlen.
}
easy.
Qed.

Theorem lap_convol_mul_length : ∀ la lb i len,
  length (lap_convol_mul la lb i len) = len.
Proof.
intros.
revert la lb i.
induction len; intros; [ easy | ].
cbn.
now rewrite IHlen.
Qed.

Theorem lap_mul_assoc : ∀ la lb lc,
  (la * (lb * lc))%lap = ((la * lb) * lc)%lap.
Proof.
intros.
apply eq_lap_norm_eq_length; [ apply lap_norm_mul_assoc | ].
unfold "*"%lap.
destruct la as [| a]; [ easy | ].
destruct lb as [| b]; [ easy | ].
destruct lc as [| c]. {
  now destruct (lap_convol_mul _ _ _ _).
}
cbn.
do 4 (rewrite Nat.add_succ_r; cbn); f_equal.
do 2 rewrite rng_add_0_r.
do 4 rewrite lap_convol_mul_length.
apply Nat.add_assoc.
Qed.

Theorem lap_convol_mul_0_l : ∀ la lb i len,
  (∀ i, nth i la 0%Rng = 0%Rng)
  → lap_norm (lap_convol_mul la lb i len) = [].
Proof.
intros * Ha.
revert i.
induction len; intros; [ easy | ].
cbn - [ summation ].
rewrite strip_0s_app.
remember (strip_0s (rev _)) as lc eqn:Hlc; symmetry in Hlc.
destruct lc as [| c]. {
  rewrite all_0_summation_0. 2: {
    intros j Hj.
    now rewrite Ha, rng_mul_0_l.
  }
  cbn.
  now destruct (rng_eq_dec 0%Rng 0%Rng).
}
unfold lap_norm in IHlen.
specialize (IHlen (S i)).
rewrite Hlc in IHlen.
now apply List_eq_rev_nil in IHlen.
Qed.

Theorem all_0_all_rev_0 : ∀ la,
  (∀ i, nth i la 0%Rng = 0%Rng)
  ↔ (∀ i, nth i (rev la) 0%Rng = 0%Rng).
Proof.
intros *.
split; intros H i. {
  destruct (lt_dec i (length la)) as [Hila| Hila]. {
    rewrite rev_nth; [ apply H | easy ].
  }
  apply nth_overflow; rewrite rev_length; flia Hila.
} {
  destruct (lt_dec i (length la)) as [Hila| Hila]. {
    rewrite <- (rev_involutive la).
    rewrite rev_nth; [ apply H | now rewrite rev_length ].
  }
  apply nth_overflow; flia Hila.
}
Qed.

Theorem eq_strip_0s_nil : ∀ la,
  strip_0s la = [] ↔ ∀ i, nth i la 0%Rng = 0%Rng.
Proof.
intros.
split. {
  intros Hla *.
  revert i.
  induction la as [| a]; intros; [ now destruct i | cbn ].
  cbn in Hla.
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]; [ | easy ].
  destruct i; [ easy | ].
  now apply IHla.
} {
  intros Hla.
  induction la as [| a]; [ easy | cbn ].
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
    apply IHla.
    intros i.
    now specialize (Hla (S i)).
  }
  now specialize (Hla 0).
}
Qed.

Theorem eq_strip_0s_rev_nil : ∀ la,
  strip_0s (rev la) = [] ↔ ∀ i, nth i la 0%Rng = 0%Rng.
Proof.
intros.
split; intros Hla. {
  apply all_0_all_rev_0.
  now apply eq_strip_0s_nil.
} {
  apply eq_strip_0s_nil.
  apply all_0_all_rev_0.
  now rewrite rev_involutive.
}
Qed.

Lemma lap_convol_mul_cons_with_0_l : ∀ a la lb i len,
  (∀ i, nth i la 0%Rng = 0%Rng)
  → lap_convol_mul (a :: la) lb i len = lap_convol_mul [a] lb i len.
Proof.
intros * Hla.
revert i.
induction len; intros; [ easy | ].
cbn - [ summation ].
f_equal; [ | apply IHlen ].
apply summation_compat.
intros j Hj.
destruct j; [ easy | ].
rewrite match_id.
now rewrite Hla.
Qed.

Theorem lap_convol_mul_succ : ∀ la lb i len,
  lap_convol_mul la lb i (S len) =
  lap_convol_mul la lb i len ++
    [Σ (j = 0, i + len),
     List.nth j la 0 * List.nth (i + len - j) lb 0]%Rng.
Proof.
intros.
cbn - [ summation ].
revert i.
induction len; intros. {
  now rewrite Nat.add_0_r.
}
cbn - [ summation ].
f_equal.
specialize (IHlen (S i)).
cbn - [ summation ] in IHlen.
rewrite Nat.add_succ_r.
apply IHlen.
Qed.

Theorem lap_norm_app_0_r : ∀ la lb,
  (∀ i, nth i lb 0%Rng = 0%Rng)
  → lap_norm la = lap_norm (la ++ lb).
Proof.
intros * Hlb.
unfold lap_norm; f_equal.
induction la as [| a]. {
  cbn; symmetry.
  induction lb as [| b]; [ easy | cbn ].
  rewrite strip_0s_app.
  rewrite IHlb. 2: {
    intros i.
    now specialize (Hlb (S i)).
  }
  specialize (Hlb 0); cbn in Hlb; rewrite Hlb; cbn.
  now destruct (rng_eq_dec 0%Rng 0%Rng).
}
cbn.
do 2 rewrite strip_0s_app.
now rewrite IHla.
Qed.

Theorem lap_convol_mul_more : ∀ n la lb i len,
  length la + length lb - 1 ≤ i + len
  → lap_norm (lap_convol_mul la lb i len) =
    lap_norm (lap_convol_mul la lb i (len + n)).
Proof.
intros.
induction n; [ rewrite Nat.add_0_r; reflexivity | idtac ].
rewrite Nat.add_succ_r.
rewrite lap_convol_mul_succ.
rewrite IHn.
apply lap_norm_app_0_r.
intros j.
rewrite all_0_summation_0. {
  destruct j; [ easy | now destruct j ].
}
clear j.
intros j (_, Hj).
apply rng_mul_eq_0.
destruct (le_dec (length la) j) as [H1| H1]. {
  now left; rewrite List.nth_overflow.
} {
  apply Nat.nle_gt in H1.
  destruct (le_dec (length lb) (i + (len + n) - j)) as [H2| H2]. {
    now right; rewrite nth_overflow.
  } {
    exfalso; apply H2; clear H2.
    flia H H1.
  }
}
Qed.

Theorem all_0_lap_norm_nil : ∀ la,
  (∀ i, nth i la 0%Rng = 0%Rng)
  → lap_norm la = [].
Proof.
intros * Hla.
induction la as [| a]; [ easy | cbn ].
rewrite strip_0s_app.
remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
destruct lb as [| b]. {
  cbn.
  destruct (rng_eq_dec a 0%Rng) as [H1| H1]; [ easy | exfalso ].
  now specialize (Hla 0); cbn in Hla.
}
exfalso.
assert (H : strip_0s (rev la) = []). {
  clear - Hla.
  apply eq_strip_0s_nil.
  intros i.
  destruct (lt_dec i (length la)) as [Hila| Hila]. {
    rewrite rev_nth; [ | easy ].
    specialize (Hla (S (length la - S i))).
    now cbn in Hla.
  }
  apply Nat.nlt_ge in Hila.
  rewrite nth_overflow; [ easy | now rewrite rev_length ].
}
now rewrite Hlb in H.
Qed.

Theorem lap_norm_repeat_0 : ∀ la,
  la = lap_norm la ++ repeat 0%Rng (length la - length (lap_norm la)).
Proof.
intros.
induction la as [| a]; [ easy | ].
cbn.
rewrite strip_0s_app.
remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
destruct lb as [| b]. {
  cbn.
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
    cbn; subst a; f_equal.
    assert (H : lap_norm la = []). {
      apply all_0_lap_norm_nil.
      intros i.
      specialize (proj1 (eq_strip_0s_nil _) Hlb) as H1.
      destruct (lt_dec i (length la)) as [Hila| Hila]. {
        replace la with (rev (rev la)) by apply rev_involutive.
        rewrite rev_nth; rewrite rev_length; [ | easy ].
        apply H1.
      }
      apply Nat.nlt_ge in Hila.
      now rewrite nth_overflow.
    }
    rewrite H in IHla; cbn in IHla.
    now rewrite Nat.sub_0_r in IHla.
  } {
    cbn; f_equal.
    assert (H : lap_norm la = []). {
      apply all_0_lap_norm_nil.
      intros i.
      specialize (proj1 (eq_strip_0s_nil _) Hlb) as H1.
      destruct (lt_dec i (length la)) as [Hila| Hila]. {
        replace la with (rev (rev la)) by apply rev_involutive.
        rewrite rev_nth; rewrite rev_length; [ | easy ].
        apply H1.
      }
      apply Nat.nlt_ge in Hila.
      now rewrite nth_overflow.
    }
    now rewrite H in IHla; cbn in IHla.
  }
} {
  cbn.
  rewrite rev_app_distr; cbn; f_equal.
  replace (rev lb ++ [b]) with (rev (b :: lb)) by easy.
  rewrite <- Hlb.
  now rewrite fold_lap_norm.
}
Qed.

Theorem lap_convol_mul_app_rep_0_l : ∀ la lb i len n,
  lap_norm (lap_convol_mul (la ++ repeat 0%Rng n) lb i len) =
  lap_norm (lap_convol_mul la lb i len).
Proof.
intros.
revert la i len.
induction n; intros. {
  now cbn; rewrite app_nil_r.
}
cbn.
replace (0%Rng :: repeat 0%Rng n) with ([0%Rng] ++ repeat 0%Rng n) by easy.
rewrite app_assoc.
rewrite IHn; clear n IHn.
revert la i.
induction len; intros; [ easy | ].
cbn - [ summation ].
do 2 rewrite strip_0s_app.
rewrite <- (rev_involutive (strip_0s _)).
rewrite fold_lap_norm.
rewrite <- (rev_involutive (strip_0s (rev _))).
rewrite fold_lap_norm.
rewrite IHlen.
remember (rev (lap_norm _)) as lc eqn:Hlc; symmetry in Hlc.
f_equal.
destruct lc as [| c]. {
  apply List_eq_rev_nil in Hlc.
  f_equal; f_equal.
  apply summation_compat.
  intros j Hj.
  f_equal; clear.
  destruct (lt_dec j (length la)) as [Hjla| Hjla]. {
    now rewrite app_nth1.
  }
  apply Nat.nlt_ge in Hjla.
  rewrite (nth_overflow la); [ | easy ].
  rewrite app_nth2; [ | easy ].
  destruct (Nat.eq_dec j (length la)) as [Hjla2| Hjla2]. {
    now rewrite Hjla2, Nat.sub_diag.
  }
  rewrite nth_overflow; [ easy | cbn; flia Hjla Hjla2 ].
} {
  f_equal; f_equal.
  apply summation_compat.
  intros j Hj.
  f_equal; clear.
  destruct (lt_dec j (length la)) as [Hjla| Hjla]. {
    now rewrite app_nth1.
  }
  apply Nat.nlt_ge in Hjla.
  rewrite (nth_overflow la); [ | easy ].
  rewrite app_nth2; [ | easy ].
  destruct (Nat.eq_dec j (length la)) as [Hjla2| Hjla2]. {
    now rewrite Hjla2, Nat.sub_diag.
  }
  rewrite nth_overflow; [ easy | cbn; flia Hjla Hjla2 ].
}
Qed.

Theorem lap_norm_cons_norm : ∀ a la lb i len,
  length (a :: la) + length lb - 1 ≤ i + len
  → lap_norm (lap_convol_mul (a :: lap_norm la) lb i len) =
    lap_norm (lap_convol_mul (a :: la) lb i len).
Proof.
intros * Hlen.
rewrite (lap_norm_repeat_0 la) at 2.
rewrite app_comm_cons.
now rewrite lap_convol_mul_app_rep_0_l.
Qed.

Theorem lap_norm_length_le : ∀ la, length (lap_norm la) ≤ length la.
Proof.
intros.
rewrite (lap_norm_repeat_0 la) at 2.
rewrite app_length; flia.
Qed.

Theorem nth_lap_add : ∀ i la lb,
  nth i (la + lb)%lap 0%Rng = (nth i la 0 + nth i lb 0)%Rng.
Proof.
intros.
revert i lb.
induction la as [| a]; intros; cbn. {
  now rewrite match_id, rng_add_0_l.
}
destruct lb as [| b]; cbn. {
  now rewrite match_id, rng_add_0_r.
}
destruct i; [ easy | ].
apply IHla.
Qed.

Theorem lap_mul_norm_idemp_l : ∀ la lb,
  lap_norm (lap_norm la * lb)%lap = lap_norm (la * lb)%lap.
Proof.
intros.
unfold "*"%lap; cbn.
destruct la as [| a]; [ easy | cbn ].
rewrite strip_0s_app.
remember (strip_0s (rev la)) as lc eqn:Hlc; symmetry in Hlc.
destruct lc as [| c]. {
  cbn.
  destruct (rng_eq_dec a 0%Rng) as [Haz| Haz]. {
    cbn.
    destruct lb as [| b]; [ easy | cbn ].
    rewrite lap_convol_mul_0_l; [ easy | ].
    intros i; cbn.
    destruct i; [ easy | ].
    specialize (proj1 (eq_strip_0s_nil _) Hlc) as H1.
    destruct (lt_dec i (length la)) as [Hil| Hil]. {
      specialize (H1 (length la - S i)).
      rewrite <- rev_length in H1.
      rewrite <- rev_nth in H1. {
        now rewrite rev_involutive in H1.
      }
      now rewrite rev_length.
    }
    apply Nat.nlt_ge in Hil.
    now rewrite nth_overflow.
  }
  cbn.
  destruct lb as [| b]; [ easy | ].
  remember (b :: lb) as ld eqn:Hld; symmetry in Hld.
  do 2 rewrite Nat.sub_0_r.
  rewrite fold_lap_norm.
  rewrite (lap_convol_mul_cons_with_0_l _ la). 2: {
    intros i.
    specialize (proj1 (eq_strip_0s_nil _) Hlc) as H1.
    destruct (lt_dec i (length la)) as [Hil| Hil]. {
      specialize (H1 (length la - S i)).
      rewrite <- rev_length in H1.
      rewrite <- rev_nth in H1. {
        now rewrite rev_involutive in H1.
      }
      now rewrite rev_length.
    }
    apply Nat.nlt_ge in Hil.
    now rewrite nth_overflow.
  }
  rewrite Nat.add_comm.
  apply lap_convol_mul_more; cbn.
  now rewrite Nat.sub_0_r.
}
rewrite rev_app_distr; cbn.
rewrite fold_lap_norm.
destruct lb as [| b]; [ easy | ].
remember (b :: lb) as d eqn:Hd.
replace (rev lc ++ [c]) with (rev (c :: lc)) by easy.
rewrite <- Hlc.
rewrite fold_lap_norm.
do 2 rewrite Nat.sub_0_r.
clear c lc b lb Hlc Hd.
rename d into lb.
rewrite (lap_convol_mul_more (length la - length (lap_norm la))). 2: {
  now cbn; rewrite Nat.sub_0_r.
}
rewrite (Nat.add_comm _ (length lb)).
rewrite <- Nat.add_assoc.
rewrite Nat.add_sub_assoc; [ | apply lap_norm_length_le ].
rewrite (Nat.add_comm _ (length la)).
rewrite Nat.add_sub.
rewrite Nat.add_comm.
apply lap_norm_cons_norm.
now cbn; rewrite Nat.sub_0_r.
Qed.

Theorem lap_mul_norm_idemp_r : ∀ la lb,
  lap_norm (la * lap_norm lb)%lap = lap_norm (la * lb)%lap.
Proof.
intros.
setoid_rewrite lap_mul_comm.
apply lap_mul_norm_idemp_l.
Qed.

Theorem poly_mul_assoc : ∀ p1 p2 p3,
  (p1 * (p2 * p3))%pol = ((p1 * p2) * p3) %pol.
Proof.
intros.
unfold "*"%pol.
remember (lap p1) as la.
remember (lap p2) as lb.
remember (lap p3) as lc.
clear p1 Heqla.
clear p2 Heqlb.
clear p3 Heqlc.
unfold poly_norm at 1 3.
apply eq_poly_eq; cbn.
rewrite lap_mul_norm_idemp_l.
rewrite lap_mul_norm_idemp_r.
now rewrite lap_mul_assoc.
Qed.

Theorem lap_mul_mul_swap : ∀ la lb lc,
  lap_mul (lap_mul la lb) lc = lap_mul (lap_mul la lc) lb.
Proof.
intros la lb lc.
do 2 rewrite <- lap_mul_assoc.
now rewrite (lap_mul_comm lb).
Qed.

Fixpoint lap_convol_mul_add al1 al2 al3 i len :=
  match len with
  | O => []
  | S len1 =>
      (Σ (j = 0, i),
       List.nth j al1 0 *
       (List.nth (i - j) al2 0 + List.nth (i - j) al3 0))%Rng ::
       lap_convol_mul_add al1 al2 al3 (S i) len1
  end.

(* *)

Theorem list_nth_add : ∀ k la lb,
  (List.nth k (lap_add la lb) 0 =
   List.nth k la 0 + List.nth k lb 0)%Rng.
Proof.
intros k la lb.
revert la lb.
induction k; intros.
 destruct la as [| a]; simpl; [ rewrite rng_add_0_l; reflexivity | idtac ].
 destruct lb as [| b]; simpl; [ rewrite rng_add_0_r; reflexivity | idtac ].
 reflexivity.

 destruct la as [| a]; simpl; [ rewrite rng_add_0_l; reflexivity | idtac ].
 destruct lb as [| b]; simpl; [ rewrite rng_add_0_r; reflexivity | idtac ].
 apply IHk.
Qed.

Theorem lap_convol_mul_lap_add : ∀ la lb lc i len,
  eq
    (lap_convol_mul la (lap_add lb lc) i len)
    (lap_convol_mul_add la lb lc i len).
Proof.
intros la lb lc i len.
revert la lb lc i.
induction len; intros; [ reflexivity | simpl ].
rewrite IHlen; f_equal.
apply summation_compat; intros j (_, Hj).
f_equal.
rewrite list_nth_add; reflexivity.
Qed.

Theorem lap_add_lap_convol_mul : ∀ la lb lc i len,
  eq
     (lap_add
        (lap_convol_mul la lb i len)
        (lap_convol_mul la lc i len))
     (lap_convol_mul_add la lb lc i len).
Proof.
intros la lb lc i len.
revert la lb lc i.
induction len; intros; [ reflexivity | simpl ].
rewrite IHlen; f_equal.
rewrite <- summation_add_distr.
apply summation_compat; intros j (_, Hj).
rewrite rng_mul_add_distr_l; reflexivity.
Qed.

Lemma lap_norm_mul_add_distr_l : ∀ la lb lc,
  lap_norm (la * (lb + lc))%lap = lap_norm (la * lb + la * lc)%lap.
Proof.
intros la lb lc.
unfold lap_mul.
destruct la as [| a]; [ easy | ].
destruct lb as [| b]; [ easy | ].
destruct lc as [| c]; [ now cbn; rewrite lap_add_0_r | ].
move b before a; move c before b.
remember (a :: la) as la' eqn:Hla'.
remember (b :: lb) as lb' eqn:Hlb'.
remember (c :: lc) as lc' eqn:Hlc'.
remember (length la' + length (lap_add lb' lc') - 1) as labc.
remember (length la' + length lb' - 1) as lab.
remember (length la' + length lc' - 1) as lac.
rewrite Heqlabc.
remember (lb' + lc')%lap as lbc.
symmetry in Heqlbc.
destruct lbc as [| bc]. {
  cbn.
  now subst lb' lc'.
}
rewrite <- Heqlbc in Heqlabc |-*.
rewrite lap_convol_mul_more with (n := (lab + lac)%nat). 2: {
  subst; flia.
}
rewrite <- Heqlabc.
symmetry.
rewrite Heqlab.
rewrite <- lap_add_norm_idemp_l.
rewrite lap_convol_mul_more with (n := (labc + lac)%nat); [ | flia ].
rewrite <- Heqlab.
rewrite lap_add_norm_idemp_l.
rewrite lap_add_comm.
rewrite <- lap_add_norm_idemp_l.
rewrite Heqlac.
rewrite lap_convol_mul_more with (n := (labc + lab)%nat); [ | flia ].
rewrite lap_add_norm_idemp_l.
rewrite <- Heqlac.
rewrite Nat.add_comm.
rewrite lap_add_comm.
rewrite Nat.add_assoc, Nat.add_shuffle0, Nat.add_comm, Nat.add_assoc.
symmetry.
rewrite lap_convol_mul_lap_add.
rewrite lap_add_lap_convol_mul.
reflexivity.
Qed.

Theorem lap_add_length : ∀ la lb,
  length (la + lb)%lap = max (length la) (length lb).
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ easy | ].
cbn.
destruct lb as [| b]; [ easy | cbn ].
now rewrite IHla.
Qed.

Lemma lap_mul_add_distr_l : ∀ la lb lc,
  (la * (lb + lc))%lap = (la * lb + la * lc)%lap.
Proof.
intros la lb lc.
apply eq_lap_norm_eq_length; [ apply lap_norm_mul_add_distr_l | ].
destruct la as [| a]; [ easy | ].
destruct lb as [| b]; [ easy | ].
destruct lc as [| c]. {
  now cbn; rewrite lap_add_0_r.
}
cbn.
do 3 (rewrite Nat.add_succ_r; cbn); f_equal.
rewrite lap_convol_mul_length.
do 2 rewrite lap_add_length; cbn.
do 2 rewrite lap_convol_mul_length.
now rewrite Nat.add_max_distr_l.
Qed.

Theorem poly_mul_add_distr_l : ∀ pa pb pc,
  (pa * (pb + pc))%pol = (pa * pb + pa * pc)%pol.
Proof.
intros.
apply eq_poly_eq; cbn.
rewrite fold_lap_norm.
rewrite lap_mul_norm_idemp_r.
rewrite lap_add_norm_idemp_l.
rewrite lap_add_norm_idemp_r.
now rewrite lap_mul_add_distr_l.
Qed.

Lemma lap_convol_mul_1_l : ∀ la i len,
  length la = i + len
  → lap_convol_mul [1%Rng] la i len = skipn i la.
Proof.
intros * Hlen.
revert i Hlen.
induction len; intros. {
  rewrite Nat.add_0_r in Hlen; rewrite <- Hlen.
  symmetry; apply skipn_all.
}
cbn - [ summation nth ].
rewrite summation_split_first; [ | flia ].
rewrite all_0_summation_0. 2: {
  intros j Hj.
  destruct j; [ flia Hj | cbn ].
  now rewrite match_id, rng_mul_0_l.
}
rewrite Nat.sub_0_r, rng_add_0_r; cbn.
rewrite rng_mul_1_l.
rewrite IHlen; [ | flia Hlen ].
clear - Hlen.
revert i Hlen.
induction la as [ | a]; intros. {
  cbn in Hlen; flia Hlen.
}
cbn.
destruct i; [ easy | ].
rewrite IHla; [ easy | ].
cbn in Hlen; flia Hlen.
Qed.

Theorem lap_mul_1_l : ∀ la, ([1%Rng] * la)%lap = la.
Proof.
intros la.
unfold lap_mul.
destruct la as [| a]; [ easy | cbn ].
rewrite rng_mul_1_l, rng_add_0_r; f_equal.
now rewrite lap_convol_mul_1_l.
Qed.

Theorem lap_mul_1_r : ∀ la, (la * [1%Rng])%lap = la.
Proof.
intros la.
rewrite lap_mul_comm.
apply lap_mul_1_l.
Qed.

Theorem poly_mul_1_l : ∀ p, (1 * p)%pol = p.
Proof.
intros (la, lapr).
unfold "*"%pol.
rewrite lap_mul_1_l; cbn.
apply eq_poly_eq; cbn.
unfold rng_eqb in lapr.
unfold lap_norm.
destruct (rng_eq_dec (last la 1%Rng) 0) as [Hlaz| Hlaz]; [ easy | ].
clear lapr.
induction la as [| a]; [ easy | cbn ].
rewrite strip_0s_app.
remember (strip_0s (rev la)) as lb eqn:Hlb; symmetry in Hlb.
destruct lb as [| b]. {
  specialize (proj1 (eq_strip_0s_rev_nil _) Hlb) as H1.
  cbn; clear Hlb.
  destruct (rng_eq_dec a 0) as [Haz| Haz]. {
    exfalso; subst a.
    cbn in IHla.
    destruct la as [| a]; [ easy | ].
    remember (a :: la) as lb; cbn in Hlaz; subst lb.
    now specialize (IHla Hlaz).
  }
  cbn in IHla |-*.
  rewrite <- IHla; [ easy | ].
  cbn in Hlaz.
  destruct la as [| a2]; [ | easy ].
  intros; apply rng_1_neq_0.
}
cbn.
rewrite rev_app_distr; cbn; f_equal.
apply IHla.
cbn in Hlaz.
now destruct la.
Qed.

End lap.

Lemma lap_add_opp_l {α} {ro : ring_op α} {rp : ring_prop} : ∀ la, lap_norm (- la + la)%lap = [].
Proof.
intros.
unfold lap_norm.
apply List_eq_rev_nil.
rewrite rev_involutive.
induction la as [| a]; [ reflexivity | cbn ].
rewrite strip_0s_app.
remember (strip_0s _) as lb eqn:Hlb; symmetry in Hlb.
subst lb.
rewrite IHla; cbn.
rewrite rng_add_opp_l.
now destruct (rng_eq_dec 0 0).
Qed.

Theorem poly_add_opp_l {α} {ro : ring_op α} {rp : ring_prop} : ∀ p, (- p + p)%pol = 0%pol.
Proof.
intros p.
unfold "+"%pol; cbn.
apply eq_poly_eq; cbn.
rewrite lap_add_norm_idemp_l.
apply lap_add_opp_l.
Qed.

Theorem poly_add_opp_r {α} {ro : ring_op α} {rp : ring_prop} : ∀ p, (p - p)%pol = 0%pol.
Proof.
intros p.
unfold poly_sub.
rewrite poly_add_comm.
apply poly_add_opp_l.
Qed.

Theorem poly_1_neq_0 {A} {ro : ring_op A} {rp : ring_prop} : 1%pol ≠ 0%pol.
Proof. easy. Qed.

Fixpoint lap_eqb {A} {ro : ring_op A} {rp : ring_prop} la lb :=
  match la with
  | [] =>
      match lb with
      | [] => true
      | _ :: _ => false
      end
  | a :: la' =>
      match lb with
      | [] => false
      | b :: lb' => if rng_eq_dec a b then lap_eqb la' lb' else false
      end
  end.

Theorem lap_eqb_eq {A} {ro : ring_op A} {rp : ring_prop} : ∀ la lb,
  lap_eqb la lb = true ↔ la = lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ now destruct lb | ].
destruct lb as [| b]; [ easy | cbn ].
destruct (rng_eq_dec a b) as [Hab| Hab]. {
  subst b.
  split; intros Hll; [ now f_equal; apply IHla | ].
  injection Hll; clear Hll; intros; subst lb.
  now apply IHla.
} {
  split; intros Hll; [ easy | ].
  now injection Hll; intros.
}
Qed.

Theorem lap_eqb_neq {A} {ro : ring_op A} {rp : ring_prop} : ∀ la lb,
  lap_eqb la lb = false ↔ la ≠ lb.
Proof.
intros.
revert lb.
induction la as [| a]; intros; [ now destruct lb | ].
destruct lb as [| b]; [ easy | cbn ].
destruct (rng_eq_dec a b) as [Hab| Hab]. {
  subst b.
  split; intros Hll. {
    intros H.
    injection H; clear H; intros; subst lb.
    now apply IHla in Hll.
  } {
    apply IHla.
    intros H; apply Hll.
    now subst lb.
  }
} {
  split; intros Hll; [ | easy ].
  intros H; apply Hab.
  now injection H; intros.
}
Qed.

Lemma lap_eq_dec {A} {ro : ring_op A} {rp : ring_prop} : ∀ la lb : list A,
  {la = lb} + {la ≠ lb}.
Proof.
intros.
remember (lap_eqb la lb) as lab eqn:Hlab; symmetry in Hlab.
destruct lab. {
  now left; apply lap_eqb_eq.
} {
  now right; apply lap_eqb_neq.
}
Qed.

Theorem poly_eq_dec {A} {ro : ring_op A} {rp : ring_prop} : ∀ pa pb : poly _,
  {pa = pb} + {pa ≠ pb}.
Proof.
intros (la, lapr) (lb, lbpr).
destruct (lap_eq_dec la lb) as [Hll| Hll]. {
  left; subst lb.
  now apply eq_poly_eq.
} {
  right; intros H; apply Hll.
  now injection H.
}
Qed.

Definition polynomial_ring_op {α} {ro : ring_op α} {rp : ring_prop} :
  ring_op (poly α) :=
  {| rng_zero := poly_zero;
     rng_one := poly_one;
     rng_add := poly_add;
     rng_mul := poly_mul;
     rng_opp := poly_opp |}.

Definition polynomial_ring_prop {α} {ro : ring_op α} {rp : ring_prop} :=
  let _ := polynomial_ring_op in
  {| rng_1_neq_0 := poly_1_neq_0;
     rng_eq_dec := poly_eq_dec;
     rng_add_comm := poly_add_comm;
     rng_add_assoc := poly_add_assoc;
     rng_add_0_l := poly_add_0_l;
     rng_add_opp_l := poly_add_opp_l;
     rng_mul_comm := poly_mul_comm;
     rng_mul_assoc := poly_mul_assoc;
     rng_mul_1_l := poly_mul_1_l;
     rng_mul_add_distr_l := poly_mul_add_distr_l |}.

(* allows to use ring theorems on polynomials *)
Canonical Structure polynomial_ring_prop.

(* *)

Definition eval_lap {α} {ro : ring_op α} {rp : ring_prop} la x :=
  (List.fold_right (λ c accu, accu * x + c) 0 la)%Rng.

Definition eval_poly {α} {ro : ring_op α} {rp : ring_prop} pol :=
  eval_lap (lap pol).


From Hammer Require Import Hammer.

Require Import ZArith_base.
Require Import ZArithRing.
Require Import Zcomplements.
Require Import Zdiv.
Require Import Wf_nat.

Open Scope Z_scope.

Notation Zgcd := Z.gcd (compat "8.3").
Notation Zggcd := Z.ggcd (compat "8.3").
Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.3").
Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.3").
Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.3").
Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.3").
Notation Zgcd_greatest := Z.gcd_greatest (compat "8.3").
Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.3").
Notation Zggcd_opp := Z.ggcd_opp (compat "8.3").

Notation Zdivide := Z.divide (compat "8.3").

Definition Zdivide_intro a b q (H:b=q*a) : Z.divide a b := ex_intro _ q H.

Notation Zdivide_refl := Z.divide_refl (compat "8.3").
Notation Zone_divide := Z.divide_1_l (compat "8.3").
Notation Zdivide_0 := Z.divide_0_r (compat "8.3").
Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (compat "8.3").
Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (compat "8.3").
Notation Zdivide_plus_r := Z.divide_add_r (compat "8.3").
Notation Zdivide_minus_l := Z.divide_sub_r (compat "8.3").
Notation Zdivide_mult_l := Z.divide_mul_l (compat "8.3").
Notation Zdivide_mult_r := Z.divide_mul_r (compat "8.3").
Notation Zdivide_factor_r := Z.divide_factor_l (compat "8.3").
Notation Zdivide_factor_l := Z.divide_factor_r (compat "8.3").

Lemma Zdivide_opp_r a b : (a | b) -> (a | - b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_opp_r".   apply Z.divide_opp_r. Qed.

Lemma Zdivide_opp_r_rev a b : (a | - b) -> (a | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_opp_r_rev".   apply Z.divide_opp_r. Qed.

Lemma Zdivide_opp_l a b : (a | b) -> (- a | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_opp_l".   apply Z.divide_opp_l. Qed.

Lemma Zdivide_opp_l_rev a b : (- a | b) -> (a | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_opp_l_rev".   apply Z.divide_opp_l. Qed.

Theorem Zdivide_Zabs_l a b : (Z.abs a | b) -> (a | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zabs_l".   apply Z.divide_abs_l. Qed.

Theorem Zdivide_Zabs_inv_l a b : (a | b) -> (Z.abs a | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zabs_inv_l".   apply Z.divide_abs_l. Qed.

Hint Resolve Z.divide_refl Z.divide_1_l Z.divide_0_r: zarith.
Hint Resolve Z.mul_divide_mono_l Z.mul_divide_mono_r: zarith.
Hint Resolve Z.divide_add_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
Zdivide_opp_l_rev Z.divide_sub_r Z.divide_mul_l Z.divide_mul_r
Z.divide_factor_l Z.divide_factor_r: zarith.

Lemma Zmult_one x y : x >= 0 -> x * y = 1 -> x = 1.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zmult_one".
Z.swap_greater. apply Z.eq_mul_1_nonneg.
Qed.

Notation Zdivide_1 := Z.divide_1_r (compat "8.3").

Notation Zdivide_antisym := Z.divide_antisym (compat "8.3").
Notation Zdivide_trans := Z.divide_trans (compat "8.3").

Lemma Zdivide_bounds a b : (a | b) -> b <> 0 -> Z.abs a <= Z.abs b.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_bounds".
intros H Hb.
rewrite <- Z.divide_abs_l, <- Z.divide_abs_r in H.
apply Z.abs_pos in Hb.
now apply Z.divide_pos_le.
Qed.

Lemma Zmod_divide : forall a b, b<>0 -> a mod b = 0 -> (b | a).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zmod_divide".
apply Z.mod_divide.
Qed.

Lemma Zdivide_mod : forall a b, (b | a) -> a mod b = 0.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_mod".
intros a b (c,->); apply Z_mod_mult.
Qed.

Lemma Zdivide_dec a b : {(a | b)} + {~ (a | b)}.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_dec".
destruct (Z.eq_dec a 0) as [Ha|Ha].
destruct (Z.eq_dec b 0) as [Hb|Hb].
left; subst; apply Z.divide_0_r.
right. subst. contradict Hb. now apply Z.divide_0_l.
destruct (Z.eq_dec (b mod a) 0).
left. now apply Z.mod_divide.
right. now rewrite <- Z.mod_divide.
Defined.

Theorem Zdivide_Zdiv_eq a b : 0 < a -> (a | b) ->  b = a * (b / a).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zdiv_eq".
intros Ha H.
rewrite (Z.div_mod b a) at 1; auto with zarith.
rewrite Zdivide_mod; auto with zarith.
Qed.

Theorem Zdivide_Zdiv_eq_2 a b c :
0 < a -> (a | b) -> (c * b) / a = c * (b / a).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zdiv_eq_2".
intros. apply Z.divide_div_mul_exact; auto with zarith.
Qed.

Theorem Zdivide_le: forall a b : Z,
0 <= a -> 0 < b -> (a | b) ->  a <= b.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_le".
intros. now apply Z.divide_pos_le.
Qed.

Theorem Zdivide_Zdiv_lt_pos a b :
1 < a -> 0 < b -> (a | b) ->  0 < b / a < b .
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zdiv_lt_pos".
intros H1 H2 H3; split.
apply Z.mul_pos_cancel_l with a; auto with zarith.
rewrite <- Zdivide_Zdiv_eq; auto with zarith.
now apply Z.div_lt.
Qed.

Lemma Zmod_div_mod n m a:
0 < n -> 0 < m -> (n | m) -> a mod n = (a mod m) mod n.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zmod_div_mod".
intros H1 H2 (p,Hp).
rewrite (Z.div_mod a m) at 1; auto with zarith.
rewrite Hp at 1.
rewrite Z.mul_shuffle0, Z.add_comm, Z.mod_add; auto with zarith.
Qed.

Lemma Zmod_divide_minus a b c:
0 < b -> a mod b = c -> (b | a - c).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zmod_divide_minus".
intros H H1. apply Z.mod_divide; auto with zarith.
rewrite Zminus_mod; auto with zarith.
rewrite H1. rewrite <- (Z.mod_small c b) at 1.
rewrite Z.sub_diag, Z.mod_0_l; auto with zarith.
subst. now apply Z.mod_pos_bound.
Qed.

Lemma Zdivide_mod_minus a b c:
0 <= c < b -> (b | a - c) -> a mod b = c.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_mod_minus".
intros (H1, H2) H3.
assert (0 < b) by Z.order.
replace a with ((a - c) + c); auto with zarith.
rewrite Z.add_mod; auto with zarith.
rewrite (Zdivide_mod (a-c) b); try rewrite Z.add_0_l; auto with zarith.
rewrite Z.mod_mod; try apply Zmod_small; auto with zarith.
Qed.

Inductive Zis_gcd (a b g:Z) : Prop :=
Zis_gcd_intro :
(g | a) ->
(g | b) ->
(forall x, (x | a) -> (x | b) -> (x | g)) ->
Zis_gcd a b g.

Lemma Zis_gcd_sym : forall a b d, Zis_gcd a b d -> Zis_gcd b a d.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_sym".
induction 1; constructor; intuition.
Qed.

Lemma Zis_gcd_0 : forall a, Zis_gcd a 0 a.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_0".
constructor; auto with zarith.
Qed.

Lemma Zis_gcd_1 : forall a, Zis_gcd a 1 1.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_1".
constructor; auto with zarith.
Qed.

Lemma Zis_gcd_refl : forall a, Zis_gcd a a a.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_refl".
constructor; auto with zarith.
Qed.

Lemma Zis_gcd_minus : forall a b d, Zis_gcd a (- b) d -> Zis_gcd b a d.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_minus".
induction 1; constructor; intuition.
Qed.

Lemma Zis_gcd_opp : forall a b d, Zis_gcd a b d -> Zis_gcd b a (- d).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_opp".
induction 1; constructor; intuition.
Qed.

Lemma Zis_gcd_0_abs a : Zis_gcd 0 a (Z.abs a).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_0_abs".
apply Zabs_ind.
intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto.
intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto.
Qed.

Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith.

Theorem Zis_gcd_unique: forall a b c d : Z,
Zis_gcd a b c -> Zis_gcd a b d ->  c = d \/ c = (- d).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_unique".
intros a b c d [Hc1 Hc2 Hc3] [Hd1 Hd2 Hd3].
assert (c|d) by auto.
assert (d|c) by auto.
apply Z.divide_antisym; auto.
Qed.

Lemma Zis_gcd_for_euclid :
forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_for_euclid".
simple induction 1; constructor; intuition.
replace a with (a - q * b + q * b). auto with zarith. ring.
Qed.

Lemma Zis_gcd_for_euclid2 :
forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_for_euclid2".
simple induction 1; constructor; intuition.
apply H2; auto.
replace r with (b * q + r - b * q). auto with zarith. ring.
Qed.

Section extended_euclid_algorithm.

Variables a b : Z.

Inductive Euclid : Set :=
Euclid_intro :
forall u v d:Z, u * a + v * b = d -> Zis_gcd a b d -> Euclid.

Lemma euclid_rec :
forall v3:Z,
0 <= v3 ->
forall u1 u2 u3 v1 v2:Z,
u1 * a + u2 * b = u3 ->
v1 * a + v2 * b = v3 ->
(forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
Proof. hammer_hook "Znumtheory" "Znumtheory.euclid_rec".
intros v3 Hv3; generalize Hv3; pattern v3.
apply Zlt_0_rec.
clear v3 Hv3; intros.
destruct (Z_zerop x) as [Heq|Hneq].
apply Euclid_intro with (u := u1) (v := u2) (d := u3).
assumption.
apply H3.
rewrite Heq; auto with zarith.
set (q := u3 / x) in *.
assert (Hq : 0 <= u3 - q * x < x).
replace (u3 - q * x) with (u3 mod x).
apply Z_mod_lt; omega.
assert (xpos : x > 0). omega.
generalize (Z_div_mod_eq u3 x xpos).
unfold q.
intro eq; pattern u3 at 2; rewrite eq; ring.
apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)).
tauto.
replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with
(u1 * a + u2 * b - q * (v1 * a + v2 * b)).
rewrite H1; rewrite H2; trivial.
ring.
intros; apply H3.
apply Zis_gcd_for_euclid with q; assumption.
assumption.
Qed.

Lemma euclid : Euclid.
Proof. hammer_hook "Znumtheory" "Znumtheory.euclid".
case (Z_le_gt_dec 0 b); intro.
intros;
apply euclid_rec with
(u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b);
auto with zarith; ring.
intros;
apply euclid_rec with
(u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b);
auto with zarith; try ring.
Qed.

End extended_euclid_algorithm.

Theorem Zis_gcd_uniqueness_apart_sign :
forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_uniqueness_apart_sign".
simple induction 1.
intros H1 H2 H3; simple induction 1; intros.
generalize (H3 d' H4 H5); intro Hd'd.
generalize (H6 d H1 H2); intro Hdd'.
exact (Z.divide_antisym d d' Hdd' Hd'd).
Qed.

Inductive Bezout (a b d:Z) : Prop :=
Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d.

Lemma Zis_gcd_bezout : forall a b d:Z, Zis_gcd a b d -> Bezout a b d.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_bezout".
intros a b d Hgcd.
elim (euclid a b); intros u v d0 e g.
generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g).
intro H; elim H; clear H; intros.
apply Bezout_intro with u v.
rewrite H; assumption.
apply Bezout_intro with (- u) (- v).
rewrite H; rewrite <- e; ring.
Qed.

Lemma Zis_gcd_mult :
forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_mult".
intros a b c d; simple induction 1. constructor; auto with zarith.
intros x Ha Hb.
elim (Zis_gcd_bezout a b d H). intros u v Huv.
elim Ha; intros a' Ha'.
elim Hb; intros b' Hb'.
apply Zdivide_intro with (u * a' + v * b').
rewrite <- Huv.
replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)).
rewrite Ha'; rewrite Hb'; ring.
ring.
Qed.

Definition rel_prime (a b:Z) : Prop := Zis_gcd a b 1.

Lemma rel_prime_bezout : forall a b:Z, rel_prime a b -> Bezout a b 1.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_bezout".
intros a b; exact (Zis_gcd_bezout a b 1).
Qed.

Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b.
Proof. hammer_hook "Znumtheory" "Znumtheory.bezout_rel_prime".
simple induction 1; constructor; auto with zarith.
intros. rewrite <- H0; auto with zarith.
Qed.

Theorem Gauss : forall a b c:Z, (a | b * c) -> rel_prime a b -> (a | c).
Proof. hammer_hook "Znumtheory" "Znumtheory.Gauss".
intros. elim (rel_prime_bezout a b H0); intros.
replace c with (c * 1); [ idtac | ring ].
rewrite <- H1.
replace (c * (u * a + v * b)) with (c * u * a + v * (b * c));
[ eauto with zarith | ring ].
Qed.

Lemma rel_prime_mult :
forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c).
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_mult".
intros a b c Hb Hc.
elim (rel_prime_bezout a b Hb); intros.
elim (rel_prime_bezout a c Hc); intros.
apply bezout_rel_prime.
apply Bezout_intro with
(u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0).
rewrite <- H.
replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ].
rewrite <- H0.
ring.
Qed.

Lemma rel_prime_cross_prod :
forall a b c d:Z,
rel_prime a b ->
rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_cross_prod".
intros a b c d; intros.
elim (Z.divide_antisym b d).
split; auto with zarith.
rewrite H4 in H3.
rewrite Z.mul_comm in H3.
apply Z.mul_reg_l with d; auto with zarith.
intros; omega.
apply Gauss with a.
rewrite H3.
auto with zarith.
red; auto with zarith.
apply Gauss with c.
rewrite Z.mul_comm.
rewrite <- H3.
auto with zarith.
red; auto with zarith.
Qed.

Lemma Zis_gcd_rel_prime :
forall a b g:Z,
b > 0 -> g >= 0 -> Zis_gcd a b g -> rel_prime (a / g) (b / g).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_rel_prime".
intros a b g; intros.
assert (g <> 0).
intro.
elim H1; intros.
elim H4; intros.
rewrite H2 in H6; subst b; omega.
unfold rel_prime.
destruct H1.
destruct H1 as (a',H1).
destruct H3 as (b',H3).
replace (a/g) with a';
[|rewrite H1; rewrite Z_div_mult; auto with zarith].
replace (b/g) with b';
[|rewrite H3; rewrite Z_div_mult; auto with zarith].
constructor.
exists a'; auto with zarith.
exists b'; auto with zarith.
intros x (xa,H5) (xb,H6).
destruct (H4 (x*g)) as (x',Hx').
exists xa; rewrite Z.mul_assoc; rewrite <- H5; auto.
exists xb; rewrite Z.mul_assoc; rewrite <- H6; auto.
replace g with (1*g) in Hx'; auto with zarith.
do 2 rewrite Z.mul_assoc in Hx'.
apply Z.mul_reg_r in Hx'; trivial.
rewrite Z.mul_1_r in Hx'.
exists x'; auto with zarith.
Qed.

Theorem rel_prime_sym: forall a b, rel_prime a b -> rel_prime b a.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_sym".
intros a b H; auto with zarith.
red; apply Zis_gcd_sym; auto with zarith.
Qed.

Theorem rel_prime_div: forall p q r,
rel_prime p q -> (r | p) -> rel_prime r q.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_div".
intros p q r H (u, H1); subst.
inversion_clear H as [H1 H2 H3].
red; apply Zis_gcd_intro; try apply Z.divide_1_l.
intros x H4 H5; apply H3; auto.
apply Z.divide_mul_r; auto.
Qed.

Theorem rel_prime_1: forall n, rel_prime 1 n.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_1".
intros n; red; apply Zis_gcd_intro; auto.
exists 1; auto with zarith.
exists n; auto with zarith.
Qed.

Theorem not_rel_prime_0: forall n, 1 < n -> ~ rel_prime 0 n.
Proof. hammer_hook "Znumtheory" "Znumtheory.not_rel_prime_0".
intros n H H1; absurd (n = 1 \/ n = -1).
intros [H2 | H2]; subst; contradict H; auto with zarith.
case (Zis_gcd_unique  0 n n 1); auto.
apply Zis_gcd_intro; auto.
exists 0; auto with zarith.
exists 1; auto with zarith.
Qed.

Theorem rel_prime_mod: forall p q, 0 < q ->
rel_prime p q -> rel_prime (p mod q) q.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_mod".
intros p q H H0.
assert (H1: Bezout p q 1).
apply rel_prime_bezout; auto.
inversion_clear H1 as [q1 r1 H2].
apply bezout_rel_prime.
apply Bezout_intro with q1  (r1 + q1 * (p / q)).
rewrite <- H2.
pattern p at 3; rewrite (Z_div_mod_eq p q); try ring; auto with zarith.
Qed.

Theorem rel_prime_mod_rev: forall p q, 0 < q ->
rel_prime (p mod q) q -> rel_prime p q.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_mod_rev".
intros p q H H0.
rewrite (Z_div_mod_eq p q); auto with zarith; red.
apply Zis_gcd_sym; apply Zis_gcd_for_euclid2; auto with zarith.
Qed.

Theorem Zrel_prime_neq_mod_0: forall a b, 1 < b -> rel_prime a b -> a mod b <> 0.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zrel_prime_neq_mod_0".
intros a b H H1 H2.
case (not_rel_prime_0 _ H).
rewrite <- H2.
apply rel_prime_mod; auto with zarith.
Qed.

Inductive prime (p:Z) : Prop :=
prime_intro :
1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p.

Lemma prime_divisors :
forall p:Z,
prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_divisors".
destruct 1; intros.
assert
(a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p).
{ assert (Z.abs a <= Z.abs p) as H2.
apply Zdivide_bounds; [ assumption | omega ].
revert H2.
pattern (Z.abs a); apply Zabs_ind; pattern (Z.abs p); apply Zabs_ind;
intros; omega. }
intuition idtac.

- absurd (rel_prime (- a) p); intuition.
inversion H2.
assert (- a | - a) by auto with zarith.
assert (- a | p) by auto with zarith.
apply H7, Z.divide_1_r in H8; intuition.

- inversion H1. subst a; omega.

- absurd (rel_prime a p); intuition.
inversion H2.
assert (a | a) by auto with zarith.
assert (a | p) by auto with zarith.
apply H7, Z.divide_1_r in H8; intuition.
Qed.

Lemma prime_rel_prime :
forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_rel_prime".
intros; constructor; intros; auto with zarith.
apply prime_divisors in H1; intuition; subst; auto with zarith.
- absurd (p | a); auto with zarith.
- absurd (p | a); intuition.
Qed.

Hint Resolve prime_rel_prime: zarith.

Theorem rel_prime_le_prime:
forall a p, prime p -> 1 <=  a < p -> rel_prime a p.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_le_prime".
intros a p Hp [H1 H2].
apply rel_prime_sym; apply prime_rel_prime; auto.
intros [q Hq]; subst a.
case (Z.le_gt_cases q 0); intros Hl.
absurd (q * p <= 0 * p); auto with zarith.
absurd (1 * p <= q * p); auto with zarith.
Qed.

Lemma prime_mult :
forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b).
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_mult".
intro p; simple induction 1; intros.
case (Zdivide_dec p a); intuition.
right; apply Gauss with a; auto with zarith.
Qed.

Lemma not_prime_0: ~ prime 0.
Proof. hammer_hook "Znumtheory" "Znumtheory.not_prime_0".
intros H1; case (prime_divisors _ H1 2); auto with zarith.
Qed.

Lemma not_prime_1: ~ prime 1.
Proof. hammer_hook "Znumtheory" "Znumtheory.not_prime_1".
intros H1; absurd (1 < 1); auto with zarith.
inversion H1; auto.
Qed.

Lemma prime_2: prime 2.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_2".
apply prime_intro; auto with zarith.
intros n (H,H'); Z.le_elim H; auto with zarith.
- contradict H'; auto with zarith.
- subst n. constructor; auto with zarith.
Qed.

Theorem prime_3: prime 3.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_3".
apply prime_intro; auto with zarith.
intros n (H,H'); Z.le_elim H; auto with zarith.
- replace n with 2 by omega.
constructor; auto with zarith.
intros x (q,Hq) (q',Hq').
exists (q' - q). ring_simplify. now rewrite <- Hq, <- Hq'.
- replace n with 1 by trivial.
constructor; auto with zarith.
Qed.

Theorem prime_ge_2 p : prime p ->  2 <= p.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_ge_2".
intros (Hp,_); auto with zarith.
Qed.

Definition prime' p := 1<p /\ (forall n, 1<n<p -> ~ (n|p)).

Lemma Z_0_1_more x : 0<=x -> x=0 \/ x=1 \/ 1<x.
Proof. hammer_hook "Znumtheory" "Znumtheory.Z_0_1_more".
intros H. Z.le_elim H; auto.
apply Z.le_succ_l in H. change (1 <= x) in H. Z.le_elim H; auto.
Qed.

Theorem prime_alt p : prime' p <-> prime p.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_alt".
split; intros (Hp,H).
-
constructor; trivial; intros n Hn.
constructor; auto with zarith; intros x Hxn Hxp.
rewrite <- Z.divide_abs_l in Hxn, Hxp |- *.
assert (Hx := Z.abs_nonneg x).
set (y:=Z.abs x) in *; clearbody y; clear x; rename y into x.
destruct (Z_0_1_more x Hx) as [->|[->|Hx']].
+ exfalso. apply Z.divide_0_l in Hxn. omega.
+ now exists 1.
+ elim (H x); auto.
split; trivial.
apply Z.le_lt_trans with n; auto with zarith.
apply Z.divide_pos_le; auto with zarith.
-
constructor; trivial. intros n Hn Hnp.
case (Zis_gcd_unique n p n 1); auto with zarith.
constructor; auto with zarith.
apply H; auto with zarith.
Qed.

Theorem square_not_prime: forall a, ~ prime (a * a).
Proof. hammer_hook "Znumtheory" "Znumtheory.square_not_prime".
intros a Ha.
rewrite <- (Z.abs_square a) in Ha.
assert (H:=Z.abs_nonneg a).
set (b:=Z.abs a) in *; clearbody b; clear a; rename b into a.
rewrite <- prime_alt in Ha; destruct Ha as (Ha,Ha').
assert (H' : 1 < a) by now apply (Z.square_lt_simpl_nonneg 1).
apply (Ha' a).
+ split; trivial.
rewrite <- (Z.mul_1_l a) at 1. apply Z.mul_lt_mono_pos_r; omega.
+ exists a; auto.
Qed.

Theorem prime_div_prime: forall p q,
prime p -> prime q -> (p | q) -> p = q.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_div_prime".
intros p q H H1 H2;
assert (Hp: 0 < p); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith.
assert (Hq: 0 < q); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith.
case prime_divisors with (2 := H2); auto.
intros H4; contradict Hp; subst; auto with zarith.
intros [H4| [H4 | H4]]; subst; auto.
contradict H; auto; apply not_prime_1.
contradict Hp; auto with zarith.
Qed.

Notation Zgcd_is_pos := Z.gcd_nonneg (compat "8.3").

Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Z.gcd a b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_is_gcd".
constructor.
apply Z.gcd_divide_l.
apply Z.gcd_divide_r.
apply Z.gcd_greatest.
Qed.

Theorem Zgcd_spec : forall x y : Z, {z : Z | Zis_gcd x y z /\ 0 <= z}.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_spec".
intros x y; exists (Z.gcd x y).
split; [apply Zgcd_is_gcd  | apply Z.gcd_nonneg].
Qed.

Theorem Zdivide_Zgcd: forall p q r : Z,
(p | q) -> (p | r) -> (p | Z.gcd q r).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zdivide_Zgcd".
intros. now apply Z.gcd_greatest.
Qed.

Theorem Zis_gcd_gcd: forall a b c : Z,
0 <= c ->  Zis_gcd a b c -> Z.gcd a b = c.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zis_gcd_gcd".
intros a b c H1 H2.
case (Zis_gcd_uniqueness_apart_sign a b c (Z.gcd a b)); auto.
apply Zgcd_is_gcd; auto.
Z.le_elim H1.
- generalize (Z.gcd_nonneg a b); auto with zarith.
- subst. now case (Z.gcd a b).
Qed.

Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (compat "8.3").
Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (compat "8.3").

Theorem Zgcd_div_swap0 : forall a b : Z,
0 < Z.gcd a b ->
0 < b ->
(a / Z.gcd a b) * b = a * (b/Z.gcd a b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_div_swap0".
intros a b Hg Hb.
assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3].
pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto.
repeat rewrite Z.mul_assoc; f_equal.
rewrite Z.mul_comm.
rewrite <- Zdivide_Zdiv_eq; auto.
Qed.

Theorem Zgcd_div_swap : forall a b c : Z,
0 < Z.gcd a b ->
0 < b ->
(c * a) / Z.gcd a b * b = c * a * (b/Z.gcd a b).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_div_swap".
intros a b c Hg Hb.
assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3].
pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto.
repeat rewrite Z.mul_assoc; f_equal.
rewrite Zdivide_Zdiv_eq_2; auto.
repeat rewrite <- Z.mul_assoc; f_equal.
rewrite Z.mul_comm.
rewrite <- Zdivide_Zdiv_eq; auto.
Qed.

Notation Zgcd_comm := Z.gcd_comm (compat "8.3").

Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c).
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_ass".
symmetry. apply Z.gcd_assoc.
Qed.

Notation Zgcd_Zabs := Z.gcd_abs_l (compat "8.3").
Notation Zgcd_0 := Z.gcd_0_r (compat "8.3").
Notation Zgcd_1 := Z.gcd_1_r (compat "8.3").

Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith.

Theorem Zgcd_1_rel_prime : forall a b,
Z.gcd a b = 1 <-> rel_prime a b.
Proof. hammer_hook "Znumtheory" "Znumtheory.Zgcd_1_rel_prime".
unfold rel_prime; split; intro H.
rewrite <- H; apply Zgcd_is_gcd.
case (Zis_gcd_unique a b (Z.gcd a b) 1); auto.
apply Zgcd_is_gcd.
intros H2; absurd (0 <= Z.gcd a b); auto with zarith.
generalize (Z.gcd_nonneg a b); auto with zarith.
Qed.

Definition rel_prime_dec: forall a b,
{ rel_prime a b }+{ ~ rel_prime a b }.
Proof. hammer_hook "Znumtheory" "Znumtheory.rel_prime_dec".
intros a b; case (Z.eq_dec (Z.gcd a b) 1); intros H1.
left; apply -> Zgcd_1_rel_prime; auto.
right; contradict H1; apply <- Zgcd_1_rel_prime; auto.
Defined.

Definition prime_dec_aux:
forall p m,
{ forall n, 1 < n < m -> rel_prime n p } +
{ exists n, 1 < n < m  /\ ~ rel_prime n p }.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_dec_aux".
intros p m.
case (Z_lt_dec 1 m); intros H1;
[ | left; intros; exfalso; omega ].
pattern m; apply natlike_rec; auto with zarith.
left; intros; exfalso; omega.
intros x Hx IH; destruct IH as [F|E].
destruct (rel_prime_dec x p) as [Y|N].
left; intros n [HH1 HH2].
rewrite Z.lt_succ_r in HH2.
Z.le_elim HH2; subst; auto with zarith.
- case (Z_lt_dec 1 x); intros HH1.
* right; exists x; split; auto with zarith.
* left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith.
- right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith.
Defined.

Definition prime_dec: forall p, { prime p }+{ ~ prime p }.
Proof. hammer_hook "Znumtheory" "Znumtheory.prime_dec".
intros p; case (Z_lt_dec 1 p); intros H1.
+ case (prime_dec_aux p p); intros H2.
* left; apply prime_intro; auto.
intros n (Hn1,Hn2). Z.le_elim Hn1; auto; subst n.
constructor; auto with zarith.
* right; intros H3; inversion_clear H3 as [Hp1 Hp2].
case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith.
+ right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto.
Defined.

Theorem not_prime_divide:
forall p, 1 < p -> ~ prime p -> exists n, 1 < n < p  /\ (n | p).
Proof. hammer_hook "Znumtheory" "Znumtheory.not_prime_divide".
intros p Hp Hp1.
case (prime_dec_aux p p); intros H1.
- elim Hp1; constructor; auto.
intros n (Hn1,Hn2).
Z.le_elim Hn1; auto with zarith.
subst n; constructor; auto with zarith.
- case H1; intros n (Hn1,Hn2).
destruct (Z_0_1_more _ (Z.gcd_nonneg n p)) as [H|[H|H]].
+ exfalso. apply Z.gcd_eq_0_l in H. omega.
+ elim Hn2. red. rewrite <- H. apply Zgcd_is_gcd.
+ exists (Z.gcd n p); split; [ split; auto | apply Z.gcd_divide_r ].
apply Z.le_lt_trans with n; auto with zarith.
apply Z.divide_pos_le; auto with zarith.
apply Z.gcd_divide_l.
Qed.


Require Import Clustering.ILP.Base.

Require Import Clustering.Tactics.

Require Import Coq.Lists.List.
Import ListNotations.

Lemma Valid_app_and V (a : Assignment V) cs ds:
      Valid (cs ++ ds) a <->
      Valid cs a /\ Valid ds a.
Proof.
 split.

  - (* cs ++ ds -> cs /\ ds *)
    split.
   + (* cs ++ ds -> cs *)
     induction cs as [|c cs].
     * constructor.
     * destruct c.
       inverts H.
       constructor; try apply IHcs; assumption.
   + (* cs ++ ds -> ds *)
     induction cs as [|c cs].
     * assumption.
     * apply IHcs.
       inverts H.
       assumption.

  - (* cs /\ ds -> cs ++ ds *)
    intros H.
    destruct H as [Hcs Hds].
    induction cs as [|c cs].
    + assumption.
    + inverts Hcs.
      simpl.
      constructor; try apply IHcs; assumption.
Qed.

Definition update {V} (V_eq_dec : forall a b, {a = b} + {a <> b})
           (v : V) (val : Z) (a : Assignment V) : Assignment V
 := fun x =>
     if V_eq_dec x v
     then val
     else a x.

(*
Print Linear.
Section V_eq_dec.

Definition mentions_go {V} (v : V) (c : Linear V) :=
 Contains (eq v).

Lemma Valid_update  (a : Assignment V) v val cs:
      Valid cs a ->
      Valid (mentions v cs) (update V_eq_dec v val a) ->
      Valid cs (update V_eq_dec v val a).
*)


Require Import Program Setoid Bool.
Require Import Containers.Sets Containers.SetConstructs SetDecide.
Require SetAVLInstance.
Require Import SetoidList Equality.
Require Import Typex.Automata.Init.

Generalizable Variables A Σ Q.

Notation "(===)" := equiv (only parsing).

(** An alphabet is a finite set with a decidable equivalence relation. *)

Class Alphabet (A : Type) :=
  { alpha_ordered :> OrderedType A;
    alpha_set : set A }.

Coercion alpha_set : Alphabet >-> set.

(** States form an ordered type so we can build finite sets of states, compare them etc..
    [OrderedType] is a typeclass as well.
 *)

Class States (A : Type) :=
  { states_ordered :> OrderedType A;
    states_set : set A }.

Coercion states_set : States >-> set.

(** Boolean formulas *)
Section Formulas.

  Context `{S : States Q}.

  Inductive formula :=
  | Top | Bottom
  | Disj (f g : formula)
  | Conj (f g : formula)
  | Neg (f : formula)
  | Left (q : Q) (H : q \In states_set)
  | Right (q : Q) (H : q \In states_set).

  Fixpoint left_states (θ : formula) : set Q :=
    match θ with
      | Disj f g | Conj f g => union (left_states f) (left_states g)
      | Neg f => left_states f
      | Left q _ => {q}
      | _ => {}
    end.

  Fixpoint right_states (θ : formula) : set Q :=
    match θ with
      | Disj f g | Conj f g => union (left_states f) (left_states g)
      | Neg f => left_states f
      | Right q _ => {q}
      | _ => {}
    end.

  Fixpoint states_of (θ : formula) : set Q * set Q :=
    match θ with
      | Disj f g
      | Conj f g =>
        let (leftf, rightf) := states_of f in
        let (leftg, rightg) := states_of g in
          (union leftf leftg, union rightf rightg)
      | Neg f => states_of f
      | Left q _ => ({q}%set, {})
      | Right q _ => ({}, {q})
      | _ => ({}, {})
    end.

  Lemma states_of_spec θ : forall l r,
                             states_of θ = (l, r) -> l [<=] states_set /\ r [<=] states_set.
  Proof.
    induction θ; intros l r Heq; depelim Heq; try intuition fsetdec.

    simpl in x. do 2 destruct states_of. specialize_eqs IHθ1. specialize_eqs IHθ2.
    depelim x. intuition fsetdec.

    simpl in x. do 2 destruct states_of. specialize_eqs IHθ1. specialize_eqs IHθ2.
    depelim x. intuition fsetdec.

    simpl in x. destruct states_of. specialize_eqs IHθ.
    depelim x. intuition fsetdec.
  Qed.

End Formulas.

Coercion Is_true : bool >-> Sortclass.

(** Transitions *)
Section Transitions.
  Context `{A:Alphabet Σ, S:States Q}.

  (** Is it a selecting transition or not? *)
  Inductive selecting : Set := select | traverse.

  (** One transition. *)
  Record Transition :=
    { trans_q : Q;
      trans_L : set Σ; (* Replace with decidable predicate fin/cofin *)
      trans_L_incl : trans_L [<=] alpha_set;
      trans_L_inh : not (is_empty trans_L);
      trans_select : selecting;
      trans_Φ : formula }.

  (** Set of transitions. *)
  Require Import Generate.

  Definition eq_transition t t' :=
    t.(trans_q) === t'.(trans_q) /\
    t.(trans_L) === t'.(trans_L).
(* Question ? *)
    (* t.(trans_select) === t'.(trans_select) /\ *)
    (* t.(trans_Φ) === t'.(trans_Φ). *)

  Definition lt_transition t t' :=
    t.(trans_q) <<< t'.(trans_q) \/
     (t.(trans_q) === t'.(trans_q) /\ t.(trans_L) <<< t'.(trans_L)).

  Definition cmp_transition t t' :=
    match t.(trans_q) =?= t'.(trans_q) with
    | Eq => t.(trans_L) =?= t'.(trans_L)
    | x => x
    end.

  Instance eq_equiv : Equivalence eq_transition.
  Proof.
    unfold eq_transition. split; red; intros.
    split; reflexivity.
    intuition symmetry; auto.
    intuition (etransitivity; eauto).
  Qed.

  Instance trans_ord : OrderedType Transition :=
    { _eq := eq_transition; _lt := lt_transition;
      _cmp := cmp_transition }.
  Proof.
    unfold lt_transition.
    constructor. red; intros.

    - intuition (try etransitivity; eauto).
      now rewrite H0 in H1.
      now rewrite <- H in H1.

    - intros; red; intros.
      destruct H0.
      destruct H.
      * order.
      * now (rewrite H1 in H; destruct H; order).

    - intros. unfold cmp_transition; simpl.
      case_eq (compare (trans_q x) (trans_q y)); intros; try constructor.
      case_eq (compare (trans_L x) (trans_L y)); intros; try constructor.
      apply compare_2 in H. apply compare_2 in H0.
      now red.

      apply compare_2 in H; apply compare_1 in H0.
      now red.

      apply compare_2 in H; apply compare_3 in H0.
      now red.

      apply compare_1 in H.
      now red.

      apply compare_3 in H.
      now red.
  Qed.

  Definition Transitions := set Transition.

End Transitions.

Section Automaton.
  Class ASTA Σ Q :=
    { auto_Σ :> Alphabet Σ;
      auto_Q :> States Q;
      auto_top_states : { s : set Q | s [<=] auto_Q } ;
      auto_transitions : Transitions }.
End Automaton.

Section Tree.
  Context `{A:Alphabet Σ}.

  (** Direction *)
  Definition direction := bool (* = 1 or 2 *).
  Delimit Scope direction_scope with dir.
  Notation "1" := false : direction_scope.
  Notation "2" := true : direction_scope.
  Open Scope direction_scope.
  Bind Scope direction_scope with direction.

  (** Nodes are cons lists: the begining of the list is the first move in the tree. *)
  Definition node := list direction.
  Definition empty_node : node := nil.
  Notation "'ε'" := empty_node : node_scope.
  Bind Scope node_scope with node.
  Open Scope node_scope.

  Infix "@" := (@app direction) (right associativity, at level 60) : node_scope.

  Definition dir_to_node (d : direction) : node := [d].
  Coercion dir_to_node : direction >-> node.

  Notation " n • d " := (n @ dir_to_node d) (at level 60).
  Notation " (• d ) " := (fun n => n @ dir_to_node d) (at level 40).

  (** Automatically inferred order on lists of booleans. *)
  Instance node_ot : OrderedType node | 0 := SOT_as_OT.
  Instance node_set_inst: @FSet node node_ot := _.
  Instance node_set_specs: FSetSpecs node_set_inst := _.
  Definition node_set := set node.

  Hint Unfold empty_node : asta.

  Lemma app_node_eps_l n : ε @ n === n.
  Proof. reflexivity. Qed.
  Lemma app_node_eps_r n : n @ ε === n.
  Proof. apply app_nil_r. Qed.
  Hint Rewrite app_node_eps_l app_node_eps_l : asta.

  Lemma app_node_assoc n m p : (n @ m) @ p === n @ m @ p.
  Proof. autounfold with asta; now rewrite app_assoc. Qed.
  Hint Rewrite app_node_assoc : asta.

  Lemma node_app_eq_l (l l' l'' : node) : (l @ l' === l @ l'' -> l' === l'').
  Proof. intros H. reduce in H.
     now apply app_inv_head in H.
  Qed.

  Lemma node_app_eq_r (l l' l'' : node) : (l' @ l === l'' @ l -> l' === l'').
  Proof. intros H. reduce in H; now apply app_inv_tail in H. Qed.

  Lemma node_app_eq_tail (l l' : node) : (l === l @ l' -> l' === ε).
  Proof. setoid_rewrite <- (app_node_eps_r l) at 1. intros; now apply node_app_eq_l in H. Qed.

  Lemma node_app_eq_head (l l' : node) : (l === l' @ l -> l' === ε).
  Proof. change l with (ε @ l) at 1. intros; now apply node_app_eq_r in H. Qed.

  Lemma empty_snoc_app π d n : ~ ε === (π • d) @ n.
  Proof. destruct π; intro; try discriminate. Qed.

  Lemma app_snoc n d π : (π • d) @ n === π @ [d] @ n.
  Proof. rewrite <- app_node_assoc. reflexivity. Qed.
  Hint Rewrite app_snoc : asta.

  Lemma node_app_eq_l_length (l0 l1 l2 l3 : node) :
    l0 @ l1 === l2 @ l3 -> length l0 = length l2 -> l0 === l2 /\ l1 === l3.
  Proof. revert l0 l2 l3; induction l0; destruct l2; simpl; intros;
     autorewrite with list in H; try discriminate.

     now idtac.

     depelim H. specialize (IHl0 _ _ x). forward IHl0. intuition congruence.
     auto with arith.
  Qed.

  Lemma node_app_length π π' : length (π @ π') = length π + length π'.
  Proof. autorewrite with list; auto with arith. Qed.

  Lemma snoc_length π d : length (π • d) = length π + 1.
  Proof. apply node_app_length. Qed.

  Hint Rewrite node_app_length snoc_length : asta.

  Lemma node_app_nil (l l' : node) : (l @ l' === [] -> l === [] /\ l' === [])%list.
  Proof. induction l; intros; simpl; auto. discriminate H. Qed.

  (** The trees we consider here *)
  Inductive binary_tree :=
  | tree_leaf | tree_node (l : Σ * α) (t1 t2 : binary_tree).

  Section Domain.

    (** Computing the domain of a tree. *)
    Fixpoint dom_aux (t : binary_tree) cur : node_set :=
      match t with
        | tree_leaf => {cur}
        | tree_node l t1 t2 => {cur; dom_aux t1 (cur • 1)} ++
                                                           dom_aux t2 (cur • 2)
      end.

    Definition domain t := dom_aux t ε.

    Lemma domain_leaf : domain tree_leaf = {ε}%set.
    Proof. reflexivity. Qed.

    Lemma dom_aux_node l t1 t2 π :
      dom_aux (tree_node l t1 t2) π = {π; dom_aux t1 (π • 1)} ++ dom_aux t2 (π • 2)%set.
    Proof. reflexivity. Qed.

    Hint Rewrite domain_leaf dom_aux_node : asta.

    Notation "d ∙ π" := (@cons direction d%dir π) (at level 0, only parsing) : node_scope.

    (** Characterisation as an inductive relation. *)
    Inductive Dom : binary_tree -> node -> Prop:=
    | dom_leaf t : Dom t ε
    | dom_node_1 {l t1 t2 π} : Dom t1 π -> Dom (tree_node l t1 t2) (1 ∙ π)
    | dom_node_2 {l t1 t2 π} : Dom t2 π -> Dom (tree_node l t1 t2) (2 ∙ π).
    Hint Constructors Dom : asta.

    Ltac easy ::= auto with asta || order || easy_base.

    Instance Dom_proper : Proper ((===) ==> (===) ==> iff) Dom.
    Proof with easy.
      assert (Proper (equiv ==> equiv ==> impl) Dom).
      reduce.
      reduce in H. subst y.
      reduce in H0. subst x0; auto.

      reduce.
      split.
      apply H; auto.
      symmetry in H0, H1.
      apply H; auto.
    Qed.

    Lemma dom_aux_cur : forall t π, π \In dom_aux t π.
    Proof. destruct t; unfold dom_aux; fsetdec. Qed.

    Lemma domain_ε t : ε \In domain t.
    Proof. unfold domain. apply dom_aux_cur. Qed.
    Hint Resolve dom_aux_cur domain_leaf domain_ε : asta.

    Instance: Proper ((===) ==> eq) (@length direction).
    Proof. reduce.
           induction H; auto.
    Qed.

    Ltac simp := simpl in *; autorewrite with asta set_simpl in *.

    Lemma Dom_dom_aux t : forall n, Dom t n -> forall π, (π @ n) \In dom_aux t π.
    Proof with try easy.
      intros. revert π. induction H; intros; auto with asta.
      now rewrite app_nil_r.

      simp. left; right. now rewrite app_comm_cons'.
      simp; right. now rewrite app_comm_cons'.
    Qed.

    Lemma Dom_domain t : forall n, Dom t n -> n \In domain t.
    Proof.
      intros.
      generalize (Dom_dom_aux t n H ε).
      now autorewrite with asta.
    Qed.

    Lemma dom_aux_length t : forall π n, π \In dom_aux t n -> length n <= length π.
    Proof.
      induction t; simpl; intros; auto with arith; autorewrite with asta set_simpl in H.
      now rewrite H.

      destruct H as [[H|H]|H].
      now rewrite H.
      specialize (IHt1 _ _ H); autorewrite with asta in IHt1. omega.
      specialize (IHt2 _ _ H); autorewrite with asta in IHt2. omega.
    Qed.

    Lemma dom_aux_inv {t} : forall {π π' n}, π @ n \In dom_aux t π' ->
                                             length π = length π' -> π = π'.
    Proof.
      induction t; simpl; intros; autorewrite with asta set_simpl in H; simpl; auto; intros.
      rewrite <- (app_node_eps_r π') in H. apply node_app_eq_l_length in H; intuition eauto.

      destruct H as [[H|H]|H].
      rewrite <- (app_node_eps_r π') in H. now (apply node_app_eq_l_length in H; intuition).

      destruct n. apply dom_aux_length in H.
      autorewrite with asta in H. simpl in H. assert False; omega.
      rewrite app_comm_cons' in H.
      specialize (IHt1 _ _ _ H). autorewrite with asta in IHt1. simpl in IHt1.
      forward IHt1.  simpl in IHt1. apply node_app_eq_l_length in IHt1; intuition auto.
      auto with arith.

      destruct n. apply dom_aux_length in H.
      autorewrite with asta in H. simpl in H. assert False; omega.
      rewrite app_comm_cons' in H.
      specialize (IHt2 _ _ _ H). autorewrite with asta in IHt2. simpl in IHt2.
      forward IHt2.  simpl in IHt2. apply node_app_eq_l_length in IHt2; intuition auto.
      auto with arith.
    Qed.

    Lemma dom_aux_Dom : forall n π t, (π @ n) \In dom_aux t π -> Dom t n.
    Proof with try easy.
      induction n; simpl; intros. constructor.

      rewrite app_comm_cons' in H.
      destruct t; simpl in H; autorewrite with asta set_simpl in H.

      - apply node_app_eq_tail in H; discriminate.

      - destruct H as [[H|H]|H].
        * apply node_app_eq_tail in H; discriminate.
        * rewrite app_assoc in H. pose (Hi:=dom_aux_inv H). apply node_app_eq_l in Hi.
          depelim Hi. constructor. eauto. simp. auto with arith.
        * rewrite app_assoc in H. pose (Hi:=dom_aux_inv H). apply node_app_eq_l in Hi.
          depelim Hi. constructor. eauto. simp. auto with arith.
    Qed.

    Lemma domain_Dom t : forall π, π \In domain t -> Dom t π.
    Proof with try easy.
      intros. apply dom_aux_Dom with ε. fold (domain t). rewrite app_node_eps_l. apply H.
    Qed.

    Lemma domain_Dom_iff t : forall n, Dom t n <-> n \In domain t.
    Proof. split; auto using domain_Dom, Dom_domain. Qed.
  End Domain.

  Section Size.

    Fixpoint tree_size (t : binary_tree) : nat :=
      match t with
        | tree_leaf => 0
        | tree_node λ l r => 1 + max (tree_size l) (tree_size r)
      end.

  End Size.

  Section Label.

    Inductive Label :=
    | hash | label (l : Σ).

    Notation "#" := hash.
    Coercion label : Σ >-> Label.

    Program
    Fixpoint label_of (t : binary_tree) (π : node | Dom t π) : Label :=
      match t with
        | tree_leaf => hash
        | tree_node λ l r =>
          match π with
            | [] => label λ
            | false :: π' => label_of l π'
            | true :: π' => label_of r π'
          end
      end.

    Next Obligation.
      depelim H. auto.
    Defined.

    Next Obligation.
      depelim H. auto.
    Defined.

    Lemma label_of_leaf π : label_of tree_leaf π = hash.
    Proof. reflexivity. Qed.

    Lemma label_of_node_ε λ l r p :
      label_of (tree_node λ l r) (exist _ ε p) = label λ.
    Proof. reflexivity. Qed.

    Program
    Definition label_of_node_l_stm λ l r π p :=
      label_of (tree_node λ l r) (exist _ (π • 1) p) = label_of l (exist _ π _).
    Next Obligation.
    Proof.
      depelim p.
    Admitted.

  End Label.

End Tree.

(* I hate this but... *)
Delimit Scope node_scope with node.
Bind Scope node_scope with node.
Delimit Scope direction_scope with direction.
Bind Scope direction_scope with direction.

Notation "'ε'" := empty_node : node_scope.
Notation "1" := (false : direction) : direction_scope.
Notation "2" := (true : direction) : direction_scope.
Infix "@" := (@app direction) (right associativity, at level 60) : node_scope.
Notation " n • d " := (n @ dir_to_node d)%node (at level 60).
Notation " (• d ) " := (fun n => n @ dir_to_node d)%node (at level 40).

(* BUG *)
Arguments binary_tree.
Implicit Arguments binary_tree [].

Require Import SetConstructs.

Definition power_union {A} `{OrderedType A} (s : set (set A)) : set A :=
  fold (fun a acc => union a acc) s {}.

Section SetComprehensions.

  Context `{OrderedType A} {B : Type} `{OrderedType B}.

  Definition from_compr (a : set A) (P : A -> bool) (f : A -> B) : set B :=
    map f (filter P a).

  Definition split (s : set (set A * set B)) : set A * set B :=
    (power_union (map fst s), power_union (map snd s)).

  (* Variable s : set. *)
  (* Check [ x \from s | true ]. *)
  (* Check [ x \from s | x == x ]. *)
End SetComprehensions.

Notation "[ 'set' x 'in' s | p ] " := (filter (fun x => p) s)
                                          (at level 0, x at level 99).

(* Notation "[ 'set' x 'from' s , q | p ] " := (from_compr s (fun x => p) (fun x => q)) (x ident, at level 0). *)

Section Evaluation.
  Context `{A: ASTA Σ Q}.

  Variable eval_trans : forall (Γ1 Γ2 : set Q) (π : node) (trans : Transitions), set Q.

  (*
1 function eval asta (A, t, ⇡, r) =
2 if t(⇡) = # then return ; else
3 let trans ={(q,L,⌧τ,π) \in L | q \in r /\ t(π) \in L}in
4 let ri = {q|#i q \in θ, ∀ θ \in trans} in
5 let Γ1 = eval asta (A,t,⇡π · 1,r1)
6 and Γ2 = eval asta (A,t,⇡π · 2,r2)
7 in return eval trans(Γ1, Γ2, π⇡, trans)
   *)

  Open Scope node_scope. Open Scope direction_scope.

  Definition set_size (r : set Q) := 0.

  Program
  Fixpoint eval (t : binary_tree Σ) (π : node | Dom t π) (r : set Q) { measure (tree_size t) } : set Q :=
    let lab := label_of t π in
    match lab with
      | hash => {}
      | label l =>
        let trans :=
            [set t in auto_transitions | (t.(trans_q) \in r) && (l \in t.(trans_L))]
        in
        let '(r1, r2) := split (map (states_of ∘ trans_Φ) trans) in
        let Γ1 := eval t (π @ [1]) r1 in
        let Γ2 := eval t (π @ [2]) r2 in
          eval_trans Γ1 Γ2 π trans
    end.

  Next Obligation.
    destruct t. depelim Heq_lab.
    simpl in Heq_lab.

  Next Obligation.
   admit.
  Defined.

  Next Obligation.
   admit.
  Defined.

End Evaluation.