(*the following is the example of Lee's ENTCS 264(2010)*)

Require Import IA.
Require Import parser.

Definition TS:IA := parse
"IA [s1,s2,s3,s4,s5,s6,s7] (s1) [acceptT,endT,newT,endM,startM] [startT,logM] []
[s1->(acceptT)s1, s1->(newT)s2, s1->(startM)s4, s2->(startT)s3, s3->(endT)s1,
s4->(endM)s1, s4->(newT)s5, s5->(startT)s6, s6->(endT)s7, s7->(logM)s4]".

Definition TPU:IA :=parse
"IA [t1,t2,t3,t4] (t1) [startT] [nOk,ok,logF,endT] []
[t1->(startT)t2, t2->(ok)t3, t2->(nOk)t4, t4->(logF)t3, t3->(endT)t1]".

Eval compute in :> (IAutomaton.IAProd TS TPU).
Eval compute in IAutomaton.b_compatible TS TPU.
Definition tmpIA: IA := IAutomaton.composition TS TPU.
Eval compute in :> tmpIA.

Definition Sup:IA := parse
"IA [u1,u2,u3,u4,u5] (u1) [logF,mOn,logM] [startM,endM] []
[u1->(logF)u1, u1->(mOn)u2, u2->(startM)u3, u3->(logM)u3,
u3->(logF)u4, u4->(logM)u5, u5->(endM)u1]".

Eval compute in (IAutomaton.b_compatible tmpIA Sup).
Eval compute in :> (IAutomaton.composition tmpIA Sup).


Notation "'sigma' x .. y , p" :=
  (sigT (fun x => .. (sigT (fun y => p)) ..))
  (at level 200, x binder, y binder, right associativity) : type_scope.

Notation "A & B" := (prod A B) (at level 100, right associativity) : type_scope.

Definition Prod_Pr1 (A B : Type) (p : A * B) : A := match p with pair x y => x end.
Definition Prod_Pr2 (A B : Type) (p : A * B) : B := match p with pair x y => y end.

Definition Correspondence A B :=
  (A -> B) & (B -> A).

Notation "A <--> B" := (Correspondence A B) (at level 101, right associativity): type_scope.

Definition Decidable P :=
  ((P) + (P -> Empty_set))%type.

Notation "A == B" := (identity A B) (at level 100, no associativity).

Notation "'not' A" := (A -> Empty_set) (at level 100, no associativity).

Definition DeMorganConj (P Q : Type) (p : Decidable P) (q : Decidable Q)
  (f : not (P & Q)) : (not P) + (not Q) :=
match p with
| inl _ x =>
  match q with
  | inl _ y => inl (not Q) (fun z : P => f (x, y))
  | inr _ y => inr _ y
  end
| inr _ x =>
  match q with
  | inl _ y => inl _ x
  | inr _ y => inl _ x
  end
end.

Definition DeMorganDisj (P Q : Type) (p : Decidable P) (q : Decidable Q)
  (f : (not P) + (not Q)) : not (P & Q) :=
match p with
| inl _ x =>
  match q with
  | inl _ y =>
      match f with
      | inl _ z => (fun w => z x)
      | inr _ z => (fun w => z y)
      end
  | inr _ y => fun w => y (snd w)
  end
| inr _ x =>
  match q with
  | inl _ y => fun w => x (fst w)
  | inr _ y => fun w => x (fst w)
  end
end.

Lemma DeMorgan (P Q : Type) (p : Decidable P) (q : Decidable Q):
  ((not P) + (not Q)) <--> not (P & Q).
split. apply DeMorganDisj; assumption. apply DeMorganConj; assumption.
Defined.

Record IsEquivalence {A : Type} (eq: A -> A -> Type) := {
  Equivalence_Reflexivity: forall a : A, eq a a;
  Equivalence_Symmetry: forall a b : A, eq a b -> eq b a;
  Equivalence_Transitivity: forall a b c : A, eq a b -> eq b c -> eq a c;
}.

Definition IdentityIsEquivalence {A: Type}: IsEquivalence (@identity A).
apply Build_IsEquivalence; intuition.
rewrite H; assumption.
Defined.

Lemma NatSucc :
  forall a b: nat, a == b <--> S a == S b.
intros. split.
- intros. rewrite H. reflexivity.
- intros. injection H. intuition.
Defined.

Lemma NatIdentityDecidable :
  forall a b: nat, Decidable (a == b).
unfold Decidable.
induction a.
intros.
induction b.
  left. reflexivity.
  right. discriminate.
induction b.
- right. discriminate.
- destruct (IHa b).
  + left. rewrite i. reflexivity.
  + right. intros. apply e. apply NatSucc. assumption.
Defined.

Inductive LessThanOrEqual : nat -> nat -> Type :=
| LessThanOrEqualRefl : forall n, LessThanOrEqual n n
| LessThanOrEqualSucc : forall n m, LessThanOrEqual n m -> LessThanOrEqual n (S m).

Definition IsLeast (n : nat) : Type := forall m : nat, LessThanOrEqual n m.

Lemma ZeroIsUnique:
  forall n : nat, IsLeast n -> n == 0.
unfold IsLeast.
intros.
specialize (H 0).
inversion H.
reflexivity.
Defined.

Lemma ZeroIsLeast : IsLeast 0.
unfold IsLeast.
induction m.
- apply LessThanOrEqualRefl.
- apply LessThanOrEqualSucc. assumption.
Defined.

Lemma ZeroIsTheLeast:
  forall n : nat, LessThanOrEqual 0 n & (LessThanOrEqual n 0 -> n == 0).
intros. split.
- apply ZeroIsLeast.
- intros. induction n. reflexivity. inversion H.
Defined.

Lemma LessThanOrEqualS1 :
  forall n m: nat, LessThanOrEqual n m -> LessThanOrEqual (S n) (S m).
intros. induction n.
  + induction m.
    * apply LessThanOrEqualRefl.
    * apply LessThanOrEqualSucc. apply IHm. inversion H. assumption.
  + induction m.
    * apply ZeroIsTheLeast in H. discriminate H.
    * inversion H. apply LessThanOrEqualRefl.
      apply LessThanOrEqualSucc. apply IHm. assumption.
      intros. assumption.
Defined.

Lemma LessThanOrEqualS2 :
  forall n m: nat, LessThanOrEqual (S n) (S m) -> LessThanOrEqual n m.
induction n.
+ induction m.
  * intros. apply LessThanOrEqualRefl.
  * intros. apply ZeroIsTheLeast.
+ induction m.
  * intros. inversion H. apply ZeroIsTheLeast in H2. discriminate H2.
  * intros.
    inversion H. apply LessThanOrEqualRefl.
    apply LessThanOrEqualSucc. apply IHm. assumption.
Defined.

Lemma LessThanOrEqualPreservedBySucc:
  forall n m: nat, LessThanOrEqual n m <--> LessThanOrEqual (S n) (S m).
intros. split. apply LessThanOrEqualS1. apply LessThanOrEqualS2. Defined.

Lemma LessThanOrEqualSubstract:
  forall n m: nat, LessThanOrEqual (S n) m -> LessThanOrEqual n m.
induction n.
- induction m.
  + intros. apply LessThanOrEqualRefl.
  + intros. apply ZeroIsTheLeast.
- induction m.
  + intros. apply ZeroIsTheLeast in H. discriminate H.
  + intros. apply (LessThanOrEqualPreservedBySucc n m). apply IHn.
    apply LessThanOrEqualPreservedBySucc. assumption.
Defined.

Lemma LessThanOrEqualDecidable :
  forall n m : nat, Decidable (LessThanOrEqual n m).
unfold Decidable.
induction n.
- intros. left. apply ZeroIsTheLeast.
- induction m.
  + right. intros. apply ZeroIsTheLeast in H. discriminate H.
  + destruct (IHn m).
    * left. apply LessThanOrEqualPreservedBySucc in l. assumption.
    * right. intros. apply e. apply LessThanOrEqualPreservedBySucc. assumption.
Defined.

Lemma PositiveIsNotLessThanOrEqualToZero:
  forall n: nat, LessThanOrEqual (S n) 0 -> Empty_set.
intros. apply ZeroIsTheLeast in H. discriminate.
Defined.

Lemma LessThanOrEqualAntisymmetry:
  forall n m: nat,
  LessThanOrEqual n m ->
  LessThanOrEqual m n -> n == m.
induction n.
- induction m.
  + intuition.
  + intros. apply ZeroIsTheLeast in H0. discriminate H0.
- induction m.
  + intros. apply ZeroIsTheLeast in H. discriminate H.
  + intros.
    apply (NatSucc n m).
    apply IHn.
    * apply LessThanOrEqualPreservedBySucc. assumption.
    * apply LessThanOrEqualPreservedBySucc. assumption.
Defined.

Lemma LessThanOrEqualLinear:
  forall n m: nat, (LessThanOrEqual n m) + (LessThanOrEqual m n).
induction n.
- induction m.
  + left. apply LessThanOrEqualRefl.
  + left. apply ZeroIsTheLeast.
- induction m.
  + right. apply ZeroIsTheLeast.
  + destruct (IHn m).
    * left. apply (LessThanOrEqualPreservedBySucc n m). assumption.
    * right. apply (LessThanOrEqualPreservedBySucc m n). assumption.
Defined.

Lemma LessThanOrEqualTransitive:
  forall n m u,
    LessThanOrEqual n m -> LessThanOrEqual m u -> LessThanOrEqual n u.
induction n.
- induction m.
  + induction u.
    * trivial.
    * intros. apply ZeroIsTheLeast.
  + intros. apply ZeroIsTheLeast.
- induction m.
  + induction u.
    * intros. apply ZeroIsTheLeast in H. discriminate H.
    * intros. apply ZeroIsTheLeast in H. discriminate H.
  + induction u.
    * intros. apply ZeroIsTheLeast in H0. discriminate H0.
    * intros.
      apply (LessThanOrEqualPreservedBySucc n u).
      apply (IHn m u).
      apply (LessThanOrEqualPreservedBySucc n m). assumption.
      apply (LessThanOrEqualPreservedBySucc m u). assumption.
Defined.

Definition LessThan (a b : nat) := LessThanOrEqual (S a) b.

Lemma LessThanIrreflexive:
  forall n : nat, LessThanOrEqual (S n) n -> Empty_set.
induction n.
- intros. apply ZeroIsTheLeast in H. discriminate H.
- intros. apply IHn. apply LessThanOrEqualPreservedBySucc. assumption.
Defined.

Lemma LessThanOrEqualStrictlySmaller:
  forall n m, LessThanOrEqual n m -> ((n == m) -> Empty_set) -> LessThanOrEqual (S n) m.
intros.
inversion H. destruct H0. rewrite H2. reflexivity.
apply (LessThanOrEqualPreservedBySucc n m0). assumption.
Defined.

Lemma LessThanOrEqualInvert:
  forall n m: nat,
  (LessThanOrEqual n m -> Empty_set) -> (LessThanOrEqual m n & ((n == m) -> Empty_set)).
intros.
split.
- destruct (LessThanOrEqualLinear n m). contradiction. assumption.
- intros. apply H. rewrite H0. apply LessThanOrEqualRefl.
Defined.

Lemma DeconstructLessThanOrEqual:
  forall n m : nat,
  LessThanOrEqual n m <--> (LessThan n m) + (n == m).
intros. split.
- intros. unfold LessThan.
  destruct (NatIdentityDecidable n m).
  + right. assumption.
  + left. apply LessThanOrEqualStrictlySmaller; assumption.
- intros. unfold LessThan in H. destruct H.
  + apply LessThanOrEqualSubstract. assumption.
  + rewrite i. apply LessThanOrEqualRefl.
Defined.

Lemma LessThanInvert:
  forall n m, (not (LessThan n m)) -> LessThanOrEqual m n.
unfold LessThan.
intros.
apply LessThanOrEqualInvert in H.
destruct H.
inversion l.
- rewrite H0 in e. contradiction.
- assumption.
Defined.

Lemma LessThanZeroFalse:
  forall n, not (LessThan n 0).
intros. unfold LessThan in H. apply ZeroIsTheLeast in H. discriminate H.
Defined.

Lemma LessThanDecidable:
  forall n m, Decidable (LessThan n m).
unfold LessThan. intros. apply LessThanOrEqualDecidable.
Defined.


(*************************************************************)
(*      This file is distributed under the terms of the      *)
(*      GNU Lesser General Public License Version 2.1        *)
(*************************************************************)
(*    Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr      *)
(*************************************************************)

(***********************************************************************
      UList.v

      Definition of list with distinct elements

      Definition: ulist
************************************************************************)
Require Import List.
Require Import Arith.
Require Import Permutation.
Require Import ListSet.

Section UniqueList.
Variable A : Set.
Variable eqA_dec : forall (a b : A),  ({ a = b }) + ({ a <> b }).
(* A list is unique if there is not twice the same element in the list *)

Inductive ulist : list A ->  Prop :=
  ulist_nil: ulist nil
 | ulist_cons: forall a l, ~ In a l -> ulist l ->  ulist (a :: l) .
Hint Constructors ulist .
(* Inversion theorem *)

Theorem ulist_inv: forall a l, ulist (a :: l) ->  ulist l.
intros a l H; inversion H; auto.
Qed.
(* The append of two unique list is unique if the list are distinct *)

Theorem ulist_app:
 forall l1 l2,
 ulist l1 ->
 ulist l2 -> (forall (a : A), In a l1 -> In a l2 ->  False) ->  ulist (l1 ++ l2).
intros L1; elim L1; simpl; auto.
intros a l H l2 H0 H1 H2; apply ulist_cons; simpl; auto.
red; intros H3; case in_app_or with ( 1 := H3 ); auto; intros H4.
inversion H0; auto.
apply H2 with a; auto.
apply H; auto.
apply ulist_inv with ( 1 := H0 ); auto.
intros a0 H3 H4; apply (H2 a0); auto.
Qed.
(* Iinversion theorem the appended list *)

Theorem ulist_app_inv:
 forall l1 l2 (a : A), ulist (l1 ++ l2) -> In a l1 -> In a l2 ->  False.
intros l1; elim l1; simpl; auto.
intros a l H l2 a0 H0 [H1|H1] H2.
inversion H0 as [|a1 l0 H3 H4 H5]; auto.
case H3; rewrite H1; auto with datatypes.
apply (H l2 a0); auto.
apply ulist_inv with ( 1 := H0 ); auto.
Qed.
(* Iinversion theorem the appended list *)

Theorem ulist_app_inv_l: forall (l1 l2 : list A), ulist (l1 ++ l2) ->  ulist l1.
intros l1; elim l1; simpl; auto.
intros a l H l2 H0.
inversion H0 as [|il1 iH1 iH2 il2 [iH4 iH5]]; apply ulist_cons; auto.
intros H5; case iH2; auto with datatypes.
apply H with l2; auto.
Qed.
(* Iinversion theorem the appended list *)

Theorem ulist_app_inv_r: forall (l1 l2 : list A), ulist (l1 ++ l2) ->  ulist l2.
intros l1; elim l1; simpl; auto.
intros a l H l2 H0; inversion H0; auto.
Qed.
(* Uniqueness is decidable *)

Definition ulist_dec: forall l,  ({ ulist l }) + ({ ~ ulist l }).
intros l; elim l; auto.
intros a l1 [H|H]; auto.
case (In_dec eqA_dec a l1); intros H2; auto.
right; red; intros H1; inversion H1; auto.
right; intros H1; case H; apply ulist_inv with ( 1 := H1 ).
Defined.
(* Uniqueness is compatible with permutation *)

Theorem ulist_perm:
 forall (l1 l2 : list A), permutation l1 l2 -> ulist l1 ->  ulist l2.
intros l1 l2 H; elim H; clear H l1 l2; simpl; auto.
intros a l1 l2 H0 H1 H2; apply ulist_cons; auto.
inversion_clear H2 as [|ia il iH1 iH2 [iH3 iH4]]; auto.
intros H3; case iH1;
 apply permutation_in with ( 1 := permutation_sym _ _ _ H0 ); auto.
inversion H2; auto.
intros a b L H0; apply ulist_cons; auto.
inversion_clear H0 as [|ia il iH1 iH2]; auto.
inversion_clear iH2 as [|ia il iH3 iH4]; auto.
intros H; case H; auto.
intros H1; case iH1; rewrite H1; simpl; auto.
apply ulist_cons; auto.
inversion_clear H0 as [|ia il iH1 iH2]; auto.
intros H; case iH1; simpl; auto.
inversion_clear H0 as [|ia il iH1 iH2]; auto.
inversion iH2; auto.
Qed.

Theorem ulist_def:
 forall l a,
 In a l -> ulist l ->  ~ (exists l1 , permutation l (a :: (a :: l1)) ).
intros l a H H0 [l1 H1].
absurd (ulist (a :: (a :: l1))); auto.
intros H2; inversion_clear H2; simpl; auto with datatypes.
apply ulist_perm with ( 1 := H1 ); auto.
Qed.

Theorem ulist_incl_permutation:
 forall (l1 l2 : list A),
 ulist l1 -> incl l1 l2 ->  (exists l3 , permutation l2 (l1 ++ l3) ).
intros l1; elim l1; simpl; auto.
intros l2 H H0; exists l2; simpl; auto.
intros a l H l2 H0 H1; auto.
case (in_permutation_ex _ a l2); auto with datatypes.
intros l3 Hl3.
case (H l3); auto.
apply ulist_inv with ( 1 := H0 ); auto.
intros b Hb.
assert (H2: In b (a :: l3)).
apply permutation_in with ( 1 := permutation_sym _ _ _ Hl3 );
 auto with datatypes.
simpl in H2 |-; case H2; intros H3; simpl; auto.
inversion_clear H0 as [|c lc Hk1]; auto.
case Hk1; subst a; auto.
intros l4 H4; exists l4.
apply permutation_trans with (a :: l3); auto.
apply permutation_sym; auto.
Qed.

Theorem ulist_eq_permutation:
 forall (l1 l2 : list A),
 ulist l1 -> incl l1 l2 -> length l1 = length l2 ->  permutation l1 l2.
intros l1 l2 H1 H2 H3.
case (ulist_incl_permutation l1 l2); auto.
intros l3 H4.
assert (H5: l3 = @nil A).
generalize (permutation_length _ _ _ H4); rewrite length_app; rewrite H3.
rewrite plus_comm; case l3; simpl; auto.
intros a l H5; absurd (lt (length l2) (length l2)); auto with arith.
pattern (length l2) at 2; rewrite H5; auto with arith.
replace l1 with (app l1 l3); auto.
apply permutation_sym; auto.
rewrite H5; rewrite app_nil_end; auto.
Qed.

Theorem ulist_incl_length:
 forall (l1 l2 : list A), ulist l1 -> incl l1 l2 ->  le (length l1) (length l2).
intros l1 l2 H1 Hi; case ulist_incl_permutation with ( 2 := Hi ); auto.
intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto.
rewrite length_app; simpl; auto with arith.
Qed.

Theorem ulist_incl2_permutation:
 forall (l1 l2 : list A),
 ulist l1 -> ulist l2 -> incl l1 l2 -> incl l2 l1  ->  permutation l1 l2.
intros l1 l2 H1 H2 H3 H4.
apply ulist_eq_permutation; auto.
apply le_antisym; apply ulist_incl_length; auto.
Qed.

Theorem ulist_incl_length_strict:
 forall (l1 l2 : list A),
 ulist l1 -> incl l1 l2 -> ~ incl l2 l1 ->  lt (length l1) (length l2).
intros l1 l2 H1 Hi Hi0; case ulist_incl_permutation with ( 2 := Hi ); auto.
intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto.
rewrite length_app; simpl; auto with arith.
generalize Hl3; case l3; simpl; auto with arith.
rewrite <- app_nil_end; auto.
intros H2; case Hi0; auto.
intros a HH; apply permutation_in with ( 1 := H2 ); auto.
intros a l Hl0; (rewrite plus_comm; simpl; rewrite plus_comm; auto with arith).
Qed.

Theorem in_inv_dec:
 forall (a b : A) l, In a (cons b l) ->  a = b \/ ~ a = b /\ In a l.
intros a b l H; case (eqA_dec a b); auto; intros H1.
right; split; auto; inversion H; auto.
case H1; auto.
Qed.

Theorem in_ex_app_first:
 forall (a : A) (l : list A),
 In a l ->
  (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) /\ ~ In a l1  ).
