Require Import List.
Require Import Setoid.
Require Import PeanoNat.
Require Import Coq.omega.Omega.
Require Import Matrix.
Require Import Coq.setoid_ring.Ring.
Require Import Coq.setoid_ring.Ring_theory.

Record AA := {
  x: nat;
  y:nat;
}.

Lemma nth_default_0: forall A: Type, forall a b : A, forall l: list A,
  nth_default b (a::l) 0 = a.
Proof.
  intros a l.
  reflexivity.
Qed.

Lemma nth_default_nil: forall A: Type, forall b : A, forall i,
  nth_default b nil i = b.
Proof.
  intros A0. intros b. intros i.
  unfold nth_default.
  unfold nth_error.
  destruct i.
  - reflexivity.
  - reflexivity.
Qed.

Lemma nth_default_S: forall A: Type, forall a b : A, forall l: list A, forall i,
  nth_default b (a :: l) (S i) = nth_default b l i.
Proof.
  intros A0 a b l i.
  unfold nth_default.
  unfold nth_error.
  reflexivity.
Qed.

Lemma nth_default_map : forall A B X d d0 i, forall f: A -> B,
  f (d) = d0 -> nth_default d0 (map f X) i =  f (nth_default d X i).
Proof.
  intros A B X.
  induction X as [| v X IHX].
  - intros d d0 i0 f H. simpl. rewrite nth_default_nil. rewrite nth_default_nil. rewrite H. reflexivity.
  - intros d d0 i0 f H. destruct i0.
    + rewrite nth_default_0. simpl. rewrite nth_default_0. reflexivity.
    + rewrite nth_default_S. simpl. rewrite nth_default_S. apply IHX.
      apply H.
Qed.

Section A.
 Variable ME : MatrixElem.
 Add Ring Aring : MEring.

Record CSR_Matrix {ME: MatrixElem} {m n : nat} :=
{
  A : list MEt;
  IA : list nat;
  JA : list nat;
  Content_IA_0: nth_default 0 IA 0 = 0;
  Content_IA_i: forall i : nat, i < m -> nth_default 0 IA i <= nth_default 0 IA (i + 1);
  Content_JA_i: forall i: nat, nth_default 0 JA i < n;
  Content_JA: forall i j j': nat, i < m -> nth_default 0 IA i < j -> j <= nth_default 0 IA (i + 1)
                                  -> nth_default 0 IA i < j' -> j' <= nth_default 0 IA (i + 1)
                                -> j < j' -> nth_default 0 JA j < nth_default 0 JA (j');

}.

Fixpoint get_v_CSR {ME: MatrixElem} (m n: nat) (M: @CSR_Matrix ME m n) (b a j: nat) :=
  match b with
  | 0 => MEzero
  | S b' => if (b =? a) then MEzero
            else if (nth_default 0 M.(JA) b <? j) then MEzero
            else if (nth_default 0 M.(JA) b =? j) then nth_default MEzero M.(A) b
            else get_v_CSR m n M b' a j
  end.

Definition Mget_CSR {ME: MatrixElem} (m n i j: nat) (M: @CSR_Matrix ME m n):=
if andb (i <? m) (j <? n) then
  get_v_CSR m n M (nth_default 0 M.(IA) (i + 1)) (nth_default 0 M.(IA) i) j
else
  MEzero.

Record CSC_Matrix {ME: MatrixElem} {m n : nat} :=
{
  B : list MEt;
  IB : list nat;
  JB : list nat;
  Content_IB_0: nth_default 0 IB 0 = 0;
  Content_IB_i: forall i : nat, i < n -> nth_default 0 IB i <= nth_default 0 IB (i + 1);
  Content_JB_i: forall i: nat, nth_default 0 JB i < m;
  Content_JB: forall i j j': nat, i < n -> nth_default 0 IB i < j -> j <= nth_default 0 IB (i + 1)
                                  -> nth_default 0 IB i < j' -> j' <= nth_default 0 IB (i + 1)
                                -> j < j' -> nth_default 0 JB j < nth_default 0 JB (j');
  }.

Fixpoint get_v_CSC {ME: MatrixElem} (m n: nat) (M: @CSC_Matrix ME m n) (b a i: nat) :=
  match b with
  | 0 => MEzero
  | S b' => if (b =? a) then MEzero
            else if (nth_default 0 M.(JB) b <? i) then MEzero
            else if (nth_default 0 M.(JB) b =? i) then nth_default MEzero M.(B) b
            else get_v_CSC m n M b' a i
  end.

Definition Mget_CSC {ME: MatrixElem} (m n i j: nat) (M: @CSC_Matrix ME m n):=
if andb (i <? m) (j <? n) then
  get_v_CSC m n M (nth_default 0 M.(IB) (j + 1)) (nth_default 0 M.(IB) j) i
else
  MEzero.

