Require Import AB.Imp9.
Require Import Coq.ZArith.ZArith.
Require Import Coq.Lists.List.

Open Scope Z.

Module Polynomial.
Import Assertion_D.

(** Definitions of poly *)
Definition poly := list Z. (* The power increases as the index goes up *)

Definition ZERO : poly := nil.
Definition CONSTANT : poly := 1::nil.
Definition LINEAR : poly := 0::1::nil.
Definition QUADRATIC : poly := 0::0::1::nil.
Definition CUBIC : poly := 0::0::0::1::nil.
(** [] *)

(** Evaluations of polynomial *)
Fixpoint poly_eval (p : poly) : Z -> Z :=
  fun z =>
    match p with
    | nil => 0
    | h :: t => h + z * (poly_eval t z)
    end.

Open Scope term_scope.
(* Print aexp'. *)

Fixpoint TPower (v : logical_var) (n : nat) : term :=
  match n with
  | O => 1
  | S n' => v * (TPower v n')
  end.

Fixpoint poly_eval_lv (p : poly) : logical_var -> term :=
  fun v =>
    match p with
    | nil => 0
    | h :: t => h + v * (poly_eval_lv t v)
    end.

Close Scope term_scope.
(** [] *)

(** Operations of polynomial *)
Fixpoint poly_add (p1 p2 : poly) : poly :=
  match p1, p2 with
  | nil, nil => nil
  | h::t, nil => h::t
  | nil, h::t => h::t
  | h::t, h'::t' => (h+h')::(poly_add t t')
  end.

Fixpoint trim_0 (p : poly) : poly :=
  match p with
  | nil => nil
  | h :: t => match trim_0 t with
              | nil => if Z.eq_dec h 0 then nil else h :: nil
              | _ => h :: trim_0 t
              end
  end.

Fixpoint poly_scalar_mult (k : Z) (p : poly) : poly :=
  match p with
  | nil => nil
  | h :: t => k * h :: poly_scalar_mult k t
  end.

Fixpoint poly_mult (p1 p2 : poly) : poly :=
  match p1, p2 with
  | nil, _ => nil
  | _, nil => nil
  | h :: t, _ => poly_add (poly_scalar_mult h p2) (0 :: (poly_mult t p2))
  end.

Notation "p '+++' q" := (poly_add p q) (at level 60).
Notation "k ** p" := (poly_scalar_mult k p) (at level 60).
Notation "p '***' q" := (poly_mult p q) (at level 60).

Section Examples.

Example poly_add_eg : poly_eval ((CONSTANT +++ LINEAR) +++ (CONSTANT +++ QUADRATIC)) 2 = 8.
Proof.
  simpl. reflexivity.
Qed.

Example poly_mult_eg : poly_eval ((CONSTANT +++ LINEAR) *** (CONSTANT +++ QUADRATIC)) 2 = 15.
Proof.
  simpl. reflexivity.
Qed.

End Examples.
(** [] *)

(** Properties of Shorthand Notations *)
Fact CONSTANT_spec : forall z, poly_eval CONSTANT z = 1.
Proof.
  intros.
  simpl.
  rewrite Z.mul_0_r.
  reflexivity.
Qed.

Fact LINEAR_spec : forall z, poly_eval LINEAR z = z.
Proof.
  intros.
  simpl.
  rewrite Z.mul_0_r.
  omega.
Qed.

Fact QUADRATIC_spec : forall z, poly_eval QUADRATIC z = z*z.
Proof.
  intros.
  simpl.
  rewrite Z.mul_0_r.
  ring.
Qed.

Fact CUBIC_spec : forall z, poly_eval CUBIC z = z*z*z.
Proof.
  intros.
  simpl.
  rewrite Z.mul_0_r.
  ring.
Qed.
(** [] *)

(** Properties of Polynomial Operations *)
Lemma poly_add_nil_l : forall p, poly_add nil p = p.
Proof.
  intros.
  destruct p.
  - auto.
  - simpl. reflexivity.
Qed.

Lemma poly_add_nil_r : forall p, poly_add p nil = p.
Proof.
  intros.
  destruct p.
  - auto.
  - simpl. reflexivity.
Qed.

Lemma poly_mult_nil_l : forall p, poly_mult nil p = nil.
Proof.
  intros.
  simpl.
  reflexivity.
Qed.

Lemma poly_mult_nil_r : forall p, poly_mult p nil = nil.
Proof.
  intros.
  destruct p; auto.
Qed.

Lemma poly_eval_zero: forall n z,
  poly_eval (repeat 0 n) z = 0.
Proof.
  intros.
  induction n.
  - simpl. reflexivity.
  - simpl. rewrite IHn. omega.
Qed.

Theorem poly_add_spec : forall (p1 p2 : poly) (z : Z),
  poly_eval (poly_add p1 p2) z = poly_eval p1 z + poly_eval p2 z.
Proof.
  intro.
  induction p1; intros.
  - rewrite poly_add_nil_l. simpl. reflexivity.
  - destruct p2.
    + simpl. omega.
    + simpl. rewrite IHp1.
      rewrite Z.mul_add_distr_l. omega.
Qed.

Theorem poly_scalar_mult_spec : forall (k : Z) (p : poly) (z : Z),
  poly_eval (poly_scalar_mult k p) z = k * poly_eval p z.
Proof.
  intros.
  induction p.
  - simpl. rewrite Z.mul_0_r. reflexivity.
  - simpl. rewrite IHp. ring.
Qed.

Theorem poly_mult_spec : forall (p1 p2 : poly) (z : Z),
  poly_eval (poly_mult p1 p2) z = poly_eval p1 z * poly_eval p2 z.
Proof.
  intro.
  induction p1; intros.
  - auto.
  - destruct p2.
    + simpl. rewrite Z.mul_0_r. reflexivity.
    + simpl.
      rewrite poly_add_spec. rewrite IHp1.
      rewrite poly_scalar_mult_spec. simpl.
      ring.
Qed.

Theorem trim_invar:
  forall p z,
  poly_eval (trim_0 p) z = poly_eval p z.
Proof.
  intro.
  induction p; intros.
  - auto.
  - simpl.
    destruct (trim_0 p) eqn:eqp.
    + destruct (Z.eq_dec a 0) eqn:eqa; rewrite <- IHp; simpl; omega.
    + rewrite <- eqp in *.
      simpl. rewrite IHp. reflexivity.
Qed.

Lemma poly_eval_cons : forall (p: poly) (a z : Z),
  poly_eval (a :: p) z = a + z * (poly_eval p z).
Proof.
  simpl.
  reflexivity.
Qed.

Lemma poly_eval_nil : forall (z : Z),
  poly_eval nil z = 0.
Proof.
  intros.
  simpl.
  reflexivity.
Qed.

Lemma poly_eval_app : forall (p1 p2 : poly) (z : Z),
  poly_eval (p1 ++ p2) z = poly_eval p1 z + (z^(Z.of_nat (length p1))) * (poly_eval p2 z).
Proof.
  intros. induction p1.
  - assert (Z.of_nat (Datatypes.length (nil:poly)) = 0). auto.
    rewrite app_nil_l.
    rewrite H. rewrite Z.pow_0_r.
    pose proof poly_eval_nil z. rewrite H0.
    omega.
  - rewrite <- app_comm_cons.
    pose proof poly_eval_cons (p1 ++ p2) a z.
    rewrite H. clear H. rewrite IHp1.
    rewrite Z.mul_add_distr_l.
    assert (z * (z ^ Z.of_nat (Datatypes.length p1)) = z ^ Z.of_nat (Datatypes.length (a :: p1))).
    {
      pose proof Z.pow_1_r z. rewrite <- H at 1.
      pose proof Z.pow_add_r z 1 (Z.of_nat (Datatypes.length p1)).
      assert (0 <= 1). omega.
      assert (0 <= Z.of_nat (Datatypes.length p1)).
      {
        clear IHp1 H H0 H1.
        induction p1.
        - simpl. omega.
        - simpl. apply Zle_0_pos.
      }
      pose proof H0 H1 H2.
      rewrite <- H3.
      assert (1 + Z.of_nat (Datatypes.length p1) = Z.of_nat (Datatypes.length (a :: p1))).
      {
        clear IHp1 H H0 H1 H2 H3.
        pose proof Nat2Z.inj_add 1 (length p1).
        assert (Z.of_nat 1 = 1). auto.
        rewrite <- H0.
        rewrite <- H.
        pose proof inj_eq (1 + (length p1)) (length (a::p1)).
        assert ((1 + Datatypes.length p1)%nat = Datatypes.length (a :: p1)). auto.
        omega.
      }
      rewrite H4.
      omega.
    }
    rewrite <- H.
    pose proof poly_eval_cons p1 a z.
    rewrite H0.
    rewrite Z.mul_assoc.
    omega.
Qed.

Lemma poly_eval_add_zero_l: forall (p : poly) n z,
  poly_eval (poly_add (repeat 0 n) p) z = poly_eval p z.
Proof.
  intros.
  rewrite poly_add_spec.
  rewrite poly_eval_zero.
  omega.
Qed.

Lemma poly_eval_add_zero_r: forall (p : poly) n z,
  poly_eval (poly_add p (repeat 0 n)) z = poly_eval p z.
Proof.
  intros.
  rewrite poly_add_spec.
  rewrite poly_eval_zero.
  omega.
Qed.

Lemma poly_add_comm: forall p1 p2,
  poly_add p1 p2 = poly_add p2 p1.
Proof.
  intro.
  induction p1; intros.
  - rewrite poly_add_nil_l, poly_add_nil_r. reflexivity.
  - destruct p2.
    + auto.
    + simpl.
      rewrite IHp1.
      rewrite Z.add_comm.
      reflexivity.
Qed.
(** [] *)

(* Dealing with the coef *)
Fixpoint poly_coef_sum (p : poly) : Z :=
  match p with
  | nil => 0
  | h::t => h + (poly_coef_sum t)
  end.

End Polynomial.

Module Polynomial'.
Export Polynomial.
Import Assertion_D.

Definition poly' := list Z. (* The power decreases as the index goes up *)

(** Evaluations of polynomial' *)
Fixpoint poly'_eval (p : poly') : Z -> Z :=
  fun z =>
    match p with
    | nil => 0
    | h :: t => h * (Z.pow z (Z.of_nat (length t))) + (poly'_eval t z)
    end.

(** Operations of polynomial *)
Fixpoint poly'_add_body (l1 l2 : list Z) : list Z :=
  match l1, l2 with
  | nil, nil => l2
  | h::t, nil => h::t
  | nil, h::t => h::t
  | h::t, h'::t' => (h+h')::(poly'_add_body t t')
  end.

Definition poly'_add (p1 p2 : poly') : poly' := rev (poly'_add_body (rev p1) (rev p2)).

(** Properties of Polynomial Operations *)
Lemma poly'_add_body_empty_r : forall l, poly'_add_body l nil = l.
Proof.
  intros.
  destruct l.
  - auto.
  - simpl. reflexivity.
Qed.

Lemma poly'_add_empty_r : forall p, poly'_add p nil = p.
Proof.
  intros.
  destruct p.
  - auto.
  - unfold poly'_add.
    rewrite poly'_add_body_empty_r.
    apply rev_involutive.
Qed.

Lemma poly'_add_body_empty_l : forall l, poly'_add_body nil l = l.
Proof.
  intros.
  destruct l.
  - auto.
  - simpl. reflexivity.
Qed.

Lemma poly'_add_empty_l : forall p, poly'_add nil p = p.
Proof.
  intros.
  destruct p.
  - auto.
  - unfold poly'_add.
    rewrite poly'_add_body_empty_l.
    apply rev_involutive.
Qed.

Lemma poly'_eval_0s: forall times n,
  poly'_eval (repeat 0 times) n = 0.
Proof.
  intros.
  induction times.
  - simpl. reflexivity.
  - simpl. omega.
Qed.

Lemma poly'_cons_eval_comm : forall p z n,
  poly'_eval (cons z p) n = poly'_eval (cons z (repeat 0 (length p))) n + poly'_eval p n.
Proof.
  intros.
  simpl.
  assert (Datatypes.length (repeat 0 (Datatypes.length p)) = Datatypes.length p).
  { induction p.
    - simpl. reflexivity.
    - simpl. rewrite IHp. reflexivity.
  }
  rewrite H.
  pose proof poly'_eval_0s (Datatypes.length p) n.
  rewrite H0.
  omega.
Qed.

Lemma poly'_app_eval_comm: forall p1 p2 n,
  poly'_eval (p1 ++ p2) n = poly'_eval (p1 ++ (repeat 0 (length p2))) n + poly'_eval p2 n.
Proof.
  intros.
  induction p1.
  - simpl.
    pose proof app_nil_l p2.
    rewrite <- H. simpl.
    pose proof poly'_eval_0s (Datatypes.length p2) n.
    rewrite H0.
    omega.
  - pose proof poly'_cons_eval_comm.
    simpl.
    assert (Datatypes.length (p1 ++ repeat 0 (Datatypes.length p2)) = Datatypes.length (p1 ++ p2)).
    { clear IHp1 H.
      assert (Datatypes.length (repeat 0%Z (Datatypes.length p2)) = Datatypes.length p2).
      { induction p2.
        - simpl. reflexivity.
        - simpl. rewrite IHp2. reflexivity.
      }
      pose proof app_length p1 p2.
      rewrite H0.
      pose proof app_length p1 (repeat 0 (Datatypes.length p2)).
      rewrite H1.
      rewrite H.
      omega.
    }
    rewrite H0.
    rewrite IHp1.
    omega.
Qed.

Lemma poly'_eval_repeat_length_p: forall a (p : poly') z,
  poly'_eval (a :: repeat 0 (length p)) z = a * z ^ (Z.of_nat (length p)).
Proof.
  intros.
  simpl.
  pose proof poly'_eval_0s (length p) z.
  rewrite H.
  pose proof repeat_length 0 (length p).
  rewrite H0.
  omega.
Qed.

Theorem poly'_eval_poly_eval: forall (p : poly') n,
  poly'_eval p n = poly_eval (rev p) n.
Proof.
  intros.
  induction p.
  - simpl. reflexivity.
  - simpl.
    pose proof poly_eval_app (rev p) (a::nil) n.
    rewrite H. simpl. clear H.
    rewrite IHp.
    pose proof rev_length p.
    rewrite H.
    assert (a + n * 0 = a). { omega. }
    rewrite H0.
    rewrite Z.mul_comm.
    omega.
Qed.

Theorem poly_eval_poly'_eval: forall (p : poly) n,
  poly_eval p n = poly'_eval (rev p) n.
Proof.
  intros.
  pose proof poly'_eval_poly_eval (rev p) n.
  rewrite rev_involutive in H.
  omega.
Qed.

End Polynomial'.

Module WZY_Poly_Enhance.
Export Polynomial.

Inductive list_le : poly -> poly -> Prop :=
  | nil_le : list_le nil nil
  | cons_le : forall p1 p2 a1 a2,
              length p1 = length p2 ->
              a1 <= a2 ->
              list_le p1 p2 ->
              list_le (a1 :: p1) (a2 :: p2).