intros a l; elim l; clear l; auto.
intros H; case H.
intros a1 l H H1; auto.
generalize (in_inv_dec _ _ _ H1); intros [H2|[H2 H3]].
exists (nil (A:=A)); exists l; simpl; split; auto.
subst; auto.
case H; auto; intros l1 [l2 [Hl2 Hl3]]; exists (a1 :: l1); exists l2; simpl;
 split; auto.
subst; auto.
intros H4; case H4; auto.
Qed.

Theorem ulist_inv_ulist:
 forall (l : list A),
 ~ ulist l ->
  (exists a ,
   exists l1 ,
   exists l2 ,
   exists l3 , l = l1 ++ ((a :: l2) ++ (a :: l3)) /\ ulist (l1 ++ (a :: l2))    ).
intros l; elim l  using list_length_ind; clear l.
intros l; case l; simpl; auto; clear l.
intros Rec H0; case H0; auto.
intros a l H H0.
case (In_dec eqA_dec a l); intros H1; auto.
case in_ex_app_first with ( 1 := H1 ); intros l1 [l2 [Hl1 Hl2]]; subst l.
case (ulist_dec l1); intros H2.
exists a; exists (@nil A); exists l1; exists l2; split; auto.
simpl; apply ulist_cons; auto.
case (H l1); auto.
rewrite length_app; auto with arith.
intros b [l3 [l4 [l5 [Hl3 Hl4]]]]; subst l1.
exists b; exists (a :: l3); exists l4; exists (l5 ++ (a :: l2)); split; simpl;
 auto.
