Require Import ZArith.
Require Import List.
Require Import String.

Open Scope Z_scope.
Delimit Scope string_scope with string.
Local Open Scope string_scope.
Set Implicit Arguments.

(****Expressoes com Variaveis****)
Print string.
(*1*)

Inductive Op : Type :=
  | P   : Op
  | M   : Op
  | MM  : Op.

Let var := string.
Inductive El : Type :=
  | Num  : Z -> El
  | Var   : var -> El.

Inductive aexp :=
  | Leaf : El -> aexp
  | Node : aexp -> Op -> aexp -> aexp.

Let state := var -> Z.
Let init : state := fun _ => 0.

Let update (s : state) (v : var) (z : Z) : state :=
  fun x => if (string_dec x v)%string then z else s x.
(*2*)

Eval compute in "123".
Eval compute in init "x".
Eval compute in update init "x" 3 "x".
Eval compute in update init "x" 3 "y".

Fixpoint aeval (a : aexp) (s : state) : Z :=
    match a with
    | Leaf (Num n) => n
    | Leaf (Var n) => s n
    | Node L P R  => aeval L s + aeval R s
    | Node L M R  => aeval L s - aeval R s
    | Node L MM R => aeval L s * aeval R s
end.

Module TreeNotations.
Notation "( L ; + ; R )" := (Node L P R).
Notation "( L ; - ; R )" := (Node L M R).
Notation "( L ; * ; R )" := (Node L MM R).
Notation "« x »" := (Leaf (Num x)).
Notation "«« x »»" := (Leaf (Var x)).
End TreeNotations.

Import TreeNotations.

Module ListNotations.
Notation "[ ]" := nil (format "[ ]") : list_scope.
Notation "[ x ]" := (cons x nil) : list_scope.
Notation "[ x ; y ; .. ; z ]" := (cons x (cons y .. (cons z nil) ..)) : list_scope.
End ListNotations.

Import ListNotations.

Open Scope Z.

(*3*)

Eval compute in (2*3)+(3*(4-2)).

Eval compute in aeval ((«2»;*;«3»);+;(«3»;*;(«4»;-;«2»))) init.

Eval compute in (20-40)*(30+(1*1)).

Eval compute in aeval ((«20»;-;«40»);*;(«30»;+;(«1»;*;«1»))) init.

Eval compute in aeval ((«20»;-;«40»);*;(«30»;+;(««"x"»»;*;««"x"»»))) (update init "x" 1).

(*4*)

Fixpoint aevalR (a : aexp) (n : Z) (s : state) : Prop :=
  match a with
  | Leaf (Num z) => z = n
  | Leaf (Var v)  => s v = n
  | Node a1 op a2 =>
      match op with
      | P =>
          exists (n1 n2: Z),  aevalR a1 n1 s /\ aevalR a2 n2 s /\ n1 + n2 = n
      | M =>
          exists (n1 n2: Z),  aevalR a1 n1 s /\ aevalR a2 n2 s /\ n1 - n2 = n
      | MM =>
          exists (n1 n2: Z),  aevalR a1 n1 s /\ aevalR a2 n2 s /\ n1 * n2 = n
     end
  end.
(*5*)

Theorem RelEqFun : forall (a : aexp) (n : Z) (s : state),
                    (aevalR a n s) <-> (aeval a s = n).
Proof.
  induction a.
  - intros.
    induction e.
    + simpl. reflexivity.
    + simpl; reflexivity.
  - red. intros. induction o.
    + split.
      * simpl. intros.
        destruct H as [n1 H].
        destruct H as [n2 H].
        destruct H. destruct H0.
        assert (IHa1 := (IHa1 n1 s)).
        assert (IHa2 := (IHa2 n2 s)).
        unfold iff in IHa1; destruct IHa1; clear H3.
        unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H)).
        assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6.
        assumption.
      * simpl. intros.
        assert (IHa1 := (IHa1 (aeval a1 s) s)).
        assert (IHa2 := (IHa2 (aeval a2 s) s)).
        unfold iff in IHa1; destruct IHa1; clear H0.
        unfold iff in IHa2. destruct IHa2. clear H0.
        exists (aeval a1 s); exists (aeval a2 s).
        auto 4.
(*______________________________________________________________________________________________________________*)
    + split.
      * simpl; intros.
        destruct H as [n1 H];destruct H as [n2 H].
        destruct H; destruct H0;
        assert (IHa1 := (IHa1 n1 s));assert (IHa2 := (IHa2 n2 s)).
        unfold iff in IHa1; destruct IHa1; clear H3;unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H));assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6;assumption.
      * simpl; intros.
        assert (IHa1 := (IHa1 (aeval a1 s) s));assert (IHa2 := (IHa2 (aeval a2 s) s)).
        unfold iff in IHa1; destruct IHa1; clear H0;unfold iff in IHa2. destruct IHa2. clear H0.
        exists (aeval a1 s); exists (aeval a2 s); auto 4.
    + split.
      * simpl; intros.
        destruct H as [n1 H];destruct H as [n2 H].
        destruct H; destruct H0;
        assert (IHa1 := (IHa1 n1 s));assert (IHa2 := (IHa2 n2 s)).
        unfold iff in IHa1; destruct IHa1; clear H3;unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H));assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6;assumption.
      * simpl; intros.
        assert (IHa1 := (IHa1 (aeval a1 s) s));assert (IHa2 := (IHa2 (aeval a2 s) s)).
        unfold iff in IHa1; destruct IHa1; clear H0;unfold iff in IHa2. destruct IHa2. clear H0.
        exists (aeval a1 s); exists (aeval a2 s); auto 4.