Fixpoint mul_CSR_CSC_row_col_eff_rec {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (x y : nat) (a b time: nat) :=
match time with
| 0 => MEzero
| S time' =>
if b =? y then MEzero
else if a =? x then MEzero
else if ((nth_default 0 M1.(JA) a) <? (nth_default 0 M2.(JB) b)) then
        mul_CSR_CSC_row_col_eff_rec m n p M1 M2 x y a (b-1) time'
else if (nth_default 0 M2.(JB) b =? nth_default 0 M1.(JA) a) then
        nth_default MEzero M1.(A) a *e nth_default MEzero M2.(B) b +e mul_CSR_CSC_row_col_eff_rec m n p M1 M2 x y (a-1) (b-1) time'
else    mul_CSR_CSC_row_col_eff_rec m n p M1 M2 x y (a-1) b time'
 end.

Definition mul_CSR_CSC_row_col_eff {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i j: nat) :=
  mul_CSR_CSC_row_col_eff_rec m n p M1 M2 (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
                                          (nth_default 0 M1.(IA) (i + 1)) (nth_default 0 M2.(IB) (j + 1))
                                          (nth_default 0 M1.(IA) (i + 1) + nth_default 0 M2.(IB) (j + 1)).

Fixpoint mul_CSR_CSC_row_col_eff_rec_le {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (x y : nat) (a b time k: nat) :=
match time with
| 0 => MEzero
| S time' =>
if b =? y then MEzero
else if a =? x then MEzero
else if ((nth_default 0 M1.(JA) a) <? (nth_default 0 M2.(JB) b)) then
        mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 x y a (b-1) time' k
else if (nth_default 0 M2.(JB) b =? nth_default 0 M1.(JA) a) then
  if (nth_default 0 M2.(JB) b <? k) then
        nth_default MEzero M1.(A) a *e nth_default MEzero M2.(B) b +e mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 x y (a-1) (b-1) time' k
  else
      mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 x y (a-1) (b-1) time' k
else    mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 x y (a-1) b time' k
 end.

Definition mul_CSR_CSC_row_col_eff_le {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i j k: nat) :=
  mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
                                          (nth_default 0 M1.(IA) (i + 1)) (nth_default 0 M2.(IB) (j + 1))
                                          (nth_default 0 M1.(IA) (i + 1) + nth_default 0 M2.(IB) (j + 1)) k.

Fixpoint mul_CSR_CSC_row_col_eff_rec_eq {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (x y : nat) (a b time k: nat) :=
match time with
| 0 => MEzero
| S time' =>
if b =? y then MEzero
else if a =? x then MEzero
else if ((nth_default 0 M1.(JA) a) <? (nth_default 0 M2.(JB) b)) then
        mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2 x y a (b-1) time' k
else if (nth_default 0 M2.(JB) b =? nth_default 0 M1.(JA) a) then
  if (nth_default 0 M2.(JB) b =? k) then
        nth_default MEzero M1.(A) a *e nth_default MEzero M2.(B) b +e mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2 x y (a-1) (b-1) time' k
  else
      mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2 x y (a-1) (b-1) time' k
else    mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2 x y (a-1) b time' k
 end.

Definition mul_CSR_CSC_row_col_eff_eq {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i j k: nat) :=
  mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2 (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
                                          (nth_default 0 M1.(IA) (i + 1)) (nth_default 0 M2.(IB) (j + 1))
                                          (nth_default 0 M1.(IA) (i + 1) + nth_default 0 M2.(IB) (j + 1)) k.

Lemma mul_CSR_CSC_row_col_eff_correct_base:
    forall m n p M1 M2 i j, mul_CSR_CSC_row_col_eff_le m n p M1 M2 i j 0 = MEzero.
Proof.
  intros.
  unfold mul_CSR_CSC_row_col_eff_le.
  remember (nth_default 0 (IA M1) (i + 1) + nth_default 0 (IB M2) (j + 1)) as time.
  clear Heqtime.
  remember (nth_default 0 (IA M1) (i + 1)) as a.
  remember (nth_default 0 (IB M2) (j + 1)) as b.
  clear Heqa. clear Heqb.
  generalize dependent b.
  generalize dependent a.
  induction time as [| time IHt]; intros.
  - cbn. reflexivity.
  - cbn. destruct (b =? nth_default 0 (IB M2) j); destruct (a =? nth_default 0 (IA M1) i); try destruct (match nth_default 0 (JB M2) b with
    | 0 => false
    | S m' => nth_default 0 (JA M1) a <=? m'
    end); try destruct ((nth_default 0 M2.(JB) b =? nth_default 0 M1.(JA) a)); try apply IHt; try reflexivity.
Qed.

Lemma mul_CSR_CSC_row_col_eff_correct_induct:
    forall m n p M1 M2 i j k,
    mul_CSR_CSC_row_col_eff_le m n p M1 M2 i j k +e mul_CSR_CSC_row_col_eff_eq m n p M1 M2 i j k
    = mul_CSR_CSC_row_col_eff_le m n p M1 M2 i j (S k).
Proof.
  intros.
  unfold mul_CSR_CSC_row_col_eff_le. unfold mul_CSR_CSC_row_col_eff_eq.
  remember (nth_default 0 (IA M1) (i + 1) + nth_default 0 (IB M2) (j + 1)) as time.
  clear Heqtime.
  remember (nth_default 0 (IA M1) (i + 1)) as a.
  remember (nth_default 0 (IB M2) (j + 1)) as b.
  clear Heqa. clear Heqb.
  generalize dependent b.
  generalize dependent a.
  induction time as [| time IHt]; intros.
  - cbn. ring.
  - cbn.
    destruct (b =? nth_default 0 (IB M2) j); try ring.
    destruct (a =? nth_default 0 (IA M1) i); try ring.
    destruct (match nth_default 0 (JB M2) b with
  | 0 => false
  | S m' => nth_default 0 (JA M1) a <=? m'
  end); try apply IHt.
    destruct (nth_default 0 (JB M2) b =? nth_default 0 (JA M1) a).
    + destruct (  match k with
    | 0 => false
    | S m' => nth_default 0 (JB M2) b <=? m'
    end) eqn : eq1.
      * assert (nth_default 0 (JB M2) b < k).
        { apply leb_iff. cbn. apply eq1. }
        assert (nth_default 0 (JB M2) b =? k = false).
        { apply Nat.eqb_neq. omega. }
        assert (nth_default 0 (JB M2) b <=? k = true).
        { apply leb_iff. omega. }
        rewrite H0. rewrite H1.
        rewrite <- IHt. ring.
      * assert (nth_default 0 (JB M2) b <? k = false).
        { apply eq1. }
        apply Nat.ltb_nlt in H.
        clear eq1.
        destruct (nth_default 0 (JB M2) b =? k) eqn: eq2.
        --- apply Nat.eqb_eq in eq2. assert (nth_default 0 (JB M2) b <=? k = true).
            { apply leb_iff. omega. }
            rewrite H0. rewrite <- IHt. ring.
        --- apply Nat.eqb_neq in eq2. assert (nth_default 0 (JB M2) b <=? k = false).
            { apply leb_iff_conv. omega. }
            rewrite H0. apply IHt.
    + apply IHt.
Qed.

Lemma mul_CSR_CSC_row_col_eff_rec_eq_caseb0:
    forall m n p M1 M2 i j a  time k,
    i < m -> j < p -> k < n -> a <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    ->  mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2
        (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
        (a + (nth_default 0 M1.(IA) i)) ((nth_default 0 M2.(IB) j)) time k
    = MEzero.
Proof.
  intros.
  cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
  destruct time; try reflexivity.
  destruct (nth_default 0 (IB M2) j); try reflexivity.
  assert (S n0 =? S n0 = true). { apply Nat.eqb_eq. reflexivity. }
  rewrite H3. reflexivity.
Qed.

Lemma mul_CSR_CSC_row_col_eff_rec_eq_casea0:
    forall m n p M1 M2 i j b  time k,
    i < m -> j < p -> k < n -> b <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    ->  mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2
        (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
        ((nth_default 0 M1.(IA) i)) (b + (nth_default 0 M2.(IB) j)) time k
    = MEzero.
Proof.
  intros.
  cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
  destruct time; try reflexivity.
  destruct (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j); try reflexivity.
  assert (nth_default 0 (IA M1) i =? nth_default 0 (IA M1) i = true).
  { apply Nat.eqb_eq. reflexivity. } rewrite H3. reflexivity.
Qed.

Lemma mul_CSR_CSC_row_col_eff_rec_eq_case0:
    forall m n p M1 M2 i j a b time k,
    i < m -> j < p -> k < n -> a <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> b <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> a = 0
        \/ b = 0 ->
      mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2
        (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
        (a + (nth_default 0 M1.(IA) i)) (b + (nth_default 0 M2.(IB) j)) time k
    = MEzero.
Proof.
  intros.
  unfold mul_CSR_CSC_row_col_eff_rec_eq.
  destruct (time); try reflexivity.
  inversion H4.
  - destruct (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j); try reflexivity.
    assert (a + nth_default 0 (IA M1) i =? nth_default 0 (IA M1) i = true).
    { apply Nat.eqb_eq. omega. }
    rewrite H6. reflexivity.
  - assert (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j = true).
    { apply Nat.eqb_eq. omega. }
    rewrite H6. reflexivity.
Qed.

Lemma mul_CSR_CSC_row_col_eff_rec_eq_case1:
    forall m n p M1 M2 i j a b time k,
    i < m -> j < p -> k < n -> a <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> b <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> nth_default 0 M1.(JA) (a + (nth_default 0 M1.(IA) i)) < k
        \/ nth_default 0 M2.(JB) (b + (nth_default 0 M2.(IB) j)) < k ->
      mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2
        (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
        (a + (nth_default 0 M1.(IA) i)) (b + (nth_default 0 M2.(IB) j)) time k
    = MEzero.
Proof.
  intros.
  destruct b; try apply mul_CSR_CSC_row_col_eff_rec_eq_caseb0; try assumption.
  destruct a; try apply mul_CSR_CSC_row_col_eff_rec_eq_casea0; try assumption.
  generalize dependent time.
  generalize dependent a.
  induction b as [| b IHb].
  - induction a as [| a IHa]; intros.
    + cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
      destruct time; try reflexivity.
      destruct (S (nth_default 0 (IB M2) j) =? nth_default 0 (IB M2) j); try reflexivity.
      destruct (S (nth_default 0 (IA M1) i) =? nth_default 0 (IA M1) i); try reflexivity.
      destruct (nth_default 0 (JA M1) (S (nth_default 0 (IA M1) i)) <?
  nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j))). Focus 1.
      assert (S (nth_default 0 (IB M2) j) - 1 = nth_default 0 (IB M2) j). { omega. }
      rewrite H5. assert (S (nth_default 0 (IA M1) i) = 1 + nth_default 0 (IA M1) i). { omega. }
      rewrite H6. apply mul_CSR_CSC_row_col_eff_rec_eq_caseb0; try assumption.

      destruct (nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j)) =?
  nth_default 0 (JA M1) (S (nth_default 0 (IA M1) i))) eqn : eq. Focus 2.
      assert (S (nth_default 0 (IA M1) i) - 1 = nth_default 0 (IA M1) i). { omega. }
      assert (S (nth_default 0 (IB M2) j) = 1 + nth_default 0 (IB M2) j). { omega. }
      rewrite H5. rewrite H6. apply mul_CSR_CSC_row_col_eff_rec_eq_casea0; try assumption.

      assert (nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j)) =? k = false).
      { apply Nat.eqb_eq in eq. apply Nat.eqb_neq.
        replace (1 + nth_default 0 (IA M1) i) with (S (nth_default 0 (IA M1) i)) in H4; try omega.
        replace (1 + nth_default 0 (IB M2) j) with (S (nth_default 0 (IB M2) j)) in H4; try omega.
      }
      rewrite H5. clear H5.
      replace (S (nth_default 0 (IA M1) i) - 1) with (nth_default 0 (IA M1) i) by omega.
      replace (S (nth_default 0 (IB M2) j) - 1) with (0 + nth_default 0 (IB M2) j) by omega.
      apply mul_CSR_CSC_row_col_eff_rec_eq_casea0; try assumption.
      assert (nth_default 0 (IB M2) j <= nth_default 0 (IB M2) (j + 1)).
      { apply M2.(Content_IB_i). assumption. }
      omega.
    + cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
      destruct time; try reflexivity.
      destruct (S (nth_default 0 (IB M2) j) =? nth_default 0 (IB M2) j); try reflexivity.
      destruct (S (S (a + nth_default 0 (IA M1) i)) =? nth_default 0 (IA M1) i); try reflexivity.
      destruct (nth_default 0 (JA M1) (S (S (a + nth_default 0 (IA M1) i))) <?
  nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j))). Focus 1.
      assert (S (nth_default 0 (IB M2) j) - 1 = nth_default 0 (IB M2) j). { omega. }
      assert (S (S (a + nth_default 0 (IA M1) i)) = (a + 2) + nth_default 0 (IA M1) i). { omega. }
      rewrite H5. rewrite H6. apply mul_CSR_CSC_row_col_eff_rec_eq_caseb0; try assumption.
      omega.

      destruct (nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j)) =?
  nth_default 0 (JA M1) (S (S (a + nth_default 0 (IA M1) i)))) eqn : eq. Focus 2.
      assert (S (S (a + nth_default 0 (IA M1) i)) - 1 = S a + nth_default 0 (IA M1) i). { omega. }
      rewrite H5. apply IHa; try assumption; try omega.
      inversion H4; try omega.
      left. assert (nth_default 0 (JA M1) (S a + nth_default 0 (IA M1) i) < nth_default 0 (JA M1) (S (S a) + nth_default 0 (IA M1) i)).
      { replace (S (S a) + nth_default 0 (IA M1) i) with ((S a + nth_default 0 (IA M1) i) + 1) by omega.
        apply M1.(Content_JA) with (i := i); try assumption; try omega. }
      omega.

      assert (nth_default 0 (JB M2) (S (nth_default 0 (IB M2) j)) =? k = false).
      { apply Nat.eqb_eq in eq. apply Nat.eqb_neq.
        replace (S (S a) + nth_default 0 (IA M1) i) with (S (S (a + nth_default 0 (IA M1) i))) in H4; try omega.
        replace (1 + nth_default 0 (IB M2) j) with (S (nth_default 0 (IB M2) j)) in H4; try omega.
      }
      rewrite H5. clear H5.
      replace (S (S (a + nth_default 0 (IA M1) i)) - 1) with ((a + 1) + nth_default 0 (IA M1) i) by omega.
      replace (S (nth_default 0 (IB M2) j) - 1) with (nth_default 0 (IB M2) j) by omega.
      apply mul_CSR_CSC_row_col_eff_rec_eq_caseb0; try assumption.
      omega.
  - induction a as [| a IHa]; intros.
    + cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
      destruct time; try reflexivity.
      destruct (S (S (b + nth_default 0 (IB M2) j)) =? nth_default 0 (IB M2) j); try reflexivity.
      destruct (S (nth_default 0 (IA M1) i) =? nth_default 0 (IA M1) i); try reflexivity.
      destruct (nth_default 0 (JA M1) (S (nth_default 0 (IA M1) i)) <?
  nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j)))). Focus 1.
      assert (S (S (b + nth_default 0 (IB M2) j)) - 1 = S b + nth_default 0 (IB M2) j). { omega. }
      assert (S (nth_default 0 (IA M1) i) = 1 + nth_default 0 (IA M1) i). { omega. }
      rewrite H5. rewrite H6. apply IHb; try omega.
      inversion H4; try omega.
      right. assert (nth_default 0 (JB M2) (S b + nth_default 0 (IB M2) j) < nth_default 0 (JB M2) (S (S b) + nth_default 0 (IB M2) j)).
      { replace (S (S b) + nth_default 0 (IB M2) j) with ((S b + nth_default 0 (IB M2) j) + 1) by omega.
        apply M2.(Content_JB) with (i := j); try omega. }
      omega.

      destruct (nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j))) =?
  nth_default 0 (JA M1) (S (nth_default 0 (IA M1) i))) eqn : eq. Focus 2.
      replace (S (nth_default 0 (IA M1) i) - 1) with (nth_default 0 (IA M1) i) by omega.
      replace (S (S (b + nth_default 0 (IB M2) j))) with ((b + 2) + nth_default 0 (IB M2) j) by omega.
      apply mul_CSR_CSC_row_col_eff_rec_eq_casea0; try omega.

      assert (nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j))) =? k = false).
      { apply Nat.eqb_eq in eq. apply Nat.eqb_neq.
        replace (1 + nth_default 0 (IA M1) i) with (S (nth_default 0 (IA M1) i)) in H4; try omega.
        replace (S (S b) + nth_default 0 (IB M2) j) with (S (S (b + nth_default 0 (IB M2) j))) in H4; try omega.
      }
      rewrite H5. clear H5.
      replace (S (nth_default 0 (IA M1) i) - 1) with (nth_default 0 (IA M1) i) by omega.
      replace (S (S (b + nth_default 0 (IB M2) j)) - 1) with ((b + 1) + nth_default 0 (IB M2) j) by omega.
      apply mul_CSR_CSC_row_col_eff_rec_eq_casea0; try omega.
    + cbn. unfold mul_CSR_CSC_row_col_eff_rec_eq.
      destruct time; try reflexivity.
      destruct (S (S (b + nth_default 0 (IB M2) j)) =? nth_default 0 (IB M2) j); try reflexivity.
      destruct (S (S (a + nth_default 0 (IA M1) i)) =? nth_default 0 (IA M1) i); try reflexivity.
      destruct (nth_default 0 (JA M1) (S (S (a + nth_default 0 (IA M1) i))) <?
     nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j)))). Focus 1.
      replace (S (S (b + nth_default 0 (IB M2) j)) - 1) with (S b + nth_default 0 (IB M2) j) by omega.
      replace (S (S (a + nth_default 0 (IA M1) i))) with ( S (S a) + nth_default 0 (IA M1) i) by omega.
      apply IHb; try omega.
      inversion H4; try omega.
      right. assert (nth_default 0 (JB M2) (S b + nth_default 0 (IB M2) j) < nth_default 0 (JB M2) (S (S b) + nth_default 0 (IB M2) j)).
      { replace (S (S b) + nth_default 0 (IB M2) j) with ((S b + nth_default 0 (IB M2) j) + 1) by omega.
        apply M2.(Content_JB) with (i := j); try omega. }
      omega.

      destruct (nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j))) =?
  nth_default 0 (JA M1) (S (S (a + nth_default 0 (IA M1) i)))) eqn : eq. Focus 2.
      replace (S (S (a + nth_default 0 (IA M1) i)) - 1) with (S a + nth_default 0 (IA M1) i) by omega.
      replace (S (S (b + nth_default 0 (IB M2) j))) with (S (S b) + nth_default 0 (IB M2) j) by omega.
      apply IHa; try omega.
      inversion H4; try omega.
      left. assert (nth_default 0 (JA M1) (S a + nth_default 0 (IA M1) i) < nth_default 0 (JA M1) (S (S a) + nth_default 0 (IA M1) i)).
      { replace (S (S a) + nth_default 0 (IA M1) i) with ((S a + nth_default 0 (IA M1) i) + 1) by omega.
        apply M1.(Content_JA) with (i := i); try omega. }
      omega.

      assert (nth_default 0 (JB M2) (S (S (b + nth_default 0 (IB M2) j))) =? k = false).
      { apply Nat.eqb_eq in eq. apply Nat.eqb_neq.
        replace (S (S a) + nth_default 0 (IA M1) i) with (S (S (a + nth_default 0 (IA M1) i))) in H4; try omega.
        replace (S (S b) + nth_default 0 (IB M2) j) with (S (S (b + nth_default 0 (IB M2) j))) in H4; try omega.
      }
      rewrite H5. clear H5.
      replace (S (S (a + nth_default 0 (IA M1) i)) - 1) with (S a + nth_default 0 (IA M1) i) by omega.
      replace (S (S (b + nth_default 0 (IB M2) j)) - 1) with (S b + nth_default 0 (IB M2) j) by omega.
      apply IHb; try omega. inversion H4.
      * left. assert (nth_default 0 (JA M1) (S a + nth_default 0 (IA M1) i) < nth_default 0 (JA M1) (S (S a) + nth_default 0 (IA M1) i)).
      { replace (S (S a) + nth_default 0 (IA M1) i) with ((S a + nth_default 0 (IA M1) i) + 1) by omega.
        apply M1.(Content_JA) with (i := i); try omega. }
      omega.
      * right. assert (nth_default 0 (JB M2) (S b + nth_default 0 (IB M2) j) < nth_default 0 (JB M2) (S (S b) + nth_default 0 (IB M2) j)).
      { replace (S (S b) + nth_default 0 (IB M2) j) with ((S b + nth_default 0 (IB M2) j) + 1) by omega.
        apply M2.(Content_JB) with (i := j); try omega. }
      omega.
Qed.

Lemma Quick_get_CSR_correct:
  forall m n i k M1 a,
    i < m -> k < n -> 1 <= a
    -> a <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> nth_default 0 M1.(JA) (a + (nth_default 0 M1.(IA) i)) = k
    -> nth_default MEzero M1.(A) (a + (nth_default 0 M1.(IA) i)) = Mget_CSR m n i k M1.