(repeat (rewrite <- ass_app; simpl)); auto.
apply ulist_cons; auto.
contradict Hl2; auto.
replace (l3 ++ (b :: (l4 ++ (b :: l5)))) with ((l3 ++ (b :: l4)) ++ (b :: l5));
 auto with datatypes.
(repeat (rewrite <- ass_app; simpl)); auto.
case (H l); auto; intros a1 [l1 [l2 [l3 [Hl3 Hl4]]]]; subst l.
exists a1; exists (a :: l1); exists l2; exists l3; split; auto.
simpl; apply ulist_cons; auto.
contradict H1.
replace (l1 ++ (a1 :: (l2 ++ (a1 :: l3))))
     with ((l1 ++ (a1 :: l2)) ++ (a1 :: l3)); auto with datatypes.
(repeat (rewrite <- ass_app; simpl)); auto.
Qed.

Theorem incl_length_repetition:
 forall (l1 l2 : list A),
 incl l1 l2 ->
 lt (length l2) (length l1) ->
  (exists a ,
   exists ll1 ,
   exists ll2 ,
   exists ll3 ,
   l1 = ll1 ++ ((a :: ll2) ++ (a :: ll3)) /\ ulist (ll1 ++ (a :: ll2))    ).
intros l1 l2 H H0; apply ulist_inv_ulist.
intros H1; absurd (le (length l1) (length l2)); auto with arith.
apply ulist_incl_length; auto.
Qed.

End UniqueList.
Implicit Arguments ulist [A].
Hint Constructors ulist .

Theorem ulist_map:
 forall (A B : Set) (f : A ->  B) l,
 (forall x y, (In x l) -> (In y l) ->  f x = f y ->  x = y) -> ulist l ->  ulist (map f l).
intros a b f l Hf Hl; generalize Hf; elim Hl; clear Hf;  auto.
simpl; auto.
intros a1 l1 H1 H2 H3 Hf; simpl.
apply ulist_cons; auto with datatypes.
contradict H1.
case in_map_inv with ( 1 := H1 ); auto with datatypes.
intros b1 [Hb1 Hb2].
replace a1 with b1; auto with datatypes.
Qed.

Theorem ulist_list_prod:
 forall (A : Set) (l1 l2 : list A),
 ulist l1 -> ulist l2 ->  ulist (list_prod l1 l2).
intros A l1 l2 Hl1 Hl2; elim Hl1; simpl; auto.
intros a l H1 H2 H3; apply ulist_app; auto.
apply ulist_map; auto.
intros x y _ _ H; inversion H; auto.
intros p Hp1 Hp2; case H1.
case in_map_inv with ( 1 := Hp1 ); intros a1 [Ha1 Ha2]; auto.
case in_list_prod_inv with ( 1 := Hp2 ); intros b1 [c1 [Hb1 [Hb2 Hb3]]]; auto.
replace a with b1; auto.
rewrite Ha2 in Hb1; injection Hb1; auto.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

Inductive natural : Type := Succ : natural -> natural |  Zero : natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

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 rev (rev_arg0 : lst) : lst
           := match rev_arg0 with
              | Nil => Nil
              | Cons x y => append (rev y) (Cons x Nil)
              end.

Fixpoint qreva (qreva_arg0 : lst) (qreva_arg1 : lst) : lst
           := match qreva_arg0, qreva_arg1 with
              | Nil, x => x
              | Cons z x, y => qreva x (Cons z y)
              end.

Lemma append_assoc : forall (x y z : lst), append (append x y) z = append x (append y z).
Proof.
   intros.
   induction x.
   - simpl. rewrite IHx. reflexivity.
   - reflexivity.
Qed.

Lemma append_nil : forall (x : lst), append x Nil = x.
Proof.
   intros.
   induction x.
   - simpl. rewrite IHx. reflexivity.
   - reflexivity.

Qed.

Lemma qreva_nil : forall (x y : lst), qreva x y = append (qreva x Nil) y.
Proof.
   intro.
   induction x.
   - intros. simpl. rewrite IHx. rewrite (IHx (Cons n Nil)). rewrite append_assoc. reflexivity.
   - reflexivity.

Qed.

Lemma qreva_append : forall (x y : lst), qreva (append x y) Nil = append (qreva y Nil) (qreva x Nil).
Proof.
   intros.
   induction x.
   - simpl. rewrite qreva_nil. rewrite IHx. lfind. Admitted.


(* 6_mystery-functions.v *)
(* FPP 2020 - YSC3236 2020-2021, Sem1 *)
(* Olivier Danvy <danvy@yale-nus.edu.sg> *)
(* Liu Zhang <zhangliu@u.yale-nus.edu.sg>*)
(* Version of 12 Sep 2020 *)

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

(* Paraphernalia: *)

Ltac fold_unfold_tactic name := intros; unfold name; fold name; reflexivity.

Require Import Arith Bool.

Notation "A =n= B" :=
  (beq_nat A B) (at level 70, right associativity).

Notation "A =b= B" :=
  (eqb A B) (at level 70, right associativity).

Compute (fst (2,3)).

Notation "A =p= B" :=
  (beq_nat (fst A) (fst B) && beq_nat (snd A) (snd B)) (at level 70, right associativity).

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

Definition specification_of_mystery_function_00 (mf : nat -> nat) :=
  mf 0 = 1 /\ forall i j : nat, mf (S (i + j)) = mf i + mf j.

(* ***** *)

Proposition there_is_at_most_one_mystery_function_00 :
  forall f g : nat -> nat,
    specification_of_mystery_function_00 f ->
    specification_of_mystery_function_00 g ->
    forall n : nat,
      f n = g n.
Proof.
Abort.

(* ***** *)

Definition unit_test_for_mystery_function_00a (mf : nat -> nat) :=
  (mf 0 =n= 1) (* etc. *).

Definition unit_test_for_mystery_function_00b (mf : nat -> nat) :=
  (mf 0 =n= 1) && (mf 1 =n= 2) (* etc. *).

Definition unit_test_for_mystery_function_00c (mf : nat -> nat) :=
  (mf 0 =n= 1) && (mf 1 =n= 2) && (mf 2 =n= 3) (* etc. *).

Definition unit_test_for_mystery_function_00d (mf : nat -> nat) :=
  (mf 0 =n= 1) && (mf 1 =n= 2) && (mf 2 =n= 3) && (mf 3 =n= 4)
  (* etc. *).

(* ***** *)

Definition mystery_function_00 := S.

Definition less_succinct_mystery_function_00 (n : nat) : nat :=
  S n.

Compute (unit_test_for_mystery_function_00d mystery_function_00).

Theorem there_is_at_least_one_mystery_function_00 :
  specification_of_mystery_function_00 mystery_function_00.
Proof.
  unfold specification_of_mystery_function_00, mystery_function_00.
  split.
  - reflexivity.
  - intros i j.
    rewrite -> (plus_Sn_m i (S j)).
    rewrite <- (plus_n_Sm i j).
    reflexivity.
Qed.

(* ***** *)

Definition mystery_function_00_alt := fun (n : nat) => n + 1.

Theorem there_is_at_least_one_mystery_function_00_alt :
  specification_of_mystery_function_00 mystery_function_00_alt.
Proof.
Abort.

(* ***** *)

Theorem soundness_of_the_unit_test_function_for_mystery_function_00 :
  forall mf : nat -> nat,
    specification_of_mystery_function_00 mf ->
    unit_test_for_mystery_function_00c mf = true.
Proof.
  unfold specification_of_mystery_function_00.
  unfold unit_test_for_mystery_function_00c.
  intros mf [H_O H_S].
  (* Goal: (mf 0 =n= 1) && (mf 1 =n= 2) && (mf 2 =n= 3) = true *)
  rewrite -> H_O.
  (* Goal: (1 =n= 1) && (mf 1 =n= 2) && (mf 2 =n= 3) = true *)
  rewrite -> (Nat.eqb_refl 1).
  (* Goal: true && (mf 1 =n= 2) && (mf 2 =n= 3) = true *)
  rewrite -> (andb_true_l (mf 1 =n= 2)).
  (* Goal: (mf 1 =n= 2) && (mf 2 =n= 3) = true *)
  (* etc. *)
  Check (Nat.add_1_l 0).
  rewrite <- (Nat.add_1_l 0) at 1.
  Check (plus_Sn_m 0 0).
  rewrite -> (plus_Sn_m 0 0).
  rewrite -> (H_S 0 0).
  rewrite -> H_O.
  rewrite -> (Nat.add_1_l 1).
  Check (Nat.eqb_refl 2).
  rewrite -> (Nat.eqb_refl 2).
  rewrite -> (andb_true_l (mf 2 =n= 3)).
  Check (Nat.add_1_l 1).
  rewrite <- (Nat.add_1_l 1) at 1.
  Check (plus_Sn_m 0 1).
  rewrite -> (plus_Sn_m 0 1).
  rewrite -> (H_S 0 1).
  rewrite -> H_O.
  rewrite <- (Nat.add_1_l 0) at 2.
  Check (plus_Sn_m 0 0).
  rewrite -> (plus_Sn_m 0 0).
  rewrite -> (H_S 0 0).
  rewrite -> H_O.
  rewrite -> (Nat.add_1_l 1).
  rewrite -> (Nat.add_1_l 2).
  exact (Nat.eqb_refl 3).
Qed.

Theorem soundness_of_the_unit_test_function_for_mystery_function_00b :
  forall mf : nat -> nat,
    specification_of_mystery_function_00 mf ->
    unit_test_for_mystery_function_00b mf = true.
