Inductive day : Type :=
| monday : day
| tuesday : day
| wednesday : day
| thursday : day
| friday : day
| saturday : day
| sunday : day.

Definition next_weekday (d : day) : day :=
  match d with
    | monday => tuesday
    | tuesday => wednesday
    | wednesday => thursday
    | thursday => friday
    | friday => monday
    | saturday => monday
    | sunday => monday
  end.

Eval simpl in (next_weekday friday).
Eval simpl in (next_weekday (next_weekday saturday)).

Example test_next_weekday :
  (next_weekday (next_weekday saturday)) = tuesday.
Proof. simpl. reflexivity. Qed.

Inductive bool : Type :=
| true : bool
| false : bool.

Definition negb (b : bool) : bool :=
  match b with
    | true => false
    | false => true
  end.

Example test_negb1 :
  (negb true) = false.
Proof. simpl. reflexivity. Qed.

Example test_negb2 :
  (negb false) = true.
Proof. simpl. reflexivity. Qed.

Definition andb (b1 b2 : bool) : bool :=
  match b1 with
    | true => b2
    | false => false
  end.

Example test_andb1 :
  (andb true true) = true.
Proof. simpl. reflexivity. Qed.

Example test_andb2 :
  (andb true false) = false.
Proof. simpl. reflexivity. Qed.

Example test_andb3 :
  (andb false true) = false.
Proof. simpl. reflexivity. Qed.

Example test_andb4 :
  (andb false false) = false.
Proof. simpl. reflexivity. Qed.

Definition orb (b1 b2 : bool) : bool :=
  match b1 with
    | true => true
    | false => b2
  end.

Example test_orb1 :
  (orb true true) = true.
Proof. simpl. reflexivity. Qed.

Example test_orb2 :
  (orb true false) = true.
Proof. simpl. reflexivity. Qed.

Example test_orb3 :
  (orb false true) = true.
Proof. simpl. reflexivity. Qed.

Example test_orb4 :
  (orb false false) = false.
Proof. simpl. reflexivity. Qed.

(* Exercise nandb *)

Definition nandb (b1 b2 : bool) : bool :=
  match b1 with
    | true => negb b2
    | false => true
  end.

Example test_nandb1:
  (nandb true false) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb2:
  (nandb false false) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb3:
  (nandb false true) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb4:
  (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

Definition andb3 (b1 b2 b3 : bool) : bool :=
  match b1 with
    | true => andb b2 b3
    | false => false
  end.

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.

Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.

Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.

Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

Check (negb true).
Check negb.
Check andb. (* : bool -> bool -> bool *)

Module Playground1.

  Inductive nat : Type :=
  | O : nat
  | S : nat -> nat.

  Definition pred (n : nat) : nat :=
    match n with
      | O => O
      | S n' => n'
    end.

End Playground1.

Definition play_minustwo (n : Playground1.nat) : Playground1.nat :=
  match n with
    | Playground1.O => Playground1.O
    | Playground1.S Playground1.O => Playground1.O
    | Playground1.S (Playground1.S n') => n'
  end.

Definition minustwo (n : nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

Check (S (S (S (S O)))).
Eval simpl in (minustwo 4).

Check S.
Check pred.
Check minustwo.

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

Example test_evenb1 :
  (evenb O) = true.
Proof. simpl. reflexivity. Qed.

Example test_evenb2 :
  (evenb (S (S (S O)))) = false.
Proof. simpl. reflexivity. Qed.

Definition oddb (n : nat) : bool :=
  negb (evenb n).

Example test_oddb1 :
  (oddb (S O)) = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2 :
  (oddb (S (S (S (S O))))) = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.

  Fixpoint plus (n m : nat) : nat :=
    match n with
      | O => m
      | S n' => S (plus n' m)
    end.

  Eval simpl in (plus (S (S O)) (S (S (S O)))).

  Example test_plus1 :
    plus (S (S O)) (S (S (S O))) = 5.
  Proof. simpl. reflexivity. Qed.

  Example test_plus2 :
    plus O (S (S (S O))) = 3.
  Proof. simpl. reflexivity. Qed.

  Fixpoint mult (n m : nat) : nat :=
    match n with
      | O => O
      | S n' => plus m (mult n' m)
    end.

  Example test_mult1 :
    mult (S (S O)) (S (S (S O))) = 6.
  Proof. simpl. reflexivity. Qed.

  Example test_mult2 :
    mult (S (S (S (S O)))) (S O) = 4.
  Proof. simpl. reflexivity. Qed.

  Fixpoint minus (n m : nat) : nat :=
    match n, m with
      | O, _ => O
      | S _, O => n
      | S n', S m' => minus n' m'
    end.

  Example test_minus1 :
    minus (S (S (S O))) (S O) = 2.
  Proof. simpl. reflexivity. Qed.

  Example test_minus2 :
    minus (S (S (S (S O)))) (S (S (S (S (S O))))) = 0.
  Proof. simpl. reflexivity. Qed.

End Playground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
    | O => S O
    | S power' => mult base (exp base power')
  end.

Example test_exp1 :
  exp (S O) O = 1.
Proof. simpl. reflexivity. Qed.

Example test_exp2 :
  exp (S (S (S O))) (S (S O)) = 9.
Proof. simpl. reflexivity. Qed.

(* Exercise factorial *)

Fixpoint factorial (n : nat) : nat :=
  match n with
    | O => S O
    | S n' => mult n (factorial n')
  end.

Example test_factorial1 :
  (factorial 3) = 6.
Proof. simpl. reflexivity. Qed.