Qed.

(****Maquina de Stack****)
Let stack     := list Z.

Inductive Exp : Type :=
  | Elm   : El -> Exp
  | Pls   : Exp
  | Min   : Exp
  | Mul   : Exp.

Let stack_exp := list Exp.

Definition SPush (n : Z) (st : stack) : stack :=
  cons n st.

Definition SLoad (x : var) (st : stack) (s : state) : stack :=
  cons (s x) st.

Definition SPlus (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b+a) c)
  end.

Definition SMinus (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b-a) c)
  end.

Definition SMult (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b*a) c)
  end.

(*1*)
Fixpoint execute (s : state) (st : stack) (a : stack_exp) : option stack :=
  match a with
  | nil => Some st
  | cons (Elm (Num n)) a' => execute s (SPush n st) a'
  | cons (Elm (Var v)) a' => execute s (SLoad v st s) a'
  | cons Pls a'     =>
      match SPlus st with
      | Some st' => execute s st' a'
      | None => None
      end
  | cons Min a'     =>
      match SMinus st with
      | Some st' => execute s st' a'
      | None => None
      end
  | cons Mul a'     =>
      match SMult st with
      | Some st' => execute s st' a'
      | None => None
      end
  end.

Check cons (Elm(Num 2)) (
                             cons (Elm(Num 3)) (
                             cons Mul (
                             cons (Elm(Num 3)) (
                             cons (Elm(Num 4)) (
                             cons (Elm(Num 2)) (
                             cons Min (
                             cons Mul (
                             cons Pls (
                             nil))))))))).

(*2*)
Let stack_machine : stack := nil.

Let expression : stack_exp := [Elm (Num 2); Elm (Num 3); Mul; Elm (Num 3); Elm (Num 4); Elm (Num 2); Min; Mul; Pls].

Eval compute in execute init stack_machine expression.

(*3*)
(*
    Decidimos usar o option para saber se houve problema.
    *)

Local Open Scope list.

(****Compilador****)

(*1*)
Fixpoint compile (a : aexp) : stack_exp :=
  match a with
  | Leaf e => cons (Elm e) nil
  | Node l P r => compile l ++ compile r ++ cons Pls nil
  | Node l M r => compile l ++ compile r ++ cons Min nil
  | Node l MM r => compile l ++ compile r ++ cons Mul nil
  end.

(*2*)

Eval compute in execute init nil (compile ((«2»;*;«3»);+;(«3»;*;(«4»;-;«2»)))).

(*3*)

Lemma Dinamic_Execute (z : Z) (se1 se2 : stack_exp) :
  forall (st st1 : stack) (s : state),
    execute s st se1 = Some (z :: nil) ->
    execute s (st ++ st1) (se1 ++ se2) = execute s (z :: st1) se2.
Proof.
  induction se1.
  - simpl.
    intros.
    inversion H.
    simpl.
    reflexivity.
  - induction a. induction e.
    + simpl.
      intros.
      apply (IHse1 (z0 :: st) st1 s).
      assumption.
    + simpl.
      intros.
      apply (IHse1 ((s v) :: st) st1 s).
      assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 + a) :: st) st1).
           assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 - a) :: st) st1).
           assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 * a) :: st) st1).
           assumption.
Qed.

Theorem Correction : forall (a : aexp) (s : state),
                     (execute s nil (compile a) = Some (cons (aeval a s) nil)).
Proof.
  intros.
  induction a. induction e.
  - simpl. reflexivity.
  - simpl; reflexivity.
  - induction o.
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1 s) (compile a1) (compile a2 ++ Pls :: nil) nil nil s) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2 s) (compile a2) (Pls :: nil) nil (aeval a1 s :: nil) s) IHa2)); simpl in H1.
      rewrite H.
      rewrite H1.
      reflexivity.
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1 s) (compile a1) (compile a2 ++ Min :: nil) nil nil s) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2 s) (compile a2) (Min :: nil) nil (aeval a1 s :: nil) s) IHa2)); simpl in H1.
      rewrite H; rewrite H1; reflexivity.
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1 s) (compile a1) (compile a2 ++ Mul :: nil) nil nil s) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2 s) (compile a2) (Mul :: nil) nil (aeval a1 s :: nil) s) IHa2)); simpl in H1.
      rewrite H; rewrite H1; reflexivity.
Qed.


(* ================================================================== *)
Section EX.

Variables (A:Set) (P : A->Prop).
Variable Q:Prop.

(* Check the type of an expression. *)
Check P.

Lemma trivial : forall x:A, P x -> P x.
Proof.
  intros.
  assumption.
Qed.

(* Prints the definition of an identifier. *)
Print trivial.

Lemma example : forall x:A, (Q -> Q -> P x) -> Q -> P x.
Proof.
  intros x H H0.
  apply H.
  assumption.
  assumption.
Qed.

Print example.

End EX.

Print example.
(* ================================================================== *)
Print trivial.

(* ================================================================== *)
(* ====================== Propositional Logic ======================= *)
(* ================================================================== *)

Section ExamplesPL.