End WZY_Poly_Enhance.

Module Monomial.
Export Polynomial.
Export Polynomial'.
Export WZY_Poly_Enhance.

Fixpoint poly_get_last (p : poly) : Z :=
  match p with
  | nil => 0
  | a::nil => a
  | h::t => poly_get_last t
  end.

Fact poly_app_nonnil: forall (p : poly) a, (p ++ a::nil) <> nil.
Proof.
  intros. unfold not. intros.
  induction p.
  - inversion H; subst.
  - inversion H; subst.
Qed.

Fact poly_get_last_app: forall (p : poly) a,
  poly_get_last (p ++ a::nil) = a.
Proof.
  intros.
  induction p.
  - simpl. reflexivity.
  - pose proof poly_app_nonnil p a.
    simpl.
    destruct (p ++ a ::nil).
    + unfold not in H. assert ((nil:poly) = (nil:poly)). { reflexivity. }
      pose proof H H0. destruct H1.
    + tauto.
Qed.

Fact poly_get_last_cons: forall (a h: Z) (t : poly),
  poly_get_last (a::h::t) = poly_get_last (h::t).
Proof.
  intros.
  simpl. reflexivity.
Qed.

Fixpoint poly'_get_first (p : poly) : Z :=
  match p with
  | nil => 0
  | h::t => h
  end.

Definition poly_monomialize (p : poly) : poly :=
  match p with
  | nil => nil
  | _ :: _ => (repeat 0 ((length p) - 1)) ++ (poly_get_last p)::nil
  end.

Definition poly'_monomialize (p : poly') : poly' :=
  match p with
  | nil => nil
  | h :: _ => h::nil ++ (repeat 0 ((length p) - 1))
  end.

Example poly_mono_1: poly_monomialize (3::2::1::nil) = 0::0::1::nil.
Proof.
  simpl. reflexivity.
Qed.

Example poly'_mono_1: poly'_monomialize (1::2::3::nil) = 1::0::0::nil.
Proof.
  simpl. reflexivity.
Qed.

Lemma poly'_eval_mono: forall (p : poly') (n : Z),
  poly'_eval (poly'_monomialize p) n = (poly'_get_first p) * n^(Z.of_nat (length p) - 1).
Proof.
  intros.
  induction p.
  - simpl. reflexivity.
  - assert (Datatypes.length p - 0 = Datatypes.length p)%nat.
    { omega. }
    assert (poly'_eval (poly'_monomialize (a :: p)) n = a * n ^ Z.of_nat (Datatypes.length (repeat 0 (Datatypes.length p - 0))) + poly'_eval (repeat 0 (Datatypes.length p - 0)) n).
    { simpl. reflexivity. }
    rewrite H0. clear H0.
    rewrite H.
    assert (Datatypes.length (repeat 0 (Datatypes.length p)) = Datatypes.length p).
    { clear IHp H.
      induction p.
      - simpl. reflexivity.
      - simpl. rewrite IHp. reflexivity.
    }
    rewrite H0.
    pose proof poly'_eval_0s (Datatypes.length p) n.
    rewrite H1.
    assert (poly'_get_first (a :: p) = a).
    { simpl. reflexivity. }
    rewrite H2.
    assert (Z.of_nat (Datatypes.length (a :: p)) - 1 = Z.of_nat (Datatypes.length p)).
    { assert (Datatypes.length (a :: p) = Datatypes.length p + 1)%nat.
      { simpl. omega. }
      rewrite H3.
      rewrite Nat2Z.inj_add.
      simpl. omega.
    }
    rewrite H3.
    omega.
Qed.

Lemma poly_mono_app_1 : forall (p : poly) a,
  poly_monomialize (p ++ a::nil) = (repeat 0 (length p)) ++ a::nil.
Proof.
  intros.
  pose proof poly_app_nonnil p a.
  pose proof poly_get_last_app p a.
  assert (length (p ++ a::nil) = length p + 1)%nat.
  { clear H H0.
    induction p.
    - simpl. reflexivity.
    - simpl. rewrite IHp. reflexivity.
  }
  unfold poly_monomialize. destruct (p ++ a::nil).
  { unfold not in H. assert ((nil:poly) = (nil:poly)). { reflexivity. }
    pose proof H H2. destruct H3.
  }
  { rewrite H0. rewrite H1.
    assert (Datatypes.length p + 1 - 1 = Datatypes.length p)%nat.
    { omega. }
    rewrite H2.
    reflexivity.
  }
Qed.

Lemma poly'_mono_poly_mono : forall (p : poly') n,
  poly_eval (poly_monomialize (rev p)) n = poly'_eval (poly'_monomialize p) n.
Proof.
  intros.
  induction p.
  - simpl. reflexivity.
  - simpl.
    assert (Datatypes.length p - 0 = Datatypes.length p)%nat.
    { omega. }
    rewrite H.
    assert (Datatypes.length (repeat 0 (Datatypes.length p)) = Datatypes.length p).
    { clear IHp H.
      induction p.
      - simpl. reflexivity.
      - simpl. rewrite IHp. reflexivity.
    }
    rewrite H0.
    pose proof poly'_eval_0s (Datatypes.length p) n.
    rewrite H1.
    pose proof poly_mono_app_1 (rev p) a.
    rewrite H2.
    rewrite rev_length.
    { clear IHp H H0 H1 H2.
      induction p.
      - simpl. omega.
      - simpl. rewrite IHp.
        assert (n * (a * n ^ Z.of_nat (Datatypes.length p) + 0) = a * n * n ^ Z.of_nat (Datatypes.length p)).
        { simpl. ring. }
        rewrite H.
        pose proof Z.pow_1_r n. rewrite <- H0 at 1. clear H0.
        pose proof Z.pow_add_r n 1 (Z.of_nat (Datatypes.length p)).
        assert (0 <= 1). { omega. }
        assert ( 0 <= Z.of_nat (Datatypes.length p)). { omega. }
        pose proof H0 H1 H2.
        assert (a * n ^ 1 * n ^ Z.of_nat (Datatypes.length p) = a * n ^ (1 + Z.of_nat (Datatypes.length p))).
        { rewrite H3. rewrite Z.mul_assoc. reflexivity. }
        rewrite H4. clear H4.
        pose proof Zpos_P_of_succ_nat (Datatypes.length p).
        rewrite Z.pow_pos_fold.
        rewrite H4.
        assert (1 + Z.of_nat (Datatypes.length p) = Z.succ (Z.of_nat (Datatypes.length p))).
        { rewrite <- Z.add_1_r.
          rewrite Z.add_comm.
          reflexivity.
        }
        rewrite H5.
        omega.
    }
Qed.

Lemma poly_mono_poly'_mono : forall (p : poly) n,
  poly_eval (poly_monomialize p) n = poly'_eval (poly'_monomialize (rev p)) n.
Proof.
  intros.
  pose proof poly'_mono_poly_mono (rev p) n.
  rewrite rev_involutive in H.
  tauto.
Qed.

Lemma poly'_last_poly_first: forall (p : poly'),
  poly_get_last (rev p) = poly'_get_first p.
Proof.
  intros. induction p.
  - simpl. reflexivity.
  - simpl. pose proof poly_get_last_app (rev p) a.
    tauto.
Qed.

Lemma poly_last_poly'_first: forall (p : poly),
  poly_get_last p = poly'_get_first (rev p).
Proof.
  intros. pose proof poly'_last_poly_first (rev p).
  rewrite rev_involutive in H.
  tauto.
Qed.

Lemma poly_eval_mono: forall (p : poly) (n : Z),
  poly_eval (poly_monomialize p) n = (poly_get_last p) * n^(Z.of_nat (length p) - 1).
Proof.
  intros.
  pose proof poly_mono_poly'_mono p n.
  rewrite H.
  pose proof poly_last_poly'_first p.
  rewrite H0.
  rewrite <- rev_length.
  pose proof poly'_eval_mono (rev p) n.
  tauto.
Qed.

Fixpoint poly_get_max (p : poly) (d : Z) : Z :=
  match p with
    | nil => d
    | b::t => poly_get_max t (Z.max b d)
  end.

Lemma poly_get_max1: forall (p : poly),
  forall z, z <= poly_get_max p z.
Proof.
  induction p; intros.
  - simpl. reflexivity.
  - simpl.
    specialize (IHp (Z.max a z)).
    assert (z <= Z.max a z).
    { apply Z.le_max_r. }
    pose proof Z.le_trans _ _ _ H IHp.
    tauto.
Qed.

Lemma poly_get_max2: forall (p : poly) z1 z2,
  z1 <= z2 ->
  poly_get_max p z1 <= poly_get_max p z2.
Proof.
  induction p; intros.
  - simpl. tauto.
  - simpl.
    assert ( a <= z1 \/ z1 < a).
    { omega. }
    destruct H0.
    + pose proof Z.max_l _ _ H0.
      rewrite Z.max_comm in H1.
      rewrite H1.
      pose proof Z.le_trans _ _ _ H0 H.
      pose proof Z.max_l _ _ H2.
      rewrite Z.max_comm in H3.
      rewrite H3.
      specialize (IHp z1 z2).
      tauto.
    + apply Z.lt_le_incl in H0.
      pose proof Z.max_l _ _ H0.
      rewrite H1.
      assert ( a <= z2 \/ z2 < a).
      { omega. }
      destruct H2.
      * pose proof Z.max_l _ _ H2.
        rewrite Z.max_comm in H3.
        rewrite H3.
        pose proof IHp a z2 H2.
        tauto.
      * apply Z.lt_le_incl in H2.
        pose proof Z.max_l _ _ H2.
        rewrite H3.
        pose proof IHp a a.
        pose proof Z.le_refl a.
        tauto.
Qed.

Lemma poly_get_max3: forall (p : poly),
  forall z, In z p -> z <= poly_get_max p 0.
Proof.
  induction p; intros.
  - simpl. inversion H.
  - simpl.
    assert (z <= 0 \/ z > 0).
    { omega. }
    destruct H0.
    + pose proof poly_get_max1 p 0.
      pose proof poly_get_max2 p 0 (Z.max a 0).
      pose proof Z.le_max_r a 0.
      pose proof H2 H3.
      pose proof Z.le_trans _ _ _ H0 H1.
      pose proof Z.le_trans _ _ _ H5 H4.
      tauto.
    + inversion H; subst.
      * pose proof poly_get_max1 p z.
        pose proof poly_get_max2 p z (Z.max z 0).
        pose proof Z.le_max_l z 0.
        pose proof H2 H3.
        pose proof Z.le_trans _ _ _ H1 H4.
        tauto.
      * specialize (IHp z).
        pose proof IHp H1.
        pose proof poly_get_max2 p 0 (Z.max a 0).
        pose proof Z.le_max_r a 0.
        pose proof H3 H4.
        pose proof Z.le_trans _ _ _ H2 H5.
        tauto.
Qed.

Lemma rev_nil : forall (l : list Z), nil = rev l -> l = nil.
Proof.
  intros.
  destruct l.
  - auto.
  - assert (length (rev (z :: l)) = length (rev (z :: l))). auto.
    rewrite <- H in H0 at 1.
    simpl in H0. rewrite app_length in H0.
    simpl in H0. rewrite Nat.add_1_r in H0.
    inversion H0.
Qed.

Lemma non_empty_list : forall (l : list Z),
  l <> nil -> exists l' a, l = l' ++ a :: nil.
Proof.
  intros.
  remember (rev l) as rl.
  destruct rl.
  - apply rev_nil in Heqrl.
    congruence.
  - assert (rev (z :: rl) = rev (rev l)).
    rewrite Heqrl. reflexivity.
    simpl in H0. rewrite rev_involutive in H0.
    exists (rev rl), z. auto.
Qed.

Lemma poly_get_last_spec : forall l a,
  poly_get_last (l ++ a :: nil) = a.
Proof.
  intros.
  induction l.
  - auto.
  - simpl.
    destruct (l ++ a :: nil) eqn:eq.
    + assert (length (l ++ a :: nil) = length (l ++ a :: nil)); auto.
      rewrite eq in H at 1.
      simpl in H. rewrite app_length in H.
      simpl in H. rewrite Nat.add_1_r in H.
      inversion H.
    + auto.
Qed.

Fact poly_get_last_in_poly: forall p,
  p <> nil -> In (poly_get_last p) p.