Example test_factorial2 :
  (factorial 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

Notation "x + y" := (plus x y) (at level 50, left associativity) : nat_scope.
Notation "x - y" := (minus x y) (at level 50, left associativity) : nat_scope.
Notation "x * y" := (mult x y) (at level 40, left associativity) : nat_scope.

Example test_notation1 :
  ((3 + 3) - 1) * 2 = 10.
Proof. simpl. reflexivity. Qed.

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

Example test_beq_nat1 :
  beq_nat (S (S (S O))) (S (S (S O))) = true.
Proof. simpl. reflexivity. Qed.

Example test_beq_nat2 :
  beq_nat O (S O) = false.
Proof. simpl. reflexivity. Qed.

Fixpoint ble_nat (n m : nat) : bool := (* less than equal *)
  match n with
    | O => true
    | S n' => match m with
                | O => false
                | S m' => ble_nat n' m'
              end
  end.

Example test_ble_nat1 :
  (ble_nat 2 2) = true.
Proof. simpl. reflexivity. Qed.

Example test_ble_nat2 :
  (ble_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.

Example test_ble_nat3 :
  (ble_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

(* Exercise blt_nat *)

Definition blt_nat (n m : nat) : bool :=
  andb (ble_nat n m) (negb (beq_nat n m)).

Example test_blt_nat1 :
  (blt_nat 2 2) = false.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat2 :
  (blt_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat3:
  (blt_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

Theorem plus_0_n :
  forall n : nat, 0 + n = n.
Proof. reflexivity. Qed.

(* Exercise simpl_plus *)

Eval simpl in (forall n:nat, n + 0 = n).
(* = forall n : nat, n + 0 = n *)
(* : Prop *)

Eval simpl in (forall n:nat, 0 + n = n).
(* = forall n : nat, n = n *)
(* : Prop *)

Theorem plus_0_n'' :
  forall n : nat, 0 + n = n.
Proof. intros n. simpl. reflexivity. Qed.

Theorem plus_1_l :
  forall n : nat, 1 + n = S n.
Proof. intros n. simpl. reflexivity. Qed.

Theorem mult_0_l : forall n : nat, 0 * n = 0.
Proof. intros. simpl. reflexivity. Qed.

Theorem plus_id_example :
  forall n m : nat,
    n = m -> n + n = m + m.
Proof.
  intros n m.
  intros H.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_id_example' :
  forall n m : nat,
    n = m -> n + n = m + m.
Proof.
  intros n m.
  intros H.
  rewrite <- H.
  reflexivity.
Qed.

(* Exercise plus_id_exercise *)

Theorem plus_id_exercise : forall n m o : nat,
  n = m ->  m = o ->  n + m = m + o.
Proof.
  intros n m o.
  intros H.
  intros I.
  rewrite -> H.
  rewrite <- I.
  reflexivity.
Qed.

Theorem mult_0_plus :
  forall n m : nat,
    (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_0_n.
  reflexivity.
Qed.

Theorem mult_1_plus :
  forall n m : nat,
    (1 + n) * m = m + (n * m).
Proof.
  intros n m.
  rewrite -> plus_1_l.
  simpl. reflexivity.
Qed.

Theorem plus_1_neq_0_firsttry :
  forall n : nat,
    beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  simpl.
  Admitted.

Theorem plus_1_neq_0 :
  forall n : nat,
    beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  destruct n as [| n'].
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

Theorem negb_involutive :
  forall b : bool,
    negb (negb b) = b.
Proof.
  intros b.
  destruct b.
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

(* Exercise zero_nbeq_plus_1 *)

Theorem zero_nbeq_plus_1 :
  forall n : nat,
    beq_nat 0 (n + 1) = false.
Proof.
  intros n.
  destruct n as [| n'].
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

Require String.
Open Scope string_scope.

Ltac move_to_top x :=
  match reverse goal with
    | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
    clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
      set (x := name); move_to_top x
    | assert_eq x name; move_to_top x
    | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

Theorem andb_true_elim1 :
  forall b c : bool,
    andb b c = true -> b = true.

Proof.
  intros b c H.
  destruct b.
  Case "b = true".
    reflexivity.
  Case "b = false".
    rewrite <- H.
    simpl.
    reflexivity.
Qed.

(* Exercise andb_true_elim2 *)

Theorem andb_true_elim2 :
  forall b c : bool,
    andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
  Case "c = true".
    reflexivity.
  Case "c = false".
    rewrite <- H.
    destruct b.
    SCase "b = true".
      simpl. reflexivity.
    SCase "b = false".
      simpl. reflexivity.
Qed.

(* Theorem plus_0_r_firsttry : *)
(*   forall n : nat, *)
(*     n + 0 = n. *)
(* Proof. *)
(*   intros n. *)
(*   destruct n as [| n']. *)
(*   simpl. reflexivity. *)
(*   simpl. *)
(*   Admitted. *)

(* Theorem plus_0_r_secondtry : *)
(*   forall n : nat, *)
(*     n + 0 = n. *)
(* Proof. *)
(*   intros n. destruct n as [| n']. *)
(*   Case "n = 0". *)
(*     reflexivity. *)
(*   Case "n = S n'". *)
(*     simpl. Admitted. *)

Theorem plus_0_r :
  forall n : nat,
    n + 0 = n.
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    reflexivity.
    Case "n = S n'".
      simpl. rewrite -> IHn'.
      reflexivity.
Qed.

(* Exercise basic_induction. *)

Theorem mult_0_r :
  forall n : nat,
    n * 0 = 0.
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'.
    reflexivity.
Qed.

Theorem plus_n_Sm :
  forall n m : nat,
    S (n + m) = n + (S m).
Proof.
  intros n m.
  induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'.
    reflexivity.
Qed.

Theorem plus_comm :
  forall n m : nat,
    n + m = m + n.
Proof.
  intros n m.
  induction n as [| n'].
  Case "n = 0".
    simpl. rewrite -> plus_0_r.
    reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'.
    rewrite -> plus_n_Sm.
    reflexivity.
Qed.

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

(* Exercise double_plus. *)

Lemma double_plus :
  forall n : nat,
    double n = n + n.
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl.
    rewrite -> IHn'.
    rewrite <- plus_n_Sm.
    reflexivity.
Qed.

(* Exercise destruct_induction. *)

(* destruct と induction の違いを短く説明しなさい. *)

(* destruct は全ての場合を網羅することで証明できる場合に用いる. Induction は任意の数の証明などの再帰的に証明しなければ証明できない場合に用いる. *)

(*** 形式的証明と非形式的証明 ***)

Theorem plus_assoc' :
  forall n m p : nat,
    n + (m + p) = (n + m) + p.
Proof. intros n m p. induction n as [| n']. reflexivity.
       simpl. rewrite -> IHn'. reflexivity. Qed.


Require Import Le.
Require Import Nat.
Require Import Compare_dec.

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

Lemma nat_dec : forall (n m:nat), {n = m} + {n <> m}.
Proof.
    induction n as [|n IH].
    - destruct m as [|m].
        + left. reflexivity.
        + right. intros H. inversion H.
    - destruct m as [|m].
        + right. intros H. inversion H.
        + destruct (IH m) as [H|H].
            { left. rewrite H. reflexivity. }
            { right. intros H'. apply H. inversion H'. reflexivity. }
Qed.

Lemma plus_n_n : forall (n:nat), n + n = 2*n.
Proof.
    destruct n as [|n].
    - reflexivity.
    - simpl. rewrite <- plus_n_Sm, <- plus_n_Sm, <- plus_n_O. reflexivity.
Qed.

Lemma max_lub : forall (n m p:nat), n <= p -> m <= p -> max n m <= p.
Proof.
    intros n m p H1 H2. destruct (le_dec n m) as [H|H].
    - rewrite max_r; assumption.
    - rewrite max_l.
        + assumption.
        + apply not_le in H. unfold gt in H. unfold lt in H.
          apply le_trans with (S m).
            { apply le_S, le_n. }
            { assumption. }
Qed.


Require Import Classical.
Require Export GeoCoq.Elements.OriginalProofs.euclidean_defs.
Require Export GeoCoq.Elements.OriginalProofs.general_tactics.

Ltac remove_double_neg :=
repeat
 match goal with
 H: ~ ~ ?X |- _ => apply NNPP in H
end.

Section basic_lemmas.

Context `{Ax:euclidean_neutral}.

Lemma Col_or_nCol : forall A B C,
  Col A B C \/ nCol A B C.
Proof.
unfold nCol, Col.
intros.
tauto.
Qed.

Lemma nCol_or_Col : forall A B C,
  nCol A B C \/ Col A B C.
Proof.
unfold nCol, Col.
intros.
tauto.
Qed.

Lemma eq_or_neq : forall A B,
 eq A B \/ neq A B.
Proof.
intros;unfold neq;tauto.
Qed.

Lemma neq_or_eq : forall A B,
 neq A B \/ eq A B.
Proof.
intros;unfold neq;tauto.
Qed.

Lemma Col_nCol_False : forall A B C, nCol A B C -> Col A B C -> False.
Proof.
unfold Col, nCol;intuition.
Qed.

Lemma nCol_notCol :
 forall A B C, ~ Col A B C -> nCol A B C.
Proof.
intros.
unfold nCol, Col, neq in *.
intuition.
Qed.

Lemma not_nCol_Col : forall A B C,
  ~ nCol A B C -> Col A B C.
Proof.
intros.
unfold nCol, Col, neq in *.
tauto.
Qed.

Lemma nCol_not_Col : forall A B C,
  nCol A B C -> ~ Col A B C.
Proof.
intros.
unfold nCol, Col, neq in *.
tauto.
Qed.

End basic_lemmas.

Hint Resolve not_nCol_Col
 nCol_not_Col nCol_notCol Col_nCol_False.

Hint Resolve
 Col_or_nCol nCol_or_Col eq_or_neq neq_or_eq : decidability.

Tactic Notation "by" "cases" "on" constr(t) :=
(let H := hyp_of_type t in decompose [or] H; clear H) ||
   let C := fresh in (assert (C:t) by (auto with decidability || unfold neq in *;tauto);
 decompose [or] C;clear C).

Ltac remove_not_nCol :=
repeat
match goal with
 H: ~ nCol ?A ?B ?C |- _ => apply not_nCol_Col in H
end.

Ltac forward_using thm :=
 remove_not_nCol;spliter;splits;
 match goal with
  H: ?X |- _ => apply thm in H;spliter;assumption
 end.

Ltac contradict :=
 (solve [eauto using Col_nCol_False]) || contradiction || (unfold nCol in *;intuition).

Ltac conclude t :=
 spliter;
 remove_double_neg;
 solve [unfold eq in *;mysubst;assumption |
        eauto using t |
        eapply t;eauto |
        eapply t;intuition |
        apply <- t;remove_exists;eauto  |
        unfold neq,eq in *;intuition |
        unfold neq,eq in *;remove_double_neg;congruence |
        apply t;tauto
].

Ltac close := solve [assumption |
                     auto |
                     repeat (split;auto) |
                     unfold neq, nCol in *;try assumption;tauto |
                     remove_exists;eauto 15
                    ].

Ltac conclude_def_aux t := (remove_double_neg;
  (progress (unfold t);
   solve [remove_exists;eauto 6 |
          remove_exists;splits;eauto  |
          remove_exists;eauto 11 |
          one_of_disjunct |
          intuition
         ]))
 ||
 solve [unfold t in *;spliter;assumption |
        unfold t in *;destruct_all;assumption |
        unfold t in *;remove_double_neg;destruct_all;remove_exists;eauto 11  ].

(** Trick to have unfold working also with definitions within typeclasses,
 thank you Pierre Courtieu *)

Tactic Notation "conclude_def" reference(x) := (conclude_def_aux x).


Require Import Arith.

Fixpoint plus' (n m:nat){struct m} : nat :=
  match m with O => n | S p => S (plus' n p)
  end.

Lemma plus'_assoc : forall n m p, plus' n (plus' m p)= plus' (plus' n m) p.
Proof.
 intros n m p ; elim p; simpl; auto.
Qed.


(** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 1 *)

(* Welcome to 6.822!  Read through `Pset1Signature.v` before starting here. *)

Require Import Frap Pset1Signature.

Module Impl.
  (* The first part of this assignment involves the [bool] datatype,
   * which has the following definition.
   * <<
       Inductive bool :=
       | true
       | false.
     >>
   * We will define logical negation and conjunction of Boolean values,
   * and prove some properties of these definitions.
   *)

  (* Define [Neg] so that it implements Boolean negation, which flips
   * the truth value of a Boolean value.
   *)
  Definition Neg (b : bool) : bool.
  Admitted.

  (* For instance, the negation of [true] should be [false].
   * This proof should follow from reducing both sides of the equation
   * and observing that they are identical.
   *)
  Theorem Neg_true : Neg true = false.
  Proof.
  Admitted.

  (* Negation should be involutive, meaning that if we negate
   * any Boolean value twice, we should get the original value back.

   * To prove a fact like this that holds for all Booleans, it suffices
   * to prove the fact for both [true] and [false] by using the
   * [cases] tactic.
   *)
  Theorem Neg_involutive : forall b : bool, Neg (Neg b) = b.
  Proof.
  Admitted.

  (* Define [And] so that it implements Boolean conjunction. That is,
   * the result value should be [true] exactly when both inputs
   * are [true].
   *)
  Definition And (x y : bool) : bool.
  Admitted.

  (* Here are a couple of examples of how [And] should act on
   * concrete inputs.
   *)
  Theorem And_true_true : And true true = true.
  Proof.
  Admitted.

  Theorem And_false_true : And false true = false.
  Proof.
  Admitted.

  (* Prove that [And] is commutative, meaning that switching the order
   * of its arguments doesn't affect the result.
   *)
  Theorem And_comm : forall x y : bool, And x y = And y x.
  Proof.
  Admitted.

  (* Prove that the conjunction of a Boolean value with [true]
   * doesn't change that value.
   *)
  Theorem And_true_r : forall x : bool, And x true = x.
  Proof.
  Admitted.

  (* In the second part of this assignment, we will work with a simple language
   * of imperative arithmetic programs that sequentially apply operations
   * to a natural-number-valued state.

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

  Print Prog.

  (* Define [run] such that [run p n] gives the final state
   * that running the program [p] should result in, when the
   * initial state is [n].
   *)
  Fixpoint run (p : Prog) (initState : nat) : nat.
  Admitted.

  Theorem run_Example1 : run Done 0 = 0.
  Proof.
  Admitted.

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

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

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

  Theorem numInstructions_Example :
    numInstructions (MulThen 5 (AddThen 2 Done)) = 2.
  Proof.
  Admitted.

  (* Define [concatProg] such that [concatProg p1 p2] is the program
   * that first runs [p1] and then runs [p2].
   *)
  Fixpoint concatProg (p1 p2 : Prog) : Prog.
  Admitted.

  Theorem concatProg_Example :
       concatProg (AddThen 1 Done) (MulThen 2 Done)
       = AddThen 1 (MulThen 2 Done).
  Proof.
  Admitted.

  (* Prove that the number of instructions in the concatenation of
   * two programs is the sum of the number of instructions in each
   * program.
   *)
  Theorem concatProg_numInstructions
    : forall (p1 p2 : Prog), numInstructions (concatProg p1 p2)
                        = numInstructions p1 + numInstructions p2.
  Proof.
  Admitted.

  (* Prove that running the concatenation of [p1] with [p2] is
     equivalent to running [p1] and then running [p2] on the
     result. *)
  Theorem concatProg_run
    : forall (p1 p2 : Prog) (initState : nat),
      run (concatProg p1 p2) initState =
      run p2 (run p1 initState).
  Proof.
  Admitted.

  (* Read this definition and understand how division by zero is handled. *)
  Fixpoint runPortable (p : Prog) (state : nat) : bool * nat :=
    match p with
    | Done => (true, state)
    | AddThen n p => runPortable p (n+state)
    | MulThen n p => runPortable p (n*state)
    | DivThen n p =>
        if n ==n 0 then (false, state) else
        runPortable p (state/n)
    | VidThen n p =>
        if state ==n 0 then (false, 0) else
        runPortable p (n/state)
    | SetToThen n p =>
        runPortable p n
    end.
  Arguments Nat.div : simpl never. (* you don't need to understand this line *)

  (* Here are a few examples: *)

  Definition goodProgram1 := AddThen 1 (VidThen 10 Done).
  Example runPortable_good : forall n,
    runPortable goodProgram1 n = (true, 10/(1+n)).
  Proof. simplify. equality. Qed.

  Definition badProgram1 := AddThen 0 (VidThen 10 Done).
  Example runPortable_bad : let n := 0 in
    runPortable badProgram1 n = (false, 0).
  Proof. simplify. equality. Qed.

  Definition badProgram2 := AddThen 1 (DivThen 0 Done).
  Example runPortable_bad2 : forall n,
    runPortable badProgram2 n = (false, 1+n).
  Proof. simplify. equality. Qed.

  (* Prove that running the concatenation [p] using [runPortable]
     coincides with using [run], as long as [runPortable] returns
     [true] to confirm that no divison by zero occurred. *)
  Lemma runPortable_run : forall p s0 s1,
    runPortable p s0 = (true, s1) -> run p s0 = s1.
  Proof.
  Admitted.

  (* The final goal of this pset is to implement [validate : Prog -> bool]
     such that if this function returns [true], the program would not trigger
     division by zero regardless of what state it starts out in.  [validate] is
     allowed to return [false] for some perfectly good programs that never cause
     division by zero, but it must recognize as good the examples given below.  In
     jargon, [validate] is required to be sound but not complete, but "complete
     enough" for the use cases defined by the examples given here: *)

  Definition goodProgram2 := AddThen 0 (MulThen 10 (AddThen 0 (DivThen 1 Done))).
  Definition goodProgram3 := AddThen 1 (MulThen 10 (AddThen 0 (VidThen 1 Done))).
  Definition goodProgram4 := Done.
  Definition goodProgram5 := SetToThen 0 (DivThen 1 Done).
  Definition goodProgram6 := SetToThen 1 (VidThen 1 Done).
  Definition goodProgram7 := AddThen 1 (DivThen 1 (DivThen 1 (VidThen 1 Done))).

  (* If you already see a way to build [validate] that meets the
   * requirements above, _and have a plan for how to prove it correct_,
   * feel free to just code away. Our solution uses one intermediate definition
   * and one intermediate lemma in the soundness proof -- both of which are more
   * sophisticated than the top-level versions given here. *)

  (* If a clear plan hasn't emerged in 10 minutes (or if you get stuck later),
   * take a look at the hints for this pset on the course web site.
   * It is not expected that this pset is doable for everyone without the hints,
   * and some planning is required to complete the proof successfully.
   * In particular, repeatedly trying out different combinations of tactics
   * and ideas from hints until something sticks can go on for arbitrarily long
   * with little insight and no success; just guessing a solution is unlikely.
   * Thus, we encourage you to take your time to think, look at the hints when
   * necessary, and only jump into coding when you have some idea why it should
   * succeed. Some may call Coq a video game, but it is not a grinding contest. *)

  Definition validate (p : Prog) : bool.
  Admitted.

  (* Start by making sure that your solution passes the following tests, and add
   * at least one of your own tests: *)

  Example validate1 : validate goodProgram1 = true. Admitted.
  Example validate2 : validate goodProgram2 = true. Admitted.
  Example validate3 : validate goodProgram3 = true. Admitted.
  Example validate4 : validate goodProgram4 = true. Admitted.
  Example validate5 : validate goodProgram5 = true. Admitted.
  Example validate6 : validate goodProgram6 = true. Admitted.
  Example validate7 : validate goodProgram7 = true. Admitted.
  Example validateb1 : validate badProgram1 = false. Admitted.
  Example validateb2 : validate badProgram2 = false. Admitted.

  (* Then, add your own example of a bad program here, and check that `validate`
   * returns `false` on it: *)

  Definition badProgram3 : Prog. Admitted.
  Example validateb3 : validate badProgram3 = false. Admitted.

  (* Finally, before diving into the Coq proof, try to convince yourself that
   * your code is correct by applying induction by hand.  Can you describe the
   * high-level structure of the proof?  Which cases will you have to reason
   * about?  What do the induction hypotheses look like?  Which key lemmas do
   * you need?  Write a short (~10-20 lines) informal proof sketch before
   * proceeding. *)

  (** Proof sketch: **)
  (* [[Fill in your proof sketch here.]] *)

  (* Now you're ready to write the proof in Coq: *)

  Lemma validate_sound : forall p, validate p = true ->
    forall s, runPortable p s = (true, run p s).
  Admitted.

  (* Here is the complete list of commands used in one possible solution:
    - Search, for example Search (_ + 0).
    - induct, for example induct x
    - simplify
    - propositional
    - equality
    - linear_arithmetic
    - cases, for example cases (X ==n Y)
    - apply, for example apply H
    - apply in, for example apply H1 in H2 or apply somelemma in H1
    - apply with, for example apply H1 with (x:=2)
    - apply in with, for example apply H1 with (x:=2) in H2
    - rewrite, for example rewrite H
    - rewrite in, for example rewrite H1 in H2 or rewrite somelemma in H1
    - ;, for example simplify; propositional *)
End Impl.

(* The following line checks that your `Impl` module implements the right
   signature.  Make sure that it works, or the auto-grader will break!
   If there are mismatches, coq will report them (`Signature components for
   label … do not match`): *)
Module ImplCorrect : Pset1Signature.S := Impl.


Require Export ZArith  List  Arith Bool.

(*

Inductive month : Set :=
| January : month | February : month | March : month
| April : month   | May : month      | June : month
| July : month    | August : month   | September : month
| October : month | November : month | December : month.

*)

(** short form
*)
Inductive month : Set :=
| January | February | March     | April   | May      | June
| July    | August   | September | October | November | December.

(** Tests :

Check month_ind.

Check month_rec.
*)

Theorem month_equal :
forall m:month,
 m=January \/ m=February \/ m=March \/ m=April \/ m=May \/ m=June \/
 m=July \/ m=August \/  m=September \/ m=October \/ m=November \/
 m=December.
Proof.
 destruct m; auto 12.
Qed.

(** explicit use of maont_ind:

*)
Theorem month_equal' :
forall m:month,
 m=January \/ m=February \/ m=March \/ m=April \/
 m=May \/ m=June \/ m=July \/ m=August \/
 m=September \/ m=October \/ m=November \/ m=December.
Proof.
 intro m; pattern m; apply month_ind; auto 12.
Qed.

Theorem bool_equal: forall (b:bool), b = true \/ b = false.
Proof.
  intros. destruct b. left. reflexivity. right. reflexivity.
Qed.

Definition month_length (leap:bool)(m:month) : nat :=
  match m with
  | January => 31 | February => if leap then 29 else 28
  | March => 31   | April => 30    | May => 31  | June => 30
  | July => 31    | August => 31   | September => 30
  | October => 31 | November => 30 | December => 31
  end.

Definition month_length' (leap:bool) :=
  month_rec (fun m:month => nat)
  31 (if leap then 29 else 28) 31 30 31 30 31 31 30 31 30 31.

Definition month_length'' (leap:bool)(m:month) :=
 match m with
 | February => if leap then 29 else 28
 | April  | June  | September | November => 30
 | _  => 31
 end.

(** Tests :

Compute  (fun leap => month_length leap November).
*)

Example  length_february : month_length false February = 28.
Proof. reflexivity. Qed.

Inductive plane : Set := point : Z->Z->plane.
Print plane.
Print plane_ind.
Print plane_rec.
(* Definition with Record *)
Reset plane.
Record plane : Set := point {abscissa : Z; ordinate : Z}.
Print abscissa.
Print plane.
Definition in_diagonal (p:plane) :=
  Z_eq_bool (abscissa p) (ordinate p).

Print plane.
Fail Print plane_ind.

Inductive vehicle : Set :=
  bicycle : nat->vehicle | motorized : nat->nat->vehicle.

(**
Check vehicle_ind.
*)

Definition nb_wheels (v:vehicle) : nat :=
  match v with
  | bicycle x => 2
  | motorized x n => n
  end.

Definition nb_seats (v:vehicle) : nat :=
  match v with
  | bicycle x => x
  | motorized x _ => x
  end.
Print vehicle_ind.
Print vehicle_rec.
Theorem at_least_28 :
 forall (leap:bool)(m:month), 28 <= month_length leap m.
Proof.
 intros leap m; case m; simpl; auto with arith.
 case leap; simpl; auto with arith.
Qed.

Definition next_month (m:month) :=
  match m with
  |  January => February  | February => March | March => April
  | April => May         | May => June       | June => July
  | July => August       | August => September
  | September => October | October => November
  | November => December | December => January
  end.

Theorem next_august_then_july :
 forall m:month, next_month m = August -> m = July.
Proof.
 intros m; case m; simpl; intros Hnext_eq;
    (reflexivity || discriminate Hnext_eq).
Qed.

(* Simulating discriminate (just for the fun) *)

Theorem not_January_eq_February' : January <> February.
Proof.
 unfold not; intros H.
 change ((fun m:month =>
          match m with | January => True | _ => False end)
        February).
 rewrite <- H.
 trivial.
Qed.

(* Using injection *)

Theorem bicycle_eq_seats :
 forall x1 y1:nat, bicycle x1 = bicycle y1 -> x1 = y1.
Proof.
 intros x1 y1 H.
 injection H.
 trivial.
Qed.

(* Simulating injection (for the fun) *)

Theorem bicycle_eq_seats' :
 forall x1 y1:nat, bicycle x1 = bicycle y1 -> x1 = y1.
Proof.
 intros x1 y1 H.
 change (nb_seats (bicycle x1) = nb_seats (bicycle y1)).
 rewrite H; reflexivity.
Qed.

(* haoyang: case_eq *)

Theorem next_march_shorter :
 forall (leap:bool)(m1 m2:month), next_month m1 = March ->
   month_length leap m1 <= month_length leap m2.
Proof.
intros. case m1. Restart.
 intros leap m1 m2 H.

destruct m1. Undo. case m1. Undo. Locate case_eq. case_eq m1. Undo.

 case_eq m1; try  (intro H0; rewrite H0 in H; simpl in H; discriminate H).
  case leap ; case m2 ; simpl; auto with arith.
Qed.

(* A first, detailed, proof of associativity of + *)

Theorem plus_assoc :
 forall x y z:nat, (x+y)+z = x+(y+z).
Proof.
 induction x as [ | x0 IHx0].
 -  simpl; reflexivity.
 - simpl; intros y z; rewrite IHx0; reflexivity.
Qed.

Fixpoint mult2 (n:nat) : nat :=
   match n with
   | 0 => 0
   | S p => S (S (mult2 p))
   end.

Inductive Z_btree : Set :=
  Z_leaf : Z_btree | Z_bnode : Z->Z_btree->Z_btree->Z_btree.

Fixpoint sum_all_values (t:Z_btree) : Z :=
  (match t with
   | Z_leaf => 0
   | Z_bnode v t1 t2 =>
       v + sum_all_values t1 + sum_all_values t2
  end)%Z.

Fixpoint zero_present (t:Z_btree) : bool :=
   match t with
   | Z_leaf => false
   | Z_bnode (0%Z)  t1 t2 => true
   | Z_bnode _ t1 t2 =>
        zero_present t1 ||  zero_present t2
   end.

Fixpoint add_one (x:positive) : positive :=
  match x with
  | xI x' => xO (add_one x')
  | xO x' => xI x'
  | xH => 2%positive
  end.

Inductive Z_fbtree : Set :=
  Z_fleaf : Z_fbtree | Z_fnode : Z ->(bool->Z_fbtree)-> Z_fbtree.

Definition right_son (t:Z_btree) : Z_btree :=
  match t with
  | Z_leaf => Z_leaf
  | Z_bnode a t1 t2 => t2
  end.

Definition fright_son (t:Z_fbtree) : Z_fbtree :=
  match t with
  | Z_fleaf => Z_fleaf
  | Z_fnode a f => f false
  end.

(**

Check Z_fbtree_ind.
*)

Fixpoint fsum_all_values (t:Z_fbtree) : Z :=
 (match t with
  | Z_fleaf => 0
  | Z_fnode v f =>
     v + fsum_all_values (f true) + fsum_all_values (f false)
  end )%Z .

Inductive Z_inf_branch_tree : Set :=
| Z_inf_leaf : Z_inf_branch_tree
| Z_inf_node : Z->(nat->Z_inf_branch_tree)->Z_inf_branch_tree.

Fixpoint sum_f (n:nat)(f : nat -> Z) : Z
 := (match n with
       | O => 0
       | S p => f n + sum_f p f
     end)%Z.

Fixpoint n_sum_all_values (n:nat)(t:Z_inf_branch_tree) : Z :=
  (match t with
    | Z_inf_leaf => 0
    | Z_inf_node v f =>
         v + sum_f n (fun x:nat => n_sum_all_values n (f x))
    end )%Z.

Definition mult2' : nat->nat :=
  fix f (n:nat) : nat :=
    match n with 0 => 0 | S p => S (S (f p)) end.

Fixpoint app {A:Type}(l m:list A) : list A :=
  match l with
  | nil => m
  | cons a l1 => cons a (app  l1 m)
  end.

Print cons.

Definition pred_option (n:nat) : option nat :=
  match n with O => None | S p => Some p end.

Definition pred2_option (n:nat) : option nat :=
  match pred_option n with
  | None => None
  | Some p => pred_option p
  end.

Fixpoint nth_option {A:Type} (n:nat)(l:list A) : option A :=
  match n, l with
  | O, cons a tl => Some a
  | S p, cons a tl => nth_option  p tl
  | _, nil => None
  end.

Fixpoint nth_option' {A:Type} (n:nat)(l:list A) {struct n} : option A :=
  match n, l with
  | O, cons a tl => Some a
  | S p, cons a tl => nth_option'  p tl
  | _, nil => None
  end.

(** Some tests:

Print fst.

Check (sum nat bool).

Check (inl bool 4).

Check (inr nat false).
*)

Print sum.

Print fst.

Check (sum nat bool).

Check (inl bool 4).

Check (inr nat false).

Check (inl bool 4).
Check (inl 4).

Inductive ltree (n:nat) : Set :=
  | lleaf : ltree n
  | lnode : forall p:nat, p <= n -> ltree n -> ltree n -> ltree n.

Inductive sqrt_data (n:nat) : Set :=
  sqrt_intro : forall x:nat, x*x <= n -> n <  S x * S x -> sqrt_data n.

Compute (sqrt_data).

Inductive sqrt_data' (n:nat) : Set :=
  sqrt_intro' : sqrt_data' n.

Compute sqrt_intro'.
Compute (sqrt_intro' 1).

Inductive htree (A:Type) : nat->Type :=
  | hleaf : A->htree A 0
  | hnode : forall n:nat, A -> htree A n -> htree A n -> htree A (S n).

Check hleaf.
Check htree_ind.

(**

Check htree_ind.

*)

Fixpoint htree_to_btree (n:nat)(t:htree Z n){struct t} : Z_btree :=
  match t with
  | hleaf _ x => Z_bnode x Z_leaf Z_leaf
  | hnode _ p v t1 t2 =>
      Z_bnode v (htree_to_btree p t1)(htree_to_btree p t2)
  end.

Fixpoint invert (A:Type)(n:nat)(t:htree A n){struct t} : htree A n :=
  match t in htree _ x return htree A x with
  | hleaf _ v => hleaf A v
  | hnode _ p v t1 t2 => hnode A p v (invert A p t2)(invert A p t1)
  end.

(**

Print Empty_set.

Check Empty_set_ind.
*)

Inductive strange : Set :=  cs : strange->strange.

Theorem strange_empty : forall x:strange, False.
Proof.
 intro x. induction x.
 assumption.
Qed.

Theorem strange_empty' : forall x:strange, False.
Proof.
 intro x. apply strange_ind.
 - intros. assumption.
 - apply x.
Qed.

Theorem nat_not_strange :  forall n:nat, False.
Proof.
 intros x.
 Print nat_ind.
 apply nat_ind.
 - admit.
 - intros; assumption.
 - apply x.
Abort.

Theorem nat_not_strange' :  forall n:nat, False.
Proof.
 intros x.
 induction x.
 - admit.
 -
Abort.

(** attempt to prove falsehood

Theorem nat_not_strange :  forall n:nat, False.
Proof.
 intros x; elim x.
Abort.

*)

Inductive even_line : nat->Set :=
  | even_empty_line : even_line 0
  | even_step_line : forall n:nat, even_line n -> even_line (S (S n)).

(** Tests :

Check even_empty_line.

Check (even_step_line _ even_empty_line).

Check (even_step_line _ (even_step_line _ even_empty_line)).
*)


Theorem plus_1 :
  forall (n m:nat), n + S m = S (n + m).
Proof. intros. induction n.
  - simpl. reflexivity.
  - simpl. rewrite IHn. reflexivity.
Qed.

Theorem plus_comm :
  forall (n m:nat), n + m = m + n.
Proof.
  intros n m.
  induction n as [|n IHn].
  - simpl. induction m; simpl; auto.
  - simpl. rewrite plus_1.  rewrite IHn. reflexivity.
Qed.


Set Warnings "-notation-overridden,-parsing".
From LF Require Export Tactics.

Theorem app_assoc_destruct : forall X (l1 l2 l3: list X),
  (l1 ++ l2) ++ l3 = l1 ++ l2 ++ l3.
Proof.
  intros.
  induction l1 as [|h t IHl'].
  - simpl. reflexivity.
  - simpl. rewrite IHl'. reflexivity.
Qed.

(* parameterized propositions *)
Definition is_three (n : nat) : Prop :=
  n = 3.
Check is_three.

Definition injective {A B} (f : A -> B) :=
  forall x y : A, f x = f y -> x = y.

Lemma succ_inj : injective S.
Proof.
  intros n m H.
  injection H as H1.
  apply H1.
Qed.

Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  split.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB.
  split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros.
  apply and_intro.
  - destruct n as [|n'].
    + reflexivity.
    + simpl in H. discriminate H.
  - destruct m as [|m'].
    + reflexivity.
    + rewrite -> plus_comm in H. simpl in H.
      discriminate H.
Qed.

Lemma and_example2 :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m H.
  destruct H as [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2'' :
  forall n m : nat, n = 0 -> m = 0 -> n + m = 0.
Proof.
  intros n m Hn Hm.
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  intros n m H.
  assert (H' : n = 0 /\ m = 0).
  { apply and_exercise. apply H. }
  destruct H' as [Hn Hm].
  rewrite Hn. reflexivity.
Qed.

Lemma proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q [HP HQ].
  apply HP.
Qed.

Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q [HP HQ].
  apply HQ.
Qed.

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  intros P Q [HP HQ].
  split.
    - (* left *) apply HQ.
    - (* right *) apply HP.
Qed.

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R [HP [HQ HR]].
  split.
  - split. apply HP. apply HQ.
  - apply HR.
Qed.

Lemma or_example : forall n m : nat,
  n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m [Hn | Hm].
  - rewrite Hn. reflexivity.
  - rewrite Hm. rewrite <- mult_n_O.
  reflexivity.
Qed.

Lemma or_intro : forall A B : Prop, A -> A \/ B.
Proof.
  intros A B HA.
  left.
  apply HA.
Qed.

Lemma zero_or_succ :
  forall n : nat, n = 0 \/ n = S (pred n).
Proof.
  intros [|n].
  - left. reflexivity.
  - right. reflexivity.
Qed.

Module MyNot.
Definition not (P:Prop) := P -> False.
Notation "~ x" := (not x) : type_scope.
Check not.
(* ===> Prop -> Prop *)
Notation "x <> y" := (~ (x = y)).
End MyNot.

(*  Latin ex falso quodlibet
  = from falsehood follows whatever you like
  = principle of explosion. *)
Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  intros P contra.
  destruct contra.
Qed.

Fact not_implies_our_not : forall (P:Prop),
  ~ P -> (forall (Q:Prop), P -> Q).
Proof.
  unfold not.
  intros.
  apply H in H0.
  destruct H0.
Qed.

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. destruct H.
Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~ P) -> Q.
Proof.
  intros P Q [HP HNA].
  unfold not in HNA.
  apply HNA in HP. destruct HP.
Qed.

Theorem double_neg : forall P : Prop,
  P -> ~ ~ P.
Proof.
  intros P H.
  unfold not. intros G.
  apply G. apply H.
Qed.

Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~ Q -> ~ P).
Proof.
  unfold not.
  intros P Q H0 H1 H2. apply H0 in H2.
  apply H1 in H2. destruct H2.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~ P).
Proof.
  intros P.
  unfold not.
  intros [H0 H1].
  apply H1 in H0.
  apply H0.
Qed.

Theorem not_true_is_false : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  - unfold not in H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.
  - reflexivity.
Qed.

Theorem not_true_is_false' : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  - (* b = true *)
    unfold not in H.
    exfalso. (* <=== *)
    apply H. reflexivity.
  - (* b = false *) reflexivity.
Qed.

Lemma True_is_true : True.
Proof. apply I. Qed.

Module MyIff.
Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).
Notation "P <-> Q" := (iff P Q)
                      (at level 95, no associativity)
                      : type_scope.
End MyIff.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  (* WORKED IN CLASS *)
  intros P Q [HAB HBA].
  split.
  - (* -> *) apply HBA.
  - (* <- *) apply HAB.
Qed.

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  (* WORKED IN CLASS *)
  intros b. split.
  - (* -> *) apply not_true_is_false.
  - (* <- *)
    intros H. rewrite H. intros H'. discriminate H'.
Qed.

Theorem or_depend_on_each_left : forall P Q : Prop,
  P -> P \/ Q.
Proof. Admitted.

Theorem or_depend_on_each_right : forall P Q : Prop,
  Q -> P \/ Q.
Proof. Admitted.

Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R. split.
  { intros [H0 | H1].
    { split.
      - apply or_depend_on_each_left. apply H0.
      - apply or_depend_on_each_left. apply H0.
    }
    { split.
      - apply proj1 in H1.
        apply or_depend_on_each_right.
        apply H1.
      - apply proj2 in H1.
        apply or_depend_on_each_right.
        apply H1.
    }
  }
  {
    intros [[H0 | H1] [H2 | H3]]. left.
    - apply H0.
    - apply or_depend_on_each_left. apply H0.
    - apply or_depend_on_each_left. apply H2.
    - apply or_depend_on_each_right.
      apply and_intro. apply H1. apply H3.
  }
Qed.

From Coq Require Import Setoids.Setoid.

Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof. Admitted.

Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof. Admitted.

Lemma mult_0 : forall n m,
  n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  split.
  - apply mult_eq_0.
  - apply or_example.
Qed.

Lemma or_assoc : forall P Q R : Prop,
  P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros P Q R. split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mult_0_3 : forall n m p,
  n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite mult_0. rewrite mult_0.
  rewrite or_assoc. reflexivity.
Qed.

Lemma apply_iff_example : forall n m : nat,
  n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m H.
  apply mult_0. apply H.
Qed.

Lemma four_is_even : exists n : nat, 4 = n + n.
Proof.
  exists 2. reflexivity.
Qed.

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n [m Hm].
  exists (2 + m).
  apply Hm.
Qed.

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P H.
  unfold not.
  (* intros [x1 Hx1] is OK, too. *)
  intros H0.
  destruct H0 as [x1 Hx1].
  apply Hx1 in H. destruct H.
Qed.

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <->
    (exists x, P x) \/ (exists x, Q x).
Proof.
  intros. split.
  - intros [x [H0 | H1]].
    + left. exists x. apply H0.
    + right. exists x. apply H1.
  - intros [[x0 H0] | [x1 H1]].
    + exists x0. left. apply H0.
    + exists x1. right. apply H1.
Qed.

Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
  match l with
  | [] => False
  | x' :: l' => x' = x \/ In x l'
  end.

Example In_example_1 : In 4 [1; 2; 3; 4; 5].
Proof.
  simpl. right. right. right. left. reflexivity.
Qed.

Example In_example_2 :
  forall n, In n [2; 4] ->
  exists n', n = 2 * n'.
Proof.
  simpl.
  intros n [H | [H | []]].
  - exists 1. rewrite <- H. reflexivity.
  - exists 2. rewrite <- H. reflexivity.
Qed.

Lemma In_map :
  forall (A B : Type) (f : A -> B) (l : list A) (x : A),
    In x l ->
    In (f x) (map f l).
Proof.
  intros A B f l x.
  induction l as [|x' l' IHl'].
  - (* l = nil, contradiction *)
    simpl. intros [].
  - (* l = x' :: l' *)
    simpl. intros [H | H].
    + rewrite H. left. reflexivity.
    + right. apply IHl'. apply H.
Qed.

Lemma In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.
Proof.
  intros. split.
  - induction l as [|x' l' IHl'].
    + simpl. apply ex_falso_quodlibet.
    + simpl. intros [H0 | H1].
      * exists x'. split. apply H0.
        left. reflexivity.
      * apply IHl' in H1. destruct H1 as [x [H1 H2]].
        exists x. split. apply H1. right. apply H2.
  - induction l as [|x' l' IHl'].
    + intros [x [H0 H1]]. simpl. simpl in H1.
      apply H1.
    + intros H. simpl in H.
      destruct H as [x [H1 [H2 | H3]]].
      * simpl. left. rewrite -> H2.
        apply H1.
      * simpl. right. apply IHl'.
        exists x. split. apply H1. apply H3.
Qed.

Lemma In_app_iff : forall A l l' (a:A),
  In a (l ++ l') <-> In a l \/ In a l'.
Proof.
  intros. split.
  - induction l as [|x' l'' IHl''].
    + simpl. intros H. right. apply H.
    + simpl. intros [H0 | H1].
      * left. left. apply H0.
      * apply or_assoc. right.
        apply IHl''. apply H1.
  - induction l as [|x' l'' IHl''].
    + simpl. intros [H0 | H1].
      * apply ex_falso_quodlibet. apply H0.
      * apply H1.
    + simpl. intros [[H0 | H1] | H2].
      * left. apply H0.
      * right. apply IHl''. left. apply H1.
      * right. apply IHl''. right. apply H2.
Qed.

Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
  | [] => True
  | x :: l' => P x /\ All P l'
  end.

Lemma All_In :
  forall T (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <->
    All P l.
Proof.
  intros. split.
  - intros H. induction l as [|x l' IHl'].
    + simpl. reflexivity.
    + simpl. split.
      * apply H. simpl. left. reflexivity.
      * apply IHl'. intros x0 H0.
        simpl in H. apply H. right. apply H0.
  - intros H. induction l as [|x l' IHl'].
    + simpl. intros x0 H0.
      apply ex_falso_quodlibet. apply H0.
    + simpl. simpl in H.
      destruct H as [H0 H1].
      intros x0 [H2 | H3].
      * rewrite <- H2. apply H0.
      * apply IHl'. apply H1. apply H3.
Qed.

Definition combine_odd_even (Podd Peven : nat -> Prop) :
   nat -> Prop :=
  fun (n : nat) => if oddb n
                   then Podd n
                   else Peven n.

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  intros.
  unfold combine_odd_even.
  destruct (oddb n) eqn:E1.
  - apply H. reflexivity.
  - apply H0. reflexivity.
Qed.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  unfold combine_odd_even.
  intros. rewrite -> H0 in H. apply H.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  unfold combine_odd_even.
  intros. rewrite H0 in H. apply H.
Qed.

(* Use theorems AS Function !!! *)
Lemma plus_comm3_take3 :
  forall x y z, x + (y + z) = (z + y) + x.
Proof.
  intros x y z.
  rewrite plus_comm.
  rewrite (plus_comm y z).
  reflexivity.
Qed.

Lemma in_not_nil :
  forall A (x : A) (l : list A),
    In x l -> l <> [].
Proof.
  intros A x l H. unfold not. intro Hl. destruct l.
  - simpl in H. destruct H.
  - discriminate Hl.
Qed.

Lemma in_not_nil_42 :
  forall l : list nat,
    In 42 l -> l <> [].
Proof.
  (* WORKED IN CLASS *)
  intros l H.
  Fail apply in_not_nil.
Abort.

Lemma in_not_nil_42_take2 :
  forall l : list nat,
    In 42 l -> l <> [].
Proof.
  intros l H.
  apply in_not_nil with (x := 42).
  apply H.
Qed.

(* apply ... in ... *)
Lemma in_not_nil_42_take3 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply in_not_nil in H.
  apply H.
Qed.

(* Explicitly apply the lemma to the value for x. *)
Lemma in_not_nil_42_take4 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply (in_not_nil nat 42).
  apply H.
Qed.

(* Explicitly apply the lemma to a hypothesis. *)
Lemma in_not_nil_42_take5 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply (in_not_nil _ _ _ H).
Qed.

Theorem mult_0_r : forall n : nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [|n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

(*
Lemma In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.

Lemma proj1 : forall P Q : Prop,
  P /\ Q -> P.

I don't know what it means yet.
*)
Example lemma_application_ex :
  forall {n : nat} {ns : list nat},
    In n (map (fun m => m * 0) ns) ->
    n = 0.
Proof.
  intros n ns H.
  destruct (proj1 _ _ (In_map_iff _ _ _ _ _) H)
           as [m [Hm _]].
  rewrite mult_0_r in Hm. rewrite <- Hm. reflexivity.
Qed.

Example function_equality_ex1 :
  (fun x => 3 + x) = (fun x => (pred 4) + x).
Proof. reflexivity. Qed.

Axiom functional_extensionality : forall {X Y: Type}
  {f g : X -> Y},
  (forall (x:X), f x = g x) -> f = g.

Example function_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
  apply functional_extensionality. intros x.
  apply plus_comm.
Qed.

Print Assumptions function_equality_ex2.

Fixpoint rev_append {X} (l1 l2 : list X) : list X :=
  match l1 with
  | [] => l2
  | x :: l1' => rev_append l1' (x :: l2)
  end.
Definition tr_rev {X} (l : list X) : list X :=
  rev_append l [].

Axiom rev_append_aux : forall X (x : X) (l: list X),
  rev_append l [x] = rev_append l [ ] ++ [x].

Lemma tr_rev_correct : forall X,
  @tr_rev X = @rev X.
Proof.
  intros.
  apply functional_extensionality.
  intros l. induction l as [|x l' IHl'].
  - reflexivity.
  - unfold tr_rev. simpl.
    rewrite <- IHl'. unfold tr_rev.
    apply rev_append_aux.
Qed.

Example even_42_bool : evenb 42 = true.
Proof. reflexivity. Qed.

Example even_42_prop : exists k, 42 = double k.
Proof. exists 21. reflexivity. Qed.

Theorem evenb_double : forall k,
  evenb (double k) = true.
Proof.
  intros k. induction k as [|k' IHk'].
  - reflexivity.
  - simpl. rewrite plus_comm. simpl.
    rewrite <- IHk'. reflexivity.
Qed.

(* Originally in Basics.v *)
Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof. Admitted.

Axiom negb_axiom1 : forall (b : bool),
  negb b = true -> b = false.

Axiom negb_axiom2 : forall (b : bool),
  negb b = false -> b = true.

Theorem evenb_double_conv : forall n,
  exists k, n = if evenb n then double k
                else S (double k).
Proof.
  intros. induction n as [|n' IHn'].
  - simpl. exists 0. reflexivity.
  - destruct (evenb (S n')) eqn:E1.
    + rewrite evenb_S in E1.
      apply negb_axiom1 in E1.
      rewrite E1 in IHn'.
      destruct IHn' as [k0 IHn'].
      exists (S k0). rewrite IHn'.
      unfold double. symmetry. simpl.
      rewrite plus_comm. simpl. reflexivity.
    + rewrite evenb_S in E1.
      apply negb_axiom2 in E1.
      rewrite E1 in IHn'.
      destruct IHn' as [k0 IHn'].
      rewrite IHn'. exists k0.
      reflexivity.
Qed.

Theorem even_bool_prop : forall n,
  evenb n = true <-> exists k, n = double k.
Proof.
  intros n. split.
  - intros H. destruct (evenb_double_conv n) as [k Hk].
    rewrite Hk. rewrite H. exists k. reflexivity.
  - intros [k Hk]. rewrite Hk. apply evenb_double.
Qed.

Theorem eqb_refl : forall n,
  true = (n =? n).
Proof.
  intros. induction n as [|n' H].
  - simpl. reflexivity.
  - simpl. apply H.
Qed.

Theorem eqb_eq : forall n1 n2 : nat,
  n1 =? n2 = true <-> n1 = n2.
Proof.
  intros n1 n2. split.
  - apply eqb_true.
  - intros H. rewrite H. rewrite <- eqb_refl. reflexivity.
Qed.

(* Proof by reflection. examples *)
Example even_1000 : exists k, 1000 = double k.
Proof. exists 500. reflexivity. Qed.
Example even_1000' : evenb 1000 = true.
Proof. reflexivity. Qed.
(* What is interesting is that, since the
   two notions are equivalent, we can use
   the boolean formulation to prove the
   other one without mentioning the value
   500 explicitly:
 *)
Example even_1000'' : exists k, 1000 = double k.
Proof. apply even_bool_prop. reflexivity. Qed.

Example not_even_1001 : evenb 1001 = false.
Proof.
  (* WORKED IN CLASS *)
  reflexivity.
Qed.

Example not_even_1001' :
  ~ (exists k, 1001 = double k).
Proof.
  (* WORKED IN CLASS *)
  rewrite <- even_bool_prop.
  unfold not.
  simpl.
  intro H.
  discriminate H.
Qed.

Lemma plus_eqb_example : forall n m p : nat,
    n =? m = true -> n + p =? m + p = true.
Proof.
  intros n m p H.
  rewrite eqb_eq in H.
  rewrite H.
  rewrite eqb_eq.
  reflexivity.
Qed.

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

Lemma andb_true_iff : forall b1 b2:bool,
  b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros. split.
  - unfold andb. intros H. destruct b1.
    + split. reflexivity. apply H.
    + discriminate H.
  - intros H. destruct H as [H1 H2].
    unfold andb. rewrite H1. simpl.
    apply H2.
Qed.

Lemma orb_true_iff : forall b1 b2,
  b1 || b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros. split.
  - unfold orb. intros H. destruct b1.
    left. reflexivity. right. apply H.
  - intros H. unfold orb.
    destruct H as [H1 | H2].
    + rewrite H1. simpl. reflexivity.
    + destruct b1. reflexivity. apply H2.
Qed.

Theorem eqb_false : forall n m,
  n =? m = false -> n <> m.
Proof. Admitted.

(*
Theorem eqb_neq : forall x y : nat,
  x =? y = false <-> x <> y.
Proof.
  intros. split.
  - apply eqb_false.
  - unfold not. intros H.
Qed.
*)

Fixpoint eqb_list {A : Type}
  (eqb : A -> A -> bool) (l1 l2 : list A) : bool :=
  match l1, l2 with
  | _ , [] => false
  | [] , _ => false
  | (h1 :: t1) , (h2 :: t2) =>
    if (eqb h1 h2) then (eqb_list eqb t1 t2)
      else false
  end.

(*
Lemma eqb_list_true_iff :
  forall A (eqb : A -> A -> bool),
    (forall a1 a2, eqb a1 a2 = true <-> a1 = a2) ->
    forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2.
Proof.
  intros. split.
*)

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | [] => true
  | x :: l' => andb (test x) (forallb test l')
  end.

Theorem forallb_true_iff : forall X test (l : list X),
   forallb test l = true <-> All (fun x => test x = true) l.
Proof.
  intros. split.
  - induction l as [|h t IHt].
    simpl. reflexivity. simpl. intros H.
    apply andb_true_iff in H.
    destruct H as [H0 H1]. split.
    apply H0. apply IHt. apply H1.
  - induction l as [|h t IHt].
    simpl. reflexivity. simpl. intros [H0 H1].
    rewrite H0. simpl. apply IHt. apply H1.
Qed.

Theorem restricted_excluded_middle : forall P b,
  (P <-> b = true) -> P \/ ~ P.
Proof.
  intros P [] H.
  - left. rewrite H. reflexivity.
  - right. rewrite H. intros contra. discriminate contra.
Qed.

Theorem restricted_excluded_middle_eq : forall (n m : nat),
  n = m \/ n <> m.
Proof.
  intros n m.
  apply (restricted_excluded_middle (n = m) (n =? m)).
  symmetry.
  apply eqb_eq.
Qed.

Definition excluded_middle := forall P : Prop,
  P \/ ~ P.

(*
Theorem not_exists_dist :
  excluded_middle ->
    forall (X:Type) (P : X -> Prop),
      ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  unfold excluded_middle. unfold not.
  intros.
Qed.

Theorem excluded_middle_irrefutable: forall (P:Prop),
  ~ ~ (P \/ ~ P).
Proof.
  intros. unfold not. intros H.
  apply H.
Qed.
*)

Definition peirce := forall P Q: Prop,
  ((P -> Q) -> P) -> P.

Definition double_negation_elimination := forall P:Prop,
  ~ ~ P -> P.

Definition de_morgan_not_and_not := forall P Q:Prop,
  ~ (~ P /\ ~ Q) -> P \/ Q.

Definition implies_to_or := forall P Q:Prop,
  (P -> Q) -> (~ P \/ Q).


(** ProofCafe Coq入門 #2 *)
(** 2017/8/19 @suharahiromichi  *)

Set Implicit Arguments.

(* 自然数 *)
Require Import Arith.

Goal forall x y z : nat, x * (y * z) = x * y * z.
Proof.
  intros.
  Search (_ * (_ * _)).
  (* Search では Notation は見つからない。 *)
  now rewrite mult_assoc.                   (* Notation *)
  Undo 1.
  now rewrite Nat.mul_assoc.
  Undo 1.
  ring.
Qed.

Goal forall x : nat, 1 * x = x.
Proof.
  intros.
  now rewrite mult_1_l.                     (* Notation *)
  Undo 1.
  now rewrite Nat.mul_1_l.
  Undo 1.
  ring.
Qed.

Goal forall x : nat, x * 1 = x.
Proof.
  intros.
  now rewrite mult_1_r.                     (* Notation *)
  Undo 1.
  now rewrite Nat.mul_1_r.
  Undo 1.
  ring.
Qed.

(* 整数 *)
Require Import ZArith.
Open Scope Z.

(* Scope については、以下を参照のこと。

   Coq RM
   Chapter 12  Syntax extensions and interpretation scopes
   12.2  Interpretation scopes

   https://coq.inria.fr/refman/Reference-Manual014.html

   主なコマンドは、Bind Scope, Open Scope, Close Scoep.
   省略時解釈は、core_scope, type_scope, nat_scope の順番である。
 *)

Goal forall x y z : Z, x * (y * z) = x * y * z.
Proof.
  intros.
  now rewrite Zmult_assoc.                  (* Notation *)
  Undo 1.
  Search (_ * (_ * _)).                     (* Scope はSearchに影響するよう。 *)
  now rewrite Z.mul_assoc.
  Undo 1.
  ring.
Qed.

Goal forall x : Z, 1 * x = x.
Proof.
  intros.
  now rewrite Zmult_1_l.                    (* Notation *)
  Undo 1.
  now rewrite Z.mul_1_l.
  Undo 1.
  ring.
Qed.

Goal forall x : Z, x * 1 = x.
Proof.
  intros.
  now rewrite Zmult_1_r.                    (* Notation *)
  Undo 1.
  now rewrite Z.mul_1_r.
  Undo 1.
  ring.
Qed.

(* END *)


Add LoadPath "F:\sfsol".
Require Export Chap3.

Theorem double_injective' : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  Case "n = O". simpl. intros m eq. destruct m as [| m'].
    SCase "m = O". reflexivity.
    SCase "m = S m'". inversion eq.
  Case "n = S n'".
    intros m eq.
    destruct m as [| m'].
    SCase "m = O". inversion eq.
    SCase "m = S m'".
      assert (n' = m') as H.
      SSCase "Proof of assertion". apply IHn'.
        inversion eq. reflexivity.
      rewrite -> H. reflexivity. Qed.

Theorem double_injective_take2 : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m.
  generalize dependent n.
  induction m as [| m'].
  Case "m = O". simpl. intros n eq. destruct n as [| n'].
    SCase "n = O". reflexivity.
    SCase "n = S n'". inversion eq.
  Case "m = S m'". intros n eq. destruct n as [| n'].
    SCase "n = O". inversion eq.
    SCase "n = S n'".
      assert (n' = m') as H.
      SSCase "Proof of assertion".
        apply IHm'. inversion eq. reflexivity.
      rewrite -> H. reflexivity. Qed.

Theorem plus_n_n_injective_take2 : forall n m,
     n + n = m + m ->
     n = m.
Proof.
  intros n m.
  generalize dependent n.
  induction m.
  destruct n.
    reflexivity.
    intros H. inversion H.
  destruct n.
    intros H. inversion H.
    rewrite <- plus_n_Sm.
    rewrite <- plus_n_Sm.
    intros H. inversion H.
    assert (n = m). apply IHm.
    apply H1.
    rewrite -> H0.
    reflexivity.
    Qed.

Theorem index_after_last: forall (n : nat) (X : Type) (l : list X),
     length l = n ->
     index (S n) l = None.
Proof.
  intros n X l.
  generalize dependent n.
  induction l.
    intros n H.
    destruct n.
      reflexivity.
      inversion H.
    intros n H.
    destruct n.
      inversion H.
      simpl.
      inversion H.
      apply IHl.
      reflexivity.
  Qed.

(* index_after_last_informal yet to write *)

Theorem length_snoc''' : forall (n : nat) (X : Type)
                              (v : X) (l : list X),
     length l = n ->
     length (snoc l v) = S n.
Proof.
  intros n X v l.
  generalize dependent n.
  induction l.
  intros n.
  destruct n.
    reflexivity.
    intros H. inversion H.
  intros n H.
  destruct n.
    inversion H.
    simpl in H. inversion H.
    simpl.
    assert (length (snoc l v) = S n).
    apply IHl. apply H1.
    rewrite -> H.
    rewrite -> H0.
    reflexivity.
  Qed.

Theorem length_snoc'''' : forall (n : nat) (X : Type)
                              (v : X) (l : list X),
     length l = n ->
     length (snoc l v) = S n.
Proof.
  intros n X v l.
  generalize dependent n.
  induction l.
  intros n H.
  destruct n.
    reflexivity.
    inversion H.
  intros n H.
  destruct n.
    inversion H.
    simpl in H. inversion H.
    simpl.
    assert (length (snoc l v) = S n).
      apply IHl.
      apply H1.
    rewrite -> H0.
    rewrite -> H.
    reflexivity.
  Qed.

Theorem app_length_cons : forall (X : Type) (l1 l2 : list X)
                                  (x : X) (n : nat),
     length (l1 ++ (x :: l2)) = n ->
     S (length (l1 ++ l2)) = n.
Proof.
  intros X l1 l2 x n.
  generalize dependent n.
  induction l1.
  intros n H.
  rewrite <- H.
  reflexivity.
  intros n H.
  destruct n.
    inversion H.
    simpl in H.
    inversion H.
    simpl.
    rewrite -> H1.
    assert(S (length (l1 ++ l2)) = n).
      apply IHl1.
    apply H1.
    rewrite -> H0.
    reflexivity.
  Qed.

Theorem app_length_twice : forall (X:Type) (n:nat) (l:list X),
     length l = n ->
     length (l ++ l) = n + n.
Proof.
  intros X n l.
  generalize dependent n.
  induction l.
  intros n H.
  simpl in H.
  rewrite <- H.
  reflexivity.
  intros n H.
  destruct n.
    inversion H.
    simpl.
    assert (length (l ++ x :: l) = S (n + n)).
    inversion H.
    assert (length (l ++ l) = n + n).
    apply IHl. apply H1.
    rewrite -> H1.
    rewrite <- H0.
    remember (length (l ++ x :: l)) as len.
    symmetry.
    apply app_length_cons with (x:=x).
    symmetry.
    apply Heqlen.
    rewrite -> H0.
    rewrite -> plus_n_Sm.
    reflexivity.
  Qed.


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

(** The type [nat] of Peano natural numbers (built from [O] and [S])
    is defined in [Datatypes.v] *)

(** This module defines the following operations on natural numbers :
    - predecessor [pred]
    - addition [plus]
    - multiplication [mult]
    - less or equal order [le]
    - less [lt]
    - greater or equal [ge]
    - greater [gt]

   It states various lemmas and theorems about natural numbers,
   including Peano's axioms of arithmetic (in Coq, these are provable).
   Case analysis on [nat] and induction on [nat * nat] are provided too
 *)

Require Import Notations.
Require Import Datatypes.
Local Open Scope identity_scope.
Require Import Logic_Type.

Open Scope nat_scope.

Definition eq_S := f_equal S.

Hint Resolve (f_equal S): v62.
Hint Resolve (f_equal (A:=nat)): core.

(** The predecessor function *)

Definition pred (n:nat) : nat := match n with
                                 | O => n
                                 | S u => u
                                 end.
(* Hint Resolve (f_equal pred): v62. *)

Theorem pred_Sn : forall n:nat, n = pred (S n).
Proof.
  simpl; reflexivity.
Qed.

(** Injectivity of successor *)

Definition eq_add_S n m (H: S n = S m): n = m := f_equal pred H.
Hint Immediate eq_add_S: core.

Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
Proof.
  red; auto.
Qed.
Hint Resolve not_eq_S: core.

Definition IsSucc (n:nat) : Type :=
  match n with
  | O => False
  | S p => True
  end.

(** Zero is not the successor of a number *)

(* XXX Andrej: Try to put back in, does not work with current Coq. *)
(* Theorem O_S : forall n:nat, 0 <> S n. *)
(* Proof. *)
(*   discriminate. *)
(* Qed. *)
(* Hint Resolve O_S: core. *)

(* XXX Andrej: Try to put back in, does not work with current Coq. *)
(* Theorem n_Sn : forall n:nat, n <> S n. *)
(* Proof. *)
(*   induction n; auto. *)
(* Qed. *)
(* Hint Resolve n_Sn: core. *)

(** addition *)

Fixpoint plus (n m:nat) : nat :=
  match n with
  | O => m
  | S p => S (p + m)
  end

where "n + m" := (plus n m) : nat_scope.

Hint Resolve (f_equal2 plus): v62.
Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.

Lemma plus_n_O : forall n:nat, n = n + 0.
Proof.
  induction n; simpl; auto.
Qed.
Hint Resolve plus_n_O: core.

Lemma plus_O_n : forall n:nat, 0 + n = n.
Proof.
  auto.
Qed.

Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
Proof.
  intros n m; induction n; simpl; auto.
Qed.
Hint Resolve plus_n_Sm: core.

Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m).
Proof.
  auto.
Qed.

(** Standard associated names *)

Notation plus_0_r_reverse := plus_n_O (compat "8.2").
Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2").

(** Multiplication *)

Fixpoint mult (n m:nat) : nat :=
  match n with
  | O => 0
  | S p => m + p * m
  end

where "n * m" := (mult n m) : nat_scope.

Hint Resolve (f_equal2 mult): core.

Lemma mult_n_O : forall n:nat, 0 = n * 0.
Proof.
  induction n; simpl; auto.
Qed.
Hint Resolve mult_n_O: core.

Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m.
Proof.
  intros; induction n as [| p H]; simpl; auto.
  destruct H; rewrite <- plus_n_Sm; apply eq_S.
  pattern m at 1 3; elim m; simpl; auto.
Qed.
Hint Resolve mult_n_Sm: core.

(** Standard associated names *)

Notation mult_0_r_reverse := mult_n_O (compat "8.2").
Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2").

(** Truncated subtraction: [m-n] is [0] if [n>=m] *)

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O, _ => n
  | S k, O => n
  | S k, S l => k - l
  end

where "n - m" := (minus n m) : nat_scope.

(** Definition of the usual orders, the basic properties of [le] and [lt]
    can be found in files Le and Lt *)

Inductive le (n:nat) : nat -> Type :=
  | le_n : n <= n
  | le_S : forall m:nat, n <= m -> n <= S m

where "n <= m" := (le n m) : nat_scope.

Hint Constructors le: core.
(*i equivalent to : "Hints Resolve le_n le_S : core." i*)

Definition lt (n m:nat) := S n <= m.
Hint Unfold lt: core.

Infix "<" := lt : nat_scope.

Definition ge (n m:nat) := m <= n.
Hint Unfold ge: core.

Infix ">=" := ge : nat_scope.

Definition gt (n m:nat) := m < n.
Hint Unfold gt: core.

Infix ">" := gt : nat_scope.

Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope.
Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.

Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
Proof.
induction 1; auto. destruct m; simpl; auto.
Qed.

Theorem le_S_n : forall n m, S n <= S m -> n <= m.
Proof.
intros n m. exact (le_pred (S n) (S m)).
Qed.

(** Case analysis *)

Theorem nat_case :
 forall (n:nat) (P:nat -> Type), P 0 -> (forall m:nat, P (S m)) -> P n.
Proof.
  induction n; auto.
Qed.

(** Principle of double induction *)

Theorem nat_double_ind :
 forall R:nat -> nat -> Type,
   (forall n:nat, R 0 n) ->
   (forall n:nat, R (S n) 0) ->
   (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
Proof.
  induction n; auto.
  destruct m; auto.
Qed.

(** Maximum and minimum : definitions and specifications *)

Fixpoint max n m : nat :=
  match n, m with
    | O, _ => m
    | S n', O => n
    | S n', S m' => S (max n' m')
  end.

Fixpoint min n m : nat :=
  match n, m with
    | O, _ => 0
    | S n', O => 0
    | S n', S m' => S (min n' m')
  end.

(* Theorem max_l : forall n m : nat, m <= n -> max n m = n. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem max_r : forall n m : nat, n <= m -> max n m = m. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem min_l : forall n m : nat, n <= m -> min n m = n. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem min_r : forall n m : nat, m <= n -> min n m = m. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(** [n]th iteration of the function [f] *)

Fixpoint nat_iter (n:nat) {A} (f:A->A) (x:A) : A :=
  match n with
    | O => x
    | S n' => f (nat_iter n' f x)
  end.

Lemma nat_iter_succ_r n {A} (f:A->A) (x:A) :
  nat_iter (S n) f x = nat_iter n f (f x).
Proof.
  induction n; intros; simpl; rewrite <- ?IHn; trivial.
Qed.

Theorem nat_iter_plus :
  forall (n m:nat) {A} (f:A -> A) (x:A),
    nat_iter (n + m) f x = nat_iter n f (nat_iter m f x).
Proof.
  induction n; intros; simpl; rewrite ?IHn; trivial.
Qed.

(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
    then the iterates of [f] also preserve it. *)

Theorem nat_iter_invariant :
  forall (n:nat) {A} (f:A -> A) (P : A -> Type),
    (forall x, P x -> P (f x)) ->
    forall x, P x -> P (nat_iter n f x).
Proof.
  induction n; simpl; trivial.
  intros A f P Hf x Hx. apply Hf, IHn; trivial.
Qed.


Require Import Coq.Lists.List.
Require Import Coq.Arith.PeanoNat.

(** List Sets *)

(* this would normally be kept abstract as a section variable,
   but for testing, we make it concrete *)
Definition E := nat.
Definition eeq: forall (e1 e2: E), {e1 = e2} + {e1 <> e2} := Nat.eq_dec.

Definition set: Type -> Type := list.

Definition contains(A: set E)(e: E): Prop := List.In e A.

Definition empty_set: set E := nil.

Definition singleton_set(e: E): set E := (cons e nil).

Definition union(A B: list E): list E :=
  fold_left (fun res a => if in_dec eeq a res then res else a :: res) A B.

Definition intersect(A B: list E): list E :=
  fold_left (fun res a => if in_dec eeq a B then a :: res else res) A nil.

Definition diff(A B: list E): list E :=
  fold_left (fun res b => remove eeq b res) B A.

(** Specs of set operations in terms of "contains" *)

Conjecture empty_set_spec: forall (x: E), contains empty_set x <-> False.

Conjecture singleton_set_spec: forall (x y: E),
    contains (singleton_set y) x <-> x = y.

Conjecture union_spec: forall (x: E) (A B: set E),
    contains (union A B) x <-> contains A x \/ contains B x.

Conjecture intersect_spec: forall (x: E) (A B: set E),
    contains (intersect A B) x <-> contains A x /\ contains B x.

Conjecture diff_spec: forall (x: E) (A B: set E),
    contains (diff A B) x <-> contains A x /\ ~ contains B x.

(** Additional functions for sets defined in terms of the primitive ones *)

Definition add(s: set E)(e: E) := union (singleton_set e) s.
Definition remove_elem(s: set E)(e: E) := diff s (singleton_set e).
Definition subset(s1 s2: set E) := forall x, contains s1 x -> contains s2 x.
Definition disjoint(s1 s2: set E) := forall x, (~ contains s1 x) \/ (~ contains s2 x).

(** List Maps *)

(* this would normally be kept abstract as a section variable,
   but for testing, we make it concrete *)
Definition K: Type := nat.
Definition V: Type := nat.
Definition keq: forall (k1 k2: K), {k1 = k2} + {k1 <> k2} := Nat.eq_dec.
Definition veq: forall (v1 v2: V), {v1 = v2} + {v1 <> v2} := Nat.eq_dec.

Definition map(K V: Type): Type := list (K * V).

Definition empty_map: map K V := nil.

Definition get(M: map K V)(k: K): option V :=
  match find (fun '(ki, vi) => if keq ki k then true else false) M with
  | Some (_, v) => Some v
  | None => None
  end.

Definition remove(M: map K V)(k: K): map K V :=
  filter (fun '(ki, vi) => if keq k ki then false else true) M.

Definition put(M: map K V)(k: K)(v: V): map K V := (k, v) :: (remove M k).

Definition restrict(M: map K V)(A: set K): map K V :=
  filter (fun '(ki, vi) => if in_dec keq ki A then true else false) M.

Definition domain(M: map K V): set K := List.map fst M.

Definition domain_and_range(M: map K V): set K * set V :=
  fold_left (fun '(d, r) '(ki, vi) =>
               if in_dec keq ki d then (d, r) else (ki :: d, vi :: r)
            ) M (empty_set, empty_set).

Definition range(M: map K V): set V :=
  snd (domain_and_range M).

Definition reverse_get(M: map K V)(v: V): option K :=
  snd (fold_left (fun '(seen_keys, res) '(ki, vi) =>
                    if in_dec keq ki seen_keys then (seen_keys, res)
                    else (ki :: seen_keys, if veq vi v then Some ki else res))
                 M (empty_set, None)).

Definition intersect_map(M1 M2: map K V): map K V :=
  filter (fun '(k1, v1) => match get M1 k1, get M2 k1 with
                           | Some v1', Some v2 => if veq v1' v1
                                                  then if veq v1 v2 then true else false
                                                  else false
                           | _, _ => false
                           end) M1.

Definition preimage(M: map K V)(vs: set V): set K :=
  filter (fun ki => match get M ki with
                    | Some vi => if in_dec veq vi vs then true else false
                    | None => false
                    end)
         (domain M).

Definition remove_keys(M: map K V)(ks: set K): map K V :=
  filter (fun '(ki, vi) => if in_dec keq ki ks then false else true) M.

Definition remove_by_value(M: map K V)(v: V): map K V :=
  remove_keys M (preimage M (singleton_set v)).

Definition remove_values(M: map K V)(vs: set V): map K V :=
  remove_keys M (preimage M vs).

Definition update_map(M1 M2: map K V): map K V :=
  (filter (fun '(k1, v1) =>
             if (find (fun '(k2, v2) => if keq k1 k2 then true else false) M2)
             then false else true) M1) ++ M2.

(** Specs of the map functions in terms of "get" *)

Conjecture empty_is_empty: forall (k: K),
    get empty_map k = None.

Conjecture get_remove_same: forall m k,
    get (remove m k) k = None.

Conjecture get_remove_diff: forall m k1 k2,
    k1 <> k2 -> get (remove m k1) k2 = get m k2.

Conjecture get_put_same: forall (m: map K V) (k: K) (v: V),
    get (put m k v) k = Some v.

Conjecture get_put_diff: forall (m: map K V) (k1 k2: K) (v: V),
    k1 <> k2 -> get (put m k1 v) k2 = get m k2.

Conjecture get_restrict_in: forall m k ks,
    contains ks k -> get (restrict m ks) k = get m k.

Conjecture get_restrict_notin: forall m k ks,
    ~ contains ks k -> get (restrict m ks) k = None.

Conjecture in_domain: forall m k v,
    get m k = Some v -> contains (domain m) k.

Conjecture not_in_domain: forall m k,
    get m k = None -> ~ contains (domain m) k.

Conjecture in_range: forall m k v,
    get m k = Some v -> contains (range m) v.

Conjecture not_in_range: forall m v,
    (forall k, get m k <> Some v) -> ~ contains (range m) v.

Conjecture range_spec: forall m v,
    contains (range m) v <-> exists k, get m k = Some v.

Conjecture reverse_get_Some: forall m k v,
    reverse_get m v = Some k -> get m k = Some v.

Conjecture reverse_get_None: forall m v,
    reverse_get m v = None -> forall k, get m k <> Some v.

Conjecture intersect_map_spec: forall k v m1 m2,
    get (intersect_map m1 m2) k = Some v <-> get m1 k = Some v /\ get m2 k = Some v.

Conjecture remove_by_value_same: forall k v m,
    get m k = Some v -> get (remove_by_value m v) k = None.

Conjecture remove_by_value_diff: forall k v m,
    get m k <> Some v -> get (remove_by_value m v) k = get m k.

Conjecture remove_values_never_there: forall m k vs,
    get m k = None ->
    get (remove_values m vs) k = None.

Conjecture remove_values_removed: forall m k v vs,
    get m k = Some v ->
    contains vs v ->
    get (remove_values m vs) k = None.

Conjecture remove_values_not_removed: forall m k v vs,
    get m k = Some v ->
    ~ contains vs v ->
    get (remove_values m vs) k = Some v.

Conjecture get_update_map_l: forall m1 m2 k,
    get m2 k = None ->
    get (update_map m1 m2) k = get m1 k.

Conjecture get_update_map_r: forall m1 m2 k v,
    get m2 k = Some v ->
    get (update_map m1 m2) k = Some v.

(** Additional map judgments defined in terms of the primitive ones *)

Definition extends(s1 s2: map K V) :=
  forall x w, get s2 x = Some w -> get s1 x = Some w.

Definition only_differ(s1: map K V)(d: set K)(s2: map K V) :=
  forall x, contains d x \/ get s1 x = get s2 x.

Definition agree_on(s1: map K V)(d: set K)(s2: map K V) :=
  forall x, contains d x -> get s1 x = get s2 x.

Definition undef_on(s: map K V)(ks: set K) :=
  forall x, contains ks x -> get s x = None.


(* Razonamiento automatizado 2020-2
   Loyola Cruz Luis Fernando.
   Reyes Granados Naomi Itzel.
   Tarea 4, Tácticas básicas y negación clásica*)

Variables p q r s t x l m:Prop.
Variables U:Type.
Variables P Q: U -> Prop.
Variables R : U -> U -> Prop.
Variables a b : U.

Section LPyLPO.

Theorem DilemaC : (p -> q) -> (r -> s) -> p \/ r -> q \/ s.
Proof.
intro.
intro.
intro.
destruct H1.
left.
apply H.
assumption.
right.
apply H0.
assumption.
Qed.

Theorem Distrib : p \/ (q /\ r) -> (p \/ q) /\ (p \/ r).
Proof.
intro.
split.
destruct H.
left.
assumption.
destruct H.
right.
assumption.
destruct H.
left.
assumption.
destruct H.
right.
assumption.
Qed.

Theorem Argumento1: ((x \/ p) /\ q -> l) /\
                    (m \/ q -> s /\ t) /\
                    ((s /\ t) /\ l -> x) /\
                    (p -> q) ->
                    (m /\ p -> x).
Proof.
intro.
destruct H.
destruct H0.
destruct H1.
intro.
destruct H3.
apply H1.
split.
apply H0.
left.
assumption.
apply H.
split.
right.
assumption.
apply H2.
assumption.
Qed.

Theorem Socrates: (forall x:U, P x -> Q x) /\ P a -> Q a.
Proof.
intro.
destruct H.
apply H.
assumption.
Qed.

Theorem DistrExistsConj: (exists x:U, P x /\ Q x) -> (exists x:U, P x) /\ (exists x:U, Q x).
Proof.
intro.
split.
destruct H.
destruct H.
exists x0.
assumption.
destruct H.
destruct H.
exists x0.
assumption.
Qed.

Theorem Argumento2: (forall y:U, P y -> Q y) -> (forall x:U, (exists y:U, P y /\ R x y) -> exists z:U, Q z /\ R x z).
Proof.
intro.
intros.
destruct H0.
destruct H0.
exists x1.
split.
apply H.
assumption.
assumption.
Qed.

End LPyLPO.

Section LogConst.

Theorem NegImp: (p -> q) -> (p -> ~q) -> ~p.
Proof.
heorem NegImp: (p -> q) -> (p -> ~q) -> ~p.
Proof.
intros.
unfold not.
intro.
absurd (q).
apply H0.
assumption.
apply H.
assumption.
Qed.

Theorem nonoTExc: ~~(p \/ ~p).
Proof.
unfold not.
intro.
apply H.
right.
intro.
apply H.
left.
assumption.
Qed.

Theorem dmorganO : ~ ( p \/ q ) <-> ~p /\ ~q.
Proof.
unfold iff.
split.
unfold not.
intro.
split.
intro.
apply H.
left.
assumption.
intro.
apply H.
right.
assumption.
unfold not.
intros.
destruct H.
destruct H0.
apply H.
assumption.
apply H1.
assumption.
Qed.

Theorem Argumento3: (forall x:U, P x -> Q x) /\
              (~ exists x:U, P x /\ Q x) ->
              ~ exists x:U, P x.
Proof.
unfold not.
intros.
destruct H.
destruct H0.
apply H1.
exists x0.
split.
assumption.
apply H.
assumption.
Qed.

End LogConst.


Module Common.

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

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

  Fixpoint evenb (n:nat) : bool :=
     match n with
     | O => true
     | S O => false
     | S (S num) => evenb num
   end.

  Definition oddb (n:nat) : bool :=
     negb (evenb n).

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

Fixpoint app {X : Type} (l1 l2 : list X)
  : (list X) :=
  match l1 with
  | nil _ => l2
  | cons _ h t => cons X h (app t l2)
  end.

Fixpoint rev {X:Type} (l:(list X)) : (list X)  :=
  match l with
  | nil _   =>  nil  X
  | cons _ h t => app (rev t) (cons X h (nil X))
  end.

  Notation "x :: l" := (cons _ x l)
                     (at level 60, right associativity).
  Notation "[ ]" := (nil _).
  Notation "[ x ; .. ; y ]" := (cons _ x .. (cons _ y (nil _) ) ..).
  Notation "x ++ y" := (app x y)
                         (right associativity, at level 60).

  Check app [1;2] [3;4].

Lemma concat_append : forall X : Type, forall e : X, forall l : list X,
   cons _ e l = [e] ++ l.
Proof.
  intros X e l.
  simpl.
  reflexivity.
Qed.

Theorem app_nil_r : forall (X:Type), forall l:(list X),
  l ++ [] = l.
Proof.
  intros X l.
  induction l.
  - simpl. reflexivity.
  - simpl. rewrite IHl. reflexivity.
Qed.

Theorem app_assoc : forall A (l m n:list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  intros A l m n.
  induction l as [| l' IHl' ].
  {
    simpl.
    reflexivity.
  }
  {
    simpl.
    rewrite IHIHl'.
    reflexivity.
  }

Qed.

Theorem rev_app_distr: forall X (l1 l2 : list X),
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros X l1 l2.
  induction l1.
  {
    simpl.
    rewrite app_nil_r.
    reflexivity.
  }
  {
    simpl.
    rewrite IHl1.
    simpl.
    rewrite app_assoc.
    reflexivity.
  }

Qed.

Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
  induction l.
  { reflexivity. }
  { rewrite <- IHl.
    rewrite concat_append.
    rewrite rev_app_distr.
    rewrite IHl.
    rewrite rev_app_distr.
    rewrite IHl.
    simpl.
    reflexivity.
    }

Qed.

(* Common numeric functions *)

Definition minustwo (n : nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

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

(* Taken from chapter 2 *)
Theorem plus_n_Sm2 : forall n m : nat,
  S (n + m) = (S n) + m.
Proof.
   intros n m.
   induction n as [| n' IHn' ].
   - simpl. reflexivity.
   - simpl. rewrite -> IHn'. reflexivity.
Qed.

Fixpoint nth_error {X : Type} (l : list X) (n : nat)
  : option X :=
  match l with
  | [] => None
  | a :: l' => if (beq_nat n 0) then Some a else nth_error l' (pred n)
  end.

Fixpoint length {X : Type } (l : list X) : nat :=
  match l with
  | [] => 0
  | h :: t => S (length t)
  end.

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y) : list (X*Y) :=
  match lx, ly with
  | [], _ => []
  | _, [] => []
  | x :: tx, y :: ty => (x, y) :: (combine tx ty)
  end.

Fixpoint split { X Y : Type } (l : list (X*Y) )
  : (list X) * (list Y) :=
  match l with
  |  nil _ => (nil _, nil _)
  |  ((x,y) :: rest) =>  match (split rest) with
                         |  (x2,y2) => ((x::x2), (y::y2))
                         end

  end.

Fixpoint filter {X:Type} (test: X -> bool) (l:list X) : (list X) :=
  match l with
  | [] => []
  | h :: t => if test h then  h :: (filter test t)
               else filter test t
  end.

Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Fixpoint map {X Y:Type} (f : X -> Y) (l:list X) : (list Y) :=
  match l with
  | [] => []
  | h :: t => (f h) :: (map f t)
  end.

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

Fixpoint fold {X Y : Type} (f : X -> Y -> Y) (l: list X) (b:Y)
  : Y :=
  match l with
  | [] => b
  | h :: t => f h (fold f t b)
  end.

End Common.