Variables Q P :Prop.

Lemma ex1 : (P -> Q) -> ~Q -> ~P.
Proof.
  tauto.
Qed.

Print ex1.

Lemma ex1' : (P -> Q) -> ~Q -> ~P.
Proof.
  intros.
  intro.
  apply H0.
  apply H.
  assumption.
Qed.

Print ex1'.

Lemma ex2 : P /\ Q -> Q /\ P.
Proof.
  intro H.
  split.
  destruct H as [H1 H2].
  exact H2.
  destruct H; assumption.
Qed.

(* We can itemize the subgoals using - for each of them.
   Note that when entering in this mode the other subgoals are not displayed.
   For nested item use the symbols -, +, *, --, ++, **, ... *)
Lemma ex2' : P /\ Q -> Q /\ P.
Proof.
  intro H.  split.
  - destruct H as [H1 H2]. exact H2.
  - destruct H; assumption.
Qed.

Lemma ex3 : P \/ Q -> Q \/ P.
Proof.
  intros.
  destruct H as [h1 | h2].
  - right. assumption.
  - left; assumption.
Qed.

Theorem ex4 : forall A:Prop, A -> ~~A.
Proof.
  intros.
  intro.
  apply H0.
  exact H.
Qed.

Lemma ex4' : forall A:Prop, A -> ~~A.
Proof.
  intros.
  red.     (* does only the unfolding of the head of the goal *)
  intro.
  unfold not in H0.   (* unfold – applies the delta rule for a transparent constant. *)
  apply H0; assumption.
Qed.

Axiom double_neg_law : forall A:Prop, ~~A -> A.  (* classical *)

(* CAUTION: Axiom is a global declaration.
   Even after the section is closed double_neg_law is assume in the enviroment, and can be used.
   If we want to avoid this we should declare double_neg_law using the command Hypothesis.
*)

Lemma ex5 : (~Q -> ~P) -> P -> Q.   (* this result is only valid classically *)
Proof.
  intros.
  apply double_neg_law.
  intro.
  (* apply H; assumption. *)
  apply H.
  - assumption.
  - assumption.
Qed.

Lemma ex6 : (P \/ Q) /\ ~P -> Q.
Proof.
  intros.
  elim H. intros .
  destruct H.
  destruct H.
  - contradiction.
  - assumption.
Qed.

Lemma ex6' : (P \/ Q) /\ ~P -> Q.
Proof.
  intros.
  destruct H.
  destruct H.
  - contradiction.
  - assumption.
Qed.

Print ex6'.
Print ex6.

Lemma ex7 : ~(P \/ Q) <-> ~P /\ ~Q.
Proof.
  red.  (* unfold "<->". *)
  split.
  - intros.
    split.
    + unfold not in H.
    intro H1.
    apply H.
      left; assumption.
    + intro H1; apply H; right; assumption.
  - intros H H1.
    destruct H.
    destruct H1.
    + contradiction.
    + contradiction.
Qed.

Lemma ex7' : ~(P \/ Q) <-> ~P /\ ~Q.
Proof.
  tauto.
Qed.

Variable B :Prop.
Variable C :Prop.

(* exercise *)
Lemma ex8 : (P -> Q) /\ (B -> C) /\ P /\ B -> Q /\ C.
Proof.
  intros.
  destruct H as [H1 H2].
  destruct H2 as [H2 H3].
  destruct H3 as [H3 H4].
  split.
  - apply H1. apply H3.
  - apply H2. apply H4.
Qed.

(* exercise *)
Lemma ex9 : ~ (P /\ ~P).
Proof.
  unfold not.
  intros.
  destruct H.
  apply H0.
  apply H.
Qed.

End ExamplesPL.

(* ================================================================== *)
(* =======================  First-Order Logic ======================= *)
(* ================================================================== *)

Section ExamplesFOL.

Variable X :Set.
Variable t :X.
Variables R W : X -> Prop.

Lemma ex10 : (R t) -> (forall x, R x -> ~(W x)) -> ~(W t).
Proof.
  intros.
  apply H0.
  exact H.
Qed.

Lemma ex11 : forall x, R x -> exists x, R x.
Proof.
  intros.
  exists x.
  assumption.
Qed.

Lemma ex11' : forall x, R x -> exists x, R x.
Proof.
  firstorder.
Qed.

Lemma ex12 : (exists x, ~(R x)) -> ~ (forall x, R x).
Proof.
  intros H H1.
  destruct H as [x0 H0].
  apply H0.
  apply H1.
Qed.

Lemma ex13 : (exists x, R x) -> (forall x y, R x -> W y) -> forall y, W y.
Proof.
 intros H H1 y1.
 destruct H as [ x1 H0].
 (* try "apply H1." to see error message *)
 apply H1 with x1 . (* apply  (H1 x1). *)
 assumption.
Qed.

(* Exercise *)
Lemma ex14 : (forall x, R x) \/ (forall x, W x) -> forall x, (R x) \/ (W x).
Proof.
  intros H x.
  destruct H.
  - left. apply H.
  - right. apply H.
Qed.

Variable G : X->X->Prop.

(* Exercise *)
Lemma ex15 : (exists x, exists y, (G x y)) -> exists y, exists x, (G x y).
Proof.
  intros.
  destruct H as [x1 H].
  destruct H as [y1 H].
  exists y1. exists x1.
  apply H.
Qed.