Proof.
  intros.
  assert (forall x,
      x <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i) - a
      -> nth_default MEzero M1.(A) (a + (nth_default 0 M1.(IA) i))
        = get_v_CSR m n M1 (a + x + (nth_default 0 M1.(IA) i)) (nth_default 0 M1.(IA) i) k).
  {
    induction x0 as [| x IHx].
    - intros.
      unfold get_v_CSR.
      cbn. destruct (a + 0 + nth_default 0 (IA M1) i) eqn : eq.
      + assert ( a + 0 + nth_default 0 (IA M1) i > 0). { omega. } rewrite eq in H5. inversion H5.
      + assert (  match k with
  | 0 => false
  | S m' => nth_default 0 (JA M1) (S n0) <=? m'
  end = false). { destruct k; try reflexivity. apply leb_iff_conv.
                  rewrite <- eq. replace (a + 0 + nth_default 0 (IA M1) i) with (a + nth_default 0 (IA M1) i) by omega.
                  omega. }
        rewrite H5.
        assert (nth_default 0 (JA M1) (S n0) = k).
        { rewrite <- eq. replace (a + 0 + nth_default 0 (IA M1) i) with (a + nth_default 0 (IA M1) i) by omega.
          assumption. }
        rewrite H6. assert (k =? k = true). { apply Nat.eqb_eq. reflexivity. }
        rewrite H7. clear H7. clear H6. rewrite <- eq.
        replace (a + 0 + nth_default 0 (IA M1) i) with (a + nth_default 0 (IA M1) i) by omega.
        assert (a + nth_default 0 (IA M1) i =? nth_default 0 (IA M1) i = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H6. reflexivity.
    - intros.
      unfold get_v_CSR.
      destruct (a + S x + nth_default 0 (IA M1) i) eqn: eq.
      + assert (a + S x + nth_default 0 (IA M1) i > 0). { omega. }
        rewrite eq in H5. inversion H5.
      + assert (nth_default 0 (JA M1) (S n0) > k).
        { rewrite <- eq. rewrite <- H3.
          apply M1.(Content_JA) with (i:=i); try omega. }
        assert (nth_default 0 (JA M1) (S n0) <? k = false).
        { apply Nat.ltb_nlt. omega. }
        rewrite H6.
        assert (nth_default 0 (JA M1) (S n0) =? k = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H7.
        assert (S n0 =? nth_default 0 (IA M1) i = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H8. assert (n0 = a + x + nth_default 0 (IA M1) i). { omega. }
        rewrite H9. apply IHx. omega. }
  unfold Mget_CSR.
  replace (andb (i <? m)  (k <? n)) with true.
  - replace (nth_default 0 (IA M1) (i + 1)) with (a + ((nth_default 0 (IA M1) (i + 1) - (nth_default 0 (IA M1) (i)) - a)) + nth_default 0 (IA M1) i) by omega.
    apply H4. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Lemma Quick_get_CSC_correct:
  forall n p j k M2 b,
    j < p -> k < n -> 1 <= b
    -> b <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> nth_default 0 M2.(JB) (b + (nth_default 0 M2.(IB) j)) = k
    -> nth_default MEzero M2.(B) (b + (nth_default 0 M2.(IB) j)) = Mget_CSC n p k j M2.
Proof.
  intros.
  assert (forall x,
      x <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j) - b
      -> nth_default MEzero M2.(B) (b + (nth_default 0 M2.(IB) j))
        = get_v_CSC n p M2 (b + x + (nth_default 0 M2.(IB) j)) (nth_default 0 M2.(IB) j) k).
  {
    induction x0 as [| x IHx].
    - intros.
      unfold get_v_CSC.
      cbn. destruct (b + 0 + nth_default 0 (IB M2) j) eqn : eq.
      + assert ( b + 0 + nth_default 0 (IB M2) j > 0). { omega. } rewrite eq in H5. inversion H5.
      + assert (  match k with
  | 0 => false
  | S m' => nth_default 0 (JB M2) (S n0) <=? m'
  end = false). { destruct k; try reflexivity. apply leb_iff_conv.
                  rewrite <- eq. replace (b + 0 + nth_default 0 (IB M2) j) with (b + nth_default 0 (IB M2) j) by omega.
                  omega. }
        rewrite H5.
        assert (nth_default 0 (JB M2) (S n0) = k).
        { rewrite <- eq. replace (b + 0 + nth_default 0 (IB M2) j) with (b + nth_default 0 (IB M2) j) by omega.
          assumption. }
        rewrite H6. assert (k =? k = true). { apply Nat.eqb_eq. reflexivity. }
        rewrite H7. clear H7. clear H6. rewrite <- eq.
        replace (b + 0 + nth_default 0 (IB M2) j) with (b + nth_default 0 (IB M2) j) by omega.
        assert (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H6. reflexivity.
    - intros.
      unfold get_v_CSC.
      destruct (b + S x + nth_default 0 (IB M2) j) eqn: eq.
      + assert (b + S x + nth_default 0 (IB M2) j > 0). { omega. }
        rewrite eq in H5. inversion H5.
      + assert (nth_default 0 (JB M2) (S n0) > k).
        { rewrite <- eq. rewrite <- H3.
          apply M2.(Content_JB) with (i:=j); try omega. }
        assert (nth_default 0 (JB M2) (S n0) <? k = false).
        { apply Nat.ltb_nlt. omega. }
        rewrite H6.
        assert (nth_default 0 (JB M2) (S n0) =? k = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H7.
        assert (S n0 =? nth_default 0 (IB M2) j = false).
        { apply Nat.eqb_neq. omega. }
        rewrite H8. assert (n0 = b + x + nth_default 0 (IB M2) j). { omega. }
        rewrite H9. apply IHx. omega. }
  unfold Mget_CSC.
  replace (andb (k <? n)  (j <? p)) with true.
  - replace (nth_default 0 (IB M2) (j + 1)) with (b + ((nth_default 0 (IB M2) (j + 1) - (nth_default 0 (IB M2) (j)) - b)) + nth_default 0 (IB M2) j) by omega.
    apply H4. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Lemma Quick_get_CSR_zero_condition0:
  forall m n i k M1 a,
    i < m -> k < n -> a = 0
    -> a < (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> nth_default 0 M1.(JA) ((a + 1) + (nth_default 0 M1.(IA) i)) > k
    -> MEzero = Mget_CSR m n i k M1.
Proof.
  intros.
  assert (forall x,
    x <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i) - a
    -> MEzero
      = get_v_CSR m n M1 (a + x + (nth_default 0 M1.(IA) i)) (nth_default 0 M1.(IA) i) k).
  {
    induction x0 as [| x IHx].
    - intros. unfold get_v_CSR. cbn.
      destruct (a + 0 + nth_default 0 (IA M1) i) eqn : eq; try reflexivity.
      assert (S n0 =? nth_default 0 (IA M1) i = true).
      { apply Nat.eqb_eq. omega. }
      rewrite H5. reflexivity.
    - intros. unfold get_v_CSR.
      destruct (a + S x + nth_default 0 (IA M1) i) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IA M1) i); try reflexivity.
      assert (nth_default 0 (JA M1) (S n0) > k).
      {
        assert (nth_default 0 (JA M1) (S n0) >= nth_default 0 (JA M1) (a + 1 + nth_default 0 (IA M1) i)).
        {
          rewrite <- eq.
          destruct (a + S x + nth_default 0 (IA M1) i =? a + 1 + nth_default 0 (IA M1) i) eqn: eq2.
          + apply Nat.eqb_eq in eq2. rewrite eq2. omega.
          + apply beq_nat_false in eq2. apply Nat.lt_le_incl. apply M1.(Content_JA) with ( i:= i); try omega. }
        omega. }
      destruct (nth_default 0 (JA M1) (S n0) <? k); try reflexivity.
      assert (nth_default 0 (JA M1) (S n0) =? k = false).
      { apply Nat.eqb_neq. omega. }
      rewrite H6. replace n0 with (a + x + nth_default 0 (IA M1) i) by omega.
      apply IHx; omega.
    }
    unfold Mget_CSR.
    replace (andb (i <? m)  (k <? n)) with true.
    - replace (nth_default 0 (IA M1) (i + 1)) with (a + ((nth_default 0 (IA M1) (i + 1) - (nth_default 0 (IA M1) (i)) - a)) + nth_default 0 (IA M1) i) by omega.
    apply H4. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Lemma Quick_get_CSC_zero_condition0:
  forall n p j k M2 b,
    j < p -> k < n -> b = 0
    -> b < (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> nth_default 0 M2.(JB) ((b + 1) + (nth_default 0 M2.(IB) j)) > k
    -> MEzero = Mget_CSC n p k j M2.
Proof.
  intros.
  assert (forall x,
    x <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j) - b
    -> MEzero
      = get_v_CSC n p M2 (b + x + (nth_default 0 M2.(IB) j)) (nth_default 0 M2.(IB) j) k).
  {
    induction x0 as [| x IHx].
    - intros. unfold get_v_CSC. cbn.
      destruct (b + 0 + nth_default 0 (IB M2) j) eqn : eq; try reflexivity.
      assert (S n0 =? nth_default 0 (IB M2) j = true).
      { apply Nat.eqb_eq. omega. }
      rewrite H5. reflexivity.
    - intros. unfold get_v_CSC.
      destruct (b + S x + nth_default 0 (IB M2) j) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IB M2) j); try reflexivity.
      assert (nth_default 0 (JB M2) (S n0) > k).
      {
        assert (nth_default 0 (JB M2) (S n0) >= nth_default 0 (JB M2) (b + 1 + nth_default 0 (IB M2) j)).
        {
          rewrite <- eq.
          destruct (b + S x + nth_default 0 (IB M2) j =? b + 1 + nth_default 0 (IB M2) j) eqn: eq2.
          + apply Nat.eqb_eq in eq2. rewrite eq2. omega.
          + apply beq_nat_false in eq2. apply Nat.lt_le_incl. apply M2.(Content_JB) with ( i:= j); try omega. }
        omega. }
      destruct (nth_default 0 (JB M2) (S n0) <? k); try reflexivity.
      assert (nth_default 0 (JB M2) (S n0) =? k = false).
      { apply Nat.eqb_neq. omega. }
      rewrite H6. replace n0 with (b + x + nth_default 0 (IB M2) j) by omega.
      apply IHx; omega.
    }
    unfold Mget_CSC.
    replace (andb (k <? n)  (j <? p)) with true.
    - replace (nth_default 0 (IB M2) (j + 1)) with (b + ((nth_default 0 (IB M2) (j + 1) - (nth_default 0 (IB M2) (j)) - b)) + nth_default 0 (IB M2) j) by omega.
    apply H4. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Lemma Quick_get_CSR_zero_condition1:
  forall m n i k M1 a,
    i < m -> k < n -> 1 <= a
    -> a < (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> nth_default 0 M1.(JA) ((a + 1) + (nth_default 0 M1.(IA) i)) > k
    -> nth_default 0 M1.(JA) (a + (nth_default 0 M1.(IA) i)) < k
    -> MEzero = Mget_CSR m n i k M1.
Proof.
  intros.
  assert (forall x,
    x <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i) - a
    -> MEzero
      = get_v_CSR m n M1 (a + x + (nth_default 0 M1.(IA) i)) (nth_default 0 M1.(IA) i) k).
  {
    induction x0 as [| x IHx].
    - intros. unfold get_v_CSR. cbn.
      destruct (a + 0 + nth_default 0 (IA M1) i) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IA M1) i); try reflexivity.
      assert (  match k with
  | 0 => false
  | S m' => nth_default 0 (JA M1) (S n0) <=? m'
  end = true).
      { destruct k; try omega. apply leb_iff. rewrite <- eq.
        replace (a + 0 + nth_default 0 (IA M1) i) with (a + nth_default 0 (IA M1) i) by omega.
        omega. }
      rewrite H6. reflexivity.
    - intros. unfold get_v_CSR.
      destruct (a + S x + nth_default 0 (IA M1) i) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IA M1) i); try reflexivity.
      assert (nth_default 0 (JA M1) (S n0) > k).
      {
        assert (nth_default 0 (JA M1) (S n0) >= nth_default 0 (JA M1) (a + 1 + nth_default 0 (IA M1) i)).
        {
          rewrite <- eq.
          destruct (a + S x + nth_default 0 (IA M1) i =? a + 1 + nth_default 0 (IA M1) i) eqn: eq2.
          + apply Nat.eqb_eq in eq2. rewrite eq2. omega.
          + apply beq_nat_false in eq2. apply Nat.lt_le_incl. apply M1.(Content_JA) with ( i:= i); try omega. }
        omega. }
      destruct (nth_default 0 (JA M1) (S n0) <? k); try reflexivity.
      assert (nth_default 0 (JA M1) (S n0) =? k = false).
      { apply Nat.eqb_neq. omega. }
      rewrite H7. replace n0 with (a + x + nth_default 0 (IA M1) i) by omega.
      apply IHx; omega.
    }
    unfold Mget_CSR.
    replace (andb (i <? m)  (k <? n)) with true.
    - replace (nth_default 0 (IA M1) (i + 1)) with (a + ((nth_default 0 (IA M1) (i + 1) - (nth_default 0 (IA M1) (i)) - a)) + nth_default 0 (IA M1) i) by omega.
    apply H5. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Lemma Quick_get_CSC_zero_condition1:
  forall n p j k M2 b,
    j < p -> k < n -> 1 <= b
    -> b < (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> nth_default 0 M2.(JB) ((b + 1) + (nth_default 0 M2.(IB) j)) > k
    -> nth_default 0 M2.(JB) (b + (nth_default 0 M2.(IB) j)) < k
    -> MEzero = Mget_CSC n p k j M2.
Proof.
  intros.
  assert (forall x,
    x <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j) - b
    -> MEzero
      = get_v_CSC n p M2 (b + x + (nth_default 0 M2.(IB) j)) (nth_default 0 M2.(IB) j) k).
  {
    induction x0 as [| x IHx].
    - intros. unfold get_v_CSC. cbn.
      destruct (b + 0 + nth_default 0 (IB M2) j) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IB M2) j); try reflexivity.
      assert (  match k with
  | 0 => false
  | S m' => nth_default 0 (JB M2) (S n0) <=? m'
  end = true).
      { destruct k; try omega. apply leb_iff. rewrite <- eq.
        replace (b + 0 + nth_default 0 (IB M2) j) with (b + nth_default 0 (IB M2) j) by omega.
        omega. }
      rewrite H6. reflexivity.
    - intros. unfold get_v_CSC.
      destruct (b + S x + nth_default 0 (IB M2) j) eqn : eq; try reflexivity.
      destruct (S n0 =? nth_default 0 (IB M2) j); try reflexivity.
      assert (nth_default 0 (JB M2) (S n0) > k).
      {
        assert (nth_default 0 (JB M2) (S n0) >= nth_default 0 (JB M2) (b + 1 + nth_default 0 (IB M2) j)).
        {
          rewrite <- eq.
          destruct (b + S x + nth_default 0 (IB M2) j =? b + 1 + nth_default 0 (IB M2) j) eqn: eq2.
          + apply Nat.eqb_eq in eq2. rewrite eq2. omega.
          + apply beq_nat_false in eq2. apply Nat.lt_le_incl. apply M2.(Content_JB) with ( i:= j); try omega. }
        omega. }
      destruct (nth_default 0 (JB M2) (S n0) <? k); try reflexivity.
      assert (nth_default 0 (JB M2) (S n0) =? k = false).
      { apply Nat.eqb_neq. omega. }
      rewrite H7. replace n0 with (b + x + nth_default 0 (IB M2) j) by omega.
      apply IHx; omega.
    }
    unfold Mget_CSC.
    replace (andb (k <? n)  (j <? p)) with true.
    - replace (nth_default 0 (IB M2) (j + 1)) with (b + ((nth_default 0 (IB M2) (j + 1) - (nth_default 0 (IB M2) (j)) - b)) + nth_default 0 (IB M2) j) by omega.
    apply H5. omega.
  - symmetry. apply Bool.andb_true_iff. split; apply Nat.ltb_lt; omega.
Qed.

Ltac urgh :=
   repeat match goal with
        | [ H: _ =? _ = true |- _ ] => rewrite Nat.eqb_eq in H
        | [ |- _ =? _ = true ] => rewrite Nat.eqb_eq
        | [ H: _ <? _ = true |- _ ] => apply Nat.ltb_lt in H
        | [ |- _ <? _ = true] => apply Nat.ltb_lt
        | [ H: _ <? _ = false |- _ ] => apply Nat.ltb_nlt in H
        | [ |- _ <? _ = false] => apply Nat.ltb_nlt
        | [ H: _ <=? _ = false |- _ ] => apply leb_iff_conv in H
        | [ |- _ <=? _ = false] => apply leb_iff_conv
        | [ H: _ <=? _ = true |- _ ] => apply leb_iff in H
        | [ |- _ <=? _ = true] => apply leb_iff
        | [ H: _ =? _ = false |- _ ] => apply Nat.eqb_neq in H
        | [ |- _ =? _ = false] => apply Nat.eqb_neq
        end.

