(* Exercises in this series are more difficult than usual, 
   at least 2 or 3 stars*)

(* A useful trick about induction *)
Fixpoint addt n m: nat := match n with
  | O => m
  | S n => addt n (S m)
  end.

Lemma addt_plus: forall n m, addt n m = n + m.
Proof.
intros n m. 
(* fails
induction n as [ | n Hn]; simpl. 
  reflexivity.
*)
(* The point is to have an induction on 
   a *quantified* formula *)
revert m. induction n as [ | n Hn]; simpl. 
  intro m; reflexivity.
  intro m. rewrite (Hn (S m)). 
Admitted.

(* Solution of last exercises in Lecture05.v
*)


Fixpoint nat_Peq (n m: nat) : Prop :=
  match n, m with
  | O, O => True
  | S n, S m => nat_Peq n m
  | _, _ => False
  end.

(* Notice that, from Coq output, the decreasing argument is n. 
   Proofs about nat_Peq should then be made
   by induction on n.
*)

Theorem eq_nat_Peq : forall n m, n = m -> nat_Peq n m.
Proof.
Admitted. 

Theorem nat_Peq_correct : forall n m, nat_Peq n m -> n = m.
Proof.
Admitted.

(* Additional variations on False --  5 STARS *)

Inductive another_False : Prop :=
  AF: another_False -> another_False.

Inductive wrongnat : Set :=
  Swn : wrongnat -> wrongnat.

Lemma no_wrongnat : wrongnat -> False.
intro n. induction n as [n Hn]. assumption.
Qed.

Fixpoint nwn (n: wrongnat) : False :=
  match n with Swn n' => nwn n' end.

Lemma another_False_False : another_False -> False.
Admitted.



(* --------------------------------------------------------------------- *)



(* --------------------------------------------------------------------- *)
(* On informative datatypes, i.e. datatypes carrying logical information *)

Section sec_sumbool.
Variable P Q: Prop.

Lemma example0: P \/ Q -> {P}+{Q} -> Q \/ P.
Proof.
intros H B.
(* destruct H as [p | q]. (* works *) *)
  destruct B as [p | q].
    right; exact p.
    left; exact q.
Defined.

Definition False_to_nat: False -> nat.
intro F. destruct F as [].
Qed.


Definition example: P \/ Q -> {P}+{Q} -> bool -> nat.
intros H B b.
(* destruct H as [p | q]. *)
(*
destruct b.
    exact 3.
    exact 10. 
*)
  destruct B as [p | q].
    exact 3.
    exact 10.
Defined.
End sec_sumbool.


(* Excluded middle *)
Lemma em: forall P, P \/ ~P.
Proof.
 intros P. 
Abort.

Section cheating.
Require Import Classical.

Lemma cheat: forall f: nat -> nat, 
   (exists n, f n = 0) \/ (forall n, ~ f n = 0).
Proof.
intro f. 
Check classic.
destruct (classic (exists n, f n = 0)) as [yes | no].
  left. exact yes.
  right. intro n. intro  e. apply no. exists n. exact e. 
Qed.

Definition should_be_impossible :
  forall f: nat -> nat, 
   { n | f n = 0 } + {forall n, ~ f n = 0}.
intro f. 
(* destruct (cheat f). *)
Abort.

Lemma or_false_true: forall b, b = true \/ b = false.
Admitted.

Lemma test_false_true: forall b, {b = true}+{b = false}.
Admitted.

Definition should_be_possible :
  forall f: bool -> bool, 
   { b | f b = true } + {forall b, ~ f b = true}.
intro f.
(* try the next one first *)
(*
case (f true).
*)
(* And observe that we lost the important information on [f true],
   because [f true] does not occur in the conclusion.
*)
(* Then try the next one *)
(* 
case (or_false_true (f true)). 
*) 
(* Actually such a test need to be performed in the world of data *)
case (test_false_true (f true)); intro ftrue.
(* FILL HERE *)
(* Hint: discriminate can be used somewhere... *)
Admitted.
  

(* 4 stars *)
(* To be constructed by induction according the same scheme as nat_Peq *)
Definition nat_eq_dec : 
  forall n m: nat, {n=m}+{n<>m}.
Admitted.

Fixpoint nat_eq_bool (n m: nat) : bool :=
  match n, m with
  | O, O => true
  | S n, S m => nat_eq_bool n m
  | _, _ => false
  end.

Definition make_sig_example : 
  forall n, {y: nat | n = 7 -> y = 12}.
intro n. 
(* destruct (nat_eq_bool n 7) (* will stuck *) *)
destruct (nat_eq_dec n 7) as [e | d].
  exists 12. intro; reflexivity.
  exists 0. intro e. red in d. case (d e).
Defined.


(* A more advanced example *)

Inductive rgb : Set :=
  | Red : rgb
  | Green : rgb
  | Blue : rgb
.


Inductive rotate : rgb -> rgb -> Prop :=
  | rg : rotate Red Green
  | gb : rotate Green Blue
  | br : rotate Blue Red