Proof.
  intros.
  apply non_empty_list in H as [l' [a ?]].
  rewrite H at 1.
  rewrite poly_get_last_spec, H.
  rewrite in_app_iff.
  right. simpl. left. auto.
Qed.

Lemma poly_distr_coef_compare:
  forall K (N : nat) n,
  K > 0 ->
  n > 0 ->
  poly_eval ((repeat 0 (Z.to_nat (Z.of_nat N-1))) ++ (K * Z.of_nat N)::nil) n >=
  poly_eval (repeat K N) n.
Proof.
  assert (forall N:nat, (Datatypes.length (repeat 0 N)) = N) as lem_repeat.
  { intros. simpl.
    induction N.
    - simpl. reflexivity.
    - simpl. rewrite IHN. reflexivity.
  }
  intros.
  induction N.
  - simpl. omega.
  - pose proof poly_eval_app (repeat 0 (Z.to_nat (Z.of_nat (S N) - 1))) (K * Z.of_nat (S N) :: nil) n.
    rewrite H1.
    pose proof poly_eval_zero (Z.to_nat (Z.of_nat (S N) - 1)).
    rewrite H2.
    pose proof lem_repeat (Z.to_nat (Z.of_nat (S N) - 1))%nat.
    rewrite H3.
    pose proof Z2Nat.id (Z.of_nat (S N) - 1).
    assert (0 <= Z.of_nat (S N) - 1).
    { clear IHN H1 H2 H3 H4.
      induction N. - simpl. omega.
      - pose proof Nat2Z.inj_succ (S N).
        rewrite H1.
        pose proof Z.le_succ_diag_r (Z.of_nat (S N)).
        omega.
    }
    pose proof H4 H5.
    rewrite H6.
    assert (poly_eval (K * Z.of_nat (S N) :: nil) n = K * Z.of_nat (S N)).
    { simpl. omega. }
    rewrite H7.
    rewrite Z.add_0_l.
    assert (S N = N + 1)%nat. { omega. }
    rewrite H8.
    assert (Z.of_nat (N + 1) - 1 = Z.of_nat N).
    { pose proof Nat2Z.inj_sub (N+1) 1.
      assert (1 <= N + 1)%nat. omega.
      pose proof H9 H10. simpl in H11.
      assert (N+1-1=N)%nat. omega.
      rewrite H12 in H11.
      omega.
    }
    rewrite H9.

    clear H1 H2 H3 H4 H5 H6 H7 H8 H9.
    pose proof poly_eval_app (repeat 0 (Z.to_nat (Z.of_nat N - 1))) (K * Z.of_nat N :: nil) n.
    rewrite H1 in IHN.
    pose proof poly_eval_zero (Z.to_nat (Z.of_nat N - 1)) n.
    rewrite H2 in IHN.
    pose proof lem_repeat (Z.to_nat (Z.of_nat N - 1))%nat.
    rewrite H3 in IHN.
    assert (poly_eval (K * Z.of_nat N :: nil) n = K * Z.of_nat N).
    { simpl. omega. }
    rewrite H4 in IHN.
    rewrite Z.add_0_l in IHN.
    assert (Z.to_nat (Z.of_nat N - 1) = N - 1)%nat.
    { pose proof Nat2Z.id N.
      pose proof Z2Nat.inj_sub (Z.of_nat N) 1.
      assert (0<=1). omega. pose proof H6 H7.
      rewrite H5 in H8.
      assert (Z.to_nat 1 = 1)%nat.
      { simpl. apply Pos2Nat.inj_1. }
      rewrite H9 in H8.
      exact H8.
    }
    rewrite H5 in IHN.

    clear H1 H2 H3 H4 H5.
    assert (poly_eval (repeat K (N + 1)) n = K * n ^ (Z.of_nat N) + poly_eval (repeat K N) n).
    { clear IHN.
      induction N.
      - simpl. omega.
      - assert (poly_eval (repeat K (S N + 1)) n = K + n * poly_eval (repeat K (S N)) n).
        { clear IHN. simpl. induction N.
          - simpl. omega.
          - simpl. rewrite IHN. omega.
        }
        rewrite H1.
        assert (S N = N + 1)%nat. omega.
        rewrite <- H2 in IHN.
        rewrite IHN at 1.
        rewrite Z.mul_add_distr_l.
        assert (n * (K * n ^ Z.of_nat N) = K * n ^ (Z.of_nat (S N))).
        { rewrite Z.mul_assoc.
          rewrite Z.mul_shuffle0.
          pose proof Z.pow_1_r n.
          rewrite <- H3 at 1.
          pose proof Z.pow_add_r n 1 (Z.of_nat N).
          assert (0 <= 1). { omega. }
          assert (0 <= Z.of_nat N). { omega. }
          pose proof H4 H5 H6. rewrite <- H7.
          assert (Z.of_nat (S N) = 1 + Z.of_nat N).
          { pose proof Nat2Z.inj_add 1 N.
            assert (1 + N = S N)%nat. { omega. }
            assert (1 = Z.of_nat 1). { simpl. omega. }
            rewrite H9 in H8.
            rewrite <- H10 in H8.
            tauto.
          }
          rewrite <- H8.
          rewrite Z.mul_comm.
          omega.
        }
        rewrite H3.
        rewrite Z.add_assoc.
        assert (K + K * n ^ Z.of_nat (S N) + n * poly_eval (repeat K N) n = K * n ^ Z.of_nat (S N) + (K + n * poly_eval (repeat K N) n)).
        { omega. }
        rewrite H4.
        assert (K + n * poly_eval (repeat K N) n = poly_eval (repeat K (S N)) n).
        { simpl. omega. }
        rewrite H5.
        omega.
      }
      rewrite H1.
      assert (n ^ Z.of_nat N * (K * Z.of_nat (N + 1)) >= n ^ Z.of_nat (N - 1) * (K * Z.of_nat N) + K * n ^ Z.of_nat N).
      { clear H1.
        assert (Z.of_nat (N + 1) = Z.of_nat N + 1).
        { pose proof Nat2Z.inj_add N 1. simpl in H1.
          tauto.
        }
        rewrite H1.
        rewrite Z.mul_add_distr_l.
        rewrite Z.mul_add_distr_l.
        assert (n >= 1). { omega. }
        assert (n ^ Z.of_nat N >= n ^ Z.of_nat (N - 1)).
        { clear IHN H1.
          induction N.
          - simpl. omega.
          - assert (n ^ Z.of_nat (S N) = n * n ^ Z.of_nat N).
            { assert (S N = N + 1)%nat. omega.
              rewrite H1. clear H1.
              assert (Z.of_nat (N + 1) = Z.of_nat N + 1).
              { pose proof Nat2Z.inj_add N 1. simpl in H1.
                tauto.
              }
              rewrite H1. clear H1.
              pose proof Z.pow_add_r n (Z.of_nat N) 1.
              assert (0 <= Z.of_nat N). omega.
              assert (0 <= 1). omega.
              pose proof H1 H3 H4. rewrite H5.
              rewrite Z.pow_1_r.
              rewrite Z.mul_comm.
              reflexivity.
            }
            rewrite H1.
            assert (S N - 1 = N)%nat. omega.
            rewrite H3.
            pose proof Z.le_mul_diag_r (n ^ Z.of_nat N) n.
            assert (0 < n ^ Z.of_nat N).
            { apply Z.pow_pos_nonneg. omega. omega. }
            assert (1<=n). omega.
            pose proof H4 H5.
            apply H7 in H6.
            rewrite Z.mul_comm in H6.
            omega.
        }
        assert (n ^ Z.of_nat N * (K * 1) = K * n ^ Z.of_nat N).
        { ring. }
        rewrite H4.
        apply Z.le_ge.
        pose proof Zplus_le_compat_r (n ^ Z.of_nat (N - 1) * (K * Z.of_nat N)) (n ^ Z.of_nat N * (K * Z.of_nat N)) (K * n ^ Z.of_nat N).
        assert (n ^ Z.of_nat (N - 1) * (K * Z.of_nat N) <= n ^ Z.of_nat N * (K * Z.of_nat N)).
        { clear H5.
          pose proof Z.mul_le_mono_nonneg_r (n ^ Z.of_nat (N - 1)) (n ^ Z.of_nat N) (K * Z.of_nat N).
          assert (0 <= K * Z.of_nat N ).
          pose proof Z.mul_nonneg_nonneg K (Z.of_nat N).
          assert (0<=K). omega. pose proof H6 H7.
          assert (0<=Z.of_nat N). omega. pose proof H8 H9.
          exact H10.
          pose proof H5 H6.
          assert (n ^ Z.of_nat (N - 1) <= n ^ Z.of_nat N). omega.
          tauto.
        }
     pose proof H5 H6.
     tauto.
   }
   assert (n ^ Z.of_nat (N - 1) * (K * Z.of_nat N) + K * n ^ Z.of_nat N >= K * n ^ Z.of_nat N + poly_eval (repeat K N) n).
   { apply Z.le_ge.
     pose proof Zplus_le_compat_l (poly_eval (repeat K N) n) (n ^ Z.of_nat (N - 1) * (K * Z.of_nat N)) (K * n ^ Z.of_nat N).
     apply Z.ge_le in IHN.
     pose proof H3 IHN. omega.
   }
  omega.
Qed.

Fact poly_mono_cons: forall a h t,
  poly_monomialize (a :: h :: t) = 0 :: poly_monomialize (h :: t).
Proof.
  intros.
  simpl.
  assert (Datatypes.length t - 0 = Datatypes.length t)%nat.
  omega.
  rewrite H.
  reflexivity.
Qed.

Fact poly_mono_length_invar: forall p : poly,
  length p = length (poly_monomialize p).
Proof.
  intros.
  induction p.
  - simpl. omega.
  - destruct p.
    + simpl. reflexivity.
    + pose proof poly_mono_cons a z p.
      rewrite H.
      assert (Datatypes.length (a :: z :: p) = 1 + Datatypes.length (z :: p))%nat. { simpl. omega. }
      assert (Datatypes.length (0 :: poly_monomialize (z :: p)) = plus 1 (Datatypes.length (poly_monomialize (z :: p)))).
      { simpl. reflexivity. }
      rewrite H0.
      rewrite H1.
      f_equal.
      omega.
Qed.

Definition term_by_term_le := list_le.

Lemma poly_each_coef_compare:
  forall p1 p2,
  length p1 = length p2 ->
  term_by_term_le p1 p2 ->
  forall n, 0 <= n ->
  poly_eval p1 n <= poly_eval p2 n.
Proof.
  intros.
  induction H0.
  - omega.
  - simpl.
    pose proof IHlist_le H0.
    apply Z.add_le_mono; auto.
    apply Z.mul_le_mono_nonneg_l; auto.
Qed.

End Monomial.

Module Polynomial_Asympotitic_Bound.
Export Polynomial.
Export Monomial.
Import Assertion_D.

Inductive AsymptoticBound : Type :=
  | BigO : poly -> logical_var -> AsymptoticBound
  | BigOmega : poly -> logical_var -> AsymptoticBound
  | BigTheta : poly -> logical_var -> AsymptoticBound.

(* Convert asymtotic bounds to corresponding inequalities. We do not consider input with nonpositive size *)
Definition ab_eval (La : Lassn) (T : AsymptoticBound) (a1 a2 t : Z) : Prop :=
  match T with
  | BigO p n => 0 < La n ->
                0 <= t <= a2 * (poly_eval p (La n))
  | BigOmega p n => 0 < La n ->
                    0 <= a1 * (poly_eval p (La n)) <= t
  | BigTheta p n => 0 < La n ->
                    0 <= a1 * (poly_eval p (La n)) <= t /\ t <= a2 * (poly_eval p (La n))
  end.

Reserved Notation "T1 '=<' T2" (at level 50, no associativity).

(* loosen relationship defines equivalence between bounds *)
Inductive loosen : AsymptoticBound -> AsymptoticBound -> Prop :=
  (* If time is bounded by Theta, it is bounded by O and Omega *)
  | Theta2Omega : forall p n, 0 < poly_get_last p -> BigTheta p n =< BigOmega p n
  | Theta2O : forall p n, 0 < poly_get_last p -> BigTheta p n =< BigO p n

  (* We can relax the bound to a monomial with the same highest order term *)
  | O_Poly2Mono : forall p n, 0 < poly_get_last p -> BigO p n =< BigO (poly_monomialize p) n
  (* TODO: a monomial should also be able to be relaxed to polynomial with same highest order, but we did not have time to prove its soundness, thus it is not included yet *)

  (* Multiplying positive constant to a bound can obtain another valid bound *)
  | O_const : forall p a b n, 0 < a -> 0 < b ->  0 < poly_get_last p -> BigO (a ** p) n =< BigO (b ** p) n

  (* A polynomial can have different forms, if they always evaulate to the same value, then bounds defined by them are equivalent *)
  | O_id : forall p1 p2 n, (forall z, poly_eval p1 z = poly_eval p2 z) -> BigO p1 n =< BigO p2 n
  | Theta_id : forall p1 p2 n, (forall z, poly_eval p1 z = poly_eval p2 z) -> BigTheta p1 n =< BigTheta p2 n
  | Omega_id : forall p1 p2 n, (forall z, poly_eval p1 z = poly_eval p2 z) -> BigOmega p1 n =< BigOmega p2 n

  where "T1 '=<' T2" := (loosen T1 T2).

End Polynomial_Asympotitic_Bound.


Require Export D.

(** **** Problem #18 : 3 stars (plus_n_n_injective)  *)
(** Practice using "in" variants in this exercise. *)

Theorem plus_n_n_injective : forall n m,
     n + n = m + m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  { (* Hint: use the [destruct] and [inversion] tactics. *)
    intros. destruct m. reflexivity.
    inversion H.
  }
  { (* Hint: use the plus_n_Sm lemma *)
    intros. destruct m. inversion H. inversion H.
    Lemma plus_n_Sm : forall (n m:nat),
      n + S m = S (n + m).
    Proof. intros. induction n. reflexivity.
      simpl. rewrite -> IHn. reflexivity. Qed.
    rewrite->plus_n_Sm in H1. symmetry in H1. rewrite -> plus_n_Sm in H1. inversion H1.
    Lemma nm_SnSm_eq : forall (n m:nat),
      n=m -> S n=S m.
    Proof. intros. rewrite -> H. reflexivity. Qed.
    apply nm_SnSm_eq. apply IHn'. symmetry. apply H2.
  }
Qed.


Require Import Nat Arith.

Inductive Nat : Type := succ : Nat -> Nat |  zero : Nat.

Inductive Lst : Type := cons : Nat -> Lst -> Lst |  nil : Lst.

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint plus (plus_arg0 : Nat) (plus_arg1 : Nat) : Nat
           := match plus_arg0, plus_arg1 with
              | zero, n => n
              | succ n, m => succ (plus n m)
              end.

Fixpoint even (even_arg0 : Nat) : bool
           := match even_arg0 with
              | zero => true
              | succ n => negb (even n)
              end.

Fixpoint append (append_arg0 : Lst) (append_arg1 : Lst) : Lst
           := match append_arg0, append_arg1 with
              | nil, x => x
              | cons x y, z => cons x (append y z)
              end.

Fixpoint len (len_arg0 : Lst) : Nat
           := match len_arg0 with
              | nil => zero
              | cons x y => succ (len y)
              end.

(* No helper lemma needed. *)
Theorem theorem0 : forall (x : Lst) (y : Lst), eq (even (len (append x y))) (even (plus (len x) (len y))).
Proof.
 induction x.
  - intros. simpl. rewrite IHx. reflexivity.
  - intros. reflexivity.
Qed.


Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *) simpl. intros n' IHn'. rewrite -> IHn'.
    reflexivity. Qed.

Check nat_ind.

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
induction n.
- reflexivity.
- simpl. rewrite IHn. reflexivity.
Qed.

Inductive yesno : Type :=
  | yes
  | no.

Check yesno_ind.

Inductive rgb : Type :=
  | red
  | green
  | blue.

(**
rgb_ind
     : forall P : rgb -> Prop, P red -> P green -> P blue -> forall y : rgb, P y
*)
Check rgb_ind.

Inductive natlist : Type :=
  | nnil
  | ncons (n : nat) (l : natlist).

(**
natlist_ind
     : forall P : natlist -> Prop, P nnil -> (forall (n:nat) (l:listnat): P l -> P (ncons n l))) -> forall y : natlist, P y
*)
Check natlist_ind.

Inductive natlist1 : Type :=
  | nnil1
  | nsnoc1 (l : natlist1) (n : nat).

Check natlist1_ind.

Inductive byntree : Type :=
 | bempty
 | bleaf (yn : yesno)
 | nbranch (yn : yesno) (t1 t2 : byntree).

(**
byntree_ind
     : forall P : byntree -> Prop, P bempty -> (forall (yn: yesno): P yn -> P rgb_ind yn) ->
      (forall (yn: yesno): (forall (t1 t2 :byntree): P yn t1 t2 -> P nbranch yn t1 t2 )) ->
      forall y : byntree_ind, P y
*)

Check byntree_ind.

(**
  byntree_ind
     : forall P : byntree -> Prop,
       P bempty ->
       (forall yn : yesno, P (bleaf yn)) ->
       (forall (yn : yesno) (t1 : byntree), P t1 -> forall t2 : byntree, P t2 -> P (nbranch yn t1 t2)) ->
       forall b : byntree, P b
*)