(* Exercise *)
Proposition ex16: (forall x, W x) /\ (forall x, R x) -> (forall x, W x /\ R x).
Proof.
  intros.
  destruct H.
  split.
  - apply H.
  - apply H0.
Qed.

(* ------- Note that we can have nested sections ----------- *)
Section Relations.

Variable D : Set.
Variable Rel : D -> D -> Prop.

Hypothesis R_symmetric : forall x y:D, Rel x y -> Rel y x.
Hypothesis R_transitive : forall x y z:D, Rel x y -> Rel y z -> Rel x z.

Lemma refl_if : forall x:D, (exists y, Rel x y) -> Rel x x.
Proof.
  intros.
  destruct H.
  (* try "apply R_transitive" to see de error message *)
  apply R_transitive with x0.   (* apply (R_transitive x x0). *)
  - assumption.
  - apply R_symmetric.
    assumption.
Qed.

Check refl_if.

End Relations.

Check refl_if. (* Note the difference after the end of the section Relations. *)

(* ====== OTHER USES OF AXIOMS ====== *)

(* --- A stack abstract data type --- *)
Section Stack.

Variable U : Type.

Parameter stack : Type -> Type.
Parameter emptyS : stack U.
Parameter push : U -> stack U -> stack U.
Parameter pop : stack U -> stack U.
Parameter top : stack U -> U.
Parameter isEmpty : stack U -> Prop.

Axiom emptyS_isEmpty : isEmpty emptyS.
Axiom push_notEmpty : forall x s, ~isEmpty (push x s).
Axiom pop_push : forall x s, pop (push x s) = s.
Axiom top_push : forall x s, top (push x s) = x.

End Stack.

Check pop_push.

(* Now we can make use of stacks in our formalisation!!! *)

(* A NOTE OF CAUTION!!! *)
(* The capability to extend the underlying theory with arbitary axiom
   is a powerful but dangerous mechanism. We must avoid inconsistency.
*)
Section Caution.

Check False_ind.

Hypothesis ABSURD : False.

Theorem oops : forall (P:Prop), P /\ ~P.
elim ABSURD.
Qed.

End Caution. (* We have declared ABSURD as an hypothesis to avoid its use outside this section. *)


Require Export chapter06.

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

Notation "m <= n" := (le m n).

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n. Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n. Qed.

Theorem test_le3 :
  (2 <= 1) -> 2 + 2 = 5.
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H2. Qed.

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n:nat, square_of n (n * n).

Inductive next_nat (n:nat) : nat -> Prop :=
  | nn : next_nat n (S n).

Inductive next_even (n:nat) : nat -> Prop :=
  | ne_1 : ev (S n) -> next_even n (S n)
  | ne_2 : ev (S (S n)) -> next_even n (S (S n)).

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros m n o Lmn Lno.
  generalize dependent Lmn.
  generalize dependent m.
  induction Lno.
  Case "le_n". intros. apply Lmn.
  Case "le_S". intros. apply le_S. apply IHLno. apply Lmn.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  intros. induction n.
  apply le_n.
  apply le_S. apply IHn.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros. induction H.
  apply le_n.
  apply le_S. apply IHle.
Qed.

Theorem n_le_Sn : forall n, n <= S n.
Proof. intros. apply le_S. apply le_n. Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros. inversion H.
    apply le_n.
    apply le_trans with (n := S n). apply n_le_Sn.
    apply H2.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros. induction a.
  Case "0". simpl. apply O_le_n.
  Case "S". simpl. apply n_le_m__Sn_le_Sm. apply IHa.
Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
Admitted.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  unfold lt. intros. apply le_S. apply H.
Qed.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  intros n m. generalize dependent n. induction m.
  Case "0". destruct n.
    SCase "0". intros. apply le_n.
    SCase "S n". simpl. intros. inversion H.
  Case "S m". intros. destruct n.
    SCase "0". apply O_le_n.
    SCase "S n". apply n_le_m__Sn_le_Sm. apply IHm.
                 simpl in H. apply H.
Qed.

Theorem le_ble_nat : forall n m,
  n <= m ->
  ble_nat n m = true.
Proof.
  intros. generalize dependent n. induction m.
  Case "0". destruct n.
    SCase "0". simpl. intros. reflexivity.
    SCase "S n". intros. inversion H.
  Case "S m". intros. destruct n.
    SCase "0". simpl. reflexivity.
    SCase "S n". simpl. apply IHm.
                 apply Sn_le_Sm__n_le_m.
                 apply H.
Qed.

Theorem ble_nat_true_trans : forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof.
  intros.
  apply le_ble_nat.
  apply le_trans with (n := m).
    apply ble_nat_true. apply H.
    apply ble_nat_true. apply H0.
Qed.

Inductive R : nat -> nat -> nat -> Prop :=
   | c1 : R 0 0 0
   | c2 : forall m n o, R m n o -> R (S m) n (S o)
   | c3 : forall m n o, R m n o -> R m (S n) (S o)
   | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
   | c5 : forall m n o, R m n o -> R n m o.

Theorem R_add : forall m n o, R m n o -> m + n = o.
Proof.
  intros.
  induction H.
    simpl. reflexivity.
    simpl. apply f_equal. apply IHR.
    rewrite plus_comm. simpl. apply f_equal. rewrite -> plus_comm. apply IHR.
    simpl in IHR. inversion IHR. rewrite -> plus_comm in H1. simpl in H1.
                  inversion H1. rewrite -> plus_comm. reflexivity.
    rewrite -> plus_comm. apply IHR.