Lemma mul_CSR_CSC_row_col_eff_rec_eq_case2:
    forall m n p M1 M2 i j a b time k,
    i < m -> j < p -> k < n -> 1 <= a -> a <= (nth_default 0 M1.(IA) (i + 1)) - (nth_default 0 M1.(IA) i)
    -> 1 <= b -> b <= (nth_default 0 M2.(IB) (j + 1)) - (nth_default 0 M2.(IB) j)
    -> a + b <= time -> nth_default 0 M1.(JA) (a + (nth_default 0 M1.(IA) i)) >= k
        /\ nth_default 0 M2.(JB) (b + (nth_default 0 M2.(IB) j)) >= k ->
      mul_CSR_CSC_row_col_eff_rec_eq m n p M1 M2
        (nth_default 0 M1.(IA) i) (nth_default 0 M2.(IB) j)
        (a + (nth_default 0 M1.(IA) i)) (b + (nth_default 0 M2.(IB) j)) time k
    = (Mget_CSR m n i k M1) *e (Mget_CSC n p k j M2).
Proof.
  intros.
  generalize dependent a.
  generalize dependent b.
  induction time as [| time IHtime].
  - intros. omega.
  - intros.
    unfold mul_CSR_CSC_row_col_eff_rec_eq.
    assert (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j = false).
    {
      apply Nat.eqb_neq. omega.
    }
    rewrite H8. clear H8.
    assert (a + nth_default 0 (IA M1) i =? nth_default 0 (IA M1) i = false).
    {
      apply Nat.eqb_neq. omega.
    }
    rewrite H8. clear H8.
    destruct (nth_default 0 (JA M1) (a + nth_default 0 (IA M1) i) <?
   nth_default 0 (JB M2) (b + nth_default 0 (IB M2) j)) eqn: eq. Focus 1.

    destruct (b - 1 =? 0) eqn: eq1.
    + urgh.
      replace (b + nth_default 0 (IB M2) j - 1) with (0 + nth_default 0 (IB M2) j) by omega.
      rewrite <- Quick_get_CSC_zero_condition0 with (b := 0); urgh; try replace (0 + 1) with b by omega; try omega.
      destruct time; try ring.
      assert (0 + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j = true) by (urgh; omega).
      rewrite H8. ring.
    + destruct (k <=? nth_default 0 (JB M2) ((b - 1) + nth_default 0 (IB M2) j)) eqn: eq2.
      --- replace (b + nth_default 0 (IB M2) j - 1) with ((b-1) + nth_default 0 (IB M2) j) by omega.
          urgh. rewrite IHtime; try omega; try ring.
      --- urgh.  rewrite <- Quick_get_CSC_zero_condition1 with (b := (b-1)); try replace (b - 1 + 1) with b by omega; try omega.
          replace (b + nth_default 0 (IB M2) j - 1) with ((b-1) + nth_default 0 (IB M2) j) by omega.
            rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega; try ring.

    + urgh.
      destruct (nth_default 0 (JB M2) (b + nth_default 0 (IB M2) j) =?
  nth_default 0 (JA M1) (a + nth_default 0 (IA M1) i)) eqn: eq2. Focus 2.

      urgh. destruct (a - 1 =? 0) eqn: eq3.
      * urgh. replace (a + nth_default 0 (IA M1) i - 1) with (0 + nth_default 0 (IA M1) i) by omega.
        rewrite <- Quick_get_CSR_zero_condition0 with (a := 0); urgh; try replace (0 + 1) with a by omega; try omega.
        destruct time; try ring.
        destruct (b + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j); try ring.
        assert (0 + nth_default 0 (IA M1) i =? nth_default 0 (IA M1) i = true) by (urgh; omega).
        rewrite H8. ring. Focus 2.
      * destruct (k <=? nth_default 0 (JA M1) ((a - 1) + nth_default 0 (IA M1) i)) eqn: eq1.
      --- replace (a + nth_default 0 (IA M1) i - 1) with ((a-1) + nth_default 0 (IA M1) i) by omega.
          urgh. rewrite IHtime; try omega; try ring. Focus 2.
      --- urgh.  rewrite <- Quick_get_CSR_zero_condition1 with (a := (a-1)); try replace (a - 1 + 1) with a by omega; try omega.
          replace (a + nth_default 0 (IA M1) i - 1) with ((a-1) + nth_default 0 (IA M1) i) by omega.
            rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega; try ring.

    urgh. destruct (nth_default 0 (JB M2) (b + nth_default 0 (IB M2) j) =? k) eqn: eq1.
    * urgh. rewrite Quick_get_CSR_correct with (k := k); try omega.
      urgh. rewrite Quick_get_CSC_correct with (k := k); try omega.
      replace (a + nth_default 0 (IA M1) i - 1) with ((a - 1) + nth_default 0 (IA M1) i) by omega.
      replace (b + nth_default 0 (IB M2) j - 1) with ((b - 1) + nth_default 0 (IB M2) j) by omega.
      destruct (a - 1 =? 0) eqn: eq3; urgh.
      --- replace (a - 1) with 0 by omega. rewrite mul_CSR_CSC_row_col_eff_rec_eq_casea0; try omega; try ring.
      --- rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega; try ring.
          left.
          assert (nth_default 0 (JA M1) (a - 1 + nth_default 0 (IA M1) i) < nth_default 0 (JA M1) (a + nth_default 0 (IA M1) i)).
          { apply M1.(Content_JA) with (i:=i); try omega. }
          omega.
    * replace (a + nth_default 0 (IA M1) i - 1) with ((a - 1) + nth_default 0 (IA M1) i) by omega.
      replace (b + nth_default 0 (IB M2) j - 1) with ((b - 1) + nth_default 0 (IB M2) j) by omega.
      urgh. destruct (b - 1 =? 0) eqn: eq3.
      --- urgh.
          rewrite <- Quick_get_CSC_zero_condition0 with (b := 0); urgh; try replace (0 + 1) with b by omega; try omega.
          destruct time; try ring.
          assert (b - 1 + nth_default 0 (IB M2) j =? nth_default 0 (IB M2) j = true) by (urgh; omega).
          rewrite H8. ring.

      --- destruct (k <=? nth_default 0 (JB M2) ((b - 1) + nth_default 0 (IB M2) j)) eqn: eq4. Focus 2.

      urgh. rewrite <- Quick_get_CSC_zero_condition1 with (b := (b-1)); try replace (b - 1 + 1) with b by omega; try omega.
      rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega; try ring.

      urgh. destruct (a - 1 =? 0) eqn: eq5. Focus 1.

      urgh.
      rewrite <- Quick_get_CSR_zero_condition0 with (a := 0); urgh; try replace (0 + 1) with a by omega; try omega.
      replace (a - 1) with 0 by omega. rewrite mul_CSR_CSC_row_col_eff_rec_eq_casea0; try omega. ring.

      urgh.
      destruct (k <=? nth_default 0 (JA M1) ((a - 1) + nth_default 0 (IA M1) i)) eqn: eq6. Focus 2.
      urgh.
      rewrite <- Quick_get_CSR_zero_condition1 with (a := (a-1)); try replace (a - 1 + 1) with a by omega; try omega.
      rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega; try ring.

      urgh. rewrite IHtime; try omega. ring.
Qed.

Theorem mul_CSR_CSC_row_col_eff_eq_correct:
forall m n p M1 M2 i j k,
i < m -> j < p -> k < n ->
 mul_CSR_CSC_row_col_eff_eq m n p M1 M2 i j k = (Mget_CSR m n i k M1) *e (Mget_CSC n p k j M2).
Proof.
  intros. unfold mul_CSR_CSC_row_col_eff_eq.
  assert (nth_default 0 (IA M1) i <= nth_default 0 (IA M1) (i + 1)).
  { apply M1.(Content_IA_i). omega. }
  replace (nth_default 0 (IA M1) (i + 1)) with ((nth_default 0 (IA M1) (i + 1) - nth_default 0 (IA M1) (i)) + nth_default 0 (IA M1) i) by omega.

  assert (nth_default 0 (IB M2) j <= nth_default 0 (IB M2) (j + 1)).
  { apply M2.(Content_IB_i). omega. }
  replace (nth_default 0 (IB M2) (j + 1)) with ((nth_default 0 (IB M2) (j + 1) - nth_default 0 (IB M2) (j)) + nth_default 0 (IB M2) j) by omega.

  destruct (nth_default 0 (IA M1) (i + 1) - nth_default 0 (IA M1) i =? 0) eqn: eq1. Focus 1.
  urgh. rewrite eq1. rewrite mul_CSR_CSC_row_col_eff_rec_eq_casea0; try omega.
  unfold Mget_CSR. assert (andb (i <? m) (k <? n) = true).
  { apply Bool.andb_true_iff. split; urgh; omega. }
  rewrite H4. unfold get_v_CSR.
  destruct (nth_default 0 (IA M1) (i + 1)); try ring.
  assert (S n0 =? nth_default 0 (IA M1) i = true).
  { urgh. omega. }
  rewrite H5. ring.

  destruct (nth_default 0 (IB M2) (j + 1) - nth_default 0 (IB M2) j =? 0) eqn: eq2. Focus 1.
  urgh. rewrite eq2. rewrite mul_CSR_CSC_row_col_eff_rec_eq_caseb0; try omega.
  unfold Mget_CSC. assert (andb (k <? n) (j <? p) = true).
  { apply Bool.andb_true_iff. split; urgh; omega. }
  rewrite H4. unfold get_v_CSC.
  destruct (nth_default 0 (IB M2) (j + 1)); try ring.
  assert (S n0 =? nth_default 0 (IB M2) j = true).
  { urgh. omega. }
  rewrite H5. ring.

  remember (nth_default 0 (IA M1) (i + 1) - nth_default 0 (IA M1) i) as a.
  remember (nth_default 0 (IB M2) (j + 1) - nth_default 0 (IB M2) j) as b.

  urgh.
  destruct (nth_default 0 (JA M1) (a + nth_default 0 (IA M1) i) <? k) eqn: eq3. Focus 1.
  urgh. rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega.
  unfold Mget_CSR. assert (andb (i <? m) (k <? n) = true).
  { apply Bool.andb_true_iff. split; urgh; omega. }
  rewrite H4. unfold get_v_CSR.
  destruct (nth_default 0 (IA M1) (i + 1)); try ring.
  destruct (S n0 =? nth_default 0 (IA M1) i); try ring.
  assert (nth_default 0 (JA M1) (S n0) <? k = true).
  { urgh. replace (S n0) with (a + nth_default 0 (IA M1) i) by omega. apply eq3. }
  rewrite H5. ring.

  urgh.
  destruct (nth_default 0 (JB M2) (b + nth_default 0 (IB M2) j) <? k) eqn: eq4. Focus 1.
  urgh. rewrite mul_CSR_CSC_row_col_eff_rec_eq_case1; try omega.
  unfold Mget_CSC. assert (andb (k <? n) (j <? p) = true).
  { apply Bool.andb_true_iff. split; urgh; omega. }
  rewrite H4. unfold get_v_CSC.
  destruct (nth_default 0 (IB M2) (j + 1)); try ring.
  destruct (S n0 =? nth_default 0 (IB M2) j); try ring.
  assert (nth_default 0 (JB M2) (S n0) <? k = true).
  { urgh. replace (S n0) with (b + nth_default 0 (IB M2) j) by omega. apply eq4. }
  rewrite H5. ring.

  rewrite mul_CSR_CSC_row_col_eff_rec_eq_case2; try omega; try ring.
  split; try urgh; try omega.
Qed.

Theorem mul_CSR_CSC_row_col_eff_le_correct:
forall m n p M1 M2 i j k,
i < m -> j < p -> k <= n ->
 mul_CSR_CSC_row_col_eff_le m n p M1 M2 i j k = sum k (fun k => (Mget_CSR m n i k M1) *e (Mget_CSC n p k j M2)).
Proof.
  intros.
  induction k as [| k IHk].
  - cbn. apply mul_CSR_CSC_row_col_eff_correct_base.
  - cbn. rewrite <- IHk; try omega.
    rewrite <- mul_CSR_CSC_row_col_eff_correct_induct.
    rewrite mul_CSR_CSC_row_col_eff_eq_correct; try omega. reflexivity.
Qed.

Lemma mul_CSR_CSC_row_col_eff_rec_le_equal:
forall m n p M1 M2 x y a b time,
 mul_CSR_CSC_row_col_eff_rec_le m n p M1 M2 x y a b time n = mul_CSR_CSC_row_col_eff_rec m n p M1 M2 x y a b time.
Proof.
  intros.
  generalize dependent a.
  generalize dependent b.
  induction time as [| time IHtime]; intros.
  - cbn. reflexivity.
  - simpl. destruct (b =? y0); try reflexivity.
    destruct (a =? x0); try reflexivity.
    destruct (nth_default 0 (JA M1) a <? nth_default 0 (JB M2) b); try apply IHtime.
    destruct (nth_default 0 (JB M2) b =? nth_default 0 (JA M1) a); try apply IHtime.
    assert (nth_default 0 (JB M2) b <? n = true).
    { urgh. apply M2.(Content_JB_i). }
    rewrite H. rewrite IHtime. reflexivity.
Qed.

Theorem mul_CSR_CSC_row_col_eff_correct:
forall m n p M1 M2 i j,
i < m -> j < p ->
 mul_CSR_CSC_row_col_eff m n p M1 M2 i j = sum n (fun k => (Mget_CSR m n i k M1) *e (Mget_CSC n p k j M2)).
Proof.
  intros.
  assert (mul_CSR_CSC_row_col_eff m n p M1 M2 i j = mul_CSR_CSC_row_col_eff_le m n p M1 M2 i j n).
  { unfold mul_CSR_CSC_row_col_eff. unfold mul_CSR_CSC_row_col_eff_le. rewrite mul_CSR_CSC_row_col_eff_rec_le_equal. reflexivity. }
  rewrite H1. apply mul_CSR_CSC_row_col_eff_le_correct; omega.
Qed.

Definition mul_CSR_CSC_row_col {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i j: nat) :=
  mul_CSR_CSC_row_col_eff m n p M1 M2 i j.