(** Find an inductive definition that gives rise to the following induction principle:
 ExSet_ind :
         ∀P : ExSet → Prop,
             (∀b : bool, P (con1 b)) →
             (∀(n : nat) (e : ExSet), P e → P (con2 n e)) →
             ∀e : ExSet, P e
*)
Inductive ExSet : Type :=
| cons1 (b :bool)
| cons2 (n:nat) (e: ExSet)
.

Check ExSet_ind.

(* Polymorphism *)

Inductive list (X:Type) : Type :=
| nil : list X
| cons : X -> list X -> list X.

Check list_ind.

Inductive tree (X:Type) : Type :=
| leaf (x : X)
| node (t1 t2 : tree X).

(**
tree_ind:
  : forall (X: Type) (P: tree X -> Prop),
  forall x: X, P (leaf x X) ->
  (forall (t1: tree X): P t1 -> forall t2: tree X, P t2 -> P (node X t1 t2)) -> forall t: tree, P t.
*)

Check tree_ind.

(**
tree_ind
     : forall (X : Type) (P : tree X -> Prop),
       (forall x : X, P (leaf X x)) ->
       (forall t1 : tree X, P t1 -> forall t2 : tree X, P t2 -> P (node X t1 t2)) ->
       forall t : tree X, P t
*)

(** Find an inductive definition that gives rise to the following induction principle:
  mytype_ind :
        ∀(X : Type) (P : mytype X → Prop),
            (∀x : X, P (constr1 X x)) →
            (∀n : nat, P (constr2 X n)) →
            (∀m : mytype X, P m →
               ∀n : nat, P (constr3 X m n)) →
            ∀m : mytype X, P m
*)

Inductive mytype (X: Type): Type :=
| constr1 (x: X)
| constr2 (n:nat)
| constr3 (m: mytype X) (n :nat)
.

Check mytype_ind.

(** Find an inductive definition that gives rise to the following induction principle:
∀(X Y : Type) (P : foo X Y → Prop),
     (∀x : X, P (bar X Y x)) →
     (∀y : Y, P (baz X Y y)) →
     (∀f1 : nat → foo X Y,
       (∀n : nat, P (f1 n)) → P (quux X Y f1)) →
     ∀f2 : foo X Y, P f2
*)
Inductive foo ( X Y : Type ) : Type :=
| bar : X ->  foo X Y
| baz : Y -> foo X Y
| quxx : ( nat -> foo X Y ) -> foo X Y.

Check foo_ind.

(* Induction Hypotheses *)

Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.

