From Coq Require Import Reals List ListSet.

From CasperCBC Require Import Preamble ListExtras ListSetExtras.

(** * Measure-related definitions and lemmas *)

Definition pos_R := {r : R | (r > 0)%R}.

Class Measurable V := { weight : V -> pos_R}.
Hint Mode Measurable ! : typeclass_instances.

Definition sum_weights `{Measurable V} (l : list V) : R :=
  fold_right (fun v r => (proj1_sig (weight v) + r)%R) 0%R l.

Lemma sum_weights_positive
  `{Measurable V} (l : list V)
  : (0 <= sum_weights l)%R.
Proof.
  induction l; try apply Rle_refl.
  simpl. apply  Rplus_le_le_0_compat; try assumption.
  destruct (weight a). simpl.
  apply Rlt_le. assumption.
Qed.

Definition weight_proj1_sig (w : pos_R) : R := proj1_sig w.

Coercion weight_proj1_sig : pos_R >-> R.

Lemma sum_weights_in
  `{EqDecision V} `{Hm : Measurable V}
  : forall v (vs:list V),
  NoDup vs ->
  In v vs ->
  sum_weights vs = (proj1_sig (weight v) + sum_weights (set_remove decide_eq v vs))%R.
Proof.
  induction vs; intros; inversion H0; subst; clear H0.
  - inversion H; subst; clear H. simpl. apply Rplus_eq_compat_l.
    destruct (decide (v = v)); congruence.
  - inversion H; subst; clear H. simpl. assert (Hav := H3). apply (in_not_in _ _ _ _ H1) in Hav.
    destruct (decide (v = a)); try (exfalso; apply Hav; assumption). simpl.
    rewrite <- Rplus_assoc. rewrite (Rplus_comm (proj1_sig (weight v)) (proj1_sig (weight a))). rewrite Rplus_assoc.
    apply Rplus_eq_compat_l. apply IHvs; assumption.
Qed.