Fixpoint mul_CSR_CSC_row {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i j: nat) :=
match j with
| 0 => nil
| S j' => mul_CSR_CSC_row_col m n p M1 M2 i (p - j) :: mul_CSR_CSC_row m n p M1 M2 i j'
end.

Fixpoint mul_CSR_CSC_to_dense_ {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) (i : nat) :=
match i with
| 0 => nil
| S i' => mul_CSR_CSC_row m n p M1 M2 (m - i) p:: mul_CSR_CSC_to_dense_ m n p M1 M2 i'
end.

Definition mul_CSR_CSC_to_dense {ME: MatrixElem} (m n p: nat) (M1: @CSR_Matrix ME m n)
                              (M2: @CSC_Matrix ME n p) :=
  mul_CSR_CSC_to_dense_ m n p M1 M2 m.

Lemma mul_CSR_CSC_correct_row: forall m n p M1 M2 k i,
  k <= m -> i < k -> nth_default nil (mul_CSR_CSC_to_dense_ m n p M1 M2 k) i
   = mul_CSR_CSC_row m n p M1 M2 (m - k + i) p.
Proof.
  intros.
  generalize dependent i.
  induction k as [| k IHk]; intros.
  - inversion H0.
  - destruct i.
    + cbn. rewrite <- plus_n_O. reflexivity.
    + assert (m - S k + S i = m - k + i). { omega. } rewrite H1.
      apply IHk; try omega.
Qed.

Lemma mul_CSR_CSC_correct_entry: forall m n p M1 M2 i k j,
  i < m -> k <= p -> j < k -> nth_default MEzero (mul_CSR_CSC_row m n p M1 M2 i k) j
   = mul_CSR_CSC_row_col m n p M1 M2 i (p - k + j).
Proof.
  intros.
  generalize dependent j.
  induction k as [| k IHk]; intros.
  - inversion H1.
  - destruct j.
    + cbn. rewrite <- plus_n_O. reflexivity.
    + assert (p - S k + S j = p - k + j). { omega. } rewrite H2.
      apply IHk; try omega.
Qed.

Lemma mul_CSR_CSC_correct': forall m n p M1 M2 i j,
  i < m -> j < p -> nth_default MEzero (nth_default nil (mul_CSR_CSC_to_dense m n p M1 M2) i) j
   = mul_CSR_CSC_row_col m n p M1 M2 i j.
Proof.
  intros.
  unfold mul_CSR_CSC_to_dense. rewrite mul_CSR_CSC_correct_row; try omega.
  rewrite mul_CSR_CSC_correct_entry; try omega.
  assert (m - m + i = i). { omega. }
  assert (p - p + j = j). { omega. }
  rewrite H1. rewrite H2. reflexivity.
Qed.

Theorem mul_CSR_CSC_correct: forall m n p M1 M2 i j,
  i < m -> j < p -> nth_default MEzero (nth_default nil (mul_CSR_CSC_to_dense m n p M1 M2) i) j
   = sum n (fun k => (Mget_CSR m n i k M1) *e (Mget_CSC n p k j M2)).
Proof.
  intros.
  rewrite mul_CSR_CSC_correct'; try assumption.
  unfold mul_CSR_CSC_row_col. rewrite mul_CSR_CSC_row_col_eff_correct; try omega.
  reflexivity.
Qed.

End A.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List.

Set Implicit Arguments.

Fixpoint tile_concat ln lt : (list bool) * list bool:=
  match ln with
    | nil   => (nil,nil)
    | x::ln => match nth x lt (nil,nil), tile_concat ln lt with
                 | (th,tl), (hh,ll) => (hh++th,ll++tl)
               end
  end.

Definition tiles_solvable lt :=
   exists ln, ln <> nil
           /\ Forall (fun x => x < length lt) ln
           /\ let (hh,ll) := tile_concat ln lt in hh = ll.


From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq div.
From mathcomp Require Import choice fintype finfun bigop prime binomial ssralg.
From mathcomp Require Import finset fingroup finalg perm zmodp matrix.
Require Import ssralg_ext.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import GRing.Theory.
Local Open Scope ring_scope.

Local Open Scope vec_ext_scope.

(** * Vandermonde Matrices *)

(** OUTLINE:
- Section vandermonde_matrix.
- Section vandermonde_k_matrix.
- Section vandermonde_determinant.

*)

Section vandermonde_matrix.