Theorem mult_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* Note the proof state at this point! *)
    (*  ∀ n', P_m0r n' → P_m0r (S n') *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.

(* More on the induction Tactic *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary n, m, and
     p..." *)
  intros n m p.
  (* ...We now use the induction tactic to prove P n (that
     is, n + (m + p) = (n + m) + p) for _all_ n,
     and hence also for the particular n that is in the context
     at the moment. *)
  induction n as [| n'].
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* In the second subgoal generated by induction -- the
       "inductive step" -- we must prove that P n' implies
       P (S n') for all n'.  The induction tactic
       automatically introduces n' and P n' into the context
       for us, leaving just P (S n') as the goal. *)
    simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem plus_comm' : forall n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  - (* n = O *) intros m. rewrite <- plus_n_O. reflexivity.
  - (* n = S n' *) intros m. simpl. rewrite -> IHn'.
    rewrite <- plus_n_Sm. reflexivity. Qed.

Theorem plus_comm'' : forall n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on m this time, instead of n... *)
  induction m as [| m'].
  - (* m = O *) simpl. rewrite <- plus_n_O. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity. Qed.


(* CharacteristicFunctionv. *)
(* author: Peter Urbak *)
(* version: 2014-06-02 *)

(** * Characteristic Function *)

(** ** Requirements *)

(* Standard library *)
Require Import Arith.

(* Own modules *)
Require Import Cases.
Require Import Power.
Require Import StreamCalculus.
Require Import DualMoessnersSieve.
Require Import BinomialCoefficients.

(** * Monomials of the binomial expansion *)

(** ** Monomial

  *** Definition *)

(* {MONOMIAL} *)
Definition monomial (t r n : nat) : nat :=
  C(r, n) * (t ^ n).
(* {END} *)
Hint Unfold monomial : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_monomial :
  forall (t r n : nat),
    monomial t r n = C(r, n) * t ^ n.
Proof.
  intros t r n.
  unfold monomial.
  reflexivity.
Qed.
Hint Rewrite unfold_monomial : charfun.

(** *** Properties *)

(* {MONOMIAL_K_EQ_0_IMPLIES_1} *)
Lemma monomial_k_eq_0_implies_1 :
  forall (t r : nat),
    monomial t r 0 = 1.
(* {END} *)
Proof.
  intros t r.
  rewrite -> unfold_monomial.
  rewrite -> mult_1_r.
  rewrite -> unfold_binomial_coefficient_base_case_n_0.
  reflexivity.
Qed.
Hint Rewrite monomial_k_eq_0_implies_1 : charfun.

(* {MONOMIAL_R_LT_N_IMPLIES_0} *)
Lemma monomial_r_lt_n_implies_0 :
  forall (t r n : nat),
    r < n ->
    monomial t r n = 0.
(* {END} *)
Proof.
  intros t r n H_r_lt_n.
  rewrite -> unfold_monomial.
  inversion_clear H_r_lt_n.

  Case "n = S r".
  rewrite -> binomial_coefficient_n_lt_k_implies_0;
    [ idtac | unfold lt; apply le_n ].
  rewrite -> mult_0_l.
  reflexivity.

  Case "k = S m".
  rename H into H_S_r_le_m.
  rewrite -> binomial_coefficient_n_lt_k_implies_0;
    [ idtac | unfold lt; apply le_S; exact H_S_r_le_m ].
  rewrite -> mult_0_l.
  reflexivity.
Qed.
Hint Resolve monomial_r_lt_n_implies_0 : charfun.

(* {MONOMIAL_R_EQ_N_IMPLIES_POWER} *)
Lemma monomial_r_eq_n_implies_power :
  forall (t r : nat),
    monomial t r r = t ^ r.
(* {END} *)
Proof.
  intros t r.
  rewrite -> unfold_monomial.
  rewrite -> binomial_coefficient_n_eq_k_implies_1.
  rewrite -> mult_1_l.
  reflexivity.
Qed.
Hint Rewrite monomial_r_eq_n_implies_power : charfun.

(* {MONOMIAL_DECOMPOSE_RANK} *)
Theorem monomial_decompose_rank :
  forall (t r' n' : nat),
    monomial t (S r') (S n') =
    monomial t r' (S n') + t * monomial t r' n'.
(* {END} *)
Proof.
  intros t r' n'.
  rewrite ->2 unfold_monomial.
  rewrite -> Pascal_s_rule.
  rewrite -> mult_plus_distr_r.
  rewrite <- unfold_monomial.
  rewrite -> unfold_power_induction_case.
  rewrite -> NPeano.Nat.mul_shuffle3.
  rewrite <- unfold_monomial.
  reflexivity.
Qed.
Hint Rewrite monomial_decompose_rank : charfun.

(** * Characteristic functions for entries in Moessner triangles

  NOTE: Be aware that [r] means rank for [moessner_entry] and row [r] for
  [rotated_moessner_entry]. *)

(** ** Moessner entry

  Given a rank [r], a row [n], a column [k], and a triangle [t],
  calculate the specific entry of a Moessner triangle.

  *** Definition *)

(* {MOESSNER_ENTRY} *)
Fixpoint moessner_entry (r n k t : nat) : nat :=
  match n with
    | 0 => match k with
             | 0 => 1
             | S k' => 0
           end
    | S n' => match k with
                | 0 => monomial t r (S n') +
                       moessner_entry r n' 0 t
                | S k' => moessner_entry r n' (S k') t +
                          moessner_entry r n' k' t
              end
  end.
(* {END} *)
Hint Unfold moessner_entry : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_moessner_entry_base_case_O :
  forall (r t : nat),
    moessner_entry r 0 0 t = 1.
Proof.
  intros r t.
  unfold moessner_entry.
  reflexivity.
Qed.
Hint Rewrite unfold_moessner_entry_base_case_O : charfun.

Lemma unfold_moessner_entry_base_case_S :
  forall (r k' t : nat),
    moessner_entry r 0 (S k') t = 0.
Proof.
  intros r k' t.
  unfold moessner_entry.
  reflexivity.
Qed.
Hint Rewrite unfold_moessner_entry_base_case_S : charfun.

Lemma unfold_moessner_entry_induction_case_O :
  forall (n' r t : nat),
    moessner_entry r (S n') 0 t =
    monomial t r (S n') + moessner_entry r n' 0 t.
Proof.
  intros n' r t.
  unfold moessner_entry; fold moessner_entry.
  reflexivity.
Qed.
Hint Rewrite unfold_moessner_entry_induction_case_O : charfun.

(* {UNFOLD_MOESSNER_ENTRY_INDUCTION_CASE_S} *)
Lemma unfold_moessner_entry_induction_case_S :
  forall (n' r k' t : nat),
    moessner_entry r (S n') (S k') t =
    moessner_entry r n' (S k') t +
    moessner_entry r n' k' t.
(* {END} *)
Proof.
  intros n' r k' t.
  unfold moessner_entry; fold moessner_entry.
  reflexivity.
Qed.
Hint Rewrite unfold_moessner_entry_induction_case_S : charfun.

(** *** Properties *)

Definition moessner_entry_Pascal_s_rule :=
  unfold_moessner_entry_induction_case_S.
Hint Rewrite moessner_entry_Pascal_s_rule : charfun.

(*
(* {MOESSNER_ENTRY_PASCAL_S_RULE} *)
Theorem moessner_entry_Pascal_s_rule :
  forall (n' r k' t : nat),
    moessner_entry r (S n') (S k') t =
    moessner_entry r n' (S k') t +
    moessner_entry r n' k' t.
(* {END} *)
*)

(* {MOESSNER_ENTRY_EQ_BINOMIAL_COEFFICIENT} *)
Theorem moessner_entry_eq_binomial_coefficient :
  forall (n k r : nat),
    moessner_entry r n k 0 = C(n, k).
(* {END} *)
Proof.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intros k r.
  unfold moessner_entry, binomial_coefficient.
  reflexivity.

  Case "n = S n'".
  case k as [ | k' ].

  SCase "k = 0".
  intro r.
  rewrite -> unfold_moessner_entry_induction_case_O.
  rewrite -> (IH_n' 0 r).
  rewrite -> unfold_monomial.
  rewrite -> power_0_e.
  rewrite -> mult_0_r.
  rewrite -> plus_0_l.
  rewrite ->2 unfold_binomial_coefficient_base_case_n_0.
  reflexivity.

  SCase "k = S k'".
  intro r.
  rewrite -> moessner_entry_Pascal_s_rule.
  rewrite -> (IH_n' (S k') r).
  rewrite -> (IH_n' k' r).
  rewrite <- Pascal_s_rule.
  reflexivity.
Qed.
Hint Rewrite moessner_entry_eq_binomial_coefficient : charfun.

(* {MOESSNER_ENTRY_N_LT_K_IMPLIES_0} *)
Lemma moessner_entry_n_lt_k_implies_0 :
  forall (r n k t : nat),
    n < k ->
    moessner_entry r n k t = 0.
(* {END} *)
Proof.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  case k as [ | k' ].

  SCase "k = 0".
  intros t H_absurd; inversion H_absurd.

  SCase "k = S k'".
  intros t H_0_lt_S_k'.
  rewrite -> unfold_moessner_entry_base_case_S.
  reflexivity.

  Case "n = S n'".
  case k as [ | k' ].

  SCase "k = 0".
  intros t H_absurd; inversion H_absurd.

  SCase "k = S k'".
  intros t H_S_n'_lt_S_k'.
  rewrite -> moessner_entry_Pascal_s_rule.

  assert (H_n'_lt_S_k': n' < S k').
    apply lt_S_n.
    unfold lt.
    apply le_S.
    unfold lt in H_S_n'_lt_S_k'.
    exact H_S_n'_lt_S_k'.

  rewrite -> (IH_n' (S k') t H_n'_lt_S_k'); clear H_n'_lt_S_k'.
  rewrite -> plus_0_l.

  assert (H_n'_lt_k': n' < k').
    apply lt_S_n.
    exact H_S_n'_lt_S_k'.

  rewrite -> (IH_n' k' t H_n'_lt_k').
  reflexivity.
Qed.
Hint Resolve moessner_entry_n_lt_k_implies_0 : charfun.

(* {MOESSNER_ENTRY_N_EQ_K_IMPLIES_1} *)
Lemma moessner_entry_n_eq_k_implies_1 :
  forall (n r t : nat),
    moessner_entry r n n t = 1.
(* {END} *)
Proof.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intros r t.
  rewrite -> unfold_moessner_entry_base_case_O.
  reflexivity.

  Case "n = S n'".
  intros r t.
  rewrite -> moessner_entry_Pascal_s_rule.
  rewrite -> (IH_n' r t).
  rewrite -> moessner_entry_n_lt_k_implies_0;
    [ rewrite -> plus_0_l | unfold lt; apply le_n ].
  reflexivity.
Qed.
Hint Rewrite moessner_entry_n_eq_k_implies_1 : charfun.

(** ** Moessner entries

  Enumerates a row of moessner entries.

  *** Definition *)

(* {MOESSNER_ENTRIES} *)
CoFixpoint moessner_entries (r n k t : nat) : Stream nat :=
  (moessner_entry r n k t) :::
  (moessner_entries r n (S k) t).
(* {END} *)
Hint Unfold moessner_entries : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_moessner_entries :
  forall (r n k t : nat),
    moessner_entries r n k t =
    (moessner_entry r n k t) :::
    (moessner_entries r n (S k) t).
Proof.
  intros r n k t.
  rewrite -> (unfold_Stream (moessner_entries r n k t)).
  unfold moessner_entries; fold moessner_entries.
  reflexivity.
Qed.
Hint Rewrite unfold_moessner_entries : charfun.

Lemma moessner_entries_initial_value :
  forall (r n k t : nat),
    (moessner_entries r n k t)(0) =
    (moessner_entry r n k t).
Proof.
  intros r n k t.
  rewrite -> initial_value.
  rewrite -> unfold_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite moessner_entries_initial_value : charfun.

Lemma moessner_entries_stream_derivative :
  forall (r n k t : nat),
    (moessner_entries r n k t)` =
    (moessner_entries r n (S k) t).
Proof.
  intros r n k t.
  rewrite -> stream_derivative.
  rewrite -> unfold_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite moessner_entries_stream_derivative : charfun.

(** ** Properties *)

(* {STR_NTH_MOESSNER_ENTRIES} *)
Lemma Str_nth_moessner_entries :
  forall (i r n k t : nat),
    Str_nth i (moessner_entries r n k t) =
    moessner_entry r n (i + k) t.
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros r n k t.
  rewrite -> Str_nth_0.
  rewrite -> moessner_entries_initial_value.
  rewrite -> plus_0_l.
  reflexivity.

  Case "i = S i'".
  intros r n k t.
  rewrite -> Str_nth_S_n.
  rewrite -> moessner_entries_stream_derivative.
  rewrite -> (IH_i' r n (S k) t).
  rewrite <- plus_n_Sm.
  rewrite -> plus_Sn_m.
  reflexivity.
Qed.
Hint Rewrite Str_nth_moessner_entries : charfun.

(** ** Rotated moessner entry

  Given a rank [n], a row [r], a column [c], and a triangle [t],
  calculate the specific entry of a Moessner triangle.

  *** Definition *)

(* {ROTATED_MOESSNER_ENTRY} *)
Definition rotated_moessner_entry (n r c t : nat) : nat :=
  moessner_entry n (c + r) c t.
(* {END} *)
Hint Unfold rotated_moessner_entry : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_rotated_moessner_entry :
  forall (n r c t : nat),
    rotated_moessner_entry n r c t =
    moessner_entry n (c + r) c t.
Proof.
  intros n r c t.
  unfold rotated_moessner_entry.
  reflexivity.
Qed.
Hint Rewrite unfold_rotated_moessner_entry : charfun.

(* {ROTATED_MOESSNER_ENTRY_PASCAL_S_RULE} *)
Lemma rotated_moessner_entry_Pascal_s_rule :
  forall (n r' c' t : nat),
    rotated_moessner_entry n (S r') (S c') t =
    rotated_moessner_entry n r' (S c') t +
    rotated_moessner_entry n (S r') c' t.
(* {END} *)
Proof.
  intros n r' c' t.
  rewrite ->3 unfold_rotated_moessner_entry.
  rewrite <-2 plus_n_Sm.
  rewrite -> plus_Sn_m.
  rewrite -> moessner_entry_Pascal_s_rule.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entry_Pascal_s_rule : charfun.

(** *** Properties *)

(* {ROTATED_MOESSNER_ENTRY_EQ_BINOMIAL_COEFFICIENT} *)
Corollary rotated_moessner_entry_eq_binomial_coefficient :
  forall (n r c : nat),
    rotated_moessner_entry n r c 0 = C(r + c, c).
(* {END} *)
Proof.
  intros n r c.
  rewrite -> unfold_rotated_moessner_entry.
  rewrite -> moessner_entry_eq_binomial_coefficient.
  rewrite -> plus_comm.
  reflexivity.
Qed.
Hint Rewrite moessner_entry_eq_binomial_coefficient : charfun.

(* {ROTATED_MOESSNER_ENTRY_EQ_ROTATED_BINOMIAL_COEFFICIENT} *)
Corollary rotated_moessner_entry_eq_rotated_binomial_coefficient :
  forall (n r c : nat),
    rotated_moessner_entry n r c 0 = R(r, c).
(* {END} *)
Proof.
  intros n r c.
  rewrite -> rotated_moessner_entry_eq_binomial_coefficient.
  rewrite -> rotated_binomial_coefficient_is_symmetric.
  rewrite -> unfold_rotated_binomial_coefficient.
  rewrite -> plus_comm.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entry_eq_rotated_binomial_coefficient : charfun.

(* {ROTATED_MOESSNER_ENTRY_R_EQ_0_IMPLIES_1} *)
Lemma rotated_moessner_entry_r_eq_0_implies_1 :
  forall (c n t : nat),
    rotated_moessner_entry n 0 c t = 1.
(* {END} *)
Proof.
  intros c n t.
  rewrite -> unfold_rotated_moessner_entry.
  rewrite -> plus_0_r.
  rewrite -> moessner_entry_n_eq_k_implies_1.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entry_r_eq_0_implies_1 : charfun.

(* {ROTATED_MOESSNER_ENTRY_C_EQ_0} *)
Lemma rotated_moessner_entry_c_eq_0 :
  forall (r' n t : nat),
    rotated_moessner_entry n (S r') 0 t =
    monomial t n (S r') + rotated_moessner_entry n r' 0 t.
(* {END} *)
Proof.
  intros r' n t.
  rewrite ->2 unfold_rotated_moessner_entry.
  rewrite ->2 plus_0_l.
  rewrite -> unfold_moessner_entry_induction_case_O.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entry_c_eq_0 : charfun.

(** ** Rotated moessner entries

  *** Definition *)

(* {ROTATED_MOESSNER_ENTRIES} *)
CoFixpoint rotated_moessner_entries (n r c t : nat) : Stream nat :=
  (rotated_moessner_entry n r c t) :::
  (rotated_moessner_entries n (S r) c t).
(* {END} *)
Hint Unfold rotated_moessner_entries : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_rotated_moessner_entries :
  forall (n r c t : nat),
    rotated_moessner_entries n r c t =
    (rotated_moessner_entry n r c t) :::
    (rotated_moessner_entries n (S r) c t).
Proof.
  intros n r c t.
  rewrite -> (unfold_Stream (rotated_moessner_entries n r c t)).
  unfold rotated_moessner_entries; fold rotated_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite unfold_rotated_moessner_entries : charfun.

Lemma rotated_moessner_entries_initial_value :
  forall (n r c t : nat),
    (rotated_moessner_entries n r c t)(0) =
    (rotated_moessner_entry n r c t).
Proof.
  intros n r c t.
  rewrite -> initial_value.
  rewrite -> unfold_rotated_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entries_initial_value : charfun.

Lemma rotated_moessner_entries_stream_derivative :
  forall (n r c t : nat),
    (rotated_moessner_entries n r c t)` =
    (rotated_moessner_entries n (S r) c t).
Proof.
  intros n r c t.
  rewrite -> stream_derivative.
  rewrite -> unfold_rotated_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entries_stream_derivative : charfun.

(** ** Properties *)

(* {STR_NTH_ROTATED_MOESSNER_ENTRIES} *)
Lemma Str_nth_rotated_moessner_entries :
  forall (i n r c t : nat),
    Str_nth i (rotated_moessner_entries n r c t) =
    rotated_moessner_entry n (r + i) c t.
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros n r c t.
  rewrite -> Str_nth_0.
  rewrite -> rotated_moessner_entries_initial_value.
  rewrite -> plus_0_r.
  reflexivity.

  Case "i = S i'".
  intros n r c t.
  rewrite -> Str_nth_S_n.
  rewrite -> rotated_moessner_entries_stream_derivative.
  rewrite -> (IH_i' n (S r) c t).
  rewrite <- plus_n_Sm, -> plus_Sn_m.
  reflexivity.
Qed.
Hint Rewrite Str_nth_rotated_moessner_entries : charfun.

Corollary Str_nth_rotated_moessner_entries_t_eq_0 :
  forall (i n r c : nat),
    Str_nth i (rotated_moessner_entries n r c 0) =
    C(r + i + c, c).
Proof.
  intros i n r c.
  rewrite -> Str_nth_rotated_moessner_entries.
  rewrite -> rotated_moessner_entry_eq_binomial_coefficient.
  reflexivity.
Qed.
Hint Rewrite Str_nth_rotated_moessner_entries_t_eq_0 : charfun.

(* {ROTATED_MOESSNER_ENTRIES_PASCAL_S_RULE} *)
Lemma rotated_moessner_entries_Pascal_s_rule :
  forall (n r' c' t : nat),
    rotated_moessner_entries n (S r') (S c') t ~
    (rotated_moessner_entries n (S r') c' t) s+
    (rotated_moessner_entries n r' (S c') t).
(* {END} *)
Proof.
  pcofix coIH.
  intros n r' c' t.
  bisimilar.

  Case "initial value".
  rewrite -> stream_sum_initial_value.
  rewrite ->3 rotated_moessner_entries_initial_value.
  rewrite -> rotated_moessner_entry_Pascal_s_rule.
  rewrite -> plus_comm.
  reflexivity.

  Case "stream derivative".
  rewrite -> stream_sum_stream_derivative.
  rewrite ->3 rotated_moessner_entries_stream_derivative.
  exact (coIH n (S r') c' t).
Qed.
Hint Rewrite rotated_moessner_entries_Pascal_s_rule : charfun.

(** ** Monomials

  Enumerates the monomials of the binomial expansion.

  *** Definition *)

(* {MONOMIALS} *)
CoFixpoint monomials (t r n : nat) : Stream nat :=
  (monomial t r n) ::: (monomials t r (S n)).
(* {END} *)
Hint Unfold monomials : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_monomials :
  forall (t r n : nat),
    monomials t r n = (monomial t r n) ::: (monomials t r (S n)).
Proof.
  intros t r n.
  rewrite -> (unfold_Stream (monomials t r n)).
  unfold monomials; fold monomials.
  reflexivity.
Qed.
Hint Rewrite unfold_monomials : charfun.

(* {MONOMIALS_INITIAL_VALUE} *)
Lemma monomials_initial_value :
  forall (t r n : nat),
    (monomials t r n)(0) = (monomial t r n).
(* {END} *)
Proof.
  intros t r n.
  rewrite -> initial_value.
  rewrite -> unfold_monomials.
  reflexivity.
Qed.
Hint Rewrite monomials_initial_value : charfun.

(* {MONOMIALS_STREAM_DERIVATIVE} *)
Lemma monomials_stream_derivative :
  forall (t r n : nat),
    (monomials t r n)` = (monomials t r (S n)).
(* {END} *)
Proof.
  intros t r n.
  rewrite -> stream_derivative.
  rewrite -> unfold_monomials.
  reflexivity.
Qed.
Hint Rewrite monomials_stream_derivative : charfun.

(** *** Properties *)

(* {STR_NTH_MONOMIALS} *)
Lemma Str_nth_monomials :
  forall (i t r n : nat),
    Str_nth i (monomials t r n) = monomial t r (i + n).
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros t r n.
  rewrite -> Str_nth_0.
  rewrite -> monomials_initial_value.
  rewrite -> plus_0_l.
  reflexivity.

  Case "i = S i'".
  intros t r n.
  rewrite -> Str_nth_S_n.
  rewrite -> monomials_stream_derivative.
  rewrite -> (IH_i' t r (S n)).
  rewrite -> plus_Sn_m, <- plus_n_Sm.
  reflexivity.
Qed.
Hint Rewrite Str_nth_monomials : charfun.

Lemma Str_nth_monomials_i_plus_n_gt_r_implies_0 :
  forall (i r n t : nat),
    r < n + i ->
    Str_nth i (monomials t r n) = 0.
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros r n t H_r_lt_n.
  rewrite -> plus_0_r in H_r_lt_n.
  rewrite -> Str_nth_0.
  rewrite -> monomials_initial_value.
  rewrite -> unfold_monomial.
  rewrite -> (binomial_coefficient_n_lt_k_implies_0 r n H_r_lt_n).
  rewrite -> mult_0_l.
  reflexivity.

  Case "i = S i'".
  intros r n t H_r_lt_n_plus_S_i'.
  rewrite -> Str_nth_S_n.
  rewrite monomials_stream_derivative.
  rewrite -> (IH_i' r (S n) t);
    [ idtac | rewrite -> plus_Sn_m, -> plus_n_Sm; exact H_r_lt_n_plus_S_i' ].
  reflexivity.
Qed.
Hint Resolve Str_nth_monomials_i_plus_n_gt_r_implies_0 : charfun.

(* {REV_STR_PREFIX_MONOMIALS} *)
Lemma rev_Str_prefix_monomials :
  forall (l n r t : nat),
    rev (Str_prefix (S l) (monomials t r n)) =
    monomial t r (n + l) :: rev (Str_prefix l (monomials t r n)).
(* {END} *)
Proof.
  induction l as [ | l' IH_l' ].

  Case "l = 0".
  intros n r t.
  rewrite -> plus_0_r.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite ->2 unfold_Str_prefix_base_case.
  rewrite -> unfold_rev_base_case.
  rewrite -> monomials_initial_value.
  rewrite -> unfold_rev_induction_case.
  rewrite -> unfold_rev_base_case.
  rewrite -> app_nil_l.
  reflexivity.

  Case "l = S l'".
  intros n r t.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite -> unfold_rev_induction_case.
  rewrite -> monomials_stream_derivative.
  rewrite -> IH_l'.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite -> monomials_initial_value.
  rewrite -> monomials_stream_derivative.
  rewrite <- plus_n_Sm, -> plus_Sn_m.
  rewrite -> unfold_rev_induction_case.
  rewrite <- app_comm_cons.
  reflexivity.
Qed.
Hint Rewrite rev_Str_prefix_monomials : charfun.

(* {REV_STR_PREFIX_ROTATED_MOESSNER_ENTRIES} *)
Lemma rev_Str_prefix_rotated_moessner_entries :
  forall (l n r c t : nat),
    rev (Str_prefix (S l) (rotated_moessner_entries n r c t)) =
    rotated_moessner_entry n (r + l) c t
      :: rev (Str_prefix l (rotated_moessner_entries n r c t )).
(* {END} *)
Proof.
  induction l as [ | l' IH_l' ].

  Case "l = 0".
  intros n r c t.
  rewrite -> plus_0_r.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite ->2 unfold_Str_prefix_base_case.
  rewrite -> unfold_rev_base_case.
  rewrite -> rotated_moessner_entries_initial_value.
  rewrite -> unfold_rev_induction_case.
  rewrite -> unfold_rev_base_case.
  rewrite -> app_nil_l.
  reflexivity.

  Case "l = S l'".
  intros n r c t.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite -> unfold_rev_induction_case.
  rewrite -> rotated_moessner_entries_stream_derivative.
  rewrite -> IH_l'.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite -> rotated_moessner_entries_initial_value.
  rewrite -> rotated_moessner_entries_stream_derivative.
  rewrite <- plus_n_Sm, -> plus_Sn_m.
  rewrite -> unfold_rev_induction_case.
  rewrite <- app_comm_cons.
  reflexivity.
Qed.
Hint Rewrite rev_Str_prefix_rotated_moessner_entries : charfun.

Lemma monomials_tail_of_0s :
  forall (i n t : nat),
    Str_nth_tl (S i) (monomials t i n) ~ #0.
Proof.
  pcofix coIH.
  intros i n t.
  bisimilar.

  Case "initial value".
  rewrite <- unfold_Str_nth.
  rewrite -> Str_nth_monomials_i_plus_n_gt_r_implies_0;
    [ idtac | unfold lt; apply le_plus_r ].
  rewrite -> stream_constant_initial_value.
  reflexivity.

  Case "stream derivative".
  rewrite -> Str_nth_tl_stream_derivative_case_i_gt_0.
  rewrite ->2 monomials_stream_derivative.
  rewrite -> stream_constant_stream_derivative.
  exact (coIH i (S n) t).
Qed.
Hint Rewrite monomials_tail_of_0s : tupmos.

(** ** Monomials sum

  Enumerates the partial sums of the monomials of the binomial expansion.

  *** Definition *)

(* {MONOMIALS_SUM} *)
CoFixpoint monomials_sum (t r n a : nat) : Stream nat :=
  let a' := (monomial t r n) + a in
  a' ::: (monomials_sum t r (S n) a').
(* {END} *)
Hint Unfold monomials_sum : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_monomials_sum :
  forall (t r n a : nat),
    monomials_sum t r n a =
    ((monomial t r n) + a) :::
    (monomials_sum t r (S n) ((monomial t r n) + a)).
Proof.
  intros t r n a.
  rewrite -> (unfold_Stream (monomials_sum t r n a)).
  unfold monomials_sum; fold monomials_sum.
  reflexivity.
Qed.
Hint Rewrite unfold_monomials_sum : charfun.

(* {MONOMIALS_SUM_INITIAL_VALUE} *)
Lemma monomials_sum_initial_value :
  forall (t r n a : nat),
    (monomials_sum t r n a)(0) = (monomial t r n) + a.
(* {END} *)
Proof.
  intros t r n a.
  rewrite -> initial_value.
  rewrite -> unfold_monomials_sum.
  reflexivity.
Qed.
Hint Rewrite monomials_sum_initial_value : charfun.

(* {MONOMIALS_SUM_STREAM_DERIVATIVE} *)
Lemma monomials_sum_stream_derivative :
  forall (t r n a : nat),
    (monomials_sum t r n a)` =
    (monomials_sum t r (S n) ((monomial t r n) + a)).
(* {END} *)
Proof.
  intros t r n a.
  rewrite -> stream_derivative.
  rewrite -> unfold_monomials_sum.
  reflexivity.
Qed.
Hint Rewrite monomials_sum_stream_derivative : charfun.

(** *** Properties *)

Lemma monomials_sum_acc_aux :
  forall (t l n i j : nat),
    (monomials_sum t l n (i + j)) ~
    (monomials_sum t l n i) s+ #j.
Proof.
  pcofix coIH.
  intros t l n i j.
  bisimilar.

  Case "initial value".
  rewrite -> monomials_sum_initial_value.
  rewrite -> stream_sum_initial_value.
  rewrite -> monomials_sum_initial_value.
  rewrite -> stream_constant_initial_value.
  rewrite <- plus_assoc.
  reflexivity.

  Case "stream derivative".
  rewrite -> monomials_sum_stream_derivative.
  rewrite -> stream_sum_stream_derivative.
  rewrite -> monomials_sum_stream_derivative.
  rewrite -> stream_constant_stream_derivative.
  rewrite -> plus_assoc.
  exact (coIH t l (S n) (monomial t l n + i) j).
Qed.
Hint Rewrite monomials_sum_acc_aux : charfun.

Corollary monomials_sum_acc :
  forall (t l n a : nat),
    (monomials_sum t l n a) ~
    (monomials_sum t l n 0) s+ #a.
Proof.
  intros t l n a.
  rewrite <- monomials_sum_acc_aux.
  rewrite -> plus_0_l.
  reflexivity.
Qed.
Hint Rewrite monomials_sum_acc : charfun.

(* {STR_NTH_MONOMIALS_SUM_STREAM_DERIVATIVE} *)
Lemma Str_nth_monomials_sum_stream_derivative :
  forall (i n t l a : nat),
    Str_nth i (monomials_sum t l n a)` =
    Str_nth i ((monomials_sum t l (S n) a) s+ #(monomial t l n)).
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros n t l a.
  rewrite -> monomials_sum_stream_derivative.
  rewrite ->2 Str_nth_0.
  rewrite -> stream_sum_initial_value.
  rewrite ->2 monomials_sum_initial_value.
  rewrite -> stream_constant_initial_value.
  rewrite <- plus_assoc.
  f_equal.
  rewrite -> plus_comm.
  reflexivity.

  Case "i = S i'".
  intros n t l a.
  rewrite ->2 Str_nth_S_n.
  rewrite -> monomials_sum_stream_derivative.
  rewrite -> stream_sum_stream_derivative.
  rewrite -> (IH_i' (S n) t l (monomial t l n + a)).
  rewrite -> monomials_sum_stream_derivative.
  rewrite -> stream_constant_stream_derivative.
  rewrite <-2 monomials_sum_acc_aux.
  rewrite -> plus_comm.
  rewrite <- plus_assoc.
  rewrite -> (plus_comm a _).
  reflexivity.
Qed.
Hint Rewrite Str_nth_monomials_sum_stream_derivative : charfun.

Corollary monomials_sum_stream_derivative_bisim :
  forall (n t l a : nat),
    (monomials_sum t l n a)` ~
    (monomials_sum t l (S n) a) s+ #(monomial t l n).
Proof.
  intros n t l a.
  apply Str_nth_implies_bisimilarity; intro i.
  exact (Str_nth_monomials_sum_stream_derivative i n t l a).
Qed.
Hint Rewrite monomials_sum_stream_derivative_bisim : charfun.

Lemma Str_nth_monomials_sum_r_eq_0 :
  forall (i t n' m' a : nat),
    Str_nth i (monomials_sum t 0 (S n') a) =
    Str_nth i (monomials_sum t 0 (S m') a).
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros t n' m' a.
  rewrite ->2 Str_nth_0.
  rewrite ->2 monomials_sum_initial_value.
  rewrite ->2 unfold_monomial.
  rewrite ->2 unfold_binomial_coefficient_base_case_0_S_k'.
  rewrite ->2 mult_0_l.
  rewrite -> plus_0_l.
  reflexivity.

  Case "i = S i'".
  intros t n' m' a.
  rewrite ->2 Str_nth_S_n.
  rewrite ->2 Str_nth_monomials_sum_stream_derivative.
  unfold stream_sum.
  rewrite ->2 Str_nth_stream_zip.
  rewrite -> (IH_i' t (S n') (S m') a).
  reflexivity.
Qed.
Hint Rewrite Str_nth_monomials_sum_r_eq_0 : charfun.

(* {SHIFT_START_INDEX_MONOMIALS_SUM} *)
Lemma shift_start_index_monomials_sum :
  forall (i' r n a t : nat),
    (monomial t r n) + (Str_nth i' (monomials_sum t r (S n) a)) =
    (monomial t r (n + (S i'))) + (Str_nth i' (monomials_sum t r n a)).
(* {END} *)
Proof.
  induction i' as [ | i'' IH_i'' ].

  Case "i' = 0".
  intros r n a t.
  rewrite ->2 Str_nth_0.
  rewrite ->2 monomials_sum_initial_value.
  rewrite -> plus_permute.
  rewrite -> (plus_comm n 1).
  reflexivity.

  Case "i' = S i''".
  intros r n a t.
  rewrite -> Str_nth_S_n.
  rewrite -> Str_nth_monomials_sum_stream_derivative.
  unfold stream_sum.
  rewrite -> Str_nth_stream_zip.
  rewrite -> Str_nth_stream_constant.
  rewrite <- (plus_comm (monomial t r (S n)) _).
  rewrite -> (IH_i'' r (S n) a t).
  rewrite <-3 plus_n_Sm, -> plus_Sn_m.

  rewrite -> Str_nth_S_n.
  rewrite -> Str_nth_monomials_sum_stream_derivative.
  unfold stream_sum.
  rewrite -> Str_nth_stream_zip.
  rewrite -> Str_nth_stream_constant.
  rewrite -> plus_comm.
  rewrite <- plus_assoc.
  reflexivity.
Qed.
Hint Rewrite shift_start_index_monomials_sum : charfun.

(** * Relations between monomials, monomials sum,
 moessner  entry rotated, make tuple, and partial sums acc *)

(* {STR_NTH_MONOMIALS_SUM_EQ_ROTATED_MOESSNER_ENTRY} *)
Theorem Str_nth_monomials_sum_eq_rotated_moessner_entry :
  forall (i t r a : nat),
    Str_nth i (monomials_sum t r 0 a) =
    (rotated_moessner_entry r i 0 t) + a.
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros t r a.
  rewrite -> Str_nth_0.
  rewrite -> monomials_sum_initial_value.
  rewrite -> unfold_monomial.
  rewrite -> unfold_power_base_case.
  rewrite -> mult_1_r.
  rewrite -> unfold_binomial_coefficient_base_case_n_0.

  rewrite -> unfold_rotated_moessner_entry.
  rewrite -> plus_0_r.
  rewrite -> unfold_moessner_entry_base_case_O.
  reflexivity.

  Case "i = S i'".
  intros t r a.
  rewrite -> Str_nth_S_n.
  rewrite -> Str_nth_monomials_sum_stream_derivative.
  unfold stream_sum.
  rewrite -> Str_nth_stream_zip.
  rewrite -> Str_nth_stream_constant.
  rewrite -> plus_comm.

  unfold rotated_moessner_entry in *.
  rewrite -> plus_0_l in *.
  rewrite -> unfold_moessner_entry_induction_case_O.
  rewrite <- plus_assoc.
  rewrite <- (IH_i' t r a).
  rewrite -> shift_start_index_monomials_sum.
  rewrite -> plus_0_l.
  reflexivity.
Qed.
Hint Rewrite Str_nth_monomials_sum_eq_rotated_moessner_entry : charfun.

(* {STREAM_PARTIAL_SUMS_ACC_MONOMIALS_BISIM_MONOMIALS_SUM} *)
Lemma stream_partial_sums_acc_monomials_bisim_monomials_sum :
  forall (t r n a : nat),
    stream_partial_sums_acc a (monomials t r n) ~
    monomials_sum t r n a.
(* {END} *)
Proof.
  pcofix coIH.
  intros t n k a.
  bisimilar.

  Case "initial value".
  rewrite -> stream_partial_sums_acc_initial_value.
  rewrite -> monomials_initial_value.
  rewrite -> monomials_sum_initial_value.
  reflexivity.

  Case "stream derivative".
  rewrite -> stream_partial_sums_acc_stream_derivative.
  rewrite -> monomials_stream_derivative.
  rewrite -> monomials_sum_stream_derivative.
  rewrite -> monomials_initial_value.
  exact (coIH t n (S k) (monomial t n k + a)).
Qed.
Hint Rewrite stream_partial_sums_acc_monomials_bisim_monomials_sum : charfun.

(* {STREAM_PARTIAL_SUMS_MONOMIALS_BISIM_MONOMIALS_SUM} *)
Corollary stream_partial_sums_monomials_bisim_monomials_sum :
  forall (t r n : nat),
    stream_partial_sums (monomials t r n) ~
    monomials_sum t r n 0.
(* {END} *)
Proof.
  intros t r n.
  rewrite -> unfold_stream_partial_sums.
  exact (stream_partial_sums_acc_monomials_bisim_monomials_sum t r n 0).
Qed.
Hint Rewrite stream_partial_sums_monomials_bisim_monomials_sum : charfun.

(* {MAKE_TUPLE_MONOMIALS_EQ_MONOMIALS_SUM} *)
Corollary make_tuple_monomials_eq_monomials_sum :
  forall (l t r n a : nat),
    make_tuple (Str_prefix (S l) (monomials t r n)) a =
    Str_prefix l (monomials_sum t r n a).
(* {END} *)
Proof.
  intros l t r n a.
  rewrite -> equivalence_of_make_tuple_and_stream_partial_sums_acc.
  rewrite -> stream_partial_sums_acc_monomials_bisim_monomials_sum.
  reflexivity.
Qed.
Hint Rewrite make_tuple_monomials_eq_monomials_sum : charfun.

(* {MONOMIALS_AND_ROTATED_MOESSNER_ENTRY} *)
Corollary monomials_and_rotated_moessner_entry :
  forall (l t r a : nat),
    nth l (make_tuple (Str_prefix (S (S l)) (monomials t r 0)) a) 0 =
    rotated_moessner_entry r l 0 t + a.
(* {END} *)
Proof.
  intros l t r a.
  rewrite <- Str_nth_monomials_sum_eq_rotated_moessner_entry.
  rewrite -> make_tuple_monomials_eq_monomials_sum.
  rewrite -> (nth_and_Str_nth l (S l) (monomials_sum t r 0 a));
      [ idtac | unfold lt; apply le_n ].
  reflexivity.
Qed.
Hint Rewrite monomials_and_rotated_moessner_entry : charfun.

(* {MONOMIALS_SUM_BISIM_ROTATED_MOESSNER_ENTRIES} *)
Corollary rotated_moessner_entries_bisim_monomials_sum :
  forall (n t : nat),
    monomials_sum t n 0 0 ~
    rotated_moessner_entries n 0 0 t.
(* {END} *)
Proof.
  intros n t.
  apply Str_nth_implies_bisimilarity; intro i.
  rewrite -> Str_nth_rotated_moessner_entries.
  rewrite -> plus_0_l.
  rewrite -> Str_nth_monomials_sum_eq_rotated_moessner_entry.
  rewrite -> plus_0_r.
  reflexivity.
Qed.
Hint Rewrite rotated_moessner_entries_bisim_monomials_sum : charfun.

(* {MAKE_TUPLE_MONOMIALS_EQ_ROTATED_MOESSNER_ENTRIES} *)
Corollary make_tuple_monomials_eq_rotated_moessner_entries :
  forall (l' n' t : nat),
    make_tuple (Str_prefix (S l') (monomials t n' 0)) 0 =
    Str_prefix l' (rotated_moessner_entries n' 0 0 t).
(* {END} *)
Proof.
  intros l' n' t.
  rewrite -> make_tuple_monomials_eq_monomials_sum.
  rewrite -> rotated_moessner_entries_bisim_monomials_sum.
  reflexivity.
Qed.
Hint Rewrite make_tuple_monomials_eq_rotated_moessner_entries : charfun.

(** * Relation between consecutive columns of arbitrary Moessner triangles *)

(** * Proof that partially summing the [c']th column of rotated moessner entries
  gives the [S c']th column *)

(* {STR_NTH_ROTATED_MOESSNER_ENTRIES_OVER_R} *)
Lemma Str_nth_rotated_moessner_entries_over_r :
  forall (i n r' c' t : nat),
    Str_nth i (rotated_moessner_entries n (S r') (S c') t) =
    Str_nth i (stream_partial_sums_acc
                 (rotated_moessner_entry n r' (S c') t)
                 (rotated_moessner_entries n (S r') c' t)).
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros n r' c' t.
  rewrite ->2 Str_nth_0.
  rewrite -> stream_partial_sums_acc_initial_value.
  rewrite ->2 rotated_moessner_entries_initial_value.
  rewrite -> rotated_moessner_entry_Pascal_s_rule.
  rewrite -> plus_comm.
  reflexivity.

  Case "i = S i'".
  intros n r' c' t.
  rewrite ->2 Str_nth_S_n.
  rewrite -> stream_partial_sums_acc_stream_derivative.
  rewrite ->2 rotated_moessner_entries_stream_derivative.
  rewrite -> rotated_moessner_entries_initial_value.
  rewrite -> (IH_i' n (S r') c' t).
  rewrite -> rotated_moessner_entry_Pascal_s_rule.
  rewrite -> plus_comm.
  reflexivity.
Qed.
Hint Rewrite Str_nth_rotated_moessner_entries_over_r : charfun.

Corollary partial_sums_rotated_moessner_entries_bisim_next_column_over_r :
  forall (n r' c' t : nat),
    (rotated_moessner_entries n (S r') (S c') t) ~
    (stream_partial_sums_acc (rotated_moessner_entry n r' (S c') t)
                      (rotated_moessner_entries n (S r') c' t)).
Proof.
  intros n r' c' t.
  apply Str_nth_implies_bisimilarity; intro i.
  exact
  (Str_nth_rotated_moessner_entries_over_r i n r' c' t).
Qed.
Hint Rewrite partial_sums_rotated_moessner_entries_bisim_next_column_over_r
  : charfun.

(* {STR_NTH_PARTIAL_SUMS_ROTATED_MOESSNER_ENTRIES} *)
Theorem Str_nth_partial_sums_rotated_moessner_entries :
  forall (i n c' t : nat),
    Str_nth i (stream_partial_sums_acc
                 0 (rotated_moessner_entries n 0 c' t)) =
    Str_nth i (rotated_moessner_entries n 0 (S c') t).
(* {END} *)
Proof.
  induction i as [ | i' IH_i' ].

  Case "i = 0".
  intros n c' t.
  rewrite ->2 Str_nth_0.
  rewrite -> stream_partial_sums_acc_initial_value.
  rewrite -> plus_0_r.
  rewrite ->2 rotated_moessner_entries_initial_value.
  rewrite ->2 unfold_rotated_moessner_entry.
  rewrite ->2 plus_0_r.
  rewrite -> moessner_entry_Pascal_s_rule.
  rewrite -> (moessner_entry_n_lt_k_implies_0 n c' (S c') t);
    [ rewrite -> plus_0_l | unfold lt; apply le_n ].
  reflexivity.

  Case "i = S i'".
  intros n c' t.
  rewrite ->2 Str_nth_S_n.
  rewrite -> stream_partial_sums_acc_stream_derivative.
  rewrite -> plus_0_r.
  rewrite ->2 rotated_moessner_entries_stream_derivative.
  rewrite -> rotated_moessner_entries_initial_value.
  rewrite -> Str_nth_rotated_moessner_entries_over_r.
  rewrite ->2 unfold_rotated_moessner_entry.
  rewrite ->2 plus_0_r.
  rewrite -> moessner_entry_Pascal_s_rule.
  rewrite -> (moessner_entry_n_lt_k_implies_0 n c' (S c') t);
    [ rewrite -> plus_0_l | unfold lt; apply le_n ].
  reflexivity.
Qed.
Hint Rewrite Str_nth_partial_sums_rotated_moessner_entries : charfun.

(* {PARTIAL_SUMS_ROTATED_MOESSNER_ENTRIES_BISIM_NEXT_COLUMN} *)
Corollary partial_sums_rotated_moessner_entries_bisim_next_column :
  forall (n c' t : nat),
    (stream_partial_sums_acc 0 (rotated_moessner_entries n 0 c' t)) ~
    (rotated_moessner_entries n 0 (S c') t).
(* {END} *)
Proof.
  intros n c' t.
  apply Str_nth_implies_bisimilarity; intro i.
  exact (Str_nth_partial_sums_rotated_moessner_entries i n c' t).
Qed.
Hint Rewrite partial_sums_rotated_moessner_entries_bisim_next_column : charfun.

Lemma last_of_rotated_moessner_entries :
  forall (c l n t : nat),
    last (Str_prefix (S l) (rotated_moessner_entries n 0 c t)) 0 =
    rotated_moessner_entry n l c t.
Proof.
  intros c l n t.
  rewrite -> (length_implies_last_index l);
    [ idtac | rewrite -> Str_prefix_length; reflexivity ].
  rewrite -> nth_and_Str_nth;
    [ idtac | unfold lt; apply le_n ].
  rewrite -> Str_nth_rotated_moessner_entries.
  rewrite -> plus_0_l.
  reflexivity.
Qed.
Hint Rewrite last_of_rotated_moessner_entries : charfun.

(* {LAST_OF_ROTATED_MOESSNER_ENTRIES_TO_BINOMIAL} *)
Corollary last_of_rotated_moessner_entries_to_binomial :
  forall (c l n t : nat),
    last (Str_prefix (S l) (rotated_moessner_entries n 0 c t)) 0 =
    moessner_entry n (c + l) c t.
(* {END} *)
Proof.
  intros c l n t.
  rewrite -> last_of_rotated_moessner_entries.
  rewrite -> unfold_rotated_moessner_entry.
  reflexivity.
Qed.
Hint Rewrite last_of_rotated_moessner_entries_to_binomial : charfun.

(** *** Proof that applying [make_tuple] on a column of [rotated_moessner_entries]
  gives the next column *)

(* {MAKE_TUPLE_ROTATED_MOESSNER_ENTRIES} *)
Corollary make_tuple_rotated_moessner_entries :
  forall (l' n' c' t : nat),
    make_tuple (Str_prefix
                  (S l') (rotated_moessner_entries n' 0 c' t)) 0 =
    Str_prefix l' (rotated_moessner_entries n' 0 (S c') t).
(* {END} *)
Proof.
  intros l' n' c' t.
  rewrite <- partial_sums_rotated_moessner_entries_bisim_next_column.
  rewrite -> equivalence_of_make_tuple_and_stream_partial_sums_acc.
  reflexivity.
Qed.
Hint Rewrite make_tuple_rotated_moessner_entries : charfun.

(** * Spelled out correctness proof of moessner entry rotated *)

(** ** Repeat make tuple

  *** Definition *)

(* {REPEAT_MAKE_TUPLE} *)
Fixpoint repeat_make_tuple (ys : tuple) (a n : nat) : tuple :=
  match n with
    | 0 => ys
    | S n' => repeat_make_tuple (make_tuple ys a) a n'
  end.
(* {END} *)
Hint Unfold repeat_make_tuple : charfun.

(** *** Unfolding lemmas *)

Lemma unfold_repeat_make_tuple_base_case :
  forall (ys : tuple) (a : nat),
    repeat_make_tuple ys a 0 = ys.
Proof.
  intros ys a.
  unfold repeat_make_tuple.
  reflexivity.
Qed.
Hint Rewrite unfold_repeat_make_tuple_base_case : charfun.

Lemma unfold_repeat_make_tuple_induction_case :
  forall (ys : tuple) (a n' : nat),
    repeat_make_tuple ys a (S n') =
    repeat_make_tuple (make_tuple ys a) a n'.
Proof.
  intros ys a n'.
  unfold repeat_make_tuple; fold repeat_make_tuple.
  reflexivity.
Qed.
Hint Rewrite unfold_repeat_make_tuple_induction_case : charfun.

(** *** Properties *)

Lemma repeat_make_tuple_nil :
  forall (a n : nat),
    repeat_make_tuple [] a n = [].
Proof.
  intros a n; revert a.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intro a.
  rewrite -> unfold_repeat_make_tuple_base_case.
  reflexivity.

  Case "n = S n'".
  intro a.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_make_tuple_base_case_nil.
  exact (IH_n' a).
Qed.
Hint Rewrite repeat_make_tuple_nil : charfun.

Lemma repeat_make_tuple_l_eq_0 :
  forall (ys : tuple) (n : nat),
    (length ys) <= n ->
    repeat_make_tuple ys 0 n = [].
Proof.
  intros ys n; revert ys.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intros ys H_length_ys_le_0.
  rewrite -> unfold_repeat_make_tuple_base_case.
  inversion H_length_ys_le_0;
   rename H0 into H_length_ys_eq_0.
  rewrite -> (length_nil_0 ys H_length_ys_eq_0).
  reflexivity.

  Case "n = S n'".
  intros ys H_length_ys_le_S_n'.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> IH_n'.
  reflexivity.
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_make_tuple_base_case_nil.
  rewrite -> unfold_length_base_case.
  exact (le_0_n n').

  SCase "ys = y :: ys'".
  case ys' as [ | y' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_make_tuple_base_case_x_nil.
  rewrite -> unfold_length_base_case.
  exact (le_0_n n').

  SSCase "ys' = y' :: ys''".
  rewrite -> unfold_make_tuple_induction_case.
  rewrite -> unfold_length_induction_case.
  rewrite -> S_length_make_tuple.
  rewrite -> unfold_length_induction_case.
  rewrite ->2 unfold_length_induction_case in H_length_ys_le_S_n'.
  rewrite -> (le_S_n (S (length ys'')) n');
    [ reflexivity | exact H_length_ys_le_S_n' ].
Qed.
Hint Resolve repeat_make_tuple_l_eq_0 : charfun.

(* {SHIFT_MAKE_TUPLE_IN_REPEAT_MAKE_TUPLE} *)
Lemma shift_make_tuple_in_repeat_make_tuple :
  forall (ys : tuple) (n a : nat),
    make_tuple (repeat_make_tuple ys a n) a =
    repeat_make_tuple (make_tuple ys a) a n.
(* {END} *)
Proof.
  intros ys n a; revert ys a.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intros ys a.
  rewrite ->2 unfold_repeat_make_tuple_base_case.
  reflexivity.

  Case "n = S n'".
  intros ys a.
  rewrite ->2 unfold_repeat_make_tuple_induction_case.
  rewrite -> (IH_n' (make_tuple ys a) a).
  reflexivity.
Qed.
Hint Rewrite shift_make_tuple_in_repeat_make_tuple : charfun.

Lemma length_repeat_make_tuple :
  forall (ys : tuple) (a n : nat),
    length (repeat_make_tuple ys a n) = (length ys) - n.
Proof.
  intros ys a n; revert ys a.
  induction n as [ | n' IH_n' ].

  Case "n = 0".
  intros ys a.
  rewrite -> unfold_repeat_make_tuple_base_case.
  rewrite <- minus_n_O.
  reflexivity.

  Case "n = S n'".
  intros ys a.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> IH_n'.
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_make_tuple_base_case_nil.
  rewrite -> unfold_length_base_case.
  unfold minus.
  reflexivity.

  SCase "ys = y :: ys'".
  case ys' as [ | y' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_make_tuple_base_case_x_nil.
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  unfold minus.
  reflexivity.

  SSCase "ys' = y' :: ys''".
  rewrite -> unfold_make_tuple_induction_case.
  rewrite -> unfold_length_induction_case.
  rewrite -> S_length_make_tuple.
  rewrite ->3 unfold_length_induction_case.
  rewrite -> NPeano.Nat.sub_succ.
  reflexivity.
Qed.
Hint Rewrite length_repeat_make_tuple : charfun.

(** ** Correctness proof of repeat_make_tuple and rotated_moessner_entry *)

(* {REPEAT_MAKE_TUPLE_ROTATED_MOESSNER_ENTRIES} *)
Theorem repeat_make_tuple_rotated_moessner_entries :
  forall (c l n t : nat),
    repeat_make_tuple
      (Str_prefix (c + l) (rotated_moessner_entries n 0 0 t)) 0 c =
    Str_prefix l (rotated_moessner_entries n 0 c t).
(* {END} *)
Proof.
  induction c as [ | c' IH_c' ].

  Case "c = 0".
  intros l n t.
  rewrite -> plus_0_l.
  rewrite -> unfold_repeat_make_tuple_base_case.
  reflexivity.

  Case "c = S c'".
  intros l n t.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite <- shift_make_tuple_in_repeat_make_tuple.
  rewrite -> plus_Sn_m, -> plus_n_Sm.
  rewrite -> (IH_c' (S l) n t).
  rewrite -> make_tuple_rotated_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite repeat_make_tuple_rotated_moessner_entries : charfun.

(* {REPEAT_MAKE_TUPLE_MONOMIALS_EQ_MOESSNER_ENTRIES} *)
Corollary repeat_make_tuple_monomials_eq_moessner_entries :
  forall (c l n t : nat),
    repeat_make_tuple
      (Str_prefix (S c + l) (monomials t n 0)) 0 (S c) =
    Str_prefix l (rotated_moessner_entries n 0 c t).
(* {END} *)
Proof.
  intros c l n t.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> plus_Sn_m.
  rewrite -> make_tuple_monomials_eq_monomials_sum.
  rewrite -> rotated_moessner_entries_bisim_monomials_sum.
  rewrite -> repeat_make_tuple_rotated_moessner_entries.
  reflexivity.
Qed.
Hint Rewrite repeat_make_tuple_monomials_eq_moessner_entries : charfun.

(* {REPEAT_MAKE_TUPLE_MONOMIALS_EQ_MOESSNER_ENTRIES_GENERAL} *)
Lemma repeat_make_tuple_monomials_eq_moessner_entries_general :
  forall (k j n t : nat),
    j <= k ->
    Str_prefix (k - j) (rotated_moessner_entries n 0 j t) =
    repeat_make_tuple (Str_prefix (S k) (monomials t n 0)) 0 (S j).
(* {END} *)
Proof.
  induction k as [ | k' IH_k' ].

  Case "k = 0".
  intros j n t H_j_le_0.
  unfold minus.
  rewrite -> unfold_Str_prefix_induction_case.
  rewrite ->2 unfold_Str_prefix_base_case.
  rewrite -> monomials_initial_value.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_make_tuple_base_case_x_nil.
  rewrite -> repeat_make_tuple_nil.
  reflexivity.

  Case "k = S k'".
  induction j as [ | j' IH_j' ].

  SCase "j = 0".
  intros n t H_0_le_S_k'.
  rewrite <- minus_n_O.
  rewrite <- repeat_make_tuple_monomials_eq_moessner_entries.
  reflexivity.

  SCase "j = S j'".
  intros n t H_S_j_le_S_k.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite <- shift_make_tuple_in_repeat_make_tuple.
  rewrite <- (IH_j' n t);
    [ idtac | apply lt_le_weak; unfold lt; exact H_S_j_le_S_k ].
  rewrite <- make_tuple_rotated_moessner_entries.
  rewrite -> NPeano.Nat.sub_succ.
  rewrite -> minus_Sn_m;
    [ idtac | apply gt_S_le; unfold gt, lt; exact H_S_j_le_S_k ].
  reflexivity.
Qed.
Hint Resolve repeat_make_tuple_monomials_eq_moessner_entries_general : charfun.

(** *** Prove relation between [repeat_make_tuple]
  and [create_triangle_vertically] *)

(* {SHIFT_MAKE_TUPLE_CREATE_TRIANGLE_VERTICALLY} *)
Lemma shift_make_tuple_create_triangle_vertically :
  forall (j' : nat) (ys : tuple),
   make_tuple
     (nth j'
          (create_triangle_vertically
             (tuple_constant (length ys) 0) ys) []) 0 =
   nth (S j')
       (create_triangle_vertically
          (tuple_constant (length ys) 0) ys) [].
(* {END} *)
Proof.
  induction j' as [ | j'' IH_j'' ].

  Case "j' = 0".
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_nil.
  rewrite -> unfold_nth_base_case_nil.
  rewrite -> unfold_make_tuple_base_case_nil.
  rewrite -> nth_n_nil.
  reflexivity.

  SCase "ys = y :: ys'".
  case ys' as [ | y' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_induction_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_x_nil.
  rewrite -> unfold_nth_base_case_nil.
  rewrite -> unfold_make_tuple_base_case_nil.
  rewrite -> nth_n_nil.
  reflexivity.

  SSCase "ys' = y' :: ys''".
  case ys'' as [ | y'' ys''' ].

  SSSCase "ys'' = []".
  rewrite ->2 unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  rewrite ->2 unfold_tuple_constant_induction_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_induction_case.
  rewrite -> unfold_create_triangle_vertically_base_case_x_nil.
  rewrite -> unfold_nth_base_case_cons.
  rewrite -> unfold_nth_induction_case_cons.
  rewrite -> unfold_nth_base_case_nil.
  rewrite -> unfold_make_tuple_induction_case.
  rewrite -> unfold_make_tuple_base_case_x_nil.
  reflexivity.

  SSSCase "ys'' = y'' :: ys'''".
  rewrite ->3 unfold_length_induction_case.
  rewrite ->3 unfold_tuple_constant_induction_case.
  rewrite ->2 unfold_create_triangle_vertically_induction_case.
  rewrite -> unfold_nth_base_case_cons.
  rewrite -> unfold_nth_induction_case_cons.
  rewrite -> unfold_nth_base_case_cons.
  reflexivity.

  Case "j' = S j''".
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_nil.
  rewrite ->2 nth_n_nil.
  rewrite -> unfold_make_tuple_base_case_nil.
  reflexivity.

  SCase "ys = y :: ys'".
  case ys' as [ | y' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_induction_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_x_nil.
  rewrite ->2 nth_n_nil.
  rewrite -> unfold_make_tuple_base_case_nil.
  reflexivity.

  SSCase "ys' = y' :: ys''".
  symmetry.
  rewrite ->2 unfold_length_induction_case.
  rewrite ->2 unfold_tuple_constant_induction_case.
  rewrite -> unfold_create_triangle_vertically_induction_case.
  rewrite <- unfold_tuple_constant_induction_case.
  rewrite <- (unfold_length_induction_case y' ys'').
  rewrite -> unfold_nth_induction_case_cons.
  rewrite <- (S_length_make_tuple ys'' y' 0).
  rewrite <- (unfold_length_induction_case y (make_tuple (y' :: ys'') 0)).
  rewrite -> unfold_nth_induction_case_cons.

  assert (H: (length (y :: make_tuple (y' :: ys'') 0)) =
             (length (make_tuple (y :: y' :: ys'') 0))).
    rewrite -> unfold_length_induction_case.
    rewrite -> unfold_make_tuple_induction_case.
    rewrite -> unfold_length_induction_case.
    rewrite -> plus_0_r.
    rewrite -> (length_tuples_xs_a_eq_ys_b
                  (y' :: ys'')
                  (y' :: ys'')
                  0
                  y); reflexivity.

  rewrite -> H; clear H.
  rewrite <- (IH_j'' (make_tuple (y :: y' :: ys'') 0)).
  reflexivity.
Qed.
Hint Rewrite shift_make_tuple_create_triangle_vertically : charfun.

(* {CORRECTNESS_OF_REPEAT_MAKE_TUPLE} *)
Theorem correctness_of_repeat_make_tuple :
  forall (j : nat) (ys : tuple),
    (repeat_make_tuple ys 0 (S j)) =
    (nth j (create_triangle_vertically
              (tuple_constant (length ys) 0)
              ys)
         []).
(* {END} *)
Proof.
  induction j as [ | j' IH_j' ].

  Case "j = 0".
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_repeat_make_tuple_base_case.
  rewrite -> unfold_make_tuple_base_case_nil.

  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_nil.
  rewrite -> unfold_nth_base_case_nil.
  reflexivity.

  SCase "ys = y :: ys'".
  case ys' as [ | x' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_repeat_make_tuple_base_case.
  rewrite -> unfold_make_tuple_base_case_x_nil.

  rewrite -> unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_induction_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_x_nil.
  rewrite -> unfold_nth_base_case_nil.
  reflexivity.

  SSCase "ys' = y' :: ys''".
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_repeat_make_tuple_base_case.
  rewrite -> unfold_make_tuple_induction_case.
  rewrite -> plus_0_r.

  rewrite ->2 unfold_length_induction_case.
  rewrite ->2 unfold_tuple_constant_induction_case.
  rewrite -> unfold_create_triangle_vertically_induction_case.
  rewrite -> unfold_nth_base_case_cons.
  rewrite -> unfold_make_tuple_induction_case.
  rewrite -> plus_0_r.
  reflexivity.

  Case "j = S j'".
  case ys as [ | y ys' ].

  SCase "ys = []".
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_nil.
  rewrite -> unfold_nth_induction_case_nil.

  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_make_tuple_base_case_nil.

  rewrite -> repeat_make_tuple_l_eq_0;
    [ reflexivity | rewrite -> unfold_length_base_case; exact (le_O_n j') ].

  SCase "ys = y :: ys''".
  case ys' as [ | y' ys'' ].

  SSCase "ys' = []".
  rewrite -> unfold_length_induction_case.
  rewrite -> unfold_length_base_case.
  rewrite -> unfold_tuple_constant_induction_case.
  rewrite -> unfold_tuple_constant_base_case.
  rewrite -> unfold_create_triangle_vertically_base_case_x_nil.
  rewrite -> unfold_nth_induction_case_nil.

  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite -> unfold_make_tuple_base_case_x_nil.
  rewrite -> unfold_make_tuple_base_case_nil.

  rewrite -> repeat_make_tuple_l_eq_0;
    [ reflexivity | rewrite -> unfold_length_base_case; exact (le_O_n j') ].

  SSCase "ys' = y' :: ys''".
  rewrite -> unfold_repeat_make_tuple_induction_case.
  rewrite <- shift_make_tuple_in_repeat_make_tuple.
  rewrite -> (IH_j' (y :: y' :: ys'')).
  rewrite -> shift_make_tuple_create_triangle_vertically.
  reflexivity.
Qed.
Hint Rewrite correctness_of_repeat_make_tuple : charfun.

(* {CORRECTNESS_OF_ROTATED_MOESSNER_ENTRY} *)
Theorem correctness_of_rotated_moessner_entry :
  forall (i j r t : nat),
    j <= S r ->
    S i <= S r - j ->
    (nth i
         (nth j
              (create_triangle_vertically
                 (tuple_constant (S (S r)) 0)
                 (Str_prefix (S (S r)) (monomials t r 0)))
              [])
         0) =
    rotated_moessner_entry r i j t.
(* {END} *)
Proof.
  intros i j r t H_j_le_S_r H_S_i_le_S_r_minus_j.

  assert (H_length_helper: (S (S r)) =
             (length (Str_prefix (S (S r)) (monomials t r 0)))).
    rewrite -> Str_prefix_length.
    reflexivity.

  assert (H_rewrite_helper:
            (tuple_constant (S (S r)) 0) =
            (tuple_constant
               (length (Str_prefix (S (S r)) (monomials t r 0))) 0)).
    f_equal.
    exact H_length_helper.

  rewrite -> H_rewrite_helper; clear H_length_helper H_rewrite_helper.

  rewrite <- correctness_of_repeat_make_tuple.

  rewrite <- repeat_make_tuple_monomials_eq_moessner_entries_general;
    [ idtac | exact H_j_le_S_r ].

  rewrite -> nth_and_Str_nth;
    [ idtac | unfold lt; exact H_S_i_le_S_r_minus_j ].

  rewrite -> Str_nth_rotated_moessner_entries.
  rewrite -> plus_0_l.
  reflexivity.
Qed.
Hint Resolve correctness_of_rotated_moessner_entry : charfun.


Require Import Frap Pset3aSig.

(* The [Prog] datatype defines abstract syntax trees for this language.
 *)

Print Prog.

(* Define [run] such that [run p n] gives the final state
 * that running the program [p] should result in, when the
 * initial state is [n].
 *)
Fixpoint run (p : Prog) (initState : nat) : nat :=
match p with
| Done  => initState
| AddThen a b   => run b (initState+a)
| MulThen a b   => run b (initState*a)
| SetToThen a b => run b a
end.

Theorem run_Example1 : run Done 0 = 0.
Proof.
  simplify. equality.
Qed.

Theorem run_Example2 : run (MulThen 5 (AddThen 2 Done)) 1 = 7.
Proof.
  simplify. equality.
Qed.

Theorem run_Example3 : run (SetToThen 3 (MulThen 2 Done)) 10 = 6.
Proof.
  simplify. equality.
Qed.

(* Define [numInstructions] to compute the number of instructions
 * in a program, not counting [Done] as an instruction.
 *)

(* We will define a utlity function that will be used to compute the number of instructions *)
Fixpoint numinsutil (p: Prog) (count:nat) :nat :=
match p with
| Done => count
| AddThen a b => numinsutil b (count+1)
| MulThen a b => numinsutil b (count+1)
| SetToThen a b => numinsutil b (count+1)
end.

Definition numInstructions (p : Prog) : nat := numinsutil p 0.

Theorem numInstructions_Example :
  numInstructions (MulThen 5 (AddThen 2 Done)) = 2.
Proof.
  simplify. equality.
Qed.

(* Define [concatProg] such that [concatProg p1 p2] is the program
 * that first runs [p1] and then runs [p2].
 *)
Fixpoint concatProg (p1 p2 : Prog) : Prog := match p1 with
| Done => p2
| AddThen a b   => AddThen a (concatProg b p2)
| MulThen a b   => MulThen a (concatProg b p2)
| SetToThen a b => SetToThen a (concatProg b p2)
end.

Theorem concatProg_Example :
     concatProg (AddThen 1 Done) (MulThen 2 Done)
     = AddThen 1 (MulThen 2 Done).
Proof.
  simplify. equality.
Qed.

(* Prove that the number of instructions in the concatenation of
 * two programs is the sum of the number of instructions in each
 * program.
 *)

(* We will use the following lemma in the proof for the theorem *)
Lemma util_val: forall (p1: Prog) (v:nat), numinsutil p1 v = v + numinsutil p1 0.
Proof.
  simplify.
  induct p1.
    (* Initial proof based on case by case analysis *)

      - simplify. ring.
    - unfold numinsutil. simplify. rewrite IHp1. fold numinsutil. rewrite -> (IHp1 1). linear_arithmetic.
    - unfold numinsutil. simplify. rewrite IHp1. fold numinsutil. rewrite -> (IHp1 1). linear_arithmetic.
    - unfold numinsutil. simplify. rewrite IHp1. fold numinsutil. rewrite -> (IHp1 1). linear_arithmetic.

    (* Try to perform proof automation *)
    (*
      try match goal with
      | [ |- numinsutil Done = _ ] => simplify; ring
      | _ => unfold numinsutil; simplify; rewrite IHp1; fold numinsutil; rewrite -> (IHp1 1); linear_arithmetic
      end.
    *)
Qed.

Theorem concatProg_numInstructions
  : forall (p1 p2 : Prog), numInstructions (concatProg p1 p2)
                      = numInstructions p1 + numInstructions p2.
Proof.
  induct p1.
   - simplify. equality.
   - unfold concatProg. simplify. fold concatProg. unfold numInstructions in IHp1. unfold numInstructions.
     simplify. rewrite (util_val p1 1). rewrite (util_val (concatProg p1 p2) 1). rewrite IHp1. linear_arithmetic.
   - unfold concatProg. simplify. fold concatProg. unfold numInstructions in IHp1. unfold numInstructions.
     simplify. rewrite (util_val p1 1). rewrite (util_val (concatProg p1 p2) 1). rewrite IHp1. linear_arithmetic.
   - unfold concatProg. simplify. fold concatProg. unfold numInstructions in IHp1. unfold numInstructions.
     simplify. rewrite (util_val p1 1). rewrite (util_val (concatProg p1 p2) 1). rewrite IHp1. linear_arithmetic.

(*
all:   unfold concatProg; simplify; fold concatProg; unfold numInstructions in IHp1; unfold numInstructions;
     simplify; rewrite (util_val p1 1); rewrite (util_val (concatProg p1 p2) 1); rewrite IHp1; linear_arithmetic.
*)
Qed.

(* Prove that running the concatenation of [p1] with [p2] is
   equivalent to running [p1] and then running [p2] on the
   result. *)
Theorem concatProg_run
  : forall (p1 p2 : Prog) (initState : nat),
    run (concatProg p1 p2) initState =
    run p2 (run p1 initState).
Proof.
    induct p1.
      - simplify. equality.
      - simplify. rewrite (IHp1 (p2) (initState+n)). equality.
      - simplify. rewrite (IHp1 (p2) (initState*n)). equality.
      - simplify. rewrite (IHp1 (p2) (n)). equality.
Qed.

(* Ignore the below lines: *)
(*
Lemma dum: forall (p:Prog), numinsutil p 0 = numInstructions p.
Proof.
  simplify.
  unfold numInstructions. rewrite numInstructions.
  linear_arithmetic.
Admitted.
*)
(* Lemma concatProg_numInstructions
  : forall (p1 p2 : Prog) (v:nat), numinsutil (concatProg p1 p2) v
                      = numinsutil p1 v + numinsutil p2 0.
Proof.
  induct p1.
    - simplify.
*)


Require Import ssreflect.
Require Import Ensembles.

Variable U : Type.

Lemma in_complements_notin_union: forall (A B: Ensemble U) (x: U),
    In U (Complement U A) x -> In U (Complement U B) x ->
        ~ In U (Union U A B) x.
Proof.
intros.

(* unfold not. *)
move=> inAuB.
destruct inAuB.

(* case x \in A *)
destruct H.
apply H1.

(* case x \in B *)
destruct H0.
apply H1.
Qed.

(* What is a sensible way to generate proofs where the goal includes a negation, given
that the Coq standard library defines `~ P` as `P -> False`? *)

Lemma demorgan1: forall A B: Ensemble U,
    Included U
        (Intersection U (Complement U A) (Complement U B))
        (Complement U (Union U A B)).
Proof.
intros.
move=> U1. (* Why do I need this one? something strange about the way the universe type U interacts with the definitions. *)
move=> inA.
destruct inA.
apply in_complements_notin_union.
apply H.
apply H0. Show Proof.
Qed.

Lemma union_subset_bigger_union: forall A B C: Ensemble U,
    Included U
        (Union U A B)
        (Union U A (Union U B C)).
Proof.
    intros.
    move=> U1.
    move=> inAuB.
    (* destruct inAuB. *)
    case inAuB.
    (* Case 1, x \in A *)
    intros.
    apply Union_introl.
    apply H.
    (* Case 2, x \in B*)
    intros.
    apply Union_intror.
    apply Union_introl.
    apply H. Show Proof.
Qed.

(* TODO why does using case un-introduce variables so I then have to use intros?*)

(* Doing this stuff with `In` is weird because it should be translated the same as `:` for the
proofs that I want to write I guess? But its really annoying to deal with and makin that
happen is going to be a pain. This *is* related to the U thing from above *)

(* TODO can I have all the Ensemble stuff automatically parametrised by U throughout so that I
don't have to keep explicitly stating it? *)