Proof.
  unfold specification_of_mystery_function_00,
         unit_test_for_mystery_function_00b.
  intros mf [H_O H_S].
  (* Goal: (mf 0 =n= 1) && (mf 1 =n= 2) = true *)
  rewrite -> H_O.
  (* Goal: (1 =n= 1) && (mf 1 =n= 2) = true *)
  rewrite -> (Nat.eqb_refl 1).
  (* Goal: true && (mf 1 =n= 2) = true *)
  rewrite -> (andb_true_l (mf 1 =n= 2)).
  (* Goal: (mf 1 =n= 2) = true *)
  (* etc. *)
  Check (Nat.add_1_l 0).
  rewrite <- (Nat.add_1_l 0) at 1.
  Check (plus_Sn_m 0 0).
  rewrite -> (plus_Sn_m 0 0).
  rewrite -> (H_S 0 0).
  rewrite -> H_O.
  Check (plus_Sn_m 0 1).
  rewrite -> (plus_Sn_m 0 1).
  Check (Nat.add_1_r 0).
  rewrite -> (Nat.add_1_r 0).
  Check (Nat.eqb_refl 2).
  exact (Nat.eqb_refl 2).
Qed.

Theorem soundness_of_the_unit_test_function_for_mystery_function_00_with_Search :
  forall mf : nat -> nat,
    specification_of_mystery_function_00 mf ->
    unit_test_for_mystery_function_00b mf = true.
Proof.
  unfold specification_of_mystery_function_00,
         unit_test_for_mystery_function_00b.
  intros mf [H_O H_S].

  rewrite -> H_O.
  Search (beq_nat _  _ = true).
  Check (Nat.eqb_refl 1).
  rewrite -> (Nat.eqb_refl 1).
  Search (true && _ = _).
  Check (andb_true_l (mf 1 =n= 2)).
  rewrite -> (andb_true_l (mf 1 =n= 2)).

  Check (Nat.add_1_l 0).
  rewrite <- (Nat.add_1_l 0) at 1.
  Check (plus_Sn_m 0 0).
  rewrite -> (plus_Sn_m 0 0).
  rewrite -> (H_S 0 0).
  rewrite -> H_O.
  Check (plus_Sn_m 0 1).
  rewrite -> (plus_Sn_m 0 1).
  Check (Nat.add_1_r 0).
  rewrite -> (Nat.add_1_r 0).
  Check (Nat.eqb_refl 2).
  exact (Nat.eqb_refl 2).
Qed.

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

Definition specification_of_mystery_function_11 (mf : nat -> nat) :=
  mf 1 = 1
  /\
  forall i j : nat,
    mf (i + j) = mf i + 2 * i * j + mf j.

Definition unit_test_for_mystery_function_11 (mf : nat -> nat) :=
  (mf 1 =n= 1) && (mf 2 =n= 4) && (mf 3 =n= 9) && (mf 4 =n= 16)
(* etc. *).

Search (Nat.square).

Check Nat.square.

Definition mystery_function_11 := Nat.square.

Compute (unit_test_for_mystery_function_11 mystery_function_11).

Lemma quadratic_formula :
  forall i j : nat,
    (i + j) * (i + j) = i * i + 2 * i * j + j * j.
Proof.
    intros i j.
    Search ((_ + _) * _).
    Check (Nat.mul_add_distr_r i j (i + j)).
    rewrite -> (Nat.mul_add_distr_r i j (i + j)).
    Check (Nat.mul_add_distr_l i i j).
    rewrite -> (Nat.mul_add_distr_l i i j).
    Check (Nat.mul_add_distr_l j i j).
    rewrite -> (Nat.mul_add_distr_l j i j).
    Search (_ * _ = _ * _).
    Check (Nat.mul_comm i j).
    rewrite <- (Nat.mul_comm i j).
    Search (S _ * _).
    Check (Nat.mul_succ_l 1 (i * j)).
    Check (Nat.mul_assoc 2 i j).
    rewrite <- (Nat.mul_assoc 2 i j).
    rewrite -> (Nat.mul_succ_l 1 (i * j)).
    rewrite -> (Nat.mul_1_l (i * j)).
    Check (Nat.add_assoc (i * i) (i * j) (i * j + j * j)).
    rewrite <- (Nat.add_assoc (i * i) (i * j) (i * j + j * j)).
    Check (Nat.add_assoc (i * i) (i * j + i * j) (j * j)).
    rewrite <- (Nat.add_assoc (i * i) (i * j + i * j) (j * j)).
    Check (Nat.add_assoc (i * j) (i * j) (j * j)).
    rewrite -> (Nat.add_assoc (i * j) (i * j) (j * j)).
    reflexivity.
Qed.

Theorem there_is_at_least_one_mystery_function_11:
  specification_of_mystery_function_11 mystery_function_11.
Proof.
  unfold specification_of_mystery_function_11, mystery_function_11.
  split.

  - Search (Nat.square _ = _).
    Check (Nat.square_spec 1).
    rewrite -> (Nat.square_spec 1).
    Search (1 * _ = _).
    Check (Nat.mul_1_l 1).
    exact (Nat.mul_1_l 1).

  - Check (quadratic_formula).
    exact (quadratic_formula).
Qed.

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