Variables (n : nat) (R : ringType) (a : 'rV[R]_n).

Definition vander_gen (r : nat) := \matrix_(i < r, j < n) (a``_j) ^+ i.

Definition vander := vander_gen n.

End vandermonde_matrix.

Section vandermonde_k_matrix.

Variable (R : comRingType).

Definition lc n (a : R) (r0 r1 : 'rV[R]_n) := r0 - a *: r1.

Definition mat_lc n cst (M : 'M[R]_n.+1) (k : 'I_n.+1) :=
  if k == 0 then M else
    \matrix_(i < n.+1) if i == k then
                         lc cst (row i M) (row (inord i.-1) M)
                       else
                         row i M.

(* k = 0 -> modifies nothing  *)
(* k = 1 -> modifies row n  *)
(* k = 2 -> modifies row n-1, n *)
(* k = 3 -> modifies row n-2, n-1, n *)
(* k = n.+1 -> modifies row 0, 1, ..., n *)
(* do not use with k > n.+1 *)
Definition vander_k n (a : 'rV[R]_n.+1) (M : 'M_n.+1) (k : nat) :=
  foldl (fun acc x => mat_lc (a``_ord0) acc (inord x)) M (rev (iota (n.+1 - k) k)).

Lemma vander_k_rec n (a : 'rV[R]_n.+1) k : k <= n.+1 ->
  forall i, i <= n ->
  forall M,
  row (inord i) (vander_k a M k) =
  if i == O then
    row 0 M
  else if n.+1 - k <= i <= n then
    lc (a``_ord0) (row (inord i) M) (row (inord i.-1) M)
  else
    row (inord i) M.
Proof.
elim: k => [n0 i ni|k IH].
  move=> M.
  case: ifPn => [/eqP ->|n0'].
    rewrite /vander_k /= (_ : inord 0 = 0) //.
    apply/val_inj => /=; by rewrite inordK.
  by rewrite subn0 ni andbT ltnNge ni.
rewrite ltnS => kn i ni M.
case: ifPn => [|i0].
  move/eqP => ?; subst i.
  rewrite /vander_k -{2}(add1n k) iota_add rev_cat foldl_cat addn1.
  rewrite -subSn // subSS -/(vander_k a _ k) subSS /= /mat_lc.
  case: ifP => [|nk0].
    move/eqP => /(congr1 (fun x => nat_of_ord x)) /=.
    rewrite inordK; last by rewrite ltnS leq_subr.
    move/eqP.
    rewrite subn_eq0 => nk.
    have ? : n = k by apply/eqP; rewrite eqn_leq kn nk.
   by rewrite IH // ltnW.
  rewrite rowK eq_sym (_ : inord 0 = 0) //; last first.
    apply/val_inj => /=; by rewrite inordK.
  rewrite nk0 -(_ : inord 0 = 0) //; last first.
    apply/val_inj => /=.
    by rewrite inordK.
  rewrite IH //; last by rewrite ltnW.
  rewrite eqxx (_ : inord 0 = 0) //.
  apply/val_inj => /=.
  by rewrite inordK.
rewrite {1}/vander_k -{2}(add1n k) iota_add rev_cat foldl_cat.
rewrite addn1 -subSn // subSS -/(vander_k a _ k) subSS /= /mat_lc.
case: ifP => [|nk0].
  move/eqP/(congr1 (fun x => nat_of_ord x)) => /=.
  rewrite inordK //; last  by rewrite ltnS leq_subr.
  move/eqP.
  rewrite subn_eq0 => nk.
  have ? : n = k by apply/eqP; rewrite eqn_leq kn nk.
  subst k.
  by rewrite subnn leq0n /= ni IH // (negbTE i0) subSn // subnn lt0n i0 ni.
rewrite rowK.
case: ifPn => [|nik].
  move/eqP => /(congr1 (fun x => nat_of_ord x)) /=.
  rewrite inordK; last by rewrite ltnS.
  rewrite inordK; last by rewrite ltnS leq_subr.
  move/eqP => ink.
  rewrite -(eqP ink) leqnn /= ni IH //; last by rewrite ltnW.
  rewrite (negbTE i0) {1}(eqP ink).
  case: ifPn.
    case/andP.
    by rewrite leq_subLR subnKC // ltnn.
  rewrite ni andbT -ltnNge => ok.
  rewrite {1}IH; last first.
    by apply: (leq_trans (@leq_pred _) ni).
    by rewrite ltnW.
  case: ifPn => [Hi1|Hi1].
    rewrite (eqP Hi1) (_ : inord 0 = 0) //.
    apply/val_inj => /=.
    by rewrite inordK.
  case: ifP => //.
  case/andP.
  rewrite {1}(eqP ink) -subnS subSn // subnS => abs.
  exfalso.
  move: abs.
  rewrite ltnNge => /negP.
  apply.
  by rewrite leq_pred.
rewrite ni andbT.
case: ifPn => nki.
  rewrite /lc IH //; last by rewrite ltnW.
  rewrite (negbTE i0) ni andbT.
  case: ifPn => [nki' //|].
  rewrite -ltnNge subSn // ltnS => abs.
  have abs' : (i = n - k)%N by apply/eqP; rewrite eqn_leq nki abs.
  exfalso.
  move/eqP : nik; apply.
  apply/val_inj => /=.
  by rewrite inordK // inordK // ltnS leq_subr.
rewrite IH //; last by rewrite ltnW.
rewrite (negbTE i0) ni andbT.
case: ifP => // abs.
exfalso.
rewrite -ltnNge in nki.
rewrite subSn // in abs.
move: (ltn_trans nki abs).
by rewrite ltnn.
Qed.

Definition vander_last n (a : 'rV[R]_n.+1) :=
  \matrix_(i < n.+1, j < n.+1)
   if i == 0 then 1
   else if j == 0 then 0
        else (a``_j) ^+ i - a``_0 * (a``_j) ^+ i.-1.

Lemma vander_lastE n (a : 'rV[R]_n.+1) : vander_last a = vander_k a (vander a) n.
Proof.
apply/row_matrixP => i.
rewrite {2}(_ : i = inord i); last first.
  apply/val_inj => /=.
  by rewrite inordK.
rewrite vander_k_rec //; last by rewrite -ltnS.
case: ifPn => i0.
  rewrite /vander_last.
  apply/rowP => j.
  rewrite !mxE.
  case: ifP => //.
  move/eqP => abs; exfalso.
  apply abs.
  apply/val_inj => /=.
  by move/eqP : i0.
rewrite subSn // subnn lt0n i0 /= -ltnS ltn_ord /= /lc /vander_last; apply/rowP => j.
rewrite !mxE.
case: ifP => [|i0'].
  move/eqP/(congr1 (fun x => nat_of_ord x)) => /= abs; exfalso.
  move/eqP : i0; by apply.
case: ifP => [|j0].
  move=> /eqP ->.
  rewrite -exprS inordK // inordK; last first.
    by rewrite (leq_trans _ (ltn_ord i)) // ltnS leq_pred.
  rewrite prednK; last first.
    by rewrite lt0n.
  by rewrite (_ : 0 = ord0) // subrr.
rewrite inordK // inordK // (ltn_trans _ (ltn_ord i)) // -subn1.
by rewrite -{2}(subn0 i) ltn_sub2l // lt0n.
Qed.

Lemma vander_k_max n (a : 'rV[R]_n.+1) (M : 'M[R]_n.+1) : vander_k a M n.+1 = vander_k a M n.
Proof.
apply/row_matrixP => i.
rewrite (_ : i = inord i); last first.
  apply/val_inj => /=.
  by rewrite inordK.
rewrite vander_k_rec //; last by rewrite -ltnS.
case: ifPn => i0.
  by rewrite (eqP i0) vander_k_rec // leq_pred.
rewrite subnn leq0n -ltnS ltn_ord /=.
rewrite vander_k_rec ?leq_pred //; last by rewrite -ltnS ltn_ord.
rewrite (negbTE i0) -(ltnS i) ltn_ord andbT.
by rewrite /= subSn // subnn lt0n i0.
Qed.

Lemma det_vander_k_rec n (a : 'rV[R]_n.+1) (k : nat) (M : 'M[R]_n.+1) : k < n.+1 ->
  \det (vander_k a M k) = \det (vander_k a M k.-1).
Proof.
move=> kn.
destruct k as [|k] => //=.
rewrite /lc /= (@determinant_multilinear _ _ _
  (\matrix_i (if i == inord (n.+1 - k.+1) then row (inord i) (vander_k a M k) else row (inord i) (vander_k a M k.+1)))
  (\matrix_i (if i == inord (n.+1 - k.+1) then row (inord i.-1) (vander_k a M k) else row (inord i) (vander_k a M k.+1)))
  (inord (n.+1 - k.+1)) 1 (- a``_ord0)); last 3 first.
  rewrite scale1r !rowK eqxx vander_k_rec //; last first.
    by rewrite subSS leq_subr.
    by rewrite ltnW.
  rewrite subSS.
  rewrite leq_subr andbT subn_eq0.
  case: ifPn => [nk|].
    move: (leq_ltn_trans nk kn).
    by rewrite ltnn.
  rewrite -ltnNge => kn'.
  rewrite leqnn /lc inordK; last by rewrite ltnS leq_subr.
  rewrite vander_k_rec //; last 2 first.
    rewrite ltnW //; by apply: (ltn_trans kn').
    by rewrite leq_subr.
  rewrite subn_eq0 leqNgt kn' /= leq_subr andbT leq_subLR addnBA; last first.
    by rewrite ltnW.
  rewrite addnC.
  rewrite -addnBA // subnn addn0 ltnn vander_k_rec //; last 2 first.
    by rewrite ltnW // ltnS ltnW.
    by rewrite -subnS leq_subr.
  rewrite -subnS subn_eq0.
  rewrite ltnS in kn, kn'.
  case: ifPn.
    rewrite -subn_eq0 => /eqP ->.
    rewrite (_ : inord 0 = 0) // ?scaleNr //.
    apply/val_inj => //=.
    by rewrite inordK.
  rewrite -ltnNge => k1n.
  case: ifPn => //.
    case/andP.
    rewrite subnS subSn; last by rewrite ltnW.
    by rewrite ltnNge leq_pred.
  by rewrite scaleNr.
  apply/matrixP => i j; by rewrite !mxE eq_sym (negbTE (neq_lift _ _)) mxE inord_val.
  apply/matrixP => i j; by rewrite !mxE eq_sym (negbTE (neq_lift _ _)) mxE inord_val.
rewrite mul1r (_ : \matrix_i _ = vander_k a M k); last first.
  apply/matrixP => i j; rewrite !mxE.
  case: ifPn => [/eqP Hi|Hi].
    rewrite !mxE (_ : inord i = i) //.
    apply/val_inj => /=.
    by rewrite inordK.
  rewrite vander_k_rec //; last first.
    by rewrite -ltnS.
  by rewrite ltnW.
  case: ifPn => i0.
    transitivity ((row (inord i) (vander_k a M k)) 0 j); last first.
      rewrite mxE (_ : inord i = i) //.
      apply/val_inj => /=.
      by rewrite inordK.
    rewrite vander_k_rec //; last 2 first.
      by rewrite (leq_trans _ kn) // -addn2 leq_addr.
      by rewrite -ltnS.
    by rewrite i0.
  rewrite -(ltnS i) ltn_ord andbT.
  case: ifPn => nki.
    rewrite /lc.
    transitivity ((row (inord i) (vander_k a M k)) 0 j); last first.
      rewrite mxE (_ : inord i = i) //.
      apply/val_inj => /=.
      by rewrite inordK.
    rewrite vander_k_rec //; last 2 first.
      by rewrite ltnW // ltnW.
      by rewrite -ltnS.
    rewrite (negbTE i0) -(ltnS i) ltn_ord andbT.
    have {nki} : n.+1 - k.+1 < i.
      rewrite ltn_neqAle nki andbT.
      apply: contra Hi => /eqP ->.
      apply/eqP/val_inj => /=.
      by rewrite inordK //.
    rewrite subnS -ltnS prednK; last by rewrite lt0n subn_eq0 -ltnNge ltnW.
    by rewrite ltnS => ->.
  transitivity ((row (inord i) (vander_k a M k)) 0 j); last first.
    rewrite mxE (_ : inord i = i) //.
    apply/val_inj => /=.
    by rewrite inordK.
  rewrite vander_k_rec //; last 2 first.
    by rewrite ltnW // ltnW.
    by rewrite -ltnS.
  rewrite (negbTE i0) -(ltnS i) ltn_ord andbT.
  have /negbTE -> // : ~~ (n.+1 - k <= i).
  apply: contra nki.
  apply: leq_trans.
  rewrite leq_subLR addnC.
  destruct n as [|n] => //.
  rewrite subSn; last by rewrite -ltnS ltnW.
  by rewrite addSn addnS subnK // -ltnS ltnW.
rewrite (_ : \det (\matrix_i _) = 0) ?mulr0 ?addr0 //.
have H : inord (n.+1 - k.+1) != inord (n.+1 - k.+2) :> 'I_n.+1.
  apply/eqP => /(congr1 (fun x => nat_of_ord x)) /=.
  rewrite 2!subSS.
  rewrite inordK // ?ltnS ?leq_subr //.
  rewrite inordK // ?ltnS ?leq_subr //.
  destruct n as [|n] => //.
  rewrite !subSS.
  move/(congr1 (fun x => x + k)%N).
  rewrite subnK; last by rewrite ltnW.
  rewrite addnC addnBA // addnC.
  rewrite addnK -{2}(addn0 n).
  rewrite -addn1 => /eqP.
  by rewrite eqn_add2l.
apply (@determinant_alternate _ _ _ (inord (n.+1 - k.+1)) (inord (n.+1 - k.+2))) => //.
move=> i.
rewrite !mxE eqxx eq_sym (negbTE H) 2!subSS.
rewrite inordK; last by rewrite ltnS leq_subr.
rewrite inordK; last by rewrite ltnS leq_subr.
rewrite -subnS [in LHS]vander_k_rec // ?leq_subr //; last by rewrite ltnW // ltnW.
rewrite subn_eq0.
case: ifPn => // nk2.
  rewrite (_ : n - k.+1 = 0)%N //; last by apply/eqP; rewrite subn_eq0.
  by rewrite  vander_k_rec // ltnW // ltnW.
rewrite andbT (_ : _ <= _ = false); last first.
  rewrite -(leq_add2r k.+1) subnK //.
  rewrite addnC addnBA; last by rewrite ltnW // ltnW.
  rewrite addnC -addnBA; last by rewrite -addn1 leq_addr.
  rewrite subSn // subnn // addn1.
  apply/negbTE.
  by rewrite -leqNgt.
rewrite [in RHS]vander_k_rec // ?leq_subr //; last by rewrite ltnW.
rewrite subn_eq0 (negbTE nk2) andbT (_ : _ <= _ = false) //.
rewrite -(leq_add2r k.+1) subnK //; last by rewrite ltnW.
by rewrite subnK ?ltnn.
Qed.

Lemma det_vander_k n (a : 'rV[R]_n.+1) (k : nat) (M : 'M[R]_n.+1) :
  k <= n.+1 -> \det (vander_k a M k) = \det (vander_k a M k.-1).
Proof.
rewrite leq_eqVlt => /orP[/eqP ->|];
  by [rewrite vander_k_max | apply det_vander_k_rec].
Qed.

Lemma det_vander_k_vander n (a : 'rV[R]_n.+1) (k : nat) : k <= n.+1 ->
  \det (vander_k a (vander a) k) = \det (vander a).
Proof.
elim: k => // k IH.
rewrite ltnS => kn.
by rewrite det_vander_k // IH // ltnW.
Qed.

End vandermonde_k_matrix.

Section vandermonde_determinant.

Variable (R : comRingType).

Lemma det_mlinear_rec n (f : 'I_n.+1 -> 'I_n.+1 -> R) (g : 'I_n.+1 -> R) k : k <= n.+1 ->
  \det (\matrix_(j, i) (f i j * g j)) =
  (\prod_(l < k) g (inord l)) * \det (\matrix_(j, i) (f i j * if j >= k then g j else 1)).
Proof.
elim: k => [_|k IH]; first by rewrite big_ord0 mul1r.
rewrite ltnS => kn.
rewrite IH; last by rewrite ltnW.
rewrite big_ord_recr /= -mulrA; congr (_ * _).
rewrite (@determinant_multilinear _ _ _ (\matrix_(j, i) (f i j * (if k < j then g j else 1))) (\matrix_(j, i) (f i j * (if k <= j then g j else 1))) (inord k) (g (inord k)) 0); last 3 first.
  rewrite scale0r addr0.
  apply/rowP => j.
  rewrite !mxE mulrCA; congr (_ * _).
  by rewrite inordK // leqnn ltnn mulr1.
  apply/matrixP => i j; rewrite !mxE.
  case: ifPn => [H1|].
    case: ifP => // /negbT; by rewrite leq_eqVlt H1 orbT.
  case: ifPn => //; rewrite -ltnNge ltnS => H1 H2.
  rewrite mulr1.
  have /eqP abs : k = lift (inord k) i by apply/eqP; rewrite eqn_leq H1 H2.
  exfalso.
  move/eqP : abs; apply/eqP.
  apply: contra (@neq_lift _ (inord k) i) => /eqP {1}->.
  apply/eqP/val_inj; by rewrite inord_val.
  apply/matrixP => i j; by rewrite !mxE.
rewrite mul0r addr0 -det_tr.
rewrite (_ : _^T = \matrix_(i, j) (f i j * (if k < j then g j else 1))) //.
by apply/matrixP => i j; rewrite !mxE.
Qed.

Lemma det_mlinear n (f : 'I_n -> 'I_n -> R) (g : 'I_n -> R) :
  \det (\matrix_(i, j) (f i j * g j)) = \prod_(i < n) g i * \det (\matrix_(i, j) (f i j)).
Proof.
destruct n as [|n]; first by rewrite big_ord0 mul1r !det_mx00.
rewrite -det_tr (_ : _^T = (\matrix_(j, i) (f i j * g j))); last first.
  by apply/matrixP => i j; rewrite !mxE.
rewrite (@det_mlinear_rec _ _ _ n.+1) //; congr (_ * _).
  apply eq_bigr => i _; by rewrite inord_val.
rewrite -det_tr; congr (\det _).
apply/matrixP => i j; by rewrite !mxE ltnNge -ltnS ltn_ord /= mulr1.
Qed.

Lemma det_vander_rec n (a : 'rV[R]_n.+1) : \det (vander a) =
  \det (vander (\row_(i < n) a``_(inord i.+1))) * \prod_(1 <= j < n.+1) (a``_(inord j) - a``_0).
Proof.
transitivity (\det (vander_last a)); first by rewrite vander_lastE /= det_vander_k_vander.
rewrite /vander_last (expand_det_col _ ord0) /= (bigD1 ord0) //=.
rewrite [X in _ + X = _](_ : _ = 0) ?addr0; last first.
  rewrite (eq_bigr (fun=> 0)); first  by rewrite big_const iter_addr0.
  move=> i i0; by rewrite !mxE (negbTE i0) /= mul0r.
rewrite mxE /= mul1r /cofactor expr0 mul1r.
transitivity (\det (\matrix_(i < n, j < n) ((\row_(i < n) a``_(inord i.+1))``_j ^+ i.+1 - a``_0 * (\row_(i < n) a``_(inord i.+1))``_j ^+ i))).
  congr (\det _).
  apply/matrixP => i j; rewrite !mxE.
  do 2 rewrite eq_sym (negbTE (neq_lift _ _)).
  rewrite !lift0 /=; congr (a ``_ _ ^+ _ - _ * a ``_ _ ^+ _);
    by apply/val_inj; rewrite -lift0 inord_val.
transitivity (\det (\matrix_(i < n, j < n) ((\row_(i < n) a``_(inord i.+1))``_j ^+ i * ((\row_(i < n) a``_(inord i.+1))``_j - a``_0)))).
  congr (\det _).
  apply/matrixP => i j; by rewrite !mxE exprS -mulrBl mulrC.
transitivity ((\prod_(j < n) (a``_(inord j.+1) - a``_0)) * \det (\matrix_(i < n, j < n) ((\row_(i < n) a``_(inord i.+1))``_j ^+ i))).
  rewrite det_mlinear; congr (_ * _).
  by apply/eq_bigr => j _; rewrite mxE.
rewrite mulrC; congr (_ * _).
rewrite (big_addn 0 n.+1 1) subn1 /= big_mkord; apply/eq_bigr => i _; by rewrite addn1.
Qed.

Lemma det_vander n (a : 'rV[R]_n.+1) : \det (vander a) =
  \prod_(i < n.+1) (\prod_(j < n.+1 | i < j) (a``_(inord j) - a``_(inord i))).
Proof.
elim: n a => [a|n IH a].
  rewrite (mx11_scalar (vander a)) det_scalar1 mxE expr0 big_ord_recr /=.
  rewrite big_ord0 mul1r (eq_bigl (xpred0)) ?big_pred0 // => i; by rewrite ord1.
rewrite det_vander_rec IH.
rewrite (eq_bigr (fun i : 'I_n.+1 => \prod_(1 <= j < n.+2 | i < j.-1) (a``_(inord j) - a``_(inord i.+1)))); last first.
  move=> i _; rewrite (big_addn O n.+2 1) subn1 /= big_mkord.
  apply/eq_big; first by move=> j; rewrite addn1.
  move=> j ij; by rewrite 2!mxE inordK // inordK // addn1.
rewrite [in RHS]big_ord_recl [in RHS]mulrC; congr (_ * _); last first.
  rewrite [in RHS]big_mkcond /= [in RHS]big_ord_recl ltnn mul1r big_add1 big_mkord.
  apply/eq_bigr => i _.
  rewrite lift0 (_ : inord 0 = 0) //.
  by apply/val_inj => /=; rewrite inordK.
apply eq_bigr => i _.
rewrite [in RHS]big_mkcond /= [in RHS]big_ord_recl ltn0 mul1r big_add1 big_mkord.
rewrite [in LHS]big_mkcond /=; by apply eq_bigr => j _.
Qed.

End vandermonde_determinant.


Require Export ZArith_base.
Require Import Base.
Require Import Kleene.
Require Import Monad ClassicalMonads.
Require Import MultivalueMonad.

Declare Scope Real_scope.
Delimit Scope Real_scope with Real.
(* Bind Scope Real_scope with Real. *)
Local Open Scope Real_scope.

Section Real_Defs1.

  Generalizable Variables K M.

  Context `{klb : LazyBool K} `{M_Monad : Monad M}
          {MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad}
          {M_MultivalueMonad : MultivalueMonad}.

  Class SemiDecOrderedField (Real : Type) :=
    {
      real_0 : Real;
      real_1 : Real;
      real_plus : Real -> Real -> Real;
      real_mult : Real -> Real -> Real;
      real_opp : Real -> Real;
      real_inv : forall {z}, z <> real_0 -> Real;
      real_lt : Real -> Real -> Prop;
      real_lt_semidec : forall x y : Real, semidec (real_lt x y);

      real_plus_comm : forall r1 r2 : Real, real_plus r1 r2 = real_plus r2 r1;
      real_plus_assoc : forall r1 r2 r3 : Real, real_plus (real_plus r1 r2) r3 = real_plus r1 (real_plus r2 r3);
      real_plus_inv : forall r : Real, real_plus r (real_opp r) = real_0;
      real_plus_unit : forall r : Real, real_plus real_0 r = r;
      real_mult_comm : forall r1 r2 : Real, real_mult r1 r2 = real_mult r2 r1;
      real_mult_assoc : forall r1 r2 r3 : Real, real_mult (real_mult r1 r2) r3 = real_mult r1 (real_mult r2 r3);
      real_mult_inv : forall (r : Real) (p : r <> real_0), real_mult (real_inv p) r = real_1;
      real_mult_unit : forall r : Real, real_mult real_1 r = r;
      real_mult_plus_distr: forall r1 r2 r3 : Real, real_mult r1 (real_plus r2 r3) = real_plus (real_mult r1 r2) (real_mult r1  r3);

      real_1_neq_0 : real_1 <> real_0;
      real_1_gt_0 : real_lt real_0 real_1;

      real_total_order : forall r1 r2 : Real, real_lt r1 r2 \/ r1 = r2 \/ real_lt r2 r1;
      real_lt_nlt : forall r1 r2 : Real, real_lt r1 r2 -> ~ real_lt r2 r1;
      real_lt_lt_lt : forall r1 r2 r3 : Real, real_lt r1 r2 -> real_lt r2 r3 -> real_lt r1 r3;
      real_lt_plus_lt : forall r r1 r2 : Real, real_lt r1 r2 -> real_lt (real_plus r r1) (real_plus r r2);
      real_lt_mult_pos_lt : forall r r1 r2 : Real, real_lt real_0 r -> real_lt r1 r2 -> real_lt (real_mult r r1) (real_mult r r2);
    }.

  Arguments real_0 {_}.
  Arguments real_1 {_}.
  Arguments real_plus {_}.
  Arguments real_mult {_}.
  Arguments real_opp {_}.
  Arguments real_inv {_}.
  Arguments real_lt {_}.
  Arguments real_lt_semidec {_}.

  Arguments real_plus_comm {_}.
  Arguments real_plus_assoc {_}.
  Arguments real_plus_inv {_} {_}.
  Arguments real_plus_unit {_}.
  Arguments real_mult_comm {_}.
  Arguments real_mult_assoc {_}.
  Arguments real_mult_inv {_}.
  Arguments real_mult_unit {_}.
  Arguments real_mult_plus_distr {_}.
  Arguments real_1_neq_0 {_}.
  Arguments real_1_gt_0 {_}.

  Arguments real_total_order {_}.
  Arguments real_lt_nlt {_}.
  Arguments real_lt_lt_lt {_}.
  Arguments real_lt_plus_lt {_}.
  Arguments real_lt_mult_pos_lt {_}.

End Real_Defs1.

Infix "+" := (real_plus ) : Real_scope.
Infix "*" := (real_mult ) : Real_scope.
Notation "- x" := (real_opp  x) : Real_scope.
Notation "/ p" := (@real_inv _ _ _ _ _ p ) : Real_scope.
Infix "<" := (real_lt ) : Real_scope.

Section Real_Defs2.

  Generalizable Variables K M Real.

  Context `{klb : LazyBool K} `{M_Monad : Monad M}
          {MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad}
          {M_MultivalueMonad : MultivalueMonad}
          {Real : Type}
          {SemiDecOrderedField_Real : SemiDecOrderedField Real}.

  Definition real_gt (x y : Real) : Prop := y < x.
  Definition real_le (x y : Real) : Prop := x < y \/ x = y.
  Definition real_ge (x y : Real) : Prop := real_gt x y \/ x = y.
  Definition real_minus (x y : Real) : Real := x + - y.

  Definition real_div (x : Real) {y : Real} (p:y <> real_0) : Real := x * (/ p).
  Definition real_ltb : Real -> Real -> K.
  Proof.
    intros x y.
    exact (projP1 _ _ (real_lt_semidec x y)).
  Defined.

  Definition real_gtb (x y : Real) : K := real_ltb y x.

End Real_Defs2.

Infix "-" := (real_minus) : Real_scope.
Infix "/" := (real_div ): Real_scope.
Infix "<=" := (real_le ): Real_scope.
Infix ">=" := (real_ge): Real_scope.
Infix ">"  := (real_gt): Real_scope.
Infix "<?" := (real_ltb): Real_scope.
Infix ">?" := (real_gtb): Real_scope.
Notation "x <= y <= z" := (x <= y /\ y <= z): Real_scope.
Notation "x <= y < z"  := (x <= y /\ y <  z): Real_scope.
Notation "x < y < z"   := (x <  y /\ y <  z): Real_scope.
Notation "x < y <= z"  := (x <  y /\ y <= z): Real_scope.

Section Real_Defs3.

  Generalizable Variables K M Real.

  Context `{klb : LazyBool K} `{M_Monad : Monad M}
          {MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad}
          {M_MultivalueMonad : MultivalueMonad}
          {Real : Type}
          {SemiDecOrderedField_Real : SemiDecOrderedField Real}.

  (* Definition W_nemp (c : Real -> Prop) := exists z, c z. *)
  (* Definition W_upb (c : Real -> Prop) (u : Real) := forall z : Real, c z -> z <= u. *)
  (* Definition W_upbd (c : Real-> Prop) := exists u, W_upb c u. *)
  (* Definition W_sup (c : Real-> Prop) (s : Real) *)
  (*   := W_upb c s /\ (forall s', W_upb c s' -> s <= s'). *)
  (* Definition is_W_complete (T : SemiDecOrderedField) := *)
  (*   forall c : Real -> Prop, W_nemp c ->  W_upbd c -> exists z, W_sup c z.  *)

  Inductive EZ :=
    Epos : nat -> EZ
  | Ezero : EZ
  | Eneg : nat -> EZ.

  Fixpoint Nreal (n : nat) : Real :=
    match n with
    | O => real_0 | S n => real_1 + Nreal n
    end.

  Arguments Nreal n%nat.

  Definition EZreal (z : EZ) : Real:=
    match z with
    | Epos n => Nreal n
    | Ezero => real_0 | Eneg n => - (Nreal n)
    end.

  (**********)
  Fixpoint IPreal_2 (p:positive) : Real :=
    match p with
    | xH => real_1 + real_1
    | xO p => (real_1 + real_1) * IPreal_2 p
    | xI p => (real_1 + real_1) * (real_1 + IPreal_2 p)
    end.

  Definition IPreal (p:positive) : Real:=
    match p with
    | xH => real_1
    | xO p => IPreal_2 p
    | xI p => real_1 + IPreal_2 p
    end.
  Arguments IPreal p%positive : simpl never.

  Definition IZreal (z : Z) : Real :=
    match z with
    | Z0 => real_0
    | Zpos n => IPreal n
    | Zneg n => - IPreal n
    end.
  Arguments IZreal z%Z : simpl never.

  (**********)
  Fixpoint INreal (n:nat) : Real  :=
    match n with
    | O => real_0
    | S O => real_1
    | S n => INreal n + real_1
    end.
  Arguments INreal n%nat.

  Definition real_2 : Real := IZreal 2.

  Lemma real_lt_n_Sn : forall (x : Real), x < x + real_1.
  Proof.
    intros.
    rewrite <- (real_plus_unit) at 1.
    rewrite (real_plus_comm (real_0) x).
    apply (real_lt_plus_lt x).
    apply real_1_gt_0.
  Qed.

  Lemma real_lt_0_2 : real_0 < real_2.
  Proof.
    unfold real_2.
    unfold IZreal.
    unfold IPreal.
    unfold IPreal_2.
    apply real_lt_lt_lt with (real_0 + real_1).
    apply real_lt_n_Sn.
    rewrite real_plus_comm.
    apply real_lt_plus_lt.
    replace (real_1 ) with (real_0 + real_1).
    apply real_lt_n_Sn.
    apply real_plus_unit.
  Qed.

  Lemma real_ngt_triv : forall (x  : Real), ~ x > x.
  Proof.
    intros x.
    intuition.
    pose proof (real_lt_nlt x x H) as H1.
    contradict H.
    intuition.
  Qed.

  Lemma real_gt_neq : forall (z1 z2 : Real), z1 > z2 -> z1 <> z2.
  Proof.
    red.
    intros z1 z2 p q.
    rewrite q in p.
    contradict p.
    apply real_ngt_triv.
  Qed.

  Lemma real_2_neq_0 : real_2 <> real_0.
  Proof.
    apply real_gt_neq.
    exact real_lt_0_2.
  Qed.

  Fixpoint prec (n : nat) : Real :=
    match n with
    | O => real_1
    | S m => (prec m) / (real_2_neq_0)
    end.
  Arguments prec n%nat.

  Definition is_fast_cauchy_p (f : nat -> Real) := forall n m, - prec n - prec m <= f n - f m <= prec n + prec m.
  Definition is_fast_limit_p (x : Real) (f : nat -> Real) := forall n, - prec n <= x - f n <= prec n.

  Class ComplArchiSemiDecOrderedField :=
    {
      (* W_complete : forall c : Real CarrierField -> Prop, W_nemp c ->  W_upbd c -> exists z, W_sup c z; *)
      real_Archimedean : forall r : Real, r > real_0 -> exists n, prec n < r;
      real_limit_p : forall f : nat -> Real, is_fast_cauchy_p f -> {x | is_fast_limit_p x f};
    }.

  (* add to hint db *)
  Create HintDb real.

End Real_Defs3.

Global Hint Resolve real_lt_semidec  real_plus_comm  real_plus_assoc  real_plus_inv real_plus_unit  real_mult_comm  real_mult_assoc  real_mult_inv  real_mult_unit  real_mult_plus_distr  real_1_neq_0  real_1_gt_0 real_total_order  real_lt_nlt  real_lt_lt_lt  real_lt_plus_lt  real_lt_mult_pos_lt real_lt_n_Sn real_lt_0_2 real_ngt_triv real_gt_neq real_2_neq_0 : real.


Inductive Provable : Prop -> Prop :=
| PA : forall (X Y:Prop), Provable (X -> Y) -> Provable X -> Provable Y
| PI : forall (X : Prop), Provable (X -> X)
| PK : forall (X Y:Prop), Provable Y -> Provable (X -> Y)
| PN : forall (X Y:Prop), Provable (X -> Y) -> Provable (~Y -> ~X)
| RE : forall (X Y:Prop), (X -> Y) -> Provable (X -> Y) (* dodgy ? *)
.

Definition Contradictory (X:Prop) : Prop := Provable (~X).
Definition Consistent (X:Prop) : Prop := ~Contradictory X.
Definition Independent (X:Prop) : Prop := ~Provable X /\ Consistent X.

Lemma L1 : forall (X Y:Prop), Provable (X -> Y) -> ~Provable Y -> ~Provable X.
Proof.
    intros X Y H1 H2 H3. apply H2. apply PA with X; assumption.
Qed.

Lemma L2 : forall (X Y:Prop), Provable (X -> Y) -> Consistent X -> Consistent Y.
Proof.
    unfold Consistent, Contradictory. intros X Y H1 H2 H3. apply H2.
    apply PA with (~Y).
    - apply PN. assumption.
    - assumption.
Qed.

Lemma L3 : forall (X Y:Prop), Provable (X -> Y) -> Provable (Y -> X) ->
    Provable X -> Provable Y.
Proof.
    intros X Y H1 H2 H3. apply PA with X; assumption.
Qed.

Lemma L4 : forall (X Y:Prop), Provable (X -> Y) -> Provable (Y -> X) ->
    ~Provable X -> ~Provable Y.
Proof.
    intros X Y H1 H2 H3 H4. apply H3. apply L3 with Y; assumption.
Qed.

Lemma L5 : forall (X Y:Prop), Provable (X -> Y) -> Provable (Y -> X) ->
    Contradictory X -> Contradictory Y.
Proof.
    unfold Contradictory. intros X Y H1 H2 H3. apply PA with (~X).
    - apply PN. assumption.
    - assumption.
Qed.

Lemma L6 : forall (X Y:Prop), Provable (X -> Y) -> Provable (Y -> X) ->
    Consistent X -> Consistent Y.
Proof.
    unfold Consistent. intros X Y H1 H2 H3 H4. apply H3.
    apply L5 with Y; assumption.
Qed.

Lemma L7 : forall (X Y:Prop), Provable (X -> Y) -> Provable (Y -> X) ->
    Independent X -> Independent Y.
Proof.
    unfold Independent. intros X Y H1 H2 [H3 H4]. split.
    - intros H5. apply H3. apply L3 with Y; assumption.
    - apply L6 with X; assumption.
Qed.

Lemma Sandwich : forall (Y:Prop),
    (exists (X Z:Prop), Provable (X -> Y) /\ Provable (Y -> Z) /\
        Consistent X /\ ~Provable Z) ->
    Independent Y.
Proof.
    intros Y [X [Z [H1 [H2 [H3 H4]]]]]. unfold Independent. split.
    - intros H5. apply H4. apply PA with Y; assumption.
    - unfold Consistent, Contradictory. intros H5.
      unfold Consistent in H3. unfold Contradictory in H3. apply H3.
      apply PA with (~Y).
        + apply PN. assumption.
        + assumption.
Qed.

Definition L8 : Prop := ~Provable False.
Definition L9 : Prop := Consistent (~False).
Definition L10: Prop :=  exists (X:Prop), Consistent X.
Definition L11: Prop := forall (X:Prop), Provable X -> Consistent X.

Lemma L12 : L8 -> L9.
Proof.
    unfold L8, L9, Consistent, Contradictory. intros H1 H2.
    apply H1. apply PA with (False -> False).
    - assumption.
    - apply PI.
Qed.

Lemma L13 : L9 -> L10.
Proof.
    unfold L9, L10. intros H. exists (~False). assumption.
Qed.

Lemma L14 : L10 -> L8.
Proof.
    unfold L8, L10. intros [X H1]. unfold Consistent, Contradictory in H1.
    intros H2. apply H1. apply PK. assumption.
Qed.

Lemma L15 : L8 -> L11.
Proof.
    unfold L8, L11. intros H1 X H2. unfold Consistent, Contradictory.
    intros H3. apply H1, PA with X; assumption.
Qed.

Lemma L16 : L11 -> L8.
Proof.
    unfold L8, L11. intros H1 H2. apply (H1 False) in H2.
    unfold Consistent, Contradictory in H2. apply H2, PI.
Qed.

Definition PAPred (p:Prop -> Prop) : Prop :=
    forall (X Y:Prop), p (X -> Y) -> p X -> p Y.

Definition PIPred (p:Prop -> Prop) : Prop :=
    forall (X:Prop), p (X -> X).

Definition PKPred (p:Prop -> Prop) : Prop :=
    forall (X Y:Prop), p Y -> p (X -> Y).

Definition PNPred (p:Prop -> Prop) : Prop :=
    forall (X Y:Prop), p (X -> Y) -> p (~ Y -> ~ X).

Definition ProvPred (p:Prop -> Prop) : Prop :=
    PAPred p /\ PIPred p /\ PKPred p /\ PNPred p.

Definition PEPred (p:Prop -> Prop) : Prop :=
    forall (X:Prop), p False -> p X.

Lemma L17 : ProvPred (fun (X:Prop) => X).
Proof.
    unfold ProvPred, PAPred, PIPred, PKPred, PNPred. split.
    - intros X Y. auto.
    - split.
        + intros X. auto.
        + split.
            { intros X Y. auto. }
            { intros X Y. auto. }
Qed.

Lemma L18 : ProvPred (fun (_:Prop) => True).
Proof.
    unfold ProvPred, PAPred, PIPred, PKPred, PNPred. split.
    - intros X Y. auto.
    - split.
        + intros X. auto.
        + split.
            { intros X Y. auto. }
            { intros X Y. auto. }
Qed.

Lemma L19 : forall (X Y:Prop),
    Provable (X -> Y) ->
    Consistent X      ->
    ~Provable Y       ->
    (Independent X) /\ (Independent Y).
Proof.
    intros X Y H1 H2 H3. split.
    - apply Sandwich. exists X, Y. split.
        + constructor.
        + split.
            { assumption. }
            { split; assumption. }
    - apply Sandwich. exists X, Y. split.
        + assumption.
        + split.
            { constructor. }
            { split; assumption. }
Qed.

Lemma L20 : forall (p:Prop -> Prop), PEPred p ->
    ~ p False <-> ~ (forall (X:Prop), p X).
Proof.
    intros p. unfold PEPred.
    intros H1. split; intros H2 H3; apply H2.
    - apply H3.
    - intros X. apply H1. assumption.
Qed.

Inductive Formula : Set :=
| Bot : Formula
| Imp : Formula -> Formula -> Formula
.

(* Truth value semantics                                                        *)
Definition TVS : Prop := forall (X:Prop), X = True \/ X = False.

(* Excluded middle                                                              *)
Definition XM : Prop := forall (X:Prop), X \/ ~X.

(* Limited propositional omniscience                                            *)
(* Tests on numbers are either satisfiable or unsatisfiable                     *)
Definition LPO : Prop := forall (f:nat -> bool),
    (exists n, f n = true) \/ ~(exists n, f n = true).

(* Markov principle                                                             *)
(* Tests on numbers which are not constantly false, are true for some numbers   *)
Definition Markov : Prop := forall (f:nat -> bool),
    ~(forall n, f n = false) -> exists n, f n = true.

(* Propositional extensionality                                                 *)
Definition PExt : Prop := forall (X Y:Prop), X <-> Y -> X = Y.

(* Proof irrelevance                                                            *)
Definition PIrr : Prop := forall (X:Prop) (a b:X), a = b.

(* functional extensionality                                                    *)
Definition FExt : Prop := forall (X Y:Type) (f g:X -> Y),
    (forall (x:X), f x = g x) -> f = g.

Lemma L21 : TVS -> XM.
Proof.
    unfold TVS, XM. intros TVS X. destruct (TVS X) as [H|H].
    - left. rewrite H. trivial.
    - right. rewrite H. auto.
Qed.

Lemma L22 : XM -> LPO.
Proof.
    unfold XM, LPO. intros XM f. apply XM.
Qed.

Lemma L23 : LPO -> Markov.
Proof.
    unfold LPO, Markov. intros LPO f H1. destruct (LPO f) as [H2|H2].
    - assumption.
    - exfalso. apply H1. intros n. destruct (f n) eqn:E.
        + exfalso. apply H2. exists n. assumption.
        + reflexivity.
Qed.

Lemma L24 : TVS -> PExt.
Proof.
   unfold TVS, PExt. intros TVS X Y [H3 H4].
   destruct (TVS X) as [H1|H1]; destruct (TVS Y) as [H2|H2].
   - rewrite H1, H2. reflexivity.
   - exfalso. rewrite H1, H2 in H3. apply H3. trivial.
   - exfalso. rewrite H1, H2 in H4. apply H4. trivial.
   - rewrite H1, H2. reflexivity.
Qed.

Lemma L25 : XM -> PExt -> TVS.
Proof.
    unfold XM, PExt, TVS. intros XM PExt X.
    destruct (XM X) as [H|H].
    - left. apply PExt. split; intros H'.
        + trivial.
        + assumption.
    - right. apply PExt. split; intros H'.
        + apply H. assumption.
        + contradiction.
Qed.

Definition Pure (X:Prop) : Prop := forall (p q:X), p = q.

Lemma L26 : Pure True.
Proof.
    unfold Pure. intros p q. destruct p, q. reflexivity.
Qed.

Lemma L27 : forall (X:Prop), X -> X <-> True.
Proof.
    intros X p. split; intros H.
    - trivial.
    - assumption.
Qed.

Lemma L28 : PExt -> PIrr.
Proof.
    unfold PExt, PIrr. intros PExt X p q.
    assert (X = True) as H1.
        { apply PExt. apply L27. assumption. }
    assert (Pure X) as H2.
        { rewrite H1.  apply L26. }
    unfold Pure in H2. apply H2.
Qed.

(* Proved at meta level                                                         *)
Axiom Ax29 : Consistent  (TVS /\ FExt). (* also true for FExtGen below *)
Axiom Ax30 : ~Provable Markov /\ ~Provable PIrr /\ ~Provable FExt.

Lemma L31 : ~Provable False.
Proof.
    apply L14. exists (TVS /\ FExt). apply Ax29.
Qed.

Lemma L32 : Independent TVS.
Proof.
    apply Sandwich. exists (TVS /\ FExt), Markov. split.
    - apply RE. intros [H1 H2]. assumption.
    - split.
        + apply RE. intros H1. apply L23, L22, L21. assumption.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

Lemma L33 : Independent XM.
Proof.
    apply Sandwich. exists (TVS /\ FExt), Markov. split.
    - apply RE. intros [H1 H2]. apply L21. assumption.
    - split.
        + apply RE.  intros H3. apply L23, L22. assumption.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

Lemma L34 : Independent LPO.
Proof.
    apply Sandwich. exists (TVS /\ FExt), Markov. split.
    - apply RE. intros [H1 H2]. apply L22, L21. assumption.
    - split.
        + apply RE. apply L23.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

Lemma L35 : Independent Markov.
Proof.
    apply Sandwich. exists (TVS /\ FExt), Markov. split.
    - apply RE. intros [H1 H2]. apply L23, L22, L21. assumption.
    - split.
        + apply PI.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

Lemma L36 : ~Provable PExt.
Proof.
    intros H1. destruct Ax30 as [H2 [H3 H4]]. apply H3.
    apply PA with PExt.
    - apply RE, L28.
    - assumption.
Qed.

Lemma L37 : Independent PExt.
Proof.
    apply Sandwich. exists (TVS /\ FExt), PExt. split.
    - apply RE. intros [H1 H2]. apply L24. assumption.
    - split.
        + constructor.
        + split.
            { apply Ax29. }
            { apply L36. }
Qed.

Lemma L38 : Independent PIrr.
Proof.
    apply Sandwich. exists (TVS /\ FExt), PIrr. split.
    - apply RE. intros [H1 H2]. apply L28, L24. assumption.
    - split.
        + constructor.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

Lemma L39 : Independent FExt.
Proof.
    apply Sandwich. exists (TVS /\ FExt), FExt. split.
    - apply RE. intros [H1 H2]. assumption.
    - split.
        + constructor.
        + split.
            { apply Ax29. }
            { destruct Ax30 as [H1 [H2 H3]]. assumption. }
Qed.

(* Able to characterize TVS without reference to True and False.                *)
Lemma L40 : TVS <-> forall (X Y Z:Prop), X = Y \/ X = Z \/ Y = Z.
Proof.
    unfold TVS. split; intros H.
    - intros X Y Z. destruct (H X), (H Y), (H Z); subst; try (left; reflexivity).
        + right. left. reflexivity.
        + right. right. reflexivity.
        + right. right. reflexivity.
        + right. left. reflexivity.
    - intros X. destruct (H X True False) as [H1|[H1|H1]].
        + left. assumption.
        + right. assumption.
        + exfalso. rewrite <- H1. trivial.
Qed.

(* Able to characterize TVS without reference to True and False.                *)
Lemma L41 : TVS <-> forall (p:Prop -> Prop), p True -> p False -> forall X, p X.
Proof.
    unfold TVS. split; intros H.
    - intros p H1 H2 X. destruct (H X) as [H3|H3]; rewrite H3; assumption.
    - apply H.
        + left. reflexivity.
        + right. reflexivity.
Qed.

(* We cannot have a sort of TVS applicable to all types, only Prop's.           *)
Lemma L42 : ~ forall (X:Type), X = True \/ X = False.
Proof.
    intros H. destruct (H bool) as [H1|H1].
    - assert (forall (x y:True), x = y) as H2.
        { intros x y. destruct x, y. reflexivity. }
      rewrite <- H1 in H2.
      assert (true = false) as H3.
        { apply H2. }
      inversion H3.
    - assert (exists (x:bool), True) as H2.
        { exists true. trivial. }
      rewrite H1 in H2. destruct H2 as [X H2]. assumption.
Qed.

(* Implicational excluded middle.                                               *)
Definition IXM : Prop := forall (X Y:Prop), (X -> Y) \/ (Y -> X).

Lemma L43 : XM -> IXM.
Proof.
    unfold XM, IXM. intros H X Y. destruct (H Y) as [H1|H1].
    - left. intros _. assumption.
    - right. intros H2. apply H1 in H2. contradiction.
Qed.

Lemma L44 : Consistent IXM.
Proof.
    apply L2 with XM.
    - apply RE. apply L43.
    - destruct L33 as [H1 H2]. assumption.
Qed.

Axiom Ax45 : ~Provable IXM.
Axiom Ax46 : ~Provable (IXM -> XM).

(* Weak excluded middle                                                         *)
Definition WXM : Prop := forall (X:Prop), ~X \/ ~~X.

Lemma L45 : forall (A B:Prop), (A -> B) -> ~ B -> ~A.
Proof.
    intros A B H1 H2 H3. apply H2, H1, H3.
Qed.

Lemma L46 : WXM <-> forall (X:Prop), ~~X \/ ~~~X.
Proof.
    unfold WXM. split; intros H; intros X.
    - apply H.
    - destruct (H X) as [H'|H'].
        + right. assumption.
        + left. intros H1. apply H'. intros H2. apply H2. assumption.
Qed.

Lemma L47 : forall (A B:Prop), ~A \/ ~B -> ~(A /\ B).
Proof.
    intros A B [H1|H1] [H2 H3]; apply H1; assumption.
Qed.

Lemma L48 : forall (A:Prop), A -> ~~A.
Proof.
    intros A H1 H2. apply H2, H1.
Qed.

Lemma L49 : forall (A: Prop), ~A <-> ~~~A.
Proof.
    intros A. split; intros H1.
    - intros H2. apply H2. assumption.
    - intros H2. apply H1. intros H3. apply H3. assumption.
Qed.

Lemma L50 : forall (A B:Prop), ~A -> ~B -> ~(A \/ B).
Proof.
    intros A B H1 H2 [H3|H3].
    - apply H1. assumption.
    - apply H2. assumption.
Qed.

Lemma L51 : WXM <-> forall (X Y:Prop), ~(X /\ Y) -> ~X \/ ~Y.
Proof.
    unfold WXM. split; intros H1 X.
    - intros Y H2. destruct (H1 Y) as [H3|H3].
        + right. assumption.
        + left. intros H4. apply H3. intros H5.
          apply H2. split; assumption.
    - apply H1. intros [H2 H3]. apply H3, H2.
Qed.

Lemma L52 : forall (A:Prop), ~~(A \/ ~A).
Proof.
    intros A H1.
    assert (~A) as H2. { intros H3. apply H1. left. assumption. }
    assert (~~A) as H3. { intros H4. apply H1. right. assumption. }
    apply H3. assumption.
Qed.

Lemma L53 : XM -> WXM.
Proof.
    unfold XM , WXM. intros H X. apply H.
Qed.

Lemma L54 : forall (X Y:Prop), Provable (X -> Y) -> Consistent X -> Consistent Y.
Proof.
    unfold Consistent, Contradictory. intros X Y H1 H2 H3. apply H2.
    apply PA with (~Y).
    - apply PN; assumption.
    - assumption.
Qed.

Lemma L55 : Consistent WXM.
Proof.
    apply L54 with XM. apply RE, L53. destruct L33 as [H1 H2]. assumption.
Qed.

Definition pure (X:Type) : Prop := forall (p q:X), p = q.

Lemma L56 : FExt -> pure (True -> True).
Proof.
    unfold FExt, pure. intros H f g. apply H. intros x.
    destruct (f x), (g x). reflexivity.
Qed.

Lemma L57 : FExt -> bool <> (True -> True).
Proof.
    intros H1 H2. apply L56 in H1. rewrite <- H2 in H1.
    unfold pure in H1. assert (true = false) as H3. { apply H1. }
    inversion H3.
Qed.

Definition L58 : exists (x:bool), x = true.
Proof.
refine (
    ex_intro
        _
        true
        eq_refl
).
Qed.

Definition L59 : exists (x:bool), x = true := ex_intro _ true eq_refl.

Lemma L60 : (exists (f : (exists (x:bool), True) -> bool),
    forall (x:bool), f (ex_intro _ x I) = x) -> ~ PIrr.
Proof.
    intros [f H1] H2. unfold PIrr in H2.
    assert (true = false) as H3.
        { rewrite <- (H1 true). rewrite <- (H1 false).
          remember (ex_intro _ true I)  as p1 eqn:P1.
          remember (ex_intro _ false I) as p2 eqn:P2.
          assert (p1 = p2) as H3. { apply H2. }
          rewrite H3. reflexivity. }
    inversion H3.
Qed.

Fail Definition trying (p:exists (x:bool), True) : bool :=
    match p with
    | ex_intro _ x _ => x
    end.

Lemma L61 : (exists (f: True \/ True -> bool),
    f (or_introl I) = true /\ f (or_intror I) = false) -> ~PIrr.
Proof.
    intros [f [H1 H2]] H3. unfold PIrr in H3.
    assert (true = false) as H4.
        { rewrite <- H1, <- H2.
          assert (or_introl I = or_intror I) as H4. { apply H3. }
          rewrite H4. reflexivity. }
    inversion H4.
Qed.

Definition FExtGen : Prop := forall (X:Type) (p:X -> Type) (f g:forall (x:X), p x),
    (forall (x:X), f x = g x) -> f = g.

Lemma L62 : FExtGen -> FExt.
Proof.
    unfold FExtGen, FExt. intros H1 X Y f g H2. apply H1, H2.
Qed.