Qed.


Require Import ZArith Nnat Omega.
Open Scope Z_scope.

(** Test of the zify preprocessor for (R)Omega *)

(* More details in file PreOmega.v

   (r)omega with Z        : starts with zify_op
   (r)omega with nat      : starts with zify_nat
   (r)omega with positive : starts with zify_positive
   (r)omega with N        : starts with uses zify_N
   (r)omega with *        : starts zify (a saturation of the others)
*)

(* zify_op *)

Goal forall a:Z, Zmax a a = a.
intros.
omega with *.
Qed.

Goal forall a b:Z, Zmax a b = Zmax b a.
intros.
omega with *.
Qed.

Goal forall a b c:Z, Zmax a (Zmax b c) = Zmax (Zmax a b) c.
intros.
omega with *.
Qed.

Goal forall a b:Z, Zmax a b + Zmin a b = a + b.
intros.
omega with *.
Qed.

Goal forall a:Z, (Zabs a)*(Zsgn a) = a.
intros.
zify.
intuition; subst; omega. (* pure multiplication: omega alone can't do it *)
Qed.

Goal forall a:Z, Zabs a = a -> a >= 0.
intros.
omega with *.
Qed.

Goal forall a:Z, Zsgn a = a -> a = 1 \/ a = 0 \/ a = -1.
intros.
omega with *.
Qed.

(* zify_nat *)

Goal forall m: nat, (m<2)%nat -> (0<= m+m <=2)%nat.
intros.
omega with *.
Qed.

Goal forall m:nat, (m<1)%nat -> (m=0)%nat.
intros.
omega with *.
Qed.

Goal forall m: nat, (m<=100)%nat -> (0<= m+m <=200)%nat.
intros.
omega with *.
Qed.
(* 2000 instead of 200: works, but quite slow *)

Goal forall m: nat, (m*m>=0)%nat.
intros.
omega with *.
Qed.

(* zify_positive *)

Goal forall m: positive, (m<2)%positive -> (2 <= m+m /\ m+m <= 2)%positive.
intros.
omega with *.
Qed.

Goal forall m:positive, (m<2)%positive -> (m=1)%positive.
intros.
omega with *.
Qed.

Goal forall m: positive, (m<=1000)%positive -> (2<=m+m/\m+m <=2000)%positive.
intros.
omega with *.
Qed.

Goal forall m: positive, (m*m>=1)%positive.
intros.
omega with *.
Qed.

(* zify_N *)

Goal forall m:N, (m<2)%N -> (0 <= m+m /\ m+m <= 2)%N.
intros.
omega with *.
Qed.

Goal forall m:N, (m<1)%N -> (m=0)%N.
intros.
omega with *.
Qed.

Goal forall m:N, (m<=1000)%N -> (0<=m+m/\m+m <=2000)%N.
intros.
omega with *.
Qed.

Goal forall m:N, (m*m>=0)%N.
intros.
omega with *.
Qed.

(* mix of datatypes *)

Goal forall p, Z_of_N (N_of_nat (nat_of_N (Npos p))) = Zpos p.
intros.
omega with *.
Qed.


(* Brandon Reno | Robbie Hughs ----- KNAPSACK PROBLEM ----- Course Project Phase 2 - Implementation *)
From LF Require Import Poly.
From LF Require Export Induction.
From LF Require Export Lists.

(* WEIGHTCHECK DEFINITION: Purpose, get the weight of a group of items *)

Fixpoint WeightCheck (l:list (nat * nat)): nat :=
match l with
| [] => 0
| h :: t => snd h + WeightCheck t
end.

Lemma weightCheck_test1: WeightCheck [(3,4);(5,6);(7,8)] = 18.
Proof. reflexivity. Qed.

Lemma weightCheck_test2: WeightCheck [(3,6);(5,8);(7,1)] = 15.
Proof. reflexivity. Qed.

(* VALUECHECK DEFINITION: Purpose, get the value of a group of items *)

Fixpoint ValueCheck (l:list (nat * nat)): nat :=
match l with
| [] => 0
| h :: t => fst h + ValueCheck t
end.

Lemma valueCheck_test1: ValueCheck [(3,4);(5,6);(7,8)] = 15.
Proof. reflexivity. Qed.

Lemma valueCheck_test2: ValueCheck [(1,6);(5,8);(20,1)] = 26.
Proof. reflexivity. Qed.

(*FILTERWEIGHTS DEFINITION: Purpose, to filter a group of items and return only the groups
 of items less than equal to max weight does this by utilizing weight check function defined above *)

Fixpoint FilterWeights (l:list(list (nat * nat))) (max: nat): list(list(nat * nat)) :=
match l with
| [] => [[(0,0)]]
| h :: t => if leb (WeightCheck h) max then h :: (FilterWeights t max) else FilterWeights t max
end.

Lemma filter_test1: FilterWeights [[(3,4) ; (5,6) ; (7,8) ; (9,10)] ; [(1,6);(5,8);(20,1)] ; [(3,2) ; (2,3)]] 10 = [[(3,2) ; (2,3)]; [(0,0)]].
Proof. reflexivity. Qed.

Lemma filter_test2: FilterWeights [[(3,4) ; (5,6) ; (7,8) ; (9,10)] ; [(1,6);(5,8);(20,1)] ; [(3,2) ; (2,3)]] 15 = [[(1, 6); (5, 8); (20, 1)]; [(3, 2); (2, 3)]; [(0, 0)]].
Proof. reflexivity. Qed.

(*SUBSETS DEFINITION: Purpose, generates subsets of differen combinations of items *)

Fixpoint Subsets (l:list (nat * nat)): (list (list (nat * nat))) :=
match l with
| [] => [[]]
| h::t => Subsets t ++ map (app [h]) (Subsets t)
end.
Compute Subsets [(3,4) ; (5,6) ; (7,8)].

Lemma subset_test: Subsets [(3,4) ; (5,6) ; (7,8)] = [[ ]; [(7, 8)]; [(5, 6)]; [(5, 6); (7, 8)];
       [(3, 4)]; [(3, 4); (7, 8)]; [(3, 4); (5, 6)];
       [(3, 4); (5, 6); (7, 8)]].
Proof. reflexivity. Qed.

(* KNAPSACK DEFINITION: Purpose find the list that gets the greatest value
   KNAPSACKDRIVER DEFINITION: Purpose generate subsets of the given list, filter the subsets based on
        the max weight and then return the list from knapsack which gives best value *)

Fixpoint Knapsack (l:list (list (nat * nat))) (l2:list (nat * nat)) (value:nat): list (nat * nat) :=
match l with
|[] => l2
|h :: t => if leb value (ValueCheck h) then Knapsack t h (ValueCheck h) else Knapsack t l2 value
end.

Definition Knapsack_Driver (l:list (nat * nat)) (l2:list (nat * nat)) (max_weight: nat) : list (nat * nat) :=
match max_weight with
|O => l2
|S n => Knapsack (FilterWeights(Subsets l) max_weight) [] 0
end.

(* Testing the knapsack problem now with some test lemmas *)

Lemma Knapsack_Test: Knapsack_Driver [(3,4) ; (5,6) ; (7,8) ; (9,10)] [] 15 = [(3, 4); (9, 10)].
Proof. reflexivity. Qed.

Lemma Knapsack_Test2: Knapsack_Driver [(3,6) ; (5,2) ; (7,5) ; (30,10)] [] 15 =[(7, 5); (30, 10)].
Proof. reflexivity. Qed.

Lemma Knapsack_Test3: Knapsack_Driver [(3,6) ; (5,2) ; (7,5) ; (30,10)] [] 10 =[(30, 10)].
Proof. reflexivity. Qed.

Lemma Knapsack_Test4: Knapsack_Driver [(33,20) ; (56,23) ; (21,15) ; (30,10) ; (40,1) ; (23,13)] [] 10 =[(40, 1)].
Proof. reflexivity. Qed.

Lemma Knapsack_Test5: Knapsack_Driver [(33,20) ; (56,23) ; (21,15) ; (30,10) ; (40,1) ; (23,13)] [] 54 = [(33, 20); (56, 23); (30, 10); (40, 1)].
Proof. reflexivity. Qed.

(* Verification phase *)

Fixpoint max_val_perm (l : list(list(nat * nat))) (n : nat) : nat :=
match l with
| [] => n
| h :: t => if leb n (ValueCheck h) then max_val_perm t (ValueCheck h) else max_val_perm t n
end.

Lemma max_val_perm_test1: max_val_perm(FilterWeights [[(3,4) ; (5,6) ; (7,8) ; (9,10)] ; [(1,6);(5,8);(20,1)] ; [(3,2) ; (2,3)]] 10) 0 = 5.
Proof. intros. reflexivity. Qed.

Lemma max_val_perm_test2: max_val_perm(FilterWeights [[(3,4) ; (5,6) ; (7,8) ; (9,10)] ; [(1,6);(5,8);(20,1)] ; [(3,2) ; (2,3)]] 20) 0 = 26.
Proof. intros. reflexivity. Qed.

Lemma max_val_perm_test3: max_val_perm(FilterWeights [[(3,4) ; (5,6) ; (7,8) ; (9,10)] ; [(1,6);(5,8);(20,1)] ; [(3,2) ; (2,3)]] 30) 0 = 26.
Proof. intros. reflexivity. Qed.

Lemma ksg0: forall (l : list(nat * nat)) (w :nat), leb 0 (ValueCheck(Knapsack_Driver l [] w)) = true.
Proof. intros. induction l.
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

Lemma vcg0: forall (l : list(nat * nat)) (w : nat), leb 0 (max_val_perm(FilterWeights(Subsets l) w) 0) = true.
Proof. intros. induction l.
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

Lemma ks_help: forall (l : list(nat * nat)) (w : nat) (x : (nat * nat)),
(Knapsack_Driver l [] w) = (Knapsack_Driver (x :: l) [] w).
Proof. intros. induction w. reflexivity. Admitted.

Lemma vc_help: forall (l : list(nat * nat)) (w : nat) (x : (nat * nat)),
(max_val_perm (FilterWeights (Subsets l ) w)0) =  (max_val_perm (FilterWeights (Subsets (x::l)) w)0).
Proof. Admitted.

Lemma Knap_help: forall (l : list(nat * nat)) (w : nat) (x : (nat * nat)),
      (ValueCheck (Knapsack_Driver l [ ] w)) =? (max_val_perm (FilterWeights (Subsets l) w) 0) = true->
      (ValueCheck (Knapsack_Driver (x::l) [ ] w)) =? (max_val_perm (FilterWeights (Subsets (x::l)) w)0) = true.
Proof. intros. rewrite <- ks_help. rewrite <- vc_help. assumption.
Qed.

Theorem KnapSack_verification: forall (l: list(nat * nat)) (w: nat),
eqb (ValueCheck(Knapsack_Driver l [] w)) (max_val_perm(FilterWeights(Subsets l) w) 0) = true.
Proof. intros. induction l. induction w.
      - reflexivity.
      - reflexivity.
      - simpl. apply Knap_help. assumption.
Qed.


Require Import Arith.
Require Import ZArith.
Require Import Bool.

(** * Scope *)
(**

- core_scope : scope for Gallina basic notation
- type_scope : scope for Type

- [Open Scope <scope>.] : to open a scope
- [exp%k] : to specify a scope for an expression, [k] is a delimiting key (a symbol associated to a scope)
- [Locate <notation>.] : to know how notation(s) are interpreted

*)

Open Scope Z_scope.

Locate "_ * _".

(**

- [Print Scope <scope>.] : to know the associated delimiting key and all notation of a scope.

*)

Print Scope Z_scope.

(** * Check type *)

(**
- [Check t.] : To know the type of the term [t].
- [nat] is the delimiting key of [nat_scope], i.e. Peano numbers (TODO:to verify).
- [Z] is the delimiting key of [Z_scope], i.e. integers.
*)

Print Scope nat_scope.

Check 33%nat.
Check 0%nat.
Check 0.

Open Scope nat_scope.

Check 33.
Check 0.

Check 33%Z.
Check (-12)%Z.

Open Scope Z_scope.

Check (-12).
Check (33%nat).

(** There is no membership in Gallina, an integer of type [nat] is not include in [Z]. If we want to convert an integer of type [nat] to [Z], we need to define a function.
*)

(** * Simply typed lambda calculus *)

(**
Two types :
- _atomic_ type : e.g. [nat], [Z] and [bool]
- _arrow_ type : e.g. [A -> B]. TODO:See Ch05. ML.
*)

(**
- Declaration : [(x:A)]
- Definition : [x := t:A]
*)

(**
- _Environment_ : sequence of *global* declarations/definitions
- _Context_ : sequence of *local* declarations/definitions

At the beginning of a session, there is an environment called [initial] and an empty context.

- [Reset Initial.] : come back to [initial] environment.
- [Reset <id>.] : remove all declaration/definition after [id].
*)

(**
- $E$ #E# and $\Gamma$ #Gamma# denote respectively the environment and the context.
-
*)


(* Define a datatype to represent natural numbers. *)
Inductive nat : Set :=
  (* A natural number can be zero, *)
  | Z : nat
  (* or the successor of another natural number. *)
  | S : nat -> nat.

(* Two is the successor of successor of zero. *)
Definition two : nat := S (S Z).

(* We can find the predecessor. *)
Definition pred (n : nat) : nat :=
  (* Let's investigate the given number: *)
  match n with
    (* If it's zero, let's just return zero. *)
  | Z => Z
    (* Otherwise, pred of "succ of n" is just n. *)
  | S n' => n'
end.

(* We define addition on two "nat"s, recursively.
   A recursive function is defined using Fixpoint. *)
Fixpoint plus (n m : nat) : nat :=
  (* Let's analyze n. *)
  match n with
    (* If it's zero, we return m. *)
  | Z => m
    (* Otherwise, n is S n' for some n'. *)
  | S n' =>
    (* We recursively compute "plus n' m", then apply S. *)
    S (plus n' m)
end.

(* Equality type is defined like this. *)
Inductive eq (A : Set) : A -> A -> Prop :=
  refl : forall x : A, eq A x x.

(* Don't need to understand this now;
   just use equality type as "eq x y" and reflexivity as "refl". *)
Arguments eq {_} x y.
Arguments refl {_ _}.

(* Reflexivity holds by definition. *)
Definition this_is_free : eq (S Z) (S Z) := refl.

(* We can write more complex expressions as "Theorem", and provide "Proof" with tactics. *)
Theorem this_is_almost_free : eq (plus two Z) (plus Z two).
(* If you use Coq IDE locally, you can see "goal" at this point. *)
Proof.
  (* If we evaluate the two sides, they're equal, so we can prove the theorem with "refl". *)
  apply refl.
  (* All goals are satisfied, we close the proof with "Qed".
     Then "this_is_almost_free" is defined with auto-generated body. *)
Qed.

(* Now, we define a utility function "cong":
   if two sides are equal, they're still equal after applying a function on both sides. *)
Theorem cong : forall (f : nat -> nat) (n m : nat), eq n m -> eq (f n) (f m).
Proof.
  (* Bring the parameters as hypotheses. *)
  intros f n m eq_n_m.
  (* The "inversion" tactic can identify how we can satisfy "eq n m" - n and m should be equal. *)
  inversion eq_n_m.
  (* Now n and m are equal, and the goal is "eq (f m) (f m)". How do we close it? *)
  apply refl.
Qed.

(* Let's prove the main theorems. *)
Theorem plus_O_a : forall n : nat, eq (plus Z n) n.
Proof.
  (* Bring the parameters as hypotheses. Hint: See above. *)
  intros.
  (* "plus Z n" is, by definition of plus, "n". *)
  simpl plus.
  apply refl.
Qed.

Theorem plus_a_O : forall n : nat, eq (plus n Z) n.
Proof.
  (* This time, it's not simple at all like the above.
     Let's try induction principle. *)
  induction n as [ | n' IHn ].
    (* Base case : the theorem holds when n = Z (this is trivial.) *)
  - simpl plus.
    apply refl.
    (* Induction case : If the theorem holds with n', the theorem holds with S n'.
       The "If" part is given as hypothesis "IHn" here.
       Let's apply the definition of plus. If you're using IDE, you can see S is extracted out. *)
  - simpl.
    (* The conclusion has S on both sides. Let's strip it. *)
    apply cong.
    (* Now it's exactly the same as the induction hypothesis. *)
    assumption.
Qed.

(* Congratulations! For better introduction, google Coq Software Foundations. *)


Require Import XR_Rabs.
Require Import XR_Rsqr_le_abs_0.
Require Import XR_plus_le_is_le.
Require Import XR_Rle_0_sqr.

Local Open Scope R_scope.

Lemma triangle_rectangle_le : forall x y z:R,
    Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z.
Proof.
  intros x y z h.
  split.
  {
    apply Rsqr_le_abs_0.
    apply plus_le_is_le with (Rsqr y).
    { apply Rle_0_sqr. }
    { exact h. }
    }
  {
    apply Rsqr_le_abs_0.
    apply plus_le_is_le with (Rsqr x).
    { apply Rle_0_sqr. }
    {
      rewrite Rplus_comm.
      exact h.
    }
  }
Qed.


Set Nested Proofs Allowed.
Require Import Utf8 ZArith.
Require Import Main.RingLike.
Open Scope Z_scope.

Record gauss_int := mk_gi { gi_re : Z; gi_im : Z }.

Definition gi_zero := mk_gi 0 0.
Definition gi_one := mk_gi 1 0.
Definition gi_i := mk_gi 0 1.

Definition gi_add α β := mk_gi (gi_re α + gi_re β) (gi_im α + gi_im β).
Definition gi_mul α β :=
  mk_gi (gi_re α * gi_re β - gi_im α * gi_im β)
    (gi_re α * gi_im β + gi_im α * gi_re β).
Definition gi_opp α := mk_gi (- gi_re α) (- gi_im α).

Definition gi_sub α β := gi_add α (gi_opp β).
Definition gi_conj α := mk_gi (gi_re α) (- gi_im α).

Declare Scope G_scope.
Delimit Scope G_scope with G.
Notation "0" := gi_zero : G_scope.
Notation "1" := gi_one : G_scope.
Notation "'ⁱ'" := gi_i (at level 0) : G_scope.
Notation "- α" := (gi_opp α) : G_scope.
Notation "α + β" := (gi_add α β) : G_scope.
Notation "α * β" := (gi_mul α β) : G_scope.
Notation "α - β" := (gi_sub α β) : G_scope.

Definition gi_gauge (α : gauss_int) :=
  Z.abs_nat (gi_re α * gi_re α + gi_im α + gi_im α)%Z.

Definition gi_eucl_div α β :=
  let d := gi_re β * gi_re β + gi_im β * gi_im β in
(**)
  let γ := gi_re (α * gi_conj β)%G / d in
  let γ' := gi_im (α * gi_conj β)%G / d in
(*
  let γ := (gi_re α * gi_re β + gi_im α * gi_im β) / d in
  let γ' := (gi_im α * gi_re β - gi_re α * gi_im β) / d in
*)
  let q :=
    if lt_dec (gi_gauge (α - β * mk_gi γ γ')%G) (gi_gauge β) then
      mk_gi γ γ'
    else if lt_dec (gi_gauge (α - β * mk_gi (γ + 1) γ')%G) (gi_gauge β) then
      mk_gi (γ + 1) γ'
    else if lt_dec (gi_gauge (α - β * mk_gi γ (γ' + 1))%G) (gi_gauge β) then
      mk_gi γ (γ' + 1)
    else if
      lt_dec (gi_gauge (α - β * mk_gi (γ + 1) (γ' + 1))%G) (gi_gauge β)
    then
      mk_gi (γ + 1) (γ' + 1)
    else
      0%G
  in
  let r := (α - β * q)%G in
  (q, r).

Definition gi_div α β := fst (gi_eucl_div α β).

Notation "α / β" := (gi_div α β) : G_scope.

Canonical Structure gauss_int_ring_like_op : ring_like_op gauss_int :=
  {| rngl_zero := gi_zero;
     rngl_one := gi_one;
     rngl_add := gi_add;
     rngl_mul := gi_mul;
     rngl_opt_opp_or_subt := Some (inl gi_opp);
     rngl_opt_inv_or_quot := Some (inr gi_div);
     rngl_opt_eqb := None; (* to be improved, perhaps *)
     rngl_opt_le := None |}.

(*
Compute (mk_gi (- 36) 242 / mk_gi 50 50)%G.
*)

(* to be completed with gauss_int_ring_like_prop... *)


Fixpoint even (n : nat) : bool :=
match n with
| 0 => true
| S n' => odd n'
end

with odd (n : nat) : bool :=
match n with
| 0 => false
| S n' => even n'
end.