Definition specification_of_mystery_function_04 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  forall n' : nat,
    mf (S n') = mf n' + S (2 * n').

Definition unit_test_for_mystery_function_04 (mf : nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 1) && (mf 2 =n= 4) && (mf 3 =n= 9).

Definition mystery_function_04 := Nat.square.

Compute (unit_test_for_mystery_function_04 mystery_function_04).

Theorem there_is_at_least_one_mystery_function_04:
  specification_of_mystery_function_04 mystery_function_04.
Proof.
  unfold specification_of_mystery_function_04, mystery_function_04.
  split.

  - Check (Nat.square_spec 0).
    rewrite -> (Nat.square_spec 0).
    Search (0 * _ = 0).
    Check (Nat.mul_0_l 0).
    exact (Nat.mul_0_l 0).
  - intro n'.
    rewrite -> (Nat.square_spec (S n')).
    rewrite -> (Nat.square_spec n').
    Search (_ + 1 = _).
    rewrite <- (Nat.add_1_r n').
    rewrite <- (Nat.add_1_r (2 * n')).
    Check (quadratic_formula n' 1).
    rewrite -> (quadratic_formula n' 1).
    Search (1 * _ = _).
    rewrite -> (Nat.mul_1_l 1).
    rewrite -> (Nat.mul_1_r (2 * n')).
    Check (Nat.add_assoc (n' * n') (2 * n') 1).
    rewrite -> (Nat.add_assoc (n' * n') (2 * n') 1).
    reflexivity.
Qed.

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

Definition specification_of_mystery_function_15 (mf : nat -> nat * nat) :=
  mf 0 = (0, 1)
  /\
  forall n' : nat,
    mf (S n') = let (x, y) := mf n'
                in (S x, y * S x).

Search (_ = (_,_)).

Definition unit_test_for_mystery_function_15 (mf : nat -> nat * nat) :=
  (mf 0 =p= (0,1)) &&
  (mf 1 =p= (1,1)) &&
  (mf 2 =p= (2,2)) &&
  (mf 3 =p= (3,6)) &&
  (mf 4 =p= (4,24)) &&
  (mf 5 =p= (5,120)).

Fixpoint fac (n : nat) : (nat * nat) :=
  match n with
  | O => (0,1)
  | S n' => let (x,y) := fac n'
            in (S x, y * S x)
  end.

Definition mystery_function_15 := fac.

Compute (unit_test_for_mystery_function_15 mystery_function_15).

Lemma fold_unfold_fac_O :
  fac O = (0,1).
Proof.
  fold_unfold_tactic fac.
Qed.

Lemma fold_unfold_fac_S :
  forall n' : nat,
    fac (S n') =
    let (x,y) := fac n'
    in (S x, y * S x).
Proof.
  fold_unfold_tactic fac.
Qed.

Theorem there_is_at_least_one_mystery_function_15:
  specification_of_mystery_function_15 mystery_function_15.
Proof.
  unfold specification_of_mystery_function_15, mystery_function_15.
  split.

  - exact fold_unfold_fac_O.

  - Check (fold_unfold_fac_S).
    exact fold_unfold_fac_S.
Qed.

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

Definition specification_of_mystery_function_16 (mf : nat -> nat * nat) :=
  mf 0 = (0, 1)
  /\
  forall n' : nat,
    mf (S n') = let (x, y) := mf n'
                in (y, x + y).

Definition unit_test_for_mystery_function_16 (mf : nat -> nat * nat) :=
  (mf 0 =p= (0,1)) &&
  (mf 1 =p= (1,1)) &&
  (mf 2 =p= (1,2)) &&
  (mf 3 =p= (2,3)) &&
  (mf 4 =p= (3,5)) &&
  (mf 5 =p= (5,8)).

Fixpoint fibp (n : nat) : (nat * nat) :=
  match n with
  | O => (0,1)
  | S n' => let (x,y) := fibp n'
            in (y, x + y)
  end.

Definition mystery_function_16 := fibp.

Compute (unit_test_for_mystery_function_16 mystery_function_16).

Lemma fold_unfold_fibp_O :
  fibp O = (0,1).
Proof.
  fold_unfold_tactic fibp.
Qed.

Lemma fold_unfold_fibp_S :
  forall n' : nat,
    fibp (S n') =
    let (x,y) := fibp n'
    in (y, x + y).
Proof.
  fold_unfold_tactic fibp.
Qed.

Theorem there_is_at_least_one_mystery_function_16:
  specification_of_mystery_function_16 mystery_function_16.
Proof.
  unfold specification_of_mystery_function_16, mystery_function_16.
  split.

  - exact fold_unfold_fibp_O.

  - Check (fold_unfold_fibp_S).
    exact fold_unfold_fibp_S.
Qed.

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

Definition specification_of_mystery_function_17 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  mf 1 = 1
  /\
  mf 2 = 1
  /\
  forall p q : nat,
    mf (S (p + q)) = mf (S p) * mf (S q) + mf p * mf q.

Definition unit_test_for_mystery_function_17 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 1) && (mf 2 =n= 1) && (mf 3 =n= 2).

Fixpoint fib (n : nat) : nat :=
  match n with
  | O => O
  | S n' => match n' with
            | O => 1
            | S n'' => fib n' + fib n''
            end
  end.

Definition mystery_function_17 := fib.

Compute (unit_test_for_mystery_function_17 mystery_function_17).

Lemma fold_unfold_fib_O :
  fib O = 0.
Proof.
  fold_unfold_tactic fib.
Qed.

Lemma fold_unfold_fib_S :
  forall n' : nat,
    fib (S n') =
    match n' with
    | 0 => 1
    | S n'' => fib n' + fib n''
    end.
Proof.
  fold_unfold_tactic fib.
Qed.

Corollary fold_unfold_fib_1 :
  fib 1 = 1.
Proof.
  rewrite -> (fold_unfold_fib_S 0).
  reflexivity.
Qed.

Corollary fold_unfold_fib_SS :
  forall n'' : nat,
    fib (S (S n'')) =
    fib (S n'') + fib n''.
Proof.
  intro n''.
  rewrite -> (fold_unfold_fib_S (S n'')).
  reflexivity.
Qed.

Theorem there_is_at_least_one_mystery_function_17 :
  specification_of_mystery_function_17 mystery_function_17.
Proof.
  unfold specification_of_mystery_function_17, mystery_function_17.
  split.
  - rewrite -> fold_unfold_fib_O.
    reflexivity.
  - split.
    -- rewrite -> fold_unfold_fib_1.
       reflexivity.
    -- split.
       --- rewrite -> (fold_unfold_fib_S 1).
           rewrite -> fold_unfold_fib_O.
           rewrite -> fold_unfold_fib_1.
           Search (_ + 0 = _).
           rewrite -> (Nat.add_0_r 1).
           reflexivity.
       --- intro p.
           induction p as [| p' IHp'].
    + intro q.
      rewrite -> (Nat.add_0_l q).
      rewrite -> fold_unfold_fib_O.
      rewrite -> fold_unfold_fib_1.
      rewrite -> (Nat.mul_0_l (fib q)).
      rewrite -> (Nat.mul_1_l (fib (S q))).
      rewrite -> (Nat.add_0_r (fib (S q))).
      reflexivity.
    + intro q.
      rewrite -> (plus_Sn_m p' q).
      rewrite -> (plus_n_Sm p' q).
      rewrite -> (IHp' (S q)).
      rewrite -> (fold_unfold_fib_SS q).
      rewrite -> (fold_unfold_fib_SS p').
      Search (_ * (_ + _)).
      rewrite -> (Nat.mul_add_distr_l (fib (S p')) (fib (S q)) (fib q)).
      Check Nat.mul_add_distr_r.
      rewrite -> (Nat.mul_add_distr_r (fib (S p')) (fib p') (fib (S q))).
      Check Nat.add_assoc.
      rewrite <- (Nat.add_assoc
                    (fib (S p') * fib (S q))
                    (fib (S p') * fib q)
                    (fib p' * fib (S q))).
      rewrite -> (Nat.add_comm  (fib (S p') * fib q)
                                (fib p' * fib (S q))).
      Check  (Nat.add_assoc
                    (fib (S p') * fib (S q))
                    (fib p' * fib (S q))
                    (fib (S p') * fib q)).
      exact  (Nat.add_assoc
                    (fib (S p') * fib (S q))
                    (fib p' * fib (S q))
                    (fib (S p') * fib q)).
Qed.

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

Definition specification_of_mystery_function_18 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  mf 1 = 1
  /\
  mf 2 = 1
  /\
  forall n''' : nat,
    mf n''' + mf (S (S (S n'''))) = 2 * mf (S (S n''')).

Definition unit_test_for_mystery_function_18 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 1) && (mf 2 =n= 1) && (mf 3 =n= 2) && (mf 4 =n= 3).

Definition mystery_function_18 := fib.

Compute (unit_test_for_mystery_function_18 mystery_function_18).

Theorem there_is_at_least_one_mystery_function_18 :
  specification_of_mystery_function_18 mystery_function_18.
Proof.
  unfold specification_of_mystery_function_18, mystery_function_18.
  split.
  - rewrite -> fold_unfold_fib_O.
    reflexivity.
  - split.
    -- rewrite -> fold_unfold_fib_1.
       reflexivity.
    -- split.
       --- rewrite -> (fold_unfold_fib_S 1).
           rewrite -> fold_unfold_fib_O.
           rewrite -> fold_unfold_fib_1.
           Search (_ + 0 = _).
           rewrite -> (Nat.add_0_r 1).
           reflexivity.
       --- intro p.
           induction p as [| p' IHp'].
           rewrite -> fold_unfold_fib_O.
           rewrite -> (Nat.add_0_l (fib 3)).
           rewrite -> (fold_unfold_fib_SS 1).
           rewrite -> (fold_unfold_fib_SS 0).
           rewrite -> (fold_unfold_fib_O).
           rewrite -> (fold_unfold_fib_1).
           rewrite -> (Nat.add_0_r 1).
           rewrite -> (Nat.add_1_r 1).
           Search (_ * 1).
           rewrite -> (Nat.mul_1_r 2).
           reflexivity.
           rewrite -> (fold_unfold_fib_S (S (S (S p'))) ).
           rewrite -> (fold_unfold_fib_S (S p')).
           Search (_ + (_ + _)).
           rewrite -> (Nat.add_shuffle3 (fib (S (S (S p')))) (fib (S p')) (fib p') ).
           rewrite -> (Nat.add_comm (fib (S (S (S p')))) (fib p')  ).
           rewrite -> IHp'.
           rewrite -> (fold_unfold_fib_S (S (S p'))).
           Search (_ + (_ + _)).
           rewrite -> (Nat.add_assoc (fib (S p')) (fib (S p')) (2 * fib (S (S p'))) ).
           Search (_ + _ = _ + _).
           rewrite -> (Nat.add_comm (fib (S (S p'))) (fib (S p'))).
           Search (_ * ( _ + _ )).
           rewrite -> (Nat.mul_add_distr_l 2 (fib (S p')) (fib (S (S p'))) ).
           Check (Nat.mul_succ_l 1 (fib (S p'))).
           rewrite -> (Nat.mul_succ_l 1 (fib (S p'))).
           Search (1 * _ = _).
           Check (Nat.mul_1_l (fib (S p'))).
           rewrite -> (Nat.mul_1_l (fib (S p'))).
           reflexivity.
Qed.

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

Definition specification_of_mystery_function_03 (mf : nat -> nat -> nat) :=
  mf 0 0 = 0
  /\
  (forall i j: nat, mf (S i) j = S (mf i j))
  /\
  (forall i j: nat, S (mf i j) = mf i (S j)).

Definition unit_test_for_mystery_function_03 (mf: nat -> nat -> nat) :=
  (mf 0 0 =n= 0) && (mf 1 0 =n= 1) && (mf 0 1 =n= 1) && (mf 1 1 =n= 2) && (mf 2 0 =n= 2).

Definition mystery_function_03 := Nat.add.

Compute (unit_test_for_mystery_function_03 mystery_function_03).

Theorem there_is_at_least_one_mystery_function_03 :
  specification_of_mystery_function_03 mystery_function_03.
Proof.
  unfold specification_of_mystery_function_03, mystery_function_03.
  split.
  - Search (_ + 0 = _).
    rewrite (Nat.add_0_r 0).
    reflexivity.
  - split.
    -- intros i j.
       rewrite -> (plus_Snm_nSm i j).
       Search (S _ = _).
       rewrite <- (plus_n_Sm i j).
       reflexivity.
    -- Search (S _ = _).
       intros i j.
       exact (plus_n_Sm i j).
Qed.

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

Definition specification_of_mystery_function_42 (mf : nat -> nat) :=
  mf 1 = 42
  /\
  forall i j : nat,
    mf (i + j) = mf i + mf j.

Definition unit_test_for_mystery_function_42 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 42) && (mf 2 =n= 84) && (mf 3 =n= 126).

Definition mystery_function_42 (n: nat) : nat := Nat.mul 42 n.

Compute (unit_test_for_mystery_function_42 mystery_function_42).

Theorem there_is_at_least_one_mystery_function_42 :
  specification_of_mystery_function_42 mystery_function_42.
Proof.
  unfold specification_of_mystery_function_42, mystery_function_42.
  split.
  - Search (_ * 1 = _).
    rewrite (Nat.mul_1_r 42).
    reflexivity.
  - intros i j.
    Search (_ * (_ + _) = _ * _ + _ * _).
    rewrite -> (Nat.mul_add_distr_l 42 i j).
    reflexivity.
Qed.

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

Definition specification_of_mystery_function_07 (mf : nat -> nat -> nat) :=
  (forall j : nat, mf 0 j = j)
  /\
  (forall i : nat, mf i 0 = i)
  /\
  (forall i j k : nat, mf (i + k) (j + k) = (mf i j) + k).

Definition unit_test_for_mystery_function_07 (mf: nat -> nat -> nat) :=
  (mf 0 0 =n= 0) && (mf 0 1 =n= 1) && (mf 2 0 =n= 2) && (mf 5 3 =n= 5).

Definition mystery_function_07 := Nat.max.

Compute (unit_test_for_mystery_function_07 mystery_function_07).

Theorem there_is_at_least_one_mystery_function_07 :
  specification_of_mystery_function_07 mystery_function_07.
Proof.
  unfold specification_of_mystery_function_07, mystery_function_07.
  split.
  - intro j.
    exact (Nat.max_0_l j).
  - split.
    -- intro i.
       exact (Nat.max_0_r i).
    -- intros i j k.
       Search Nat.max.
       exact (Nat.add_max_distr_r i j k).
Qed.

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

Definition specification_of_mystery_function_08 (mf : nat -> nat -> bool) :=
  (forall j : nat, mf 0 j = true)
  /\
  (forall i : nat, mf (S i) 0 = false)
  /\
  (forall i j : nat, mf (S i) (S j) = mf i j).

Definition unit_test_for_mystery_function_08 (mf: nat -> nat -> bool) :=
  (mf 0 0 =b= true) && (mf 0 1 =b= true) && (mf 2 0 =b= false) && (mf 5 3 =b= false).

Definition mystery_function_08 := Nat.leb.

Compute (unit_test_for_mystery_function_08 mystery_function_08).

Lemma fold_unfold_leb_S :
  forall i j: nat,
    Nat.leb (S i) (S j) = (Nat.leb i j).
Proof.
  fold_unfold_tactic Nat.leb.
Qed.

Theorem there_is_at_least_one_mystery_function_08 :
  specification_of_mystery_function_08 mystery_function_08.
Proof.
  unfold specification_of_mystery_function_08, mystery_function_08.
  split.
  - intro j.
    Search Nat.leb.
    rewrite -> (leb_correct 0 j).
    reflexivity.
    exact (Nat.le_0_l j).
  - split.
    -- intro i.
       Search Nat.leb.
       rewrite -> (leb_correct_conv).
       reflexivity.
       Search (0 < _).
       exact (Nat.lt_0_succ i).
    -- intros i j.
       rewrite -> (fold_unfold_leb_S i j).
       reflexivity.
Qed.

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

Definition specification_of_mystery_function_23 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  mf 1 = 0
  /\
  forall n'' : nat,
    mf (S (S n'')) = S (mf n'').

Definition unit_test_for_mystery_function_23 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 0) && (mf 2 =n= 1) && (mf 10 =n= 5).

Definition mystery_function_23 (n: nat) : nat := n / 2.

Compute (unit_test_for_mystery_function_23 mystery_function_23).

Theorem there_is_at_least_one_mystery_function_23 :
  specification_of_mystery_function_23 mystery_function_23.
Proof.
  unfold specification_of_mystery_function_23, mystery_function_23.
  split.
  - Search Nat.div.
    rewrite -> (Nat.div_small 0 2).
    reflexivity.
    Search (0 < _).
    exact Nat.lt_0_2.
  - split.
    -- rewrite -> (Nat.div_small 1 2).
       reflexivity.
       Search (1 < _).
       exact Nat.lt_1_2.
    -- intro n.
       rewrite <- (Nat.add_1_r (n / 2)).
       rewrite <- (Nat.add_1_r n).
       rewrite <- (Nat.add_1_r (n + 1)).
       Search (_ + _ + _ = _ + (_ + _)).
       rewrite -> (plus_assoc_reverse n 1 1).
       Search (_ * 1 = _).
       rewrite <- (Nat.mul_1_r (1 + 1)).
       Search (1 + 1).
       rewrite <- BinInt.ZL0.
       rewrite (Nat.mul_comm 2 1).
       Search ((_ + _)/_).
       rewrite -> (Nat.div_add n 1 2).
       reflexivity.
       exact (Nat.neq_succ_0 1).
Qed.

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

Definition specification_of_mystery_function_24 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  mf 1 = 1
  /\
  forall n'' : nat,
    mf (S (S n'')) = S (mf n'').

Definition unit_test_for_mystery_function_24 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 1) && (mf 3 =n= 2) && (mf 10 =n= 5).

Definition mystery_function_24 (n: nat) : nat := (n + 1) / 2.

Compute (unit_test_for_mystery_function_24 mystery_function_24).

Theorem there_is_at_least_one_mystery_function_24 :
  specification_of_mystery_function_24 mystery_function_24.
Proof.
  unfold specification_of_mystery_function_24, mystery_function_24.
  split.
  - Search (0 + _ = _).
    rewrite -> (Nat.add_0_l 1).
    rewrite -> (Nat.div_small 1 2).
    reflexivity.
    exact Nat.lt_1_2.
  - split.
    + rewrite <- BinInt.ZL0.
      Search (_ / _ = _).
      rewrite -> (Nat.div_same 2).
      reflexivity.
      exact (Nat.neq_succ_0 1).
    + intro n.
      rewrite <- (Nat.add_1_r ((n + 1) / 2)).
      rewrite <- (Nat.add_1_r ((S n))).
      rewrite -> (plus_assoc_reverse (S n) 1 1).
      rewrite <- (Nat.mul_1_r (1 + 1)).
      rewrite <- BinInt.ZL0.
      rewrite (Nat.mul_comm 2 1).
      rewrite -> (Nat.div_add (S n) 1 2).
      rewrite <- (Nat.add_1_r n).
      reflexivity.
      exact (Nat.neq_succ_0 1).
Qed.

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

Definition specification_of_mystery_function_13 (mf : nat -> nat) :=
  (forall q : nat, mf (2 * q) = q)
  /\
  (forall q : nat, mf (S (2 * q)) = q).

Definition unit_test_for_mystery_function_13 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 2 =n= 1) && (mf 3 =n= 1) && (mf 10 =n= 5).

Definition mystery_function_13 (n: nat) : nat := n / 2.

Compute (unit_test_for_mystery_function_13 mystery_function_13).

Theorem there_is_at_least_one_mystery_function_13 :
  specification_of_mystery_function_13 mystery_function_13.
Proof.
  unfold specification_of_mystery_function_13, mystery_function_13.
  split.
  - intro q.
    Search (_ * _  = _ * _ ).
    rewrite -> (Nat.mul_comm 2 q).
    Search (_ * _ / _).
    rewrite -> (Nat.div_mul q 2).
    reflexivity.
    Search (_ <> 0).
    exact (Nat.neq_succ_0 1).
  - intro q.
    rewrite <- (Nat.div2_div (S (2 * q))).
    Search (2 * _).
    exact (Nat.div2_succ_double q).
Qed.

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

Definition specification_of_mystery_function_25 (mf : nat -> nat) :=
  mf 0 = 0
  /\
  (forall q : nat,
      mf (2 * (S q)) = S (mf (S q)))
  /\
  mf 1 = 0
  /\
  (forall q : nat,
      mf (S (2 * (S q))) = S (mf (S q))).

Definition unit_test_for_mystery_function_25 (mf: nat -> nat) :=
  (mf 0 =n= 0) && (mf 1 =n= 0) && (mf 2 =n= 1) && (mf 10 =n= 3).

Definition mystery_function_25 := Nat.log2.

Compute (unit_test_for_mystery_function_25 mystery_function_25).

Theorem there_is_at_least_one_mystery_function_25 :
  specification_of_mystery_function_25 mystery_function_25.
Proof.
  unfold specification_of_mystery_function_25, mystery_function_25.
  split.
  - Search Nat.log2.
    rewrite -> (Nat.log2_nonpos 0).
    reflexivity.
    Search (_ <= 0).
    rewrite -> (Nat.le_0_r 0).
    reflexivity.
  - split.
    + intro q.
      Search (Nat.log2 (2 * _) = _).
      rewrite -> (Nat.log2_double (S q)).
      reflexivity.
      Search (0 < S _).
      exact (Nat.lt_0_succ q).
    + split.
      -- Search Nat.log2.
         exact (Nat.log2_1).
      -- intro q.
         Search (S (Nat.log2 _)).
         Search (S _).
         rewrite <- (Nat.add_1_r (2 * S q)).
         rewrite -> (Nat.log2_succ_double (S q)).
         reflexivity.
         exact (Nat.lt_0_succ q).
Qed.

(* ****** *)

Definition specification_of_mystery_function_20 (mf : nat -> nat -> nat) :=
  (forall j : nat, mf O j = j)
  /\
  (forall i j : nat, mf (S i) j = S (mf i j)).

Definition unit_test_for_mystery_function_20 (mf : nat -> nat -> nat) :=
  (mf O 1 =n= 1) && (mf 1 O =n= 1) && (mf 1 1 =n= 2) && (mf 2 1 =n= 3).

Definition mystery_function_20 (n : nat) (m : nat) : nat :=
  n + m.

Compute (unit_test_for_mystery_function_20 mystery_function_20).

Theorem there_is_at_least_one_mystery_function_20 :
  specification_of_mystery_function_20 mystery_function_20.
Proof.
  unfold specification_of_mystery_function_20, mystery_function_20.
  split.
  - Search (0 + _).
    intro j.
    rewrite -> (Nat.add_0_l j).
    reflexivity.
  - intros i j.
    Search (S _ + _).
    rewrite (plus_Sn_m i j).
    reflexivity.
Qed.

Theorem there_is_at_most_one_mystery_function_20 :
  forall (mf20a mf20b : nat -> nat -> nat),
    specification_of_mystery_function_20 mf20a ->
    specification_of_mystery_function_20 mf20b ->
    forall (i j : nat),
      mf20a i j = mf20b i j.
Proof.
  intros mf20a mf20b.
  unfold specification_of_mystery_function_20.
  intro S1.
  destruct S1 as [SaO SaS].
  intro S2.
  destruct S2 as [SbO SbS].
  intros i j.
  induction i as [i | IHi ].
  - rewrite -> (SaO j).
    rewrite -> (SbO j).
    reflexivity.
  - rewrite -> (SaS IHi j).
    rewrite -> (SbS IHi j).
    Search (S _ = S _).
    rewrite -> IHIHi.
    reflexivity.
Qed.

(* ****** *)

Definition specification_of_mystery_function_21 (mf : nat -> nat -> nat) :=
  (forall j : nat, mf O j = j)
  /\
  (forall i j : nat, mf (S i) j = mf i (S j)).

Definition unit_test_for_mystery_function_21 (mf : nat -> nat -> nat) :=
  (mf O 1 =n= 1) && (mf 1 O =n= 1) && (mf 1 1 =n= 2) && (mf 2 1 =n= 3).

Definition mystery_function_21 (n : nat) (m : nat) : nat :=
  n + m.

Compute (unit_test_for_mystery_function_21 mystery_function_21).

Theorem there_is_at_least_one_mystery_function_21 :
  specification_of_mystery_function_21 mystery_function_21.
Proof.
  unfold specification_of_mystery_function_21, mystery_function_21.
  split.
  - intro j.
    rewrite -> (Nat.add_0_l j).
    reflexivity.
  - intros i j.
    Search (S _ + _).
    rewrite (Nat.add_succ_comm i j).
    reflexivity.
Qed.

(* ****** *)

Definition specification_of_mystery_function_22 (mf : nat -> nat -> nat) :=
  forall i j : nat,
    mf O j = j
    /\
    mf (S i) j = mf i (S j).

Definition unit_test_for_mystery_function_22 (mf : nat -> nat -> nat) :=
  (mf O 1 =n= 1) && (mf 1 O =n= 1) && (mf 1 1 =n= 2) && (mf 2 1 =n= 3).

Definition mystery_function_22 (n : nat) (m : nat) : nat :=
  n + m.

Compute (unit_test_for_mystery_function_22 mystery_function_22).

Theorem there_is_at_least_one_mystery_function_22 :
  specification_of_mystery_function_22 mystery_function_22.
Proof.
  unfold specification_of_mystery_function_22, mystery_function_22.
  intros i j.
  split.
  - rewrite -> (Nat.add_0_l j).
    reflexivity.
  - Search (S _ + _).
    rewrite (Nat.add_succ_comm i j).
    reflexivity.
Qed.

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

(* Binary trees of natural numbers: *)

Inductive tree : Type :=
  | Leaf : nat -> tree
  | Node : tree -> tree -> tree.

Definition specification_of_mystery_function_19 (mf : tree -> tree) :=
  (forall n : nat,
     mf (Leaf n) = Leaf n)
  /\
  (forall (n : nat) (t : tree),
     mf (Node (Leaf n) t) = Node (Leaf n) (mf t))
  /\
  (forall t11 t12 t2 : tree,
     mf (Node (Node t11 t12) t2) = mf (Node t11 (Node t12 t2))).

(* You might not manage to prove
   that at most one function satisfies this specification (why?),
   but consider whether the following function does.
   Assuming it does, what does this function do?
   And what is the issue here?
*)

Fixpoint mystery_function_19_aux (t a : tree) : tree :=
  match t with
  | Leaf n =>
     Node (Leaf n) a
  | Node t1 t2 =>
     mystery_function_19_aux t1 (mystery_function_19_aux t2 a)
  end.

Fixpoint mystery_function_19 (t : tree) : tree :=
  match t with
  | Leaf n =>
     Leaf n
  | Node t1 t2 =>
     mystery_function_19_aux t1 (mystery_function_19 t2)
  end.

(* recursive definition, yet the specification of mf19 is not recursive because the tree has changed *)

(* Find rightmost Leaf n *)

Lemma fold_unfold_19_leaf :
  forall n : nat,
  (mystery_function_19 (Leaf n)) = Leaf n.
Proof.
  fold_unfold_tactic mystery_function_19.
Qed.

Lemma fold_unfold_19_case2 :
  forall (n : nat) (t : tree),
    mystery_function_19  (Node (Leaf n) t) = Node (Leaf n) (mystery_function_19 t).
Proof.
  fold_unfold_tactic mystery_function_19.
Qed.

Lemma fold_unfold_19_node :
  forall t11 t12 t2 : tree,
  mystery_function_19 (Node (Node t11 t12) t2) = mystery_function_19 (Node t11 (Node t12 t2)).
Proof.
  fold_unfold_tactic mystery_function_19.
Qed.

Theorem there_is_at_least_one_mystery_function_19 :
  specification_of_mystery_function_19 mystery_function_19.
Proof.
  unfold specification_of_mystery_function_19.
  split.
  - intro n.
    rewrite -> (fold_unfold_19_leaf n).
    reflexivity.
  - split.
    + intros n t.
      Check (fold_unfold_19_case2 n t).
      rewrite -> (fold_unfold_19_case2 n t).
      reflexivity.
    + intros t11 t12 t2.
      rewrite -> (fold_unfold_19_node t11 t12 t2).
      reflexivity.
Qed.

Theorem there_is_at_most_one_mystery_function_19 :
  forall (mf19a mf19b : tree -> tree),
    specification_of_mystery_function_19 mf19a ->
    specification_of_mystery_function_19 mf19b ->
    forall (t : tree),
    mf19a t = mf19b t.
Proof.
  intros mf19a mf19b.
  unfold specification_of_mystery_function_19.
  intros [Sa_Leaf [Sa_Case2 Sa_Node]]
         [Sb_Leaf [Sb_Case2 Sb_Node]].
  intro t.
  induction t as [ n | t1 IHt1 t2 IHt2].
  - Check (Sa_Leaf n).
    rewrite -> (Sa_Leaf n).
    rewrite -> (Sb_Leaf n).
    reflexivity.
  - destruct t1 as [n1 | t11 t12].
    + Check (Sa_Case2 n1 t2).
      rewrite -> (Sa_Case2 n1 t2).
      rewrite -> (Sb_Case2 n1 t2).
      rewrite -> IHt2.
      reflexivity.
    + Check (Sa_Node t11 t12 t2).
      rewrite -> (Sa_Node t11 t12 t2).
      rewrite -> (Sb_Node t11 t12 t2).
Abort.

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

Definition specification_of_mystery_function_05 (mf : nat -> nat) :=
  mf 0 = 1
  /\
  forall i j : nat,
    mf (S (i + j)) = 2 * mf i * mf j.

Definition unit_test_for_mystery_function_05 (mf : nat -> nat) :=
  (mf 0 =n= 1) &&
  (mf 1 =n= 2) &&
  (mf 2 =n= 4) &&
  (mf 3 =n= 8) &&
  (mf 4 =n= 16) &&
  (mf 5 =n= 32).

Definition mystery_function_05 (n : nat) : nat :=
  Nat.pow 2 n.

Compute (unit_test_for_mystery_function_05 mystery_function_05).

Theorem there_is_at_least_one_mystery_function_05 :
  specification_of_mystery_function_05 mystery_function_05.
Proof.
  unfold specification_of_mystery_function_05, mystery_function_05.
  split.
  - Search (_ ^ 0 = 1).
    exact (Nat.pow_0_r 2).
  - intros i j.
    Search (Nat.pow).
    Check (Nat.pow_succ_r' 2 (i + j)).
    rewrite -> (Nat.pow_succ_r' 2 (i + j)).
    Search (_ ^ (_ + _ )).
    Check (Nat.pow_add_r 2 i j).
    rewrite -> (Nat.pow_add_r 2 i j).
    Search (_ * (_ * _) = _ * _ * _).
    Check (Nat.mul_assoc 2 (2 ^ i) (2 ^ j)).
    rewrite -> (Nat.mul_assoc 2 (2 ^ i) (2 ^ j)).
    reflexivity.
Qed.

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

Definition specification_of_mystery_function_06 (mf : nat -> nat) :=
  mf 0 = 2
  /\
  forall i j : nat,
    mf (S (i + j)) = mf i * mf j.

Definition unit_test_for_mystery_function_06 (mf : nat -> nat) :=
  (mf 0 =n= 2) &&
  (mf 1 =n= 4) &&
  (mf 2 =n= 8) &&
  (mf 3 =n= 16) &&
  (mf 4 =n= 32) &&
  (mf 5 =n= 64).

Definition mystery_function_06 (n : nat) : nat :=
  Nat.pow 2 (n + 1).

Compute (unit_test_for_mystery_function_06 mystery_function_06).

Theorem there_is_at_least_one_mystery_function_06 :
  specification_of_mystery_function_06 mystery_function_06.
Proof.
  unfold specification_of_mystery_function_06, mystery_function_06.
  split.

  - Search (0 + _ = _).
    Check (Nat.add_0_l 1).
    rewrite -> (Nat.add_0_l 1).
    Search (_ ^ 1 = _).
    Check (Nat.pow_1_r 2).
    exact (Nat.pow_1_r 2).

  - intros i j.
    Search (_ ^ (_ + _ )).
    Check (Nat.pow_add_r 2 (S (i + j)) 1).
    rewrite -> (Nat.pow_add_r 2 (S (i + j)) 1).
    Search (_ ^ (S _)).
    Check (Nat.pow_succ_r' 2 (i + j)).
    rewrite -> (Nat.pow_succ_r' 2 (i + j)).
    Check (Nat.pow_add_r 2 i j).
    rewrite -> (Nat.pow_add_r 2 i j).
    Search (_ ^ (_ + _)).
    rewrite -> (Nat.pow_add_r 2 i 1).
    rewrite -> (Nat.pow_add_r 2 j 1).
    rewrite -> (Nat.pow_1_r 2).
    Search (_ * _ * _).
    rewrite -> (Nat.mul_assoc 2 (2 ^ i) (2 ^ j)).
    Check (Nat.mul_comm (2 ^ i) 2).
    rewrite -> (Nat.mul_comm (2 ^ i) 2).
    Search (_ * _ * _).
    Check (Nat.mul_assoc (2 * 2 ^ i) (2 ^ j) 2).
    rewrite -> (Nat.mul_assoc (2 * 2 ^ i) (2 ^ j) 2).
    reflexivity.
Qed.

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

Definition specification_of_mystery_function_09 (mf : nat -> bool) :=
  mf 0 = false
  /\
  mf 1 = true
  /\
  forall i j : nat,
    mf (i + j) = xorb (mf i) (mf j).

Definition unit_test_for_mystery_function_09 (mf : nat -> bool) :=
  (mf 0 =b= false) &&
  (mf 1 =b= true) &&
  (mf 2 =b= false) &&
  (mf 3 =b= true).

Fixpoint oddp (n : nat) : bool :=
  match n with
  | O => false
  | S n' => negb (oddp n')
  end.

Lemma fold_unfold_oddp_O :
  oddp O = false.
Proof.
  fold_unfold_tactic oddp.
Qed.

Lemma fold_unfold_oddp_S  :
  forall n',
    oddp (S n') = negb (oddp n').
Proof.
  fold_unfold_tactic oddp.
Qed.

Corollary fold_unfold_oddp_1 :
  oddp 1 = true.
Proof.
  rewrite -> (fold_unfold_oddp_S 0).
  rewrite -> fold_unfold_oddp_O.
  reflexivity.
Qed.

Definition mystery_function_09 (n : nat) :=
  oddp n.

Compute (unit_test_for_mystery_function_09 mystery_function_09).

Lemma eureka_lemma_09 :
  forall i j : nat,
    oddp (i + j) = xorb (oddp i) (oddp j).
Proof.
  induction i as [ | i' IHi'].
  - intro j.
    Search (0 + _ = _).
    rewrite -> (Nat.add_0_l j).
    rewrite -> (fold_unfold_oddp_O).
    Search (xorb false _ = _).
    rewrite -> (xorb_false_l (oddp j)).
    reflexivity.
  - intro j.
    Search ((S _) + _ = S (_ + _)).
    Check (Nat.add_succ_l i' j).
    rewrite -> (Nat.add_succ_l i' j).
    Check (fold_unfold_oddp_S (i' + j)).
    rewrite -> (fold_unfold_oddp_S (i' + j)).
    rewrite -> (IHi' j).
    rewrite -> (fold_unfold_oddp_S i').
    Search (negb (xorb _ _)).
    Check (negb_xorb_l (oddp i') (oddp j)).
    exact (negb_xorb_l (oddp i') (oddp j)).
Qed.

Theorem there_is_at_least_one_mystery_function_09 :
  specification_of_mystery_function_09 mystery_function_09.
Proof.
  unfold specification_of_mystery_function_09, mystery_function_09.
  split.
  - exact fold_unfold_oddp_O.

  - split.
    -- exact fold_unfold_oddp_1.
    -- exact eureka_lemma_09.
Qed.

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

Definition specification_of_mystery_function_10 (mf : nat -> bool) :=
  mf 0 = false
  /\
  mf 1 = true
  /\
  forall i j : nat,
    mf (i + j) = (mf i =b= mf j).

(* mf (1 + 0) = false, contradiction! *)

Theorem there_are_zero_mystery_function_10 :
  forall f : nat -> bool,
    specification_of_mystery_function_10 f ->
    exists n : nat,
      f n <> f n.
Proof.
  intro f.
  unfold specification_of_mystery_function_10.
  intros [S_O [S_1 S_other]].
  exists 1.
  Check (Nat.add_0_r).
  rewrite <- (Nat.add_0_r 1) at 1.
  rewrite -> (S_other 1 0).
  rewrite -> S_1 at 2.
  rewrite -> S_O.
  rewrite -> S_1.
  unfold not.
  intro H_absurd.
  Search (_ =b= _).
  Check (eqb_prop true false).
  Check (eqb_prop true false H_absurd).
  apply (eqb_prop true false) in H_absurd.
  discriminate H_absurd.
Qed.

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

Definition specification_of_mystery_function_12 (mf : nat -> nat) :=
  mf 1 = 1
  /\
  forall i : nat,
    mf (S (S i)) = (S (S i)) * mf (S i).

(* vacuous: this should have 2 base cases since (S (S i)), but 0 is not defined *)

Theorem there_are_zero_mystery_function_12 :
  forall f : nat -> bool,
    specification_of_mystery_function_10 f ->
    exists n : nat,
      f n = false.
Proof.
  intro f.
  unfold specification_of_mystery_function_10.
  intros SO.
  destruct SO as [S1 S2].
  exists 0.
  exact S1.
Qed.

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

Definition specification_of_mystery_function_14 (mf : nat -> bool) :=
  (forall q : nat, mf (2 * q) = true)
  /\
  (forall q : nat, mf (S (2 * q)) = false).

Definition mystery_function_14 (n : nat) : bool :=
  match n mod 2 with
  | O => true
  | S _ => false
  end.

Theorem there_is_at_least_one_mystery_function_14 :
  specification_of_mystery_function_14 mystery_function_14.
Proof.
  unfold specification_of_mystery_function_14, mystery_function_14.
  split.
  - intro q.
Qed.

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

(* Simple examples of specifications: *)

(* ***** *)

Definition specification_of_the_factorial_function (fac : nat -> nat) :=
  fac 0 = 1
  /\
  forall n' : nat, fac (S n') = S n' * fac n'.

(* ***** *)

Definition specification_of_the_fibonacci_function (fib : nat -> nat) :=
  fib 0 = 0
  /\
  fib 1 = 1
  /\
  forall n'' : nat,
    fib (S (S n'')) = fib n'' + fib (S n'').

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

(* end of week-05_mystery-functions.v *)


(* Expressions and Values *)

Require Import MyReals.
Require Import Types.

(* We distinguish syntactically between Values (canonical forms)
   and general expressions.  These are mutually recursive,
   because of abstractions. *)

(* Expressions and Values of type o, with free variables drawn from G *)

Inductive Exp G : Otype -> Type :=
| valexp : forall o, Val G o -> Exp G o
| prodexp : forall m m', Exp G (Stype m) -> Exp G (Stype m') ->
                         Exp G (Stype (Prod_type m m'))
| proj1exp : forall m m', Exp G (Stype (Prod_type m m'))
                          -> Exp G (Stype m)
| proj2exp : forall m m', Exp G (Stype (Prod_type m m'))
                          -> Exp G (Stype m')
| appexp : forall (a b : Otype),
             (Exp G (Funtype a b)) -> (Exp G a) -> (Exp G b)
| bindexp : forall (o o' : Mtype),  Exp G (Meastype o) ->
                        Exp G (Funtype (Stype o) (Meastype o')) ->
                        Exp G (Meastype o')
| returnexp : forall (o : Mtype), Exp G (Stype o)
                                  -> Exp G (Meastype o)
with
Val G : Otype -> Type :=
| constexp : real -> Val G (Stype Real_type)
| prodval : forall m m', Val G (Stype m) -> Val G (Stype m')
                         -> Val G (Stype (Prod_type m m'))
| varexp : forall o, Var G o -> Val G o
| absexp : forall (o o': Otype),
             (Exp (cons o G) o') -> (Val G (Funtype o o'))
| uniformval : Val G (Meastype Real_type)
| distval : Val G (Stype Real_type) -> Val G (Meastype Real_type)  (* some non-uniform distribution: *)

| bindval : forall o o', Val G (Meastype o) ->
                         Val G (Funtype
                                  (Stype o)
                                  (Meastype o')) ->
                        Val G (Meastype o')
| returnval : forall a, Val G (Stype a) -> Val G (Meastype a).

Arguments valexp {G o} _.
Arguments prodexp {G m m'} _ _.
Arguments proj1exp {G m m'} _.
Arguments proj2exp {G m m'} _.
Arguments appexp {G a b} _ _.
Arguments bindexp {G o o'} _ _.
Arguments returnexp {G o} _.
Arguments constexp {G} _.
Arguments varexp {G o} _.
Arguments prodval {G m m'} _ _.
Arguments absexp {G o o'} _.
Arguments uniformval {G}.
Arguments distval {G} _.
Arguments bindval {G o o'} _ _.
Arguments returnval {G a} _.

(* Coq doesn't generate the correct mutual induction hypotheses
   for these, so we have to help it along. *)

Scheme exp_val_rec := Induction for Exp Sort Prop
with
val_exp_rec := Induction for Val Sort Prop.


Require Import SetoidCat SetoidUtils Algebra.Functor Algebra.Monoid PairUtils Algebra.Utils UnitUtils Algebra.Applicative Algebra.Functor.Identity.

Require Import SetoidClass.

Section IdentityApplicative.

  Definition idFunc_unitA := IdentityIso unit tt.
  Definition idFunc_prod {A B} {AS : Setoid A} {BS : Setoid B} : IdentityS AS ~> IdentityS BS ~~> IdentityS (AS ~*~ BS) :=
    flipS @ compS @ IdentityIsoS (AS ~*~ BS)
          ∘ compS @ IdentityIsoS' BS
          ∘ curryS @ @idS _ (AS ~*~ BS) ∘ IdentityIsoS' AS.

  Existing Instance IdentityFunctor.
  Existing Instance IdentityS.

  Instance Identity_Applicative : @Applicative IdentityFunc _ _.

  Proof.

    exists (@idFunc_unitA) (@idFunc_prod).

    intros. simpl. destruct a. reflexivity.
    intros. simpl. destruct a. reflexivity.
    intros. simpl. split. reflexivity. split. reflexivity. reflexivity.
    intros. simpl. split. reflexivity. reflexivity.
  Defined.
End IdentityApplicative.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(*i $Id: Raxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)

(*********************************************************)
(**    Axiomatisation of the classical reals             *)
(*********************************************************)

Require Export ZArith_base.
Require Export Rdefinitions.
Open Local Scope R_scope.

(*********************************************************)
(** *            Field axioms                            *)
(*********************************************************)

(*********************************************************)
(** **   Addition                                        *)
(*********************************************************)

(**********)
Axiom Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1.
Hint Resolve Rplus_comm: real.

(**********)
Axiom Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3).
Hint Resolve Rplus_assoc: real.

(**********)
Axiom Rplus_opp_r : forall r:R, r + - r = 0.
Hint Resolve Rplus_opp_r: real v62.

(**********)
Axiom Rplus_0_l : forall r:R, 0 + r = r.
Hint Resolve Rplus_0_l: real.

(***********************************************************)
(** **    Multiplication                                   *)
(***********************************************************)

(**********)
Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1.
Hint Resolve Rmult_comm: real v62.

(**********)
Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3).
Hint Resolve Rmult_assoc: real v62.

(**********)
Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1.
Hint Resolve Rinv_l: real.

(**********)
Axiom Rmult_1_l : forall r:R, 1 * r = r.
Hint Resolve Rmult_1_l: real.

(**********)
Axiom R1_neq_R0 : 1 <> 0.
Hint Resolve R1_neq_R0: real.

(*********************************************************)
(** **   Distributivity                                  *)
(*********************************************************)

(**********)
Axiom
  Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3.
Hint Resolve Rmult_plus_distr_l: real v62.

(*********************************************************)
(** *    Order axioms                                    *)
(*********************************************************)
(*********************************************************)
(** **   Total Order                                     *)
(*********************************************************)

(**********)
Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}.

(*********************************************************)
(** **   Lower                                           *)
(*********************************************************)

(**********)
Axiom Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1.

(**********)
Axiom Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3.

(**********)
Axiom Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2.

(**********)
Axiom
  Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2.

Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.

(**********************************************************)
(** *    Injection from N to R                            *)
(**********************************************************)

(**********)
Boxed Fixpoint INR (n:nat) : R :=
  match n with
  | O => 0
  | S O => 1
  | S n => INR n + 1
  end.
Arguments Scope INR [nat_scope].

(**********************************************************)
(** *    Injection from [Z] to [R]                        *)
(**********************************************************)

(**********)
Definition IZR (z:Z) : R :=
  match z with
  | Z0 => 0
  | Zpos n => INR (nat_of_P n)
  | Zneg n => - INR (nat_of_P n)
  end.
Arguments Scope IZR [Z_scope].

(**********************************************************)
(** *    [R] Archimedean                                  *)
(**********************************************************)

(**********)
Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1.

(**********************************************************)
(** *    [R] Complete                                     *)
(**********************************************************)

(**********)
Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m.

(**********)
Definition bound (E:R -> Prop) :=  exists m : R, is_upper_bound E m.

(**********)
Definition is_lub (E:R -> Prop) (m:R) :=
  is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b).

(**********)
Axiom
  completeness :
    forall E:R -> Prop,
      bound E -> (exists x : R, E x) -> { m:R | is_lub E m }.


(* Xor ist nicht vordefiniert *)
(* Xor heißt: Eines wahr das andere falsch oder umgekehrt *)
Definition xor P Q :=
    (P /\ ~Q) \/ (~P /\ Q).
(* ~ steht für Negation ¬ *)
Notation "P 'xor' Q" := (xor P Q)(at level 80).

(* Ein paar Libraries, um unten Automatisation zu benutzen *)
Require Import PeanoNat.
Require Import Lia.
From Hammer Require Import Hammer.

Goal
    (forall x y z,
        ((x<y xor x<>z)
        \/
        (x=y /\ x=z)) ->
        x > z
    ) ->
    forall x y, y>x.
Proof.
    intros H. (* →:Bew *)
    intros x y. (* ∀:Bew *)
    apply H with (y:=y). (* ∀:Anw und modus ponens (→:Anw) *)
      (* es sieht automatisch, dass ich für x y und für z x einsetze; nur y muss ich vorgeben *)

    destruct (Nat.eq_dec y x) as [H2|H2]. (* Fallunterscheidung über y=x *)
    (* Nat.eq_dec : forall n m : nat, n = m \/ n <> m *)
    - rewrite H2. (* subst ginge hier auch als Befehl. Subst Regel: ersetze y durch x *)
      right. (* \/:Bew *)
      split. (* /\:Bew *)
      + reflexivity. (* Subst, True, ... *)
      + reflexivity.
    - left. (* \/:Bew *)
      right. (* Subst, \/:Bew *)
      split. (* /\:Bew *)
      + apply Nat.lt_irrefl. (* Lemma Nat.lt_irrefl : forall x : nat, ~ x < x *)
      + apply H2.
      (* Fertig *)
Restart. (* Beweis mit Taktiken *)
    intros H x y.
    apply H with (y:=y).
    destruct (Nat.eq_dec y x).
    - lia. (* lia löst "rechnen" *)
    - left. right. lia. (* hier braucht es ein wenig Hilfe *)
    (* Fertig *)
Restart. (* Beweis mit Taktiken *)
    now sfirstorder. (* fertig. Automatisation hat es gelöst *)
    (* Fertig *)
Qed.