Lemma sum_weights_incl
  `{EqDecision V} `{Hm : Measurable V}
  : forall (vs vs':list V),
  NoDup vs ->
  NoDup vs' ->
  incl vs vs' ->
  (sum_weights vs <= sum_weights vs')%R.
Proof.
  induction vs; intros; try apply sum_weights_positive.
  specialize (sum_weights_in a vs' H0) as Hvs'.
  spec Hvs'; try (apply H1; left; reflexivity).
  rewrite Hvs'. simpl.
  apply Rplus_le_compat_l.
  inversion H. subst.  clear H.
  apply IHvs; try assumption.
  - apply set_remove_nodup. assumption.
  - intros v Hv. apply set_remove_iff; try assumption.
    split.
    + apply H1. right. assumption.
    + intro contra. elim H4. subst. assumption.
Qed.

Lemma set_eq_nodup_sum_weight_eq
  `{EqDecision V} `{Hm : Measurable V}
  : forall (lv1 lv2 : list V),
    NoDup lv1 ->
    NoDup lv2 ->
    set_eq lv1 lv2 ->
    sum_weights lv1 = sum_weights lv2.
Proof.
  intros lv1 lv2 H_nodup1 H_nodup2 [H_eq_l H_eq_r].
  assert (H_useful := sum_weights_incl lv1 lv2 H_nodup1 H_nodup2 H_eq_l).
  assert (H_useful' := sum_weights_incl lv2 lv1 H_nodup2 H_nodup1 H_eq_r).
  now apply Rle_antisym.
Qed.

Lemma sum_weights_app
  `{Hm : Measurable V}
  : forall (vs vs':list V),
  sum_weights (vs ++ vs') = (sum_weights vs + sum_weights vs')%R.
Proof.
  induction vs; intros; simpl.
  - rewrite Rplus_0_l. reflexivity.
  - rewrite IHvs. rewrite Rplus_assoc. reflexivity.
Qed.


Require Export Program.Basics. Open Scope program_scope.
From Paco Require Import paconotation_internal paco_internal pacotac_internal.
From Paco Require Export paconotation.
Set Implicit Arguments.

Section PACO0.

(** ** Predicates of Arity 0
*)

Definition paco0(gf : rel0 -> rel0)(r: rel0) : rel0 :=
  @curry0 (paco (fun R0 => @uncurry0 (gf (@curry0 R0))) (@uncurry0 r)).

Definition upaco0(gf : rel0 -> rel0)(r: rel0) := paco0 gf r \0/ r.
Arguments paco0 : clear implicits.
Arguments upaco0 : clear implicits.
#[local] Hint Unfold upaco0 : core.

Definition monotone0 (gf: rel0 -> rel0) :=
  forall r r' (IN: gf r) (LE: r <0= r'), gf r'.

Definition _monotone0 (gf: rel0 -> rel0) :=
  forall r r'(LE: r <0= r'), gf r <0== gf r'.

Lemma monotone0_eq (gf: rel0 -> rel0) :
  monotone0 gf <-> _monotone0 gf.
Proof. unfold monotone0, _monotone0, le0. split; intros; eapply H; eassumption. Qed.

Lemma monotone0_map (gf: rel0 -> rel0)
      (MON: _monotone0 gf) :
  _monotone (fun R0 => @uncurry0 (gf (@curry0 R0))).
Proof.
  red; intros. apply uncurry_map0. apply MON; apply curry_map0; assumption.
Qed.

Lemma monotone0_compose (gf gf': rel0 -> rel0)
      (MON1: monotone0 gf)
      (MON2: monotone0 gf'):
  monotone0 (compose gf gf').
Proof.
  red; intros. eapply MON1. apply IN.
  intros. eapply MON2. apply PR. apply LE.
Qed.

Lemma monotone0_union (gf gf': rel0 -> rel0)
      (MON1: monotone0 gf)
      (MON2: monotone0 gf'):
  monotone0 (gf \1/ gf').
Proof.
  red; intros. destruct IN.
  - left. eapply MON1. apply H. apply LE.
  - right. eapply MON2. apply H. apply LE.
Qed.

Lemma _paco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  paco0 gf r <0== paco0 gf' r'.
Proof.
  apply curry_map0. red; intros. eapply paco_mon_gen. apply PR.
  - intros. apply LEgf, PR0.
  - intros. apply LEr, PR0.
Qed.

Lemma paco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (REL: paco0 gf r)
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  paco0 gf' r'.
Proof.
  eapply _paco0_mon_gen; [apply LEgf | apply LEr | apply REL].
Qed.

Lemma paco0_mon_bot (gf gf': rel0 -> rel0) r'
    (REL: paco0 gf bot0)
    (LEgf: gf <1= gf'):
  paco0 gf' r'.
Proof.
  eapply paco0_mon_gen; [apply REL | apply LEgf | intros; contradiction PR].
Qed.

Lemma upaco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (REL: upaco0 gf r)
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  upaco0 gf' r'.
Proof.
  destruct REL.
  - left. eapply paco0_mon_gen; [apply H | apply LEgf | apply LEr].
  - right. apply LEr, H.
Qed.

Lemma upaco0_mon_bot (gf gf': rel0 -> rel0) r'
    (REL: upaco0 gf bot0)
    (LEgf: gf <1= gf'):
  upaco0 gf' r'.
Proof.
  eapply upaco0_mon_gen; [apply REL | apply LEgf | intros; contradiction PR].
Qed.

Section Arg0.

Variable gf : rel0 -> rel0.
Arguments gf : clear implicits.

Theorem _paco0_mon: _monotone0 (paco0 gf).
Proof.
  red; intros. eapply curry_map0, _paco_mon; apply uncurry_map0; assumption.
Qed.

Theorem _paco0_acc: forall
  l r (OBG: forall rr (INC: r <0== rr) (CIH: l <0== rr), l <0== paco0 gf rr),
  l <0== paco0 gf r.
Proof.
  intros. apply uncurry_adjoint1_0.
  eapply _paco_acc. intros.
  apply uncurry_adjoint1_0 in INC. apply uncurry_adjoint1_0 in CIH.
  apply uncurry_adjoint2_0.
  eapply le0_trans. eapply (OBG _ INC CIH).
  apply curry_map0.
  apply _paco_mon; try apply le1_refl; apply curry_bij1_0.
Qed.

Theorem _paco0_mult_strong: forall r,
  paco0 gf (upaco0 gf r) <0== paco0 gf r.
Proof.
  intros. apply curry_map0.
  eapply le1_trans; [| eapply _paco_mult_strong].
  apply _paco_mon; intros [] H; apply H.
Qed.

Theorem _paco0_fold: forall r,
  gf (upaco0 gf r) <0== paco0 gf r.
Proof.
  intros. apply uncurry_adjoint1_0.
  eapply le1_trans; [| apply _paco_fold]. apply le1_refl.
Qed.

Theorem _paco0_unfold: forall (MON: _monotone0 gf) r,
  paco0 gf r <0== gf (upaco0 gf r).
Proof.
  intros. apply curry_adjoint2_0.
  eapply _paco_unfold; apply monotone0_map; assumption.
Qed.

Theorem paco0_acc: forall
  l r (OBG: forall rr (INC: forall (PR: r : Prop), rr : Prop) (CIH: forall (PR: l : Prop), rr : Prop), forall (PR: l : Prop), paco0 gf rr : Prop),
  l <0= paco0 gf r.
Proof.
  apply _paco0_acc.
Qed.

Theorem paco0_mon: monotone0 (paco0 gf).
Proof.
  apply monotone0_eq.
  apply _paco0_mon.
Qed.

Theorem upaco0_mon: monotone0 (upaco0 gf).
Proof.
  red; intros.
  destruct IN.
  - left. eapply paco0_mon. apply H. apply LE.
  - right. apply LE, H.
Qed.

Theorem paco0_mult_strong: forall r,
  paco0 gf (upaco0 gf r) <0= paco0 gf r.
Proof.
  apply _paco0_mult_strong.
Qed.

Corollary paco0_mult: forall r,
  paco0 gf (paco0 gf r) <0= paco0 gf r.
Proof. intros; eapply paco0_mult_strong, paco0_mon; [apply PR|..]; intros; left; assumption. Qed.

Theorem paco0_fold: forall r,
  gf (upaco0 gf r) <0= paco0 gf r.
Proof.
  apply _paco0_fold.
Qed.

Theorem paco0_unfold: forall (MON: monotone0 gf) r,
  paco0 gf r <0= gf (upaco0 gf r).
Proof.
  intro. eapply _paco0_unfold; apply monotone0_eq; assumption.
Qed.

End Arg0.

Arguments paco0_acc : clear implicits.
Arguments paco0_mon : clear implicits.
Arguments upaco0_mon : clear implicits.
Arguments paco0_mult_strong : clear implicits.
Arguments paco0_mult : clear implicits.
Arguments paco0_fold : clear implicits.
Arguments paco0_unfold : clear implicits.

Global Instance paco0_inst  (gf : rel0->_) r : paco_class (paco0 gf r) :=
{ pacoacc    := paco0_acc gf;
  pacomult   := paco0_mult gf;
  pacofold   := paco0_fold gf;
  pacounfold := paco0_unfold gf }.

End PACO0.

Global Opaque paco0.

#[export] Hint Unfold upaco0 : core.
#[export] Hint Resolve paco0_fold : core.
#[export] Hint Unfold monotone0 : core.


Require Export LL.PLL.PreTactics.
Require Import Coq.Program.Equality.

Export LLNotations .
Set Implicit Arguments.

Section LL2BasicTheory.

Section StructuralProperties.

Lemma LL2N_compat : forall n B1 B2 L1 L2,
     Permutation B1 B2 -> Permutation L1 L2 ->
     LL2 n |-- B1 ; L1 -> LL2 n |-- B2 ; L2.
Proof with sauto.
  intros n B1 B2 L1 L2 PB PL H.
  revert L1 L2 PL B1 B2 PB H;
  induction n using lt_wf_ind; intros...
  inversion H0...
  all: try rewrite PL in H1.
  LL2init A.
  LL2top M.
  LL2plus1 F G M.
  eapply H with (B1:=B1)...
  LL2plus2 F G M.
  eapply H with (B1:=B1)...
  LL2with F G M.
  eapply H with (B1:=B1)...
  eapply H with (B1:=B1)...
  LL2bot M.
  eapply H with (B1:=B1)...
  LL2par F G M.
  eapply H with (B1:=B1)...
  LL2tensor F G M N.
  eapply H with (B1:=B1)...
  eapply H with (B1:=B1)...
  LL2store F M.
  eapply H with (B1:=F::B1)...
  LL2bang.
  eapply H with (B1:=B1)...
  LL2copy F.
  rewrite <- PB...
  eapply H with (B1:=B1) (L1:=F::L1)...
 Qed.

Global Instance LL2N_morphism n:
  Proper (Permutation (A:=oo) ==> Permutation (A:=oo) ==> iff) (LL2N n).
Proof.
  unfold Proper; unfold respectful.
  intros B1 B2 PB L1 L2 PL.
  split; intro H.
  refine (LL2N_compat PB PL H).
  refine (LL2N_compat (symmetry PB) (symmetry PL) H).
Qed.

Lemma LL2S_compat : forall B1 B2 L1 L2,
     Permutation B1 B2 -> Permutation L1 L2 ->
     LL2 |-- B1 ; L1 -> LL2 |-- B2 ; L2.
Proof with sauto.
  intros B1 B2 L1 L2 PB PL H.
  revert dependent B2.
  revert dependent L2.
  induction H;intros L2 PL B2 PB...
  LL2init A.
  all: try rewrite PL in H.
  LL2top M.
  LL2plus1 F G M.
  LL2plus2 F G M.
  LL2with F G M.
  LL2bot M.
  LL2par F G M.
  LL2tensor F G M N.
  LL2store F M.
  rewrite PB in H.
  LL2copy F.
 Qed.

Global Instance LL2S_morphism:
  Proper (Permutation (A:=oo) ==> Permutation (A:=oo) ==> iff) (LL2S).
Proof.
  unfold Proper; unfold respectful.
  intros B1 B2 PB L1 L2 PL.
  split; intro H.
  refine (LL2S_compat PB PL H).
  refine (LL2S_compat (symmetry PB) (symmetry PL) H).
Qed.

Instance LL2S_morphism' B:
  Proper (Permutation (A:=oo) ==> Basics.flip Basics.impl) (LL2S B).
Proof.
  unfold Proper; unfold respectful.
  intros L1 L2 PL H.
  rewrite PL;auto.
 Qed.

Lemma LL2NtoLL2S : forall n B L,
    LL2N n B L -> LL2S B L.
 Proof with sauto.
  induction n using lt_wf_ind;intros...
  inversion H0...
  all: clear H0.
  LL2init A.
  all:
  try repeat
    match goal with
    [H1: LL2N _ _ _ |- _] =>
    apply H in H1;sauto
    end.
   LL2top M.
   LL2plus1 F G M.
   LL2plus2 F G M.
   LL2with F G M.
   LL2bot M.
   LL2par F G M.
   LL2tensor F G M N.
   LL2store F M.
   LL2copy F.
  Qed.

Axiom LL2StoLL2N : forall B L,
    LL2S B L -> exists n, LL2N n B L.

Theorem LL2weakeningN : forall n CC LC F ,
        (LL2N n CC LC) -> LL2N n (F::CC) LC.
 Proof with sauto.
    induction n using lt_wf_ind;intros.
      inversion H0...
      LL2init A.
      LL2top M.
      LL2plus1 F0 G M.
      LL2plus2 F0 G M.
      LL2with F0 G M.
      LL2bot M.
      LL2par F0 G M.
      LL2tensor F0 G M N.
      LL2store F0 M.
      rewrite perm_swap;auto.
      LL2copy F0.
      firstorder.
  Qed.

Theorem LL2weakening (CC LC : multiset oo) F:
    LL2S CC LC -> LL2S (F :: CC) LC.
   Proof with sauto.
    intros.
    revert dependent F.
    induction H;intros...
    LL2init A.
    LL2top M.
    LL2plus1 F G M.
    LL2plus2 F G M.
    LL2with F G M.
    LL2bot M.
    LL2par F G M.
    LL2tensor F G M N.
    LL2store F M.
    rewrite perm_swap;auto.
    LL2copy F.
    firstorder.
 Qed.

Theorem LL2weakeningGen (CC' CC LC : multiset oo):
    LL2S CC LC -> LL2S (CC' ++ CC) LC.
   Proof with sauto.
    intros.
    revert dependent CC.
    revert LC.
    induction CC';intros...
    rewrite <- app_comm_cons.
    apply LL2weakening...
 Qed.

Theorem LL2storeGen (CC' CC LC : multiset oo):
    LL2S (CC'++CC) LC -> LL2S CC (map Quest CC' ++ LC).
   Proof with sauto.
    intros.
    revert dependent CC.
    revert LC.
    induction CC';intros...
    simpl...
    LL2store a (map Quest CC' ++ LC).
    eapply IHCC'.
    rewrite <- Permutation_middle...
 Qed.

Theorem LL2copyGen (CC' CC LC : multiset oo):
   LL2S CC (CC' ++ LC) ->  LL2S (CC'++CC) LC.
   Proof with sauto.
    intros.
    revert dependent CC.
    revert LC.
    induction CC';intros...
    simpl...
    LL2copy a...
    apply LL2weakening...
    eapply IHCC'.
    rewrite <- Permutation_middle...
 Qed.

Theorem LL2contractionN  : forall n F CC LC,
    LL2N n (F :: CC) LC -> In F CC -> LL2N n CC LC.
  Proof with sauto.
  do 2 intro.
  induction n using lt_wf_ind;intros...
    inversion H0...
    LL2init A.
    LL2top M.
    LL2plus1 F0 G M.
    LL2plus2 F0 G M.
    LL2with F0 G M.
    LL2bot M.
    LL2par F0 G M.
    LL2tensor F0 G M N.
    LL2store F0 M.
    rewrite perm_swap in H3...
    apply H in H3...
    LL2copy F0.
    inversion H2...
Qed.

Theorem LL2contraction  : forall F CC LC,
    LL2S (CC++[F]) LC -> In F CC -> LL2S CC LC.
  Proof with sauto.
  intros.
  dependent induction H generalizing CC...
    LL2init A.
    LL2top M.
    LL2plus1 F0 G M.
    LL2plus2 F0 G M.
    LL2with F0 G M.
    LL2bot M.
    LL2par F0 G M.
    LL2tensor F0 G M N.
    LL2store F0 M.
    apply IHLL2S...
    apply in_app_or in H...
    LL2copy F0.
    inversion H2...
    LL2copy F0.
Qed.

Theorem LL2initGen : forall B F,  LL2S B [F; dual F].
Proof with simpl;sauto.
   induction F...
   1-2: LL2init n.
   1,3: LL2top [0].
   1-2: LL2bot ['1].
   - LL2with F1 F2 [F1 ^ ⊕ F2 ^].
     LL2plus1 (dual F1) (dual F2) [F1].
     rewrite perm_takeit_8...
     LL2plus2 (dual F1) (dual F2) [F2]...
     rewrite perm_takeit_8...
   - LL2par (dual F1) (dual F2) [F1 ⊗ F2].
      LL2tensor F1 F2 [dual F1] [dual F2].
   - LL2with (dual F1) (dual F2) [F1 ⊕ F2 ].
     LL2plus1 F1 F2 [dual F1].
     LL2plus2 F1 F2 [dual F2].
   - LL2par F1 F2 [dual F1 ⊗ dual F2].
      LL2tensor (dual F1) (dual F2) [F1] [F2].
     1-2: rewrite perm_takeit_8...
   - LL2store (dual F) [! F].
     constructor.
     LL2copy (dual F)...
    apply LL2weakening.
     rewrite perm_takeit_8...
   - LL2store F [! (dual F)].
     constructor.
     LL2copy F...
     apply LL2weakening...
 Qed.

End StructuralProperties.

Section GeneralResults.

  Lemma LL2_HeightGeq : forall m n  B L,
        LL2N n B L ->
        m>=n -> LL2N m B L.
    Proof with sauto.
   intro. induction m ;intros...
   - inversion H0...
   - inversion H0...
     inversion H...
     LL2init A.
     LL2top M.
     LL2plus1 F G M.
     apply IHm in H3...
     LL2plus2 F G M.
     apply IHm in H3...
     LL2with F G M.
     apply IHm in H3...
     apply IHm in H4...
     LL2bot M.
     apply IHm in H3...
     LL2par F G M.
     apply IHm in H3...
     LL2tensor F G M N.
     apply IHm in H3...
     apply IHm in H4...
     LL2store F M.
     apply IHm in H3...
     LL2bang.
     apply IHm in H1...
     LL2copy F.
     apply IHm in H3...
 Qed.

  End GeneralResults.

 End LL2BasicTheory.


(*  Exercises for chapter 5 Tactics *)

Require  Common.

(* Very important novice mistake,
   we need an import for the .vo file and
   one import for the module define in this file
   for this case both are named 'Common'*)

(* REMEMBER
   In order to import the definitions we must
   first compile the imported module using:

     coqc Common.v

   This is going to generate a .vo file which
   is required to do the `Require`
 *)

Import Common.Common.

Theorem silly1 : forall (n m o p : nat),
    n = m ->
    [n;o] = [n;p] ->
    [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1.
  rewrite -> eq2.
  reflexivity.
Qed.

Theorem silly1_2 : forall (n m o p : nat),
    n = m ->
    [n;o] = [n;p] ->
    [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1.
  apply eq2.

Qed.

Theorem silly2 : forall (n m o p : nat),
    n = m ->
    (forall (q r : nat), q = r -> [q;o] = [r;p]) ->
    [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  apply eq2. apply eq1.

(*  rewrite eq1.
  rewrite eq2.  --- error
*)
Qed.

Theorem silly_ex :
  (forall n, evenb n = true -> oddb (S n) = true) ->
  evenb 3 = true ->
  oddb 4 = true.
Proof.
  intros e1 e2.
  apply e1.
  apply e2.
Qed.

Theorem silly3_firsttry : forall (n : nat),
    true = beq_nat n 5 ->
    beq_nat (S (S n)) 7 = true.
Proof.
  intros n h.
  simpl.
  symmetry.
  apply h.

Qed.

Theorem rev_exercise1 : forall (l l'  : list nat),
    l = rev l' ->
    l' = rev l.
Proof.
  intros a b c.
  symmetry.
  rewrite c.
  apply rev_involutive.
Qed.

Example trans_eq_example : forall (a b c d e f : nat),
    [a;b] = [c;d] ->
    [c;d] = [e;f] ->
    [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  rewrite -> eq1.
  rewrite -> eq2.
  reflexivity.
Qed.

Theorem trans_eq : forall (X:Type) (n m o : X),
    n = m -> m = o -> n = o.
Proof.
  intros X n m o eq1 eq2.
  rewrite -> eq1.
  rewrite -> eq2.
  reflexivity.
Qed.

Example trans_eq_example' : forall(a b c d e f : nat),
    [a;b] = [c;d] ->
    [c;d] = [e;f] ->
    [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  apply trans_eq with (m := [c;d]).
  apply eq1.
  apply eq2.
Qed.

Example trans_eq_exercise : forall( n m o p : nat),
    m = (minustwo o) ->
    (n + p) = m ->
    (n + p) = (minustwo o).
Proof.
  intros n m o p eq1 eq2.
  symmetry.

  apply trans_eq with (m := m).
  symmetry. apply eq1.
  symmetry. apply eq2.
Qed.

Example inversion_ex3 :forall (X:Type) (x y z: X) (l j : list X),
    x :: y :: l = z :: j ->
    y :: l = x :: j ->
    x = y.
Proof.
  intros x y z l j h1 h2 h3.
  inversion h3.
  reflexivity.
Qed.

Theorem beq_nat_0_l : forall n,
    beq_nat 0 n = true -> n = 0.
Proof.
  intros n.
  destruct n as [| n'].
  reflexivity.
  simpl.
  intros H.
  inversion H.
Qed.

Theorem inversion_ex4 : forall (n : nat),
    S n = 0 ->
    2 + 2 = 5.
Proof.
  intros n contra.
  inversion contra.
Qed.

Example inversion_ex6 : forall ( X : Type)
                               ( x y z : X) (l j : list X),
    x :: y :: l = [] ->
    y :: l = z :: j ->
    x = z.
Proof.
  intros X x y z l j h1.
  inversion h1.
Qed.

(* Some utility definitions
   to help me understand `inversion`
 *)

Inductive my_func :=
| PrintFunc
| ExitFunc.

Inductive my_flag :=
| ActiveFlag
| InactiveFlag.

Inductive my_stat :=
| MyCall : my_func -> my_stat
| MyBlock : (list my_stat) -> my_stat
| MyConditional : my_flag -> my_stat -> my_stat -> my_stat.

Check MyBlock [(MyCall PrintFunc);
                 (MyConditional
                    ActiveFlag
                    (MyCall PrintFunc)
                    (MyCall ExitFunc)
              )].

Theorem invoked_tested : forall (x y : my_func) (f : my_flag) (e : my_stat),
    (MyConditional ActiveFlag  (MyCall x) e) = (MyConditional ActiveFlag (MyCall y) e) -> x = y.
Proof.
  intros x y f e H1.
  inversion H1.
  reflexivity.
Qed.

Inductive my_option {X:Type} : Type :=
| my_some : X -> my_option
| my_none : my_option.

Fixpoint invoked_function (stat : my_stat) : (my_option ) :=
  match stat with
  | MyCall func => my_some func
  | MyBlock _ => my_none (* Don't know if you can create
                            mutually recursive function *)
  | MyConditional ActiveFlag then_stat _ => invoked_function then_stat| MyConditional InactiveFlag _ else_stat  => invoked_function else_stat
  end.

Theorem invoked_active : forall (x : my_flag) (s1 s2 : my_stat),
    x = ActiveFlag ->
       invoked_function (MyConditional x s1 s2) = invoked_function  s1.
Proof.
  intros x s1 s2 H1.
(*
  rewrite H1.
  simpl.
  reflexivity. *)
  inversion H1.
  reflexivity.
Qed.

Theorem silly3 : forall (n : nat),
    (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
    true = beq_nat n 5 ->
    true = beq_nat (S (S n)) 7.
Proof.
  intros n eq H.
  symmetry in H.
  apply eq in H.
  symmetry in H.
  apply H.
Qed.

Theorem plus_n_n_eq_zero : forall n : nat,
    n + n = 0 -> n = 0.
Proof.
  intros n.
  induction n.
  {
    simpl.
    intros H1.
    reflexivity.
  }
  {
    intros H1.
    inversion H1.

  }
Qed.

Theorem plus_n_n_injective1 : forall n m,
    n + n = m + m ->
    n = m.
Proof.
  intros n.
  induction n as [| n' ].
  {
    simpl .
    intros m H.
    symmetry.
    rewrite H.
    destruct m.
    - reflexivity.
    - inversion H.
  }
  {
    intros m H2.

    induction m.
    {
      inversion H2.

    }
    {
      inversion H2.
      rewrite <- plus_n_Sm in H0.
      rewrite <- plus_n_Sm in H0.
      inversion H0.

      apply IHn' in H1.
      rewrite H1.

      reflexivity.
    }
  }
Qed.

Definition double(x : nat) := x + x.

Compute double(10).

Theorem f_equal : forall (A B : Type) (f: A -> B) (x y : A),
    x = y -> f x = f y.
Proof.
  intros A B f x y eq.
  rewrite eq.
  reflexivity.
Qed.

Theorem beq_nat_true : forall n m,
    beq_nat n m = true -> n = m.
Proof.
  intros n. (* m H.*)
  induction n.
  {
    intros m H.
    destruct m.
    - reflexivity.
    - inversion H.
  }
  {
    simpl.
    destruct m.
    {
      simpl.
      intros H.
      inversion H.
    }
    {
      simpl.
      intros H.
      apply f_equal.

      apply IHn.
      apply H.

    }

  }
Qed.

(* need to go back to "Varying the Induction Hypothesis"  *)
Theorem nth_error_after_last : forall (n : nat) (X : Type) (l : list X),
    length l = n -> nth_error l n = None.
Proof.
  intros n t l h1.
  generalize dependent n.
  induction l.
  {
    simpl.
    reflexivity.
  }
  {
    intros n h2.
    simpl in h2.
    symmetry in h2.
    rewrite h2.
    simpl.
    rewrite IHl.
    reflexivity.
    reflexivity.
}
Qed.

(* **********************  *)

Definition square n := n * n.

Compute square 2.

(* destruct on compounds *)

(*
Theorem  combine_split : forall X Y (l : list (X * Y)) l1 l2,
     split l = (l1, l2) ->
    combine l1 l2 = l.
Proof.
  intros X Y l l1 l2.
  intros P.

  induction l.
  {
    simpl.
    inversion P.
    simpl.
    reflexivity.
  }
  {
    inversion P.

    apply IHl.
    rewrite <- H0.
    rewrite <-   P in H0.
  }

  simpl in P.

Qed.
 p
 *)

Theorem  combine_parts : forall X Y (l : list (X * Y)) l1 l2 (v : (X * Y)) (x1 : X) (y1 : Y),
    (v :: l) = combine (x1 :: l1) (y1 :: l2) ->
    (v :: l) = (x1 , y1) :: (combine l1 l2).
Proof.
  intros xt yt lt l1t l2t vt x1t y1t.
  simpl.
  intros H.
  apply H.

Qed.

Theorem  combine_parts2 : forall X Y (l : list (X * Y)) l1 l2 (v : (X * Y)) (x1 : X) (y1 : Y),
    (v :: l) = (x1 , y1) :: (combine l1 l2) ->
    (v :: l) = combine (x1 :: l1) (y1 :: l2) .

Proof.
  intros xt yt lt l1t l2t vt x1t y1t.
  simpl.
  intros H.
  apply H.

Qed.

Compute split [(1,2)].
Compute split ([] : list(nat * nat)).
Compute combine ([] : list(nat)) ([] : list( nat)).

(*
Lemma split_empty : forall X Y (l : list (X * Y)) o,
    split l = ([], o) -> l = [].
Proof.
  intros X Y l o.

  induction l.

  { reflexivity. }
  { intros H. inversion H.
    re
  simpl.

Qed.
*)

Definition left { X Y :Type } (t : (X*Y)) :=
  match t with
  | (x, _) => x
  end.

Definition right { X Y :Type } (t : (X*Y)) :=
  match t with
  | (_, x) => x
  end.

Lemma split_parts2 : forall X Y (l : list (X * Y)) l1 l2,
    split l = (l1 ,l2) -> l2 = right (split l).
Proof.
  intros X Y l l1 l2 H .
  rewrite H.

  reflexivity.
Qed.

Lemma split_cons : forall X Y (l : list (X * Y))  (x : (X*Y)),
    split (((left x), (right x)) :: l) = (((left x)::(left (split l))), ((right x)::(right (split l)))).
Proof.
  intros X Y l x.
  simpl.

  destruct (split l).
  - simpl. reflexivity.
Qed.

Lemma split_parts : forall X Y (l : list (X * Y)) l1 l2,
    split l = (l1 ,l2) -> l1 = left (split l).
Proof.
  intros X Y l l1 l2.
  induction l.
  {
    simpl.
    intros H.
    inversion H.
    reflexivity.
  }
  {
    intros H.
    rewrite H.
    simpl.
    reflexivity.
  }
Qed.
(*
Theorem combine_uni : forall X Y (l : list (X * Y)) (x : X) (y : Y),
    combine (left (split l)) (right (split l)) = l.
Proof.
  intros X Y l x y.
  induction l.
  { simpl.
    reflexivity.
  }
  {
    destruct  (x0 :: l).
    - simpl. reflexivity.
    - simpl.
    unfold combine.
    unfold right.
    unfold left.
     simpl.
  }

 *)

Lemma pairs_left_right : forall X Y (x : (X*Y)),
    x = (left x, right x).
Proof.
  intros X Y x.
  destruct x.
  - simpl. reflexivity.
Qed.

Theorem  combine_split : forall X Y (l : list (X * Y)) l1 l2,
     split l = (l1, l2) ->
    combine l1 l2 = l.
Proof.
  intros X Y l l1 l2.
  generalize dependent l1.
  generalize dependent l2.

  induction l.
  {
    simpl.
    intros H H2 H3.
    inversion H3.
    simpl.
    reflexivity.
  }
  {
    intros l2 l1.
    intros H.
    assert(HRight : l2 = right (split (x::l))).
    {
      apply split_parts2  in H.
      apply H.
    }
    assert(HLeft : l1 = left (split (x::l))).
    {
      apply split_parts  in H.
      apply H.
    }

    rewrite HRight.
    rewrite HLeft.

    assert (HLR : x = ((left x),(right x))).
    {
      simpl.
      destruct x.
      - simpl. reflexivity.
    }

    rewrite HLR.
    rewrite split_cons.

    simpl.

    rewrite IHl.
    reflexivity.

    rewrite <-  pairs_left_right.

    reflexivity.

    }
Qed.

Theorem i_f : forall ( f: bool -> bool) ( x  y: bool),
    x = y -> f x = f y.
Proof.
  intros.
  inversion H.
  reflexivity.
Qed.

Theorem bool_fn_applied_thrice :
  forall(f : bool -> bool) ( b : bool ) ,
  f( f ( f b)) = f b.
Proof.
  intros.

  destruct b eqn:H1.
  destruct (f true) eqn:H2.
  rewrite H2.
  rewrite H2.
  reflexivity.
  destruct (f false) eqn:H3.
  rewrite H2.
  reflexivity.
  rewrite H3.
  reflexivity.
  destruct (f false) eqn:H4.
  destruct (f true) eqn:H5.
  rewrite H5.
  reflexivity.
  rewrite H4.
  reflexivity.
  rewrite H4.
  rewrite H4.
  reflexivity.
Qed.

Theorem beq_nat_sym : forall (n m : nat),
    beq_nat n m = beq_nat m n.
Proof.
  induction n .
  {
    intros m.
    induction m.
    {
      reflexivity.
    }
    {
      simpl.
      reflexivity.
    }
  }
  {
    intros m.
    induction m.
    {
      simpl.
      reflexivity.
    }
    {
      simpl.
      apply IHn.
    }

  }
Qed.

Theorem beq_nat_trans : forall n m p,
    beq_nat n m = true ->
    beq_nat m p = true ->
    beq_nat n p = true.
Proof.
  intros n m p H H2.

  rewrite beq_nat_sym in H.
  assert (H3 : n = m).
  apply beq_nat_true.
  rewrite beq_nat_sym in H.
  rewrite <- H.
  reflexivity.
  rewrite H3.
  apply H2.
Qed.

Compute length [1;2;3].

Definition split_combine_statement : Prop :=
  forall X Y (l1 : list(X)) (l2 : list(Y)),
     length l1 = length l2 ->
     split (combine l1 l2) = (l1, l2).

Theorem split_combine : split_combine_statement.
Proof.
  intros X Y .
  induction l1.
  {
    intros l2.
    simpl.
    destruct l2.
    - simpl. reflexivity.
    - simpl. intros H2. inversion H2.
   }
  {
    intros l2.
    intros H2.
    simpl in H2.

    destruct l2.
    - simpl. inversion H2.
    - simpl in H2. simpl. rewrite IHl1. reflexivity.
      inversion H2.
      reflexivity.

  }

Qed.

(*
Lemma filter_append : forall (X : Type) (test : X -> bool)
                             (x : X) (l lf l3 l4 : list X),
    filter test (app l3 app([x] l4))  = x :: lf -> test x = true.
Proof.
Qed.
*)

Theorem filter_excercise : forall (X : Type) (test : X -> bool)
                                  (x : X) (l lf : list X),
    filter test l = x :: lf -> test x = true.
Proof.
  intros X test x l lf.

  induction l.
  {
    simpl.

    intros  H.
    inversion H.
  }
  {
    simpl.
    intros H4.
    assert ((test x0 = true) -> (x0 = x)).
    intros H3.
    rewrite H3 in H4.
    inversion H4.
    reflexivity.

    destruct (test x0) eqn: HD.
    {
      simpl in  H.
      inversion H4.
      rewrite <- H1.
      rewrite HD.
      reflexivity.
    }
    {

      inversion H4.

      apply IHl.
      apply H1.
    }
  }

Qed.

Theorem filter_excercise_2 : forall (X : Type) (test : X -> bool)
                                  (x : X) (l lf : list X),
    filter test l = x :: lf -> test x = true.
Proof.
  intros X test x l lf.

  induction l.
  {
    simpl.

    intros  H.
    inversion H.
  }
  {
    simpl.
    intros H4.

    destruct (test x0) eqn: HD.
    {
      inversion H4.
      rewrite <- H0.
      rewrite HD.
      reflexivity.
    }
    {
      inversion H4.
      apply IHl.
      apply H0.
    }
  }

Qed.

Fixpoint forallb  { X  :Type } (f : X -> bool) (l : list X) :=
  match l with
  | (x::r) => andb (f x) (forallb f r)
  | _ => true
  end.

Compute (forallb oddb [1;2;3]).
Compute (forallb oddb [11;23;3]).
Compute (forallb negb [false;false]).

Fixpoint existsb  { X  :Type } (f : X -> bool) (l : list X) :=
  match l with
  | (x::r) => orb (f x) (existsb f r)
  | _ => false
  end.

Compute (existsb  (beq_nat 5)  [1;2;3]).
Compute (existsb (andb true) [true;true;false]).
Compute (existsb oddb [1;0;0;0;0;3] ).

Definition existsb' { X  :Type } (f : X -> bool) (l : list X) :=
  negb (forallb (fun k => negb (f k)) l).

Compute (existsb'  (beq_nat 5)  [1;2;3]).
Compute (existsb' (andb true) [true;true;false]).
Compute (existsb' oddb [1;0;0;0;0;3] ).

Theorem existsb_existsb' : forall (X : Type) (l : list X) (f : X -> bool),
    existsb' f l = existsb f l.
Proof.
  intros X l f.
  induction l.
  {
    simpl.
    unfold existsb'.
    unfold forallb.
    simpl.
    reflexivity.
  }
  {

    unfold existsb'.
(*    unfold existsb.*)
    destruct (f x) eqn: H2.
    { simpl.
      rewrite H2.
      simpl.
      reflexivity.
    }
    {
      simpl.
      rewrite H2.
      simpl.
      unfold existsb' in IHl.
      apply IHl.

    }

  }

Qed.