.

Inductive nat_rgb : nat -> rgb -> Prop :=
  | nr0 : nat_rgb 0 Red
  | nrS : 
     forall n c1 c2, nat_rgb n c1 -> 
     rotate c1 c2 -> nat_rgb (S n) c2.

Lemma nat_rgb1: nat_rgb 1 Green.
Proof.
apply (nrS 0 Red). 
  constructor.
  constructor.
Qed.

Lemma nat_rgb2: nat_rgb 2 Blue.
Proof.
apply (nrS 1 Green). 
  apply nat_rgb1.
  constructor.
Qed.

Definition frot c : rgb := 
  match c with
  | Red => Green
  | Green => Blue
  | Blue => Red
  end.

Lemma frot3_id : forall c, frot (frot (frot c)) = c.
Proof.
Admitted.

Lemma frot_correct : forall c, rotate c (frot c).
Proof.
Admitted.

Lemma nrS_frot : forall n c, nat_rgb n c -> nat_rgb (S n) (frot c).
Proof.
Admitted.

Lemma nat_rgb3n: forall n c, nat_rgb n c -> nat_rgb (S (S (S n))) c.
Proof.
Admitted.

Fixpoint seq_rgb (n: nat) : rgb := 
  match n with
  | O => Red
  | 1 => Green
  | 2 => Blue
  | S (S (S n')) => seq_rgb n'
  end.

Fixpoint seq_rgb_inter (n: nat) : rgb.
(* apply (seq_rgb_inter n). will fail *)
  destruct n as [ | [ | [ | n']]].
    exact Red.
    exact Green.
    exact Blue.
    exact (seq_rgb_inter n').
Defined.

(* The interactive way provides the same definition *)
Remark r1: seq_rgb_inter = seq_rgb.
reflexivity.
Qed.

(* Simply minded induction fails *)
Theorem prop_seq_rgb : forall n, nat_rgb n (seq_rgb n).
induction n.
  simpl. apply nr0.
  simpl. destruct n as [ | n0].
    apply nat_rgb1.
    destruct n0 as [ | n1].
      apply nat_rgb2.
(*Stuck*)
Abort.

(* Direct proof by fixpoint works *)
Fixpoint prop_seq_rgb (n: nat): nat_rgb n (seq_rgb n).
(* apply (prop_seq_rgb n). fails on Qed *)
destruct n as [ | [ | [ | n']]]; simpl.
  apply nr0.
  apply nat_rgb1.
  apply nat_rgb2.
  apply nat_rgb3n. apply prop_seq_rgb. 
Qed.

Locate "{ _ | _ }".
Print sig.

(* Defining an informative version of seq_rgb *)
Fixpoint seq_rgb_spec (n: nat) : {c:rgb | nat_rgb n c}.
destruct n as [ | [ | [ | n']]].
  exists Red. apply nr0.
  exists Green. apply nat_rgb1.
  exists Blue. apply nat_rgb2.
  destruct (seq_rgb_spec n') as [c Hc].
  exists c. apply nat_rgb3n. exact Hc.
Defined.

Print seq_rgb_spec. 
(* Extraction seq_rgb_spec. *)

(* Induction on nat *)
Section sec_nat_ind.
Variable P:nat -> Prop.
Variable p0: P O.
Variable pS: forall n, P n -> P (S n).

Fixpoint nind (n: nat) : P n.
Proof.
destruct n as [ | n'].
  assumption.
  apply pS. apply nind.
Qed.
End sec_nat_ind.

Print nind.
  

Locate "_ /\ _". (* got that this is or *) 
Print or.
Locate "{ _ } + { _ }".
Print sumbool.
Locate "_ <> _".

Fixpoint nat_eq_test (n m: nat) : bool :=
  match n with
    | O => 
      match m with 
        | O => true
        | S _ => false
      end
    | S n' =>
      match m with 
        | O => false
        | S m' => nat_eq_test n' m'
      end
  end.

(* interactive version *)

Fixpoint nat_eq_test_i (n m: nat) : bool.
  destruct n as [| n'].
    destruct m as [| m'].
      left (* exact true *) .
      right (* exact false *) .
    destruct m as [| m'].
      right.
      exact (nat_eq_test_i n' m').
Defined.

Print nat_eq_test_i.


(* Exercises : prove previous theorems by fixpoint *)

Fixpoint nat_Peq_correct_direct
 (n m: nat): nat_Peq n m -> n = m.

Lemma S_injective: forall n m, S n = S m -> n = m.
Admitted.

(* Proof the following by induction *)
Theorem nat_eq_or_diff : forall (n m: nat), n=m \/ n<>m.
Admitted.

(* Same, but by fixpoint *)
Fixpoint nat_eq_or_diff_fix (n m: nat): n=m \/ n<>m.
Admitted.

(* Same, in the world of data *)
Fixpoint test_eq_nat (n m: nat): {n=m}+{n<>m}.
Admitted.