/-
Copyright (c) 2020 James Arthur. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Chris Hughes, Shing Tak Lam
-/
import analysis.special_functions.trigonometric.deriv
import analysis.special_functions.log

/-!
# Inverse of the sinh function

In this file we prove that sinh is bijective and hence has an
inverse, arsinh.

## Main Results

- `sinh_injective`: The proof that `sinh` is injective
- `sinh_surjective`: The proof that `sinh` is surjective
- `sinh_bijective`: The proof `sinh` is bijective
- `arsinh`: The inverse function of `sinh`

## Tags

arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective
-/
noncomputable theory

namespace real

/-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/
@[pp_nodot] def arsinh (x : ℝ) := log (x + sqrt (1 + x^2))

/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/
lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective

private lemma aux_lemma (x : ℝ) : 1 / (x + sqrt (1 + x ^ 2)) = -x + sqrt (1 + x ^ 2) :=
begin
  refine (eq_one_div_of_mul_eq_one _).symm,
  have : 0 ≤ 1 + x ^ 2 := add_nonneg zero_le_one (sq_nonneg x),
  rw [add_comm, ← sub_eq_neg_add, ← mul_self_sub_mul_self,
      mul_self_sqrt this, sq, add_sub_cancel]
end

private lemma b_lt_sqrt_b_one_add_sq (b : ℝ) : b < sqrt (1 + b ^ 2) :=
calc  b
    ≤ sqrt (b ^ 2)     : le_sqrt_of_sq_le le_rfl
... < sqrt (1 + b ^ 2) : sqrt_lt_sqrt (sq_nonneg _) (lt_one_add _)

private lemma add_sqrt_one_add_sq_pos (b : ℝ) : 0 < b + sqrt (1 + b ^ 2) :=
by { rw [← neg_neg b, ← sub_eq_neg_add, sub_pos, sq, neg_mul_neg, ← sq],
  exact b_lt_sqrt_b_one_add_sq (-b) }

/-- `arsinh` is the right inverse of `sinh`. -/
lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x :=
by rw [sinh_eq, arsinh, ← log_inv, exp_log (add_sqrt_one_add_sq_pos x),
      exp_log (inv_pos.2 (add_sqrt_one_add_sq_pos x)),
      inv_eq_one_div, aux_lemma x, sub_eq_add_neg, neg_add, neg_neg, ← sub_eq_add_neg,
      add_add_sub_cancel, add_self_div_two]

/-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/
lemma sinh_surjective : function.surjective sinh := function.left_inverse.surjective sinh_arsinh

/-- `sinh` is bijective, both injective and surjective. -/
lemma sinh_bijective : function.bijective sinh :=
⟨sinh_injective, sinh_surjective⟩

/-- A rearrangement and `sqrt` of `real.cosh_sq_sub_sinh_sq`. -/
lemma sqrt_one_add_sinh_sq (x : ℝ): sqrt (1 + sinh x ^ 2) = cosh x :=
begin
  have H := real.cosh_sq_sub_sinh_sq x,
  have G : cosh x ^ 2 - sinh x ^ 2 + sinh x ^ 2 = 1 + sinh x ^ 2 := by rw H,
  rw sub_add_cancel at G,
  rw [←G, sqrt_sq],
  exact le_of_lt (cosh_pos x),
end

/-- `arsinh` is the left inverse of `sinh`. -/
lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x :=
function.right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x

end real


/- 2∗ This important question makes sure that you have definitely got the hang of equivalence classes. Try and get through as much of it as you can. Most of it is only very mild extensions of stuff I proved in lectures, so go back to your notes if you’re not sure, and ask your tutor if you need help.
Let S be a set, and let ∼ be an equivalence relation on S. In lectures I talked about the equivalence class cl(s) of an element s ∈ S. If I just talk about an equivalence class, I mean a subset of S which is equal to cl(s) for some s ∈ S.
(i) Let S be the set of all integers, and define an equivalence relation ∼ on S by a ∼ b if and only if a ≡ b mod 2. Prove that there are two equivalence classes, namely the subset of all even integers, and the subset of all odd integers.
(ii) Staying with the example in (i), is it possible to have two distinct elements a, b ∈ S with a ̸= b but cl(a) = cl(b)?
(iii) Staying with the example in (i), is it possible to have two equivalence classes X and Y (subsetsofS)withX̸=Y butX∩Y ̸=∅?
(iv) Now let’s go to the general case. Let S be any set, and let ∼ be an equivalence relation on S. Prove that if a,b ∈ S then cl(a) = cl(b) if and only if a ∼ b.
(v) Now prove that if a, b ∈ S then the following are equivalent: (a) cl(a) ∩ cl(b) ̸= ∅;
(b) a ∼ b;
(c) cl(a) = cl(b).
Note that to prove that these statements are equivalent, it would be enough to show that (a) implies (b), that (b) implies (c) and that (c) implies (a).-/


import data.real.basic

/-
One of the earliest kind of proofs one encounters while learning mathematics is proving by
a calculation. It may not sound like a proof, but this is actually using lemmas expressing
properties of operations on numbers. It also uses the fundamental property of equality: if two
mathematical objects A and B are equal then, in any statement involving A, one can replace A
by B. This operation is called rewriting, and the Lean "tactic" for this is `rw`.

In the following exercises, we will use the following two lemmas:
  mul_assoc a b c : a * b * c = a * (b * c)
  mul_comm a b : a*b = b*a

Hence the command
  rw mul_assoc a b c,
will replace a*b*c by a*(b*c) in the current goal.

In order to replace backward, we use
  rw ← mul_assoc a b c,
replacing a*(b*c) by a*b*c in the current goal.

Of course we don't want to constantly invoke those lemmas, and we will eventually introduce
more powerful solutions.
-/

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

-- 0001
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc b c a,
  rw mul_comm c,
end

-- 0002
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc a b c,
  rw mul_comm a b,
  rw mul_assoc b a c,
end

/-
Now let's return to the preceding example to experiment with what happens
if we don't give arguments to mul_assoc or mul_comm.
For instance, you can start the next proof with
  rw ← mul_assoc,
Try to figure out what happens.
-/

-- 0003
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc,
  rw mul_comm a b,
  rw mul_assoc,
end

/-
We can also perform rewriting in an assumption of the local context, using for instance
  rw mul_comm a b at hyp,
in order to replace a*b by b*a in assumption hyp.

The next example will use a third lemma:
  two_mul a : 2*a = a + a

Also we use the `exact` tactic, which allows to provide a direct proof term.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a*d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp, -- Our assumption hyp is now exactly what we have to prove
end

/-
And the next one can use:
  sub_self x : x - x = 0
-/

-- 0004
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  rw hyp' at hyp,
  rw mul_comm at hyp,
  rw sub_self _ at hyp,
  exact hyp,
end

/-
What is written in the two preceding example is very far away from what we would write on
paper. Let's now see how to get a more natural layout.
Inside each pair of curly braces below, the goal is to prove equality with the preceding line.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b : by { rw hyp }
  ... = d*a + a*d  : by { rw hyp' }
  ... = a*d + a*d  : by { rw mul_comm d a }
  ... = 2*(a*d)    : by { rw two_mul }
  ... = 2*a*d      : by { rw mul_assoc },
end

/-
Let's note there is no comma at the end of each line of calculation. `calc` is really one
command, and the comma comes only after it's fully done.

From a practical point of view, when writing such a proof, it is convenient to:
* pause the tactic state view update in VScode by clicking the Pause icon button
  in the top right corner of the Lean Goal buffer
* write the full calculation, ending each line with ": by {}"
* resume tactic state update by clicking the Play icon button and fill in proofs between
  curly braces.

Let's return to the other example using this method.
-/

-- 0005
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  calc c = b*a - d : by { rw hyp }
  ... = b*a - a*b  : by { rw hyp' }
  ... = b*a - b*a  : by { rw mul_comm a b }
  ... = 0          : by { rw sub_self},
end

/-
The preceding proofs have exhausted our supply of "mul_comm" patience. Now it's time
to get the computer to work harder. The `ring` tactic will prove any goal that follows by
applying only the axioms of commutative (semi-)rings, in particular commutativity and
associativity of addition and multiplication, as well as distributivity.

We also note that curly braces are not necessary when we write a single tactic proof, so
let's get rid of them.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b   : by rw hyp
     ... = d*a + a*d : by rw hyp'
     ... = 2*a*d     : by ring,
end

/-
Of course we can use `ring` outside of `calc`. Let's do the next one in one line.
-/

-- 0006
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  ring,
end

/-
This is too much fun. Let's do it again.
-/

-- 0007
example (a b : ℝ) : (a + b) + a = 2*a + b :=
begin
  ring,
end

/-
Maybe this is cheating. Let's try to do the next computation without ring.
We could use:
pow_two x : x^2 = x*x
mul_sub a b c : a*(b-c) = a*b - a*c
add_mul a b c : (a+b)*c = a*c + b*c
add_sub a b c : a + (b - c) = (a + b) - c
sub_sub a b c : a - b - c = a - (b + c)
add_zero a : a + 0 = a
-/

-- 0008
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 :=
begin
  rw mul_sub,
  rw add_mul,
  rw add_mul,
  rw pow_two,
  rw pow_two,
  rw ← sub_sub,
  rw mul_comm b a,
  rw ← add_sub,
  rw sub_self,
  rw add_zero,
end

/- Let's stick to ring in the end. -/


import PnP2023.Lec_01_20.NatMin

/-!
# Selection sort (part 1)

Selection sort is a simple sorting algorithm. It works by repeatedly finding the minimum element and moving it to the front. In this lab, you will implement selection sort in Lean (building on the `smallest` function defined in the lectures) and prove its basic properties.

You will implement this in two labs (this one and the next). In this lab, you will implement the `selectionSort` function and prove termination. In the next lab, you will prove that the function is correct, i.e., `selectionSort` preserves membership list and the result is sorted.

__Note:__ If the list has duplicates the sorted list will erase these. For example, `[1, 1, 2, 3]` will be sorted to `[1, 2, 3]`. For the purposes of this exercise, this is fine.
-/

/-!
## Removing the smallest element

The first step will be to use the `List.remove` function to remove an element from a list. The function is already defined.
```lean
def remove (a : α) : List α → List α
  | [] => []
  | (b :: bs) => if a = b then remove a bs else b :: remove a bs
```
-/

-- For your convenience, here are some definitions/theorems that may be useful in the two labs. Clicking on them takes you to the source, where you may find other useful results.
#check List.remove -- {α : Type u_1} → [inst : DecidableEq α] → α → List α → List α
#check List.length_cons -- ∀ {α : Type u_1} (a : α) (as : List α), List.length (a :: as) = Nat.succ (List.length as)
#check List.mem_cons -- ∀ {α : Type u_1} {a b : α} {l : List α}, a ∈ b :: l ↔ a = b ∨ a ∈ l
#check List.mem_of_mem_remove -- ∀ {α : Type u_1} [inst : DecidableEq α] {a b : α} {as : List α}, b ∈ List.remove a as → b ∈ as
#check List.remove_eq_of_not_mem -- ∀ {α : Type u_1} [inst : DecidableEq α] {a : α} {as : List α}, ¬a ∈ as → List.remove a as = as
#check List.mem_remove_iff -- ∀ {α : Type u_1} [inst : DecidableEq α] {a b : α} {as : List α}, b ∈ List.remove a as ↔ b ∈ as ∧ b ≠ a

/-!
We will work throughout with lists of natural numbers.

- Problem 1: Prove the following theorem (remove the sorry)
-/

/-- Removing an element from a list does not increase length -/
theorem remove_length_le (a : ℕ) (l : List ℕ) : (List.remove a l).length ≤ l.length := by
  sorry

/-- Removing a member from a list shortens the list -/
theorem remove_mem_length {a : ℕ} {l : List ℕ} (hyp : a ∈ l) : (List.remove a l).length < l.length  := by
  sorry

/-!
- Problem 3: Prove termination of the following definition (remove the sorry). You may wish to remove the `decreasing_by` line.
-/
/-- The selection sort function -/
def selectionSort (l : List ℕ) : List ℕ :=
    if c: l=[] then [] else
    (smallest l c) :: selectionSort (List.remove (smallest l c) l)
termination_by _ _ => l.length
decreasing_by sorry


import tactic
import tactic.basic
import tactic.linarith
import tactic.norm_cast
import tactic.ring

open int
open nat

/-
The 1969 IMO, problem 1:
Prove that there are infinitely many natural numbers $a$ with the following property:
the number $z = n^4 + a$ is not prime for any natural number $n$.

The key to the solution is that you can factor this into the product of two polynomials, if a = 4*m^4.
-/

lemma factorization (m n: ℤ): (n^2 + 2*m^2 - 2*n*m) * (n^2 + 2*m^2 + 2*n*m) = n^4 + 4*m^4
:= by ring

/-
To show that the product is not prime, we need to show each of the factors is at least 2, which we can
do with a sum-of-squares expression.
-/
lemma left_factor_large (m n: ℤ) (h: m > 1): (n^2 + 2*m^2 - 2*n*m) > 1 :=
have h: (n^2 + 2*m^2 - 2*n*m) = (m-n)^2 + m^2, by ring,
begin
  rw h,
  nlinarith,
end

lemma right_factor_large (m n: ℤ) (h: m > 1): (n^2 + 2*m^2 + 2*n*m) > 1 :=
have h: (n^2 + 2*m^2 + 2*n*m) = (m+n)^2 + m^2, by ring,
begin
  rw h,
  nlinarith,
end

/-
The factorization is over the integers, but we need the nonprimality over the natural numbers.
-/

lemma int_large (a: ℤ) (h: a > 1) : a.nat_abs > 1 :=
have a = ↑(a.nat_abs) ∨ a = -↑(a.nat_abs), from nat_abs_eq a,
or.elim this
  (assume: a = ↑(a.nat_abs), by linarith)
  (assume: a = -↑(a.nat_abs), by linarith)

lemma int_not_prime (a b: ℤ) (c: ℕ) (h1: a > 1) (h2: b > 1) (h3: a*b = ↑c) : ¬ prime c :=
have h4: (a*b).nat_abs = a.nat_abs * b.nat_abs, from nat_abs_mul a b,
have h5: a.nat_abs * b.nat_abs = c, by finish,
norm_num.not_prime_helper a.nat_abs b.nat_abs c h5 (int_large a h1) (int_large b h2)

lemma polynomial_not_prime (m n: ℕ) (h1: m > 1) : ¬ prime (n^4 + 4*m^4) :=
have h2: of_nat m > 1, from coe_nat_lt.mpr h1,
begin
  refine int_not_prime _ _ _ (left_factor_large ↑m ↑n h2) (right_factor_large ↑m ↑n h2) _,
  rw factorization,
  norm_cast
end

/-
Now we just need to show this works for an arbitrarily large a, to prove there are infinitely many of them.
a = 4*(2+b)^4 should do. So m = 2+b.
-/

theorem imo1969_q1: ∀ b: ℕ, ∃ a: ℕ, a ≥ b ∧ ∀ n: ℕ, ¬ prime (n^4 + a) :=
assume b,
have h1: 2+b > 1, by linarith,
have b^2 ≥ b, by nlinarith,
have h2: 4*(2+b)^4 ≥ b, by nlinarith,
begin
  fapply exists.intro,
  exact 4*(2+b)^4,
  apply and.intro h2,
  assume n,
  exact polynomial_not_prime (2+b) n h1
end


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import ring_theory.noetherian -- theory of Noetherian rings
/-

# Commutative algebra

I find this quite a joy to do in Lean.

Keith Conrad has some notes on Noetherian rings here:

https://kconrad.math.uconn.edu/blurbs/ringtheory/noetherian-ring.pdf

In this section I prove some of the results which he discusses.

## Noetherian rings

A commutative ring is Noetherian if every ideal is finitely-generated.
Noetherian-ness is a very weak finiteness condition which is satisfied by
many rings which show up naturally in algebra, number theory and and geometry.
Lean has several equivalent standard criteria for being Noetherian. Let's
use one of them to prove Theorem 3.2 in Conrad's notes: a surjective
map from a Noetherian ring to itself is injective (note that this
is a ring-theoretic analogue of the set-theoretic result that a surjective
map from a finite set to itself is injective.)

-/

open function

example (R : Type) [comm_ring R] [is_noetherian_ring R]
  (φ : R →+* R) (hφsurj : surjective φ) : injective φ :=
begin
  -- we follow Conrad's notes.
  -- For `n` a natural number, define `Kₙ` to be the kernel of `φ ∘ φ ∘ φ ∘ ⋯ φ : R →+* R`,
  -- where we iterate `φ` `n` times. Of course in Lean `K` is a function `ℕ → ideal R`.
  let K : ℕ → ideal R := λ n, ring_hom.ker (φ^n),
  -- The ideals Kₙ satisfy Kₙ ⊆ Kₙ₊₁.
  have hKinc : ∀ n, K n ≤ K (n + 1),
  { -- for if x ∈ Kₙ
    intros n x hx,
    -- then φⁿ(x) = 0
    simp only [K, ring_hom.mem_ker] at hx ⊢,
    -- so φⁿ⁺¹(x) = φ(0)=0
    apply_fun φ at hx, rw ring_hom.map_zero at hx,
    -- so x ∈ Kₙ₊₁
    exact hx, },
  -- Hence K is a monotone function.
  have hKmono : monotone K := monotone_nat_of_le_succ hKinc,
  -- So by Noetherian-ness of `R`, there exists `n` such that `Kₙ=Kₙ₊₁=Kₙ₊₂=…`
  obtain ⟨n, hn⟩ := monotone_stabilizes_iff_noetherian.2 infer_instance ⟨K, hKmono⟩,
  -- It suffices to prove that every element of ker(φ) is 0
  rw [ring_hom.injective_iff_ker_eq_bot, ← le_bot_iff],
  -- so say r ∈ ker(φ)
  intros r hr,
  -- and let's prove r=0
  rw ideal.mem_bot,
  -- For all naturals m, The map φ^m is surjective
  have hφmsurj : ∀ m : ℕ, surjective ((φ^m : R →+* R) : R → R),
  -- (by an easy induction)
  { intro m, induction m with d hd,
    -- (base case)
    { exact surjective_id, },
    -- (inductive step)
    { exact hφsurj.comp hd, }, },
  -- so r = φ^n r' for some r' ∈ R
  rcases hφmsurj n r with ⟨r', rfl⟩,
  -- Thus 0 = φ(r)=φ^{n+1}(r')
  rw ring_hom.mem_ker at hr,
  change (φ^(n+1) : R →+* R) r' = 0 at hr,
  -- Therefore r' ∈ ker(φ^{n+1})
  rw ← ring_hom.mem_ker at hr ⊢,
  change r' ∈ K (n + 1) at hr,
  -- ...=ker(φ^n)
  rw (show K (n + 1) = K n, from (hn (n+1) (by linarith)).symm) at hr,
  -- and hence r=φ^n(r')=0 as required
  exact hr,
end


/-
This file defines the constructive real numbers ℛ,
defined by sequences of shrinking and dwindling rational segments
-/

import ..Intuitionism.segment

/--
We say that a sequence of segments is 'shrinking' if each segment is contained within its predecessor
-/
def shrinking (r : ℕ → 𝕊) := ∀ n, r (n + 1) ⊑ r n

/--
We say that a sequence of segments is 'dwindling' if we can make the segments arbitrarily small
-/
def dwindling (r : ℕ → 𝕊) := ∀ q : ℚ, q > 0 → ∃ n : ℕ, (r n).snd - (r n).fst < q

/--
The definition of real sequences ℛ, representing the real numbers
(Called 'real_seq' here to not interfere with the classical real numbers,
which are already defined in Lean using Cauchy sequences)
A real sequence is a sequence of rational segments that shrinks and dwindles
-/
def real_seq := {r : ℕ → 𝕊 // shrinking r ∧ dwindling r}

notation `ℛ` := real_seq

namespace real_seq

/--
Used to extract the underlying sequence of rational segments
-/
def seq (r : ℛ) : ℕ → 𝕊 := subtype.val r

-- We can turn a real segment into a sequence of rationals by only taking the first position
def fst (r : ℛ) : ℕ → ℚ := λ n, (r.seq n).fst

-- We can turn a real segment into a sequence of rationals by only taking the second position
def snd (r : ℛ) : ℕ → ℚ := λ n, (r.seq n).snd

lemma shrinking (r : ℛ) : shrinking r.val := (subtype.property r).elim_left

lemma dwindling (r : ℛ) : dwindling r.val := (subtype.property r).elim_right

theorem contained_of_le (r : ℛ) {n m : ℕ} (h₁ : n ≤ m) : r.seq m ⊑ r.seq n :=
begin
    induction h₁ with d hd,
    {-- need to prove: seq r n ⊑ seq r n
        refl,
    },
    {-- need to prove: seq r (nat.succ d) ⊑ seq r n
        transitivity (seq r d),
        {-- need to prove: seq r (nat.succ d) ⊑ seq r d
            exact r.shrinking d,
        },
        {-- need to prove: seq r d ⊑ seq r n
            exact h₁_ih,
        }
    }
end

def lt (x y : ℛ) : Prop := ∃ n : ℕ, x.seq n < y.seq n

infix `<` := lt

def le (x y : ℛ) : Prop := ∀ n : ℕ, x.seq n ≤ y.seq n

infix `≤` := le

def apart (x y : ℛ) : Prop := x < y ∨ y < x

infix `#` := apart

def eq (x y : ℛ) : Prop := ∀ n : ℕ, x.seq n ≈ y.seq n

infix `='`:50 := eq

def ne (x y : ℛ) : Prop := ¬ x =' y

infix `≠'`:50 := ne

@[trans] theorem lt_trans (x y z : ℛ) (h₁ : x < y) (h₂ : y < z) : x < z :=
begin
    cases h₁ with n hn,
    cases h₂ with m hm,
    use max m n,
    transitivity seq y (max m n),
    {-- need to prove: seq x (max m n) < seq y (max m n)
        have h₁ := contained_of_le x (le_max_right m n),
        have h₂ := contained_of_le y (le_max_right m n),
        apply lt_of_le_of_lt h₁.elim_right,
        apply lt_of_lt_of_le hn,
        exact h₂.elim_left,
    },
    {-- need to prove: seq y (max m n) < seq z (max m n)
        have h₁ := contained_of_le y (le_max_left m n),
        have h₂ := contained_of_le z (le_max_left m n),
        apply lt_of_le_of_lt h₁.elim_right,
        apply lt_of_lt_of_le hm,
        exact h₂.elim_left,
    }
end

lemma lt_or_lt_from_sub_lt_sub {a b c d : ℚ} (h : a - b < c - d) : a < c ∨ d < b :=
begin
    have hac := lt_trichotomy a c,
    cases hac with hl hr,
    {-- case: a < c
        left,
        exact hl,
    },
    {-- case: a = c ∨ c < a
        right,
        cases hr with heq hlt,
        {-- case: a = c
            rwa [heq, sub_eq_add_neg, sub_eq_add_neg, add_lt_add_iff_left, neg_lt_neg_iff] at h,
        },
        {-- case: c < a
            rw ← sub_lt_zero,
            transitivity (c-a),
            {-- need to prove: d - b < c - a
                rwa [lt_sub_iff_add_lt',
                    ← add_sub_assoc,
                    sub_lt_iff_lt_add',
                    ← lt_sub_iff_add_lt,
                    add_sub_assoc, add_comm,
                    ← sub_lt_iff_lt_add] at h,
            },
            {-- need to prove: c - a < 0
                rw ← sub_lt_zero at hlt,
                exact hlt,
            }
        }
    }
end

theorem lt_cotrans (x y z : ℛ) (h₁ : x < y) : x < z ∨ z < y :=
begin
    cases h₁ with n hn,
    rwa [segment.lt, ← sub_pos, ← gt_from_lt] at hn,
    cases z.dwindling (segment.fst (seq y n) - segment.snd (seq x n)) hn with m hm,
    cases lt_or_lt_from_sub_lt_sub hm with zlty xltz,
    {-- case: z.snd m < y.fst n
        right,
        use max m n,
        have h₁ := contained_of_le z (le_max_left m n),
        have h₂ := contained_of_le y (le_max_right m n),
        apply lt_of_le_of_lt h₁.elim_right,
        exact lt_of_lt_of_le zlty h₂.elim_left,
    },
    {-- case: x.snd n < z.fst m
        left,
        use max m n,
        have h₁ := contained_of_le z (le_max_left m n),
        have h₂ := contained_of_le x (le_max_right m n),
        apply lt_of_le_of_lt h₂.elim_right,
        exact lt_of_lt_of_le xltz h₁.elim_left,
    }
end

theorem apart_cotrans (x y z : ℛ) (h : x # y) : x # z ∨ z # y :=
begin
    cases h with h₁ h₂,
    {-- case: x < y
        cases lt_cotrans x y z h₁ with hz hz,
        {-- case: x < z
            left,
            left,
            exact hz,
        },
        {-- case: z < y
            right,
            left,
            exact hz,
        }
    },
    {-- case: case y < x
        cases lt_cotrans y x z h₂ with hz hz,
        {-- case: y < z
            right,
            right,
            exact hz,
        },
        {-- case: z < x
            left,
            right,
            exact hz,
        }
    }
end

theorem le_iff_not_lt (x y : ℛ) : x ≤ y ↔ ¬ y < x :=
begin
    split,
    {-- need to prove: x ≤ y → ¬ y < x
        intros h₁ h₂,
        cases h₂ with n hn,
        have hn₁ := h₁ n,
        rw segment.le_iff_not_lt at hn₁,
        exact hn₁ hn,
    },
    {-- need to prove: ¬ y < x → x ≤ y
        intros h n,
        rw segment.le_iff_not_lt,
        revert n,
        exact forall_not_of_not_exists h,
    }
end

theorem eq_of_le_of_le (x y : ℛ) : x ≤ y → y ≤ x → x =' y :=
begin
    intros hxy hyx n,
    split,
    {-- need to prove: seq x n ≤ seq y n
        exact hxy n,
    },
    {-- need to prove: seq y n ≤ seq x n
        exact hyx n,
    }
end

@[trans] theorem le_trans (x y z : ℛ) (h₁ : x ≤ y) (h₂ : y ≤ z) : x ≤ z :=
begin
    rw le_iff_not_lt at *,
    intro zltx,
    cases lt_cotrans z x y zltx with hz hz,
    {-- case: z < y
        exact h₂ hz,
    },
    {-- case: y < x
        exact h₁ hz,
    }
end

@[refl] theorem le_refl (x : ℛ) : x ≤ x :=
begin
    intro n,
    refl,
end

theorem eq_iff_not_apart (x y : ℛ) : x =' y ↔ ¬x # y :=
begin
    split,
    {-- need to prove: x = y → ¬ x # y
        intros h₁ h₂,
        cases h₂ with xlty yltx,
        {-- case: x < y
            cases xlty with n hn,
            have hn₁ := h₁ n,
            rw segment.lt_iff_not_le at hn,
            exact hn hn₁.elim_right,
        },
        {-- case: y < x
            cases yltx with n hn,
            have hn₁ := h₁ n,
            rw segment.lt_iff_not_le at hn,
            exact hn hn₁.elim_left,
        }
    },
    {-- need to prove: ¬ x # y → x = y
        intros h n,
        rw apart at h,
        rw segment.touches,
        rw not_or_distrib at h,
        split,
        {-- need to prove: seq x n ≤ seq y n
            rw segment.le_iff_not_lt,
            have h₁ := forall_not_of_not_exists h.elim_right n,
            exact h₁,
        },
        {-- need to prove: seq y n ≤ seq x n
            rw segment.le_iff_not_lt,
            have h₂ := forall_not_of_not_exists h.elim_left n,
            exact h₂,
        }
    }
end

@[trans] theorem eq_trans (x y z: ℛ) (h₁ : x =' y) (h₂ : y =' z) : x =' z :=
begin
    rw eq_iff_not_apart,
    intro h₃,
    cases apart_cotrans x z y h₃ with xay yaz,
    {-- case: x # y
        rw eq_iff_not_apart at h₁,
        exact h₁ xay,
    },
    {-- case: y # z
        rw eq_iff_not_apart at h₂,
        exact h₂ yaz,
    }
end

@[symm] theorem eq_symm (x y : ℛ) : x =' y ↔ y =' x :=
begin
    repeat {rw eq},
    simp [segment.touches_symm],
end

@[refl] theorem eq_refl (x : ℛ) : x =' x :=
begin
    intro n,
    refl,
end

theorem le_stable (x y : ℛ) : ¬¬x ≤ y → x ≤ y :=
begin
    rw le_iff_not_lt,
    exact not_of_not_not_not,
end

theorem eq_stable (x y : ℛ) : ¬¬x =' y → x =' y :=
begin
    rw eq_iff_not_apart,
    exact not_of_not_not_not,
end

/--
The inclusion from ℚ into ℛ
-/
def inclusion_const (q : ℚ) : ℛ :=
    subtype.mk (λ _ , segment.inclusion q)
    begin
        split,
        {-- need to prove: the defined real_seq is shrinking
            intro n,
            refl,
        },
        {-- need to prove: the defined real_seq is dwindling
            intros e he,
            use 0,
            rw gt_iff_lt at he,
            apply lt_of_le_of_lt _ he,
            apply le_of_eq,
            rw sub_eq_zero,
            refl,
        }
    end

@[instance] def has_zero : has_zero ℛ := { zero := inclusion_const 0 }

lemma zero : 0 = inclusion_const 0 := rfl

/--
The definition of + on real sequences
-/
def add (x y : ℛ) : ℛ := subtype.mk (λ n, segment.add (x.seq n) (y.seq n))
    begin
        have hx := subtype.property x,
        have hy := subtype.property y,
        split,
        {-- need to prove: shrinking
            intro n,
            split,
            {
                apply add_le_add,
                    exact (hx.elim_left n).elim_left,
                    exact (hy.elim_left n).elim_left,
            },
            {
                apply add_le_add,
                    exact (hx.elim_left n).elim_right,
                    exact (hy.elim_left n).elim_right,
            }
        },
        {-- need to prove: dwindling
            intros q hq,
            have hq2 : q / 2 > 0, by
            {
                rw gt_iff_lt,
                apply div_pos,
                exact gt_iff_lt.elim_left hq,
                exact zero_lt_two,
            },
            cases hx.elim_right (q / 2) hq2 with xn hxn,
            cases hy.elim_right (q / 2) hq2 with yn hyn,
            use max xn yn,
            simp [add_sub_comm, segment.add, segment.fst, segment.snd],
            have hqa : (q / 2) + (q / 2) = q, by
            {
                rw ← mul_two,
                rw div_mul_cancel,
                exact two_ne_zero,
            },
            rw ← hqa,
            apply add_lt_add,
            {-- need to prove: snd (x.seq (max xn yn)) - fst (x.seq (max xn yn)) < q / 2
                have hm : segment.snd (seq x (max xn yn)) - segment.fst (seq x (max xn yn)) ≤ (segment.snd (x.val xn) - segment.fst (x.val xn)), by
                {-- need to prove: snd - fst of x.seq (max xn yn) < snd - fst of x.seq xn
                    apply segment.contained_bounds_le,
                    apply contained_of_le _ (le_max_left _ _),
                },
                exact lt_of_le_of_lt hm hxn,
            },
            {
                have hm : segment.snd (seq y (max xn yn)) - segment.fst (seq y (max xn yn)) ≤ (segment.snd (y.val yn) - segment.fst (y.val yn)), by
                {-- need to prove: snd - fst of x.seq (max xn yn) < snd - fst of x.seq xn
                    apply segment.contained_bounds_le,
                    exact contained_of_le _ (le_max_right _ _),
                },
                exact lt_of_le_of_lt hm hyn,
            }
        }
    end

theorem add_assoc {x y z : ℛ} : add (add x y) z =' add x (add y z) :=
begin
    intro n,
    split,
    repeat {simp [seq, add, segment.add_assoc]},
end

theorem add_comm {x y : ℛ} : add x y =' add y x :=
begin
    intro n,
    split,
    repeat {simp [seq, add, segment.add_comm]},
end

theorem add_zero {x : ℛ} : add x 0 =' x :=
begin
    intro n,
    simp [zero, add, inclusion_const, seq, segment.add,
        segment.fst, segment.snd, segment.inclusion, segment.touches],
end

theorem zero_add {x : ℛ} : add 0 x =' x :=
begin
    transitivity (add x 0),
    exact add_comm,
    exact add_zero,
end

theorem eq_implies_add_eq_add {x y z : ℛ} : y =' z → add x y =' add x z :=
begin
    intros h n,
    have hn := h n,
    split,
    {-- need to prove: seq (add x y) n≤seq (add x z) n
        simp [seq, add, segment.le, segment.fst, segment.snd, segment.add],
        apply add_le_add,
        exact subtype.property (x.val n),
        exact hn.elim_left,
    },
    {
        simp [seq, add, segment.le, segment.fst, segment.snd, segment.add],
        apply add_le_add,
        exact subtype.property (x.val n),
        exact hn.elim_right,
    }
end

def neg (x : ℛ) : ℛ := subtype.mk (λ n, (x.val n).neg)
    begin
    	split,
        {-- shrinking
            intro n,
            split,
            { -- use: segment.snd (x.val (n + 1)) ≤ segment.snd (x.val n)
                simp [segment.fst, segment.fst, segment.neg, segment.neg, neg_le_neg_iff],
                exact ((subtype.property x).elim_left n).elim_right,
            },
            {--  use: segment.fst (x.val n) ≤ segment.fst (x.val (n + 1))
                simp [segment.snd, segment.snd, segment.neg, segment.neg, neg_le_neg_iff],
                exact ((subtype.property x).elim_left n).elim_left,
            }
        },
        {-- dwindling
            intros q hq,
            have hx := (subtype.property x).elim_right q hq,
            cases hx with xn hxn,
            use xn,
            have h :
                segment.snd ((λ (n : ℕ), segment.neg (x.val n)) xn) - segment.fst ((λ (n : ℕ), segment.neg (x.val n)) xn)
                    =
                segment.snd (x.val xn) - segment.fst (x.val xn),
            by simp [segment.snd, segment.fst, segment.neg],
            rw h,
            exact hxn,
        }
    end

def sub (x y : ℛ) : ℛ := add x (neg y)

theorem sub_self_eq_zero (x : ℛ) : sub x x =' 0 :=
begin
    rwa [zero, inclusion_const],
    intro n,
    simp [sub, add, neg, seq, segment.add, segment.neg, segment.fst, segment.snd, segment.touches, segment.inclusion],
    split,
    {-- sub x x ≤ 0
        simp [segment.le, segment.snd, segment.fst],
        exact (subtype.property (x.seq n)), --use: (x.seq n) is a segment
    },
    {-- 0 ≤ sub x x
        simp [segment.le, segment.snd, segment.fst],
        rwa [← sub_eq_add_neg, le_sub, sub_zero],
        exact (subtype.property (x.seq n)), --use: (x.seq n) is a segment
    }
end

theorem forall_exists_additive_inverse : ∀ x : ℛ, ∃ y : ℛ, add x y =' 0 :=
begin
    intro x,
    use neg x,
    rw ← sub,
    exact sub_self_eq_zero x,
end

-- In traditional notation: (x + y) - y = x
theorem sub_add (x y : ℛ) : sub (add x y) y =' x :=
begin
    transitivity add x (add y (neg y)),
    exact add_assoc,
    transitivity add x 0,
    {-- need to prove: add x (sub y y) =' add x 0
        exact eq_implies_add_eq_add (sub_self_eq_zero y),
    },
    exact add_zero,
end

theorem sub_add_comm {x y z : ℛ} : sub (add x y) z =' add x (sub y z) := add_assoc

end real_seq


-- Pruebas de la relación entre length y map
-- =========================================

import data.nat.basic
open nat
open list

variables {α : Type*} {β : Type*}
variable  (x : α)
variables (xs : list α)

-- ----------------------------------------------------
-- Nota. Se usarán la función longitud y sus
-- propiedades estudiadas anteriormente.
-- ----------------------------------------------------

def longitud : list α → nat
| []        := 0
| (x :: xs) := longitud xs + 1

@[simp]
lemma longitud_nil :
  longitud ([] : list α) = 0 :=
rfl

@[simp]
lemma longitud_cons :
  longitud (x :: xs) = longitud xs + 1 :=
rfl

-- ----------------------------------------------------
-- Ejercicio 3. Definir la función
--    aplica : (α → β) → list α → 'b list
-- tal que (aplica f xs) es la lista obtenida
-- aplicando la función f a los elementos de xs. Por
-- ejemplo,
--    aplica (λx, 2*x) [3,2,5] = [6,4,10]
--    aplica ((*) 2)   [3,2,5] = [6,4,10]
--    aplica ((+) 2)   [3,2,5] = [5,4,7]
-- ----------------------------------------------------

def aplica : (α → β) → list α → list β
| f []        := []
| f (x :: xs) := (f x) :: aplica f xs

-- #eval aplica (λx, 2*x) [3,2,5]
-- #eval aplica ((*) 2) [3,2,5]
-- #eval aplica ((+) 2) [3,2,5]

-- ----------------------------------------------------
-- Ejercicio 4. Demostrar los siguientes lemas
-- + aplica_nil :
--      aplica f [] = []
-- + aplica_cons :
--      aplica f (x :: xs) = (f x) :: aplica f xs
-- ----------------------------------------------------

@[simp]
lemma aplica_nil
  (f : α → β)
  : aplica f [] = [] :=
rfl

@[simp]
lemma aplica_cons
  (f : α → β)
  : aplica f (x :: xs) = (f x) :: aplica f xs :=
rfl

-- ----------------------------------------------------
-- Ejercicio 1. (p. 48) Demostrar que
--    longitud (aplica f xs) = longitud xs
-- ----------------------------------------------------

-- 1ª demostración
example
  (f : α → β)
  : longitud (aplica f xs) = longitud xs :=
begin
  induction xs with a as HI,
  { rw aplica_nil,
    rw longitud_nil,
    rw longitud_nil, },
  { rw aplica_cons,
    rw longitud_cons,
    rw HI,
    rw longitud_cons, },
end

-- 2ª demostración
example
  (f : α → β)
  : longitud (aplica f xs) = longitud xs :=
begin
  induction xs with a as HI,
  { calc longitud (aplica f [])
         = longitud []                   : by rw aplica_nil
     ... = 0                             : by rw longitud_nil
     ... = longitud []                   : by rw longitud_nil, },
  { calc longitud (aplica f (a :: as))
         = longitud (f a :: aplica f as) : by rw aplica_cons
     ... = longitud (aplica f as) + 1    : by rw longitud_cons
     ... = longitud as + 1               : by rw HI
     ... = longitud (a :: as)            : by rw longitud_cons, },
end

-- 3ª demostración
example
  (f : α → β)
  : longitud (aplica f xs) = longitud xs :=
begin
  induction xs with x xs HI,
  { simp, },
  { simp [HI], },
end

-- 4ª demostración
example
  (f : α → β)
  : longitud (aplica f xs) = longitud xs :=
by induction xs ; simp [*]

-- 5ª demostración
lemma longitud_aplica
  (f : α → β)
  : ∀ xs, longitud (aplica f xs) = longitud xs
| []        := by simp
| (a :: as) := by simp [longitud_aplica as]

-- Comentarios sobre las función map:
-- + Es equivalente a la función aplica.
-- + Para usarla hay que importar la librería
--   data.list.basic y abrir el espacio de nombre
--   list escribiendo al principio del fichero
--      import data.list.basic
--      open list
-- + Se puede evaluar. Por ejemplo,
--      #eval map (λx, 2*x) [3,2,5]
--      #eval map ((*) 2) [3,2,5]
--      #eval map ((+) 2) [3,2,5]
-- + Se puede demostrar. Por ejemplo,
example
  (f : α → β)
  : length (map f xs) = length xs :=
by induction xs ; simp [*]

example
  (f : α → β)
  : length (map f xs) = length xs :=
-- by suggest
length_map f xs

example
  (f : α → β)
  : length (map f xs) = length xs :=
by simp


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Yury Kudryashov
-/
import algebra.big_operators.associated
import data.nat.choose.sum
import data.nat.choose.dvd
import data.nat.parity
import data.nat.prime

/-!
# Primorial

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

open finset
open nat
open_locale big_operators nat

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ := ∏ p in (filter nat.prime (range (n + 1))), p
local notation x`#` := primorial x

lemma primorial_pos (n : ℕ) : 0 < n# :=
prod_pos $ λ p hp, (mem_filter.1 hp).2.pos

lemma primorial_succ {n : ℕ} (hn1 : n ≠ 1) (hn : odd n) : (n + 1)# = n# :=
begin
  refine prod_congr _ (λ _ _, rfl),
  rw [range_succ, filter_insert, if_neg (λ h, odd_iff_not_even.mp hn _)],
  exact (h.even_sub_one $ mt succ.inj hn1)
end

lemma primorial_add (m n : ℕ) :
  (m + n)# = m# * ∏ p in filter nat.prime (Ico (m + 1) (m + n + 1)), p :=
begin
  rw [primorial, primorial, ← Ico_zero_eq_range, ← prod_union, ← filter_union,
    Ico_union_Ico_eq_Ico],
  exacts [zero_le _, add_le_add_right (nat.le_add_right _ _) _,
    disjoint_filter_filter $ Ico_disjoint_Ico_consecutive _ _ _]
end

lemma primorial_add_dvd {m n : ℕ} (h : n ≤ m) : (m + n)# ∣ m# * choose (m + n) m :=
calc (m + n)# = m# * ∏ p in filter nat.prime (Ico (m + 1) (m + n + 1)), p :
  primorial_add _ _
... ∣ m# * choose (m + n) m :
  mul_dvd_mul_left _ $ prod_primes_dvd _ (λ k hk, (mem_filter.1 hk).2.prime) $ λ p hp,
    begin
      rw [mem_filter, mem_Ico] at hp,
      exact hp.2.dvd_choose_add hp.1.1 (h.trans_lt (m.lt_succ_self.trans_le hp.1.1))
        (nat.lt_succ_iff.1 hp.1.2)
    end

lemma primorial_add_le {m n : ℕ} (h : n ≤ m) : (m + n)# ≤ m# * choose (m + n) m :=
le_of_dvd (mul_pos (primorial_pos _) (choose_pos $ nat.le_add_right _ _)) (primorial_add_dvd h)

lemma primorial_le_4_pow (n : ℕ) : n# ≤ 4 ^ n :=
begin
  induction n using nat.strong_induction_on with n ihn,
  cases n, { refl },
  rcases n.even_or_odd with (⟨m, rfl⟩ | ho),
  { rcases m.eq_zero_or_pos with rfl | hm, { dec_trivial },
    calc (m + m + 1)# = (m + 1 + m)# : by rw [add_right_comm]
    ... ≤ (m + 1)# * choose (m + 1 + m) (m + 1) : primorial_add_le m.le_succ
    ... = (m + 1)# * choose (2 * m + 1) m : by rw [choose_symm_add, two_mul, add_right_comm]
    ... ≤ 4 ^ (m + 1) * 4 ^ m :
      mul_le_mul' (ihn _ $ succ_lt_succ $ (lt_add_iff_pos_left _).2 hm) (choose_middle_le_pow _)
    ... ≤ 4 ^ (m + m + 1) : by rw [← pow_add, add_right_comm] },
  { rcases decidable.eq_or_ne n 1 with rfl | hn,
    { dec_trivial },
    { calc (n + 1)# = n# : primorial_succ hn ho
      ... ≤ 4 ^ n : ihn n n.lt_succ_self
      ... ≤ 4 ^ (n + 1) : pow_le_pow_of_le_right  four_pos n.le_succ } }
end


/- LoVe Exercise 5: Inductive Predicates -/

import .love05_inductive_predicates_demo

namespace LoVe

/- Question 1: Even and Odd -/

/- The `even` predicate is true for even numbers and false for odd numbers. -/

#check even

/- 1.1. Prove that 0, 2, 4, and 6 are even. -/

-- enter your answer here

/- We define `odd` as the negation of `even`: -/

def odd (n : ℕ) : Prop :=
  ¬ even n

/- 1.2. Prove that 1 is odd and register this fact as a `simp` rule.

Hint: `cases` is useful to reason about hypotheses of the form `even …`. -/

@[simp] lemma odd_1 :
  odd 1 :=
sorry

/- 1.3. Prove that 3, 5, and 7 are odd. -/

-- enter your answer here

/- 1.4. Complete the following proof by structural induction.

Hint: You can rely implicitly on computation for the induction step. -/

lemma even_two_times :
  ∀m : ℕ, even (2 * m)
:= sorry

/- 1.5. Complete the following proof by rule induction.

Hint: You can use the `cases` tactic (or `match … with`) to destruct an
existential quantifier and extract the witness. -/

lemma even_imp_exists_two_times :
  ∀n : ℕ, even n → ∃m, n = 2 * m
| _ even.zero            := exists.intro 0 (by simp)
| _ (even.add_two n hen) :=
sorry

/- 1.6. Using `even_two_times` and `even_imp_exists_two_times`, prove the
following equivalence. -/

lemma even_iff_exists_two_times (n : ℕ) :
  even n ↔ ∃m, n = 2 * m :=
sorry

/- Question 2: Binary Trees -/

/- 2.1. Prove the converse of `is_full_mirror`. You may exploit already proved
lemmas (e.g., `is_full_mirror`, `mirror_mirror`). -/

lemma mirror_is_full {α : Type} :
  ∀t : btree α, is_full (mirror t) → is_full t :=
sorry

/- 2.2. Define a function that counts the number of constructors (`empty` or
`node`) in a tree. -/

def count {α : Type} : btree α → ℕ
:= sorry

end LoVe


import .satisfiability
import .rules_of_reasoning
..
/-
CS2102 Exam #2: Propositional Logic
-/

-- You submitted an exam: [3 points free!]

/- [20 points]

    2 for header
    9 for reaching until list of interpretations (First 2 lines of is_satisfaible)
    4.5 for the helper function (fold_or) and
    4.5 for calling it from is_satisfiable

#1. Define a predicate function, is_satisfiable: pExp → bool
that returns true iff the given proposition is satisfiable.
Hint: Model your answer on our definition of is_valid. You
may need to define one or more helper functions. You should
test your solution, but we will only grade your definition.
Please write test cases in a separate file. Do not submit
that file.
-/
--returns true if at least one interpretation results in
--the expression being true
def foldr_or : list bool → bool
| [] := ff
| (h::t) := bor h (foldr_or t)

-- Answer here
def is_satisfiable (e : pExp) : bool :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    foldr_or rs

/-

[8 points]
1 point each

#2. Clearly the propositions in rules_of_reasoning.lean
that are valid are also satisfiable. But what about the following?
Apply your satisfiability predicate function to decide whether
or not each of the following formulae is satisfiable or not.
Write an "#eval is_satisfiable e" command for each expression.

A. The "fallacies" in that file (the ones that aren't valid).

B. The proposition, pFalse.

C. The following propositions:

1. P ∧ ¬ P
2. P ∨ ¬ P
3. = (¬x1 ∨ x2) ∧ (¬x2 ∨ x3 ∨ ¬x4) ∧ (x1 ∨ x2 ∨ x3 ∨ ¬x4)

Note that for 3. you will have to define four new variables.
Call them x1, x2, x3, and x4.

x1...x4 are needed for last one but is not graded

-/
def x1 : pExp := pExp.pVar (var.mk 0)
def x2 : pExp := pExp.pVar (var.mk 1)
def x3 : pExp := pExp.pVar (var.mk 2)
def x4 : pExp := pExp.pVar (var.mk 3)

-- Answers here
--All satisfiable but not valid
#eval is_satisfiable true_imp
#eval is_satisfiable affirm_consequence
#eval is_satisfiable affirm_disjunct
#eval is_satisfiable deny_antecedent

--False is unsatisfiable
#eval is_satisfiable pExp.pFalse

#eval is_satisfiable (P ∧ ¬ P) --unsatisfiable
#eval is_satisfiable (P ∨ ¬ P) --satisfiable (valid)
#eval is_satisfiable ((¬x1 ∨ x2) ∧ (¬x2 ∨ x3 ∨ ¬x4) ∧ (x1 ∨ x2 ∨ x3 ∨ ¬x4))
--also satisfiable (all true)

/- 20 POINTS

-- 8 points for generating all interpretations
-- 8 points for seeing that you need to find a satisfying one
-- 4 points for returning the value correctly as an option value

3. In the previous problems, you defined a satisfiability
predicate function that returns true or false depending on
whether a given formula is satisfiable or not. Often we will
want to know not only whether there exists a solution but an
actual example of a solution, if there is one. Define a function
called sat_solver : pExp → option (var → bool) that returns a
satisfying interpretation (as "some interpretation") if there
is one, or "none" otherwise. Hint: Model your solution on our
validity checker. First compute the list of interpretations for
a given expression, e, then reduce that list to a value of type
option (var → bool). Evaluate e under each interpretation in
the list until either (A) you find one, call it i, for which e
evaluates to true, or until you reach the empty list, empty
handed.
-/

-- Answer here
--helper function
def reduce_interpretations : pExp → list (var → bool) → option (var → bool)
| e list.nil := none
| e (h::t) := match (pEval e h) with
        | tt := some h
        | ff := reduce_interpretations e t
        end

def sat_solver (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    reduce_interpretations e is

-- Example (OPTIONAL)
#reduce sat_solver (P ∧ Q >> (¬ P))

-- for getting the truth value you can also do (OPTIONAL)

def option_to_interp'' : option (var → bool) → (var → bool)
| none := λ (v : var), ff
| (some i) := i

#reduce option_to_interp'' (sat_solver (P ∧ Q >> (¬ P)))

#eval pEval (P ∧ Q >> (¬ P)) (option_to_interp'' (sat_solver (P ∧ Q >> (¬ P))))

/- [10 points] All or nothing/ Just make sure it works

4. Define a predicate function, is_unsatisfiable : pExp → bool,
that takes a propositional logic formula, e, and returns true
iff e is unsatisfiable. Hint: Easy. Build on what you have.
-/

-- Answer here

-- 3 different ways:

--1
---------------------------------------------------------------------
def is_unsatisfiable (e : pExp) : bool := ¬ (is_satisfiable e)
---------------------------------------------------------------------
--2
---------------------------------------------------------------------
def F_to_T : list bool → list bool
| [] := []
| (h::t) := ((¬h) :: F_to_T t)

def is_unsatisfiable' (e : pExp) : bool :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    let rs := map_pEval_over_interps e is in
    let ft := F_to_T rs in
    foldr_and ft
---------------------------------------------------------------------
--3
---------------------------------------------------------------------
def is_unsatisfiable'' : pExp → bool
| e := match (sat_solver e) with
        | none := tt
        | _ := ff
        end
---------------------------------------------------------------------

-- For proof checking check these propositions

#eval is_unsatisfiable ((P ∧ ¬ Q) ∨ ((Q ∧ ¬ P)))        --ff
#eval is_unsatisfiable ((P ∧ ¬ Q))                      --ff
#eval is_unsatisfiable (P ∧ ¬ P)                        --tt
#eval is_unsatisfiable pExp.pFalse                      --tt
#eval is_unsatisfiable pExp.pTrue                       --ff

/- [15 points]

4 => for finding list of interps
8 points => Find which interps work as a counter example (match...with or if..else or simply called sat_solver with ¬e)
3 => returning as an option

5. Given a propositional logic expression, e, and an incorrect
claim that it's valid, we often want to produce a counter-example
to that claim. Such a counter example is an interpretation under
which the expression is not true. Equivalently, a counterexample
is an interpretation under which the *negation* of the expression
*is* true.

Define a function, counterexample : pExp → option (var → bool),
that takes any expression e and returns either a counterexample
(as "some interpretation") or "none" if there isn't one. Hint:
given e, try to find a model for the expression, ¬ e.

-/

-- Answer here
-- 2 different ways
--1
---------------------------------------------------------------------
def mk_counter_example : pExp → list (var → bool) → option (var → bool)
| e list.nil := none
| e (h::t) := match (pEval e h) with
        | ff := some h
        | tt := mk_counter_example e t
        end

def counter_example (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    mk_counter_example e is
---------------------------------------------------------------------
--2
---------------------------------------------------------------------
def counter_example' (e : pExp) : option (var → bool) :=
    let n := number_of_variables_in_expression e in
    let is := interpretations_for_n_vars n in
    sat_solver (¬ e)
---------------------------------------------------------------------

-- OPTIONAL for checking

def option_to_interp : option (var → bool) → (var → bool)
| none := λ (v : var), ff
| (some i) := i

#reduce pEval deny_antecedent (option_to_interp (counter_example' deny_antecedent))

/- ONE POINT EACH (24 points)

6. Give an English language example for every valid rule of
reasoning in rules_of_reasoning.lean, and also give an English
language counter-example for each fallacy.

For example, for the rule, P >> Q >> P ∧ Q, you could say,
"If the ball is red then if (in addition to that) the box
is blue, then (in this context) the ball is red AND the box
is blue." It will be easiest is you re-use the same words
for P, Q, and R, in all of your examples. E.g., P means "the
ball is red", Q means "the box is blue", etc.

Copy the contents of rules_of_reasoning.lean into this comment
block and under each rule give your English language sentence.
-/

--english examples etc.

/-
def true_intro : pExp := pTrue

True is true.

def false_elim := pFalse >> P

False implies anything.
If false is true then anything is true.

def true_imp := pTrue >> P

Fallacy.
True implies anything.
If true is true then anything is true.
If 1=1 then 1=0.

def and_intro := P >> Q >> P ∧ Q

If it's raining then if the streets
are wet then it's raining and the streets are wet.

def and_elim_left := P ∧ Q >> P

If it's raining and the streets are wet then it's raining.

def and_elim_right := P ∧ Q >> Q

If it's raining and the streets are wet then the streets are wet.

def or_intro_left := P >> P ∨ Q

If it's raining then it's raining or the the streets are wet.

def or_intro_right := Q >> P ∨ Q

If the streets are wet then it's raining or the the streets are wet.

------------------------------------------------------------------------------ (First 8)

def or_elim := P ∨ Q >> (P >> R) >> (Q >> R) >> R

If it's raining or the sprinkler is running, then if whenever its
raining the streets are wet, then if whenever the sprinkler is running
the streets are wet, then the streets are wet.

def iff_intro := (P >> Q) >> (Q >> P) >> (P ↔ Q)

If it's the case that if it's spring the flowers are blooming, and
then it's also the case that if the flowers are blooming then it's
springtime, then the flowers are blooming if and only if it's spring.

def iff_intro' := (P >> Q) ∧ (Q >> P) >> (P ↔ Q)

If it's the case that if it's spring the flowers are blooming, and
it's also the case that if the flowers are blooming then it's
springtime, then the flowers are blooming if and only if it's spring.

def iff_elim_left := (P ↔ Q) >> (P >> Q)

If the flowers are blooming if and only if it's spring, then if the
flowers are blooming then it's spring.

def iff_elim_right := (P ↔ Q) >> (Q >> P)

If the flowers are blooming if and only if it's spring, then if it's
spring then the flowers are blooming.

def arrow_elim := (P >> Q) >> (P >> Q)

If whenever it's raining the streets are wet, then if it's raining,
the streets are wet.

def resolution := (P ∨ Q) >> (¬ Q ∨ R) >> (P ∨ R)

If the pizza is hot (P) or the soda is cold (Q), then if the soda is
warm (¬ Q) or the cheese sticks are tasty (R), then the pizza is hot
or the cheese sticks are tasty.

def unit_resolution := (P ∨ Q) >> ((¬ Q) >> P)

If the pizza is hot or the soda is cold, then if the soda is not cold,
the pizza must be hot.

-------------------------------------------------------------------------------------- (Middle 8)

def syllogism := (P >> Q) >> (Q >> R) >> (P >> R)

If being sick makes you sad, and being sad makes you cry, then
being sick makes you cry.

def modus_tollens := (P >> Q) >> (¬ Q >> ¬ P)

If being sick makes you cry, then if you're not crying you must
not be sick.

def neg_elim := (¬ ¬ P) >> P

If a natural number, n, is not not even, then n is even.

If you're not not happy, then you're happy.
(The connotation of not not happy in English is not really exactly
the same as the connotation of happy. So here the English and the
logic don't quite align.)

def excluded_middle := P ∨ (¬ P)

A natural number, n, is even or n is not even.

def neg_intro := (P >> pFalse) >> (¬ P)

If the assumption that a = b let's you deduce something that's
impossible, then a=b can't be true, and must be false.

def affirm_consequence := (P >> Q) >> (Q >> P)

If it's raining then the streets are wet, then if the streets are wet
it must be raining. This is fallacy, as the streets could be wet even if
it's not raining (by other causes).

def affirm_disjunct := (P ∨ Q) >> (P >> ¬ Q)

Professor Foo is great or Prof. Bar is great, so if Prof. Foo is great
then Prof. Bar must not be. This is also a fallacy, as both can be great.

def deny_antecedent := (P >> Q) >> (¬ P >> ¬ Q)

If it's raining means the streets are wet, then if it's not raining the
streets must be dry. Also a fallacy, for the same reason as above. The
streets could be wet even it's not raining. Maybe someone spilled their
drink.
-------------------------------------------------------------------------------- (Last 8)

-/


import data.int.modeq

/-
Let p be a prime number and k a positive integer.
(a) Show that if x is an integer such that x^2 ≡ x mod p, then x ≡ 0 or 1 mod p.
(b) Show that if x is an integer such that x^2 ≡ x mod p^k, then x ≡ 0 or 1 mod p^k.
-/

lemma part_a (p : ℤ) (hp : prime p) (x : ℤ) : x^2 ≡ x [ZMOD p] → x ≡ 0 [ZMOD p] ∨ x ≡ 1 [ZMOD p] :=
begin
  sorry
end

lemma part_b (p : ℤ) (hp : prime p) (k : ℕ) (hk : k > 0) (x : ℤ) : x^2 ≡ x [ZMOD p^k] → x ≡ 0 [ZMOD p^k] ∨ x ≡ 1 [ZMOD p^k] :=
begin
  sorry
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 3 : not in (`∉`) and complement `Aᶜ`

The definition in Lean of `x ∉ A` is `¬ (x ∈ A)`. In other words,
`x ∉ A`, `¬ (x ∈ A)` and `(x ∈ A) → false` are all equal *by definition*
in Lean.

The complement of a subset `A` of `X` is the subset `Aᶜ`; it's the terms of
type `X` which aren't in `A`. The *definition* of `x ∈ Aᶜ` is `x ∉ A`.

For example, if you have a hypothesis `h : x ∈ Aᶜ` and your goal
is `false`, then `apply h` will work and will change the goal to `x ∈ A`.
Think a bit about why.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : x ∉ A → (x ∈ A → false) :=
begin
  intro h,
  exact h,
end

example : x ∈ A → (x ∉ A → false) :=
begin
  intros h1 h2,
  exact h2 h1,
end

example : (A ⊆ B) → x ∉ B → x ∉ A :=
begin
  intros hAB hB hA,
  apply hB,
  exact hAB hA,
end

-- Lean couldn't work out what I meant when I wrote `x ∈ ∅` so I had
-- to give it a hint by telling it the type of `∅`.
example : x ∉ (∅ : set X):=
begin
  intro h,
  exact h,
end

example : x ∈ Aᶜ ↔ x ∉ A :=
begin
  refl,
end

example : (∀ x, x ∈ A) ↔ ¬ (∃ x, x ∈ Aᶜ) :=
begin
  -- `hint` tells you some tactics which do this in one line
  -- `simp`, `finish`, `tidy` all work and so do other things
  -- also `exact not_exists_not.symm` works
  -- And `library_search` works after
  -- `change (∀ x, x ∈ A) ↔ ¬ (∃ x, x ∉ A)`
  split,
  { rintros h1 ⟨x, hx⟩,
    exact hx (h1 x) },
  { intros h x,
    by_contra h2,
    apply h,
    exact ⟨x, h2⟩ },
end

example : (∃ x, x ∈ A) ↔ ¬ (∀ x, x ∈ Aᶜ) :=
begin
  finish,
end


variables p q r s : Prop

theorem and_commutative (p q : Prop) : p ∧ q → q ∧ p :=
assume hpq : p ∧ q,
have hp : p, from and.left hpq,
have hq : q, from and.right hpq,
show q ∧ p, from and.intro hq hp

theorem or_commutative (p q : Prop) : p ∨ q → q ∨ p :=
assume hpq : p ∨ q,
show q ∨ p,
from or.elim hpq
    (assume hp : p,
    show q ∨ p, from or.intro_right q hp)
    (assume hq: q,
    show q ∨ p, from or.intro_left p hq)

theorem and_associ (h : (p ∧ q) ∧ r) : p ∧ (q ∧ r) :=
have hpq : p ∧ q, from and.left h,
have hr : r, from and.right h,
have hp : p, from and.left hpq,
have hq : q, from and.right hpq,
have hqr : q ∧ r, from and.intro hq hr,
show p ∧ (q ∧ r), from and.intro hp hqr

theorem or_associ (h : (p ∨ q) ∨ r) : p ∨ (q ∨ r) :=
show p ∨ (q ∨ r),
from or.elim h
    (assume hpq : p ∨ q,
    show p ∨ (q ∨ r), from
    or.elim hpq
        (assume hp : p, or.inl hp)
        (assume hq : q, or.inr (or.inl hq))
    )
    (assume hr : r,
    show p ∨ (q ∨ r), from
    or.intro_right p (or.intro_right q hr))

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    apply or.elim (and.right h),
      intro hq,
      apply or.inl,
      apply and.intro,
        exact and.left h,
      exact hq,
    intro hr,
    apply or.inr,
    apply and.intro,
      exact and.left h,
    exact hr,
  intro h,
  apply or.elim h,
    intro hpq,
    apply and.intro,
      exact and.left hpq,
    apply or.inl,
    exact and.right hpq,
  intro hpr,
  apply and.intro,
    exact and.left hpr,
  apply or.inr,
  exact and.right hpr
end

theorem and_associ_tac (h : (p ∧ q) ∧ r) : p ∧ (q ∧ r) :=
begin
apply and.intro,
exact and.left (and.left h),
apply and.intro,
exact and.right (and.left h),
exact and.right h
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  transitivity,
  symmetry,
  assumption,
  assumption
end


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intros h h2,
  apply h2,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro h,
  by_cases h : P,
  assumption,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  intro h,
  by_cases h: P,
  assumption,
  contradiction,
  intros h h2,
  contradiction,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------
-- this might be useful: apply or.inl

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h,
  cases h with hp hq,
  right, exact hp,
  left, exact hq,

end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h,
  split,
  exact h_right,
  exact h_left,

end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intros h h2,
  cases h with c1 c2,
  contradiction,
  exact c2,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intros h h2,
  cases h with c1 c2,
  contradiction,
  exact c2,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros h h2 h3,
  have hq : Q := h h3,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros h h2,
  by_cases h3 : Q,
  assumption,
  have homi : ¬P := h h3,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intros h h2 h3,
  have hq : Q := h h3,
  contradiction,
  intros h h2,
  by_cases h3 : Q,
  assumption,
  have homi : ¬P := h h3,
  contradiction,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  have h2 : P∨¬P,
    right,
    intro h3,
    have h4 : P∨¬P,
      left,
      assumption,
    apply h h4,
    apply h h2,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros h h2,
  have hnew : (P → Q),
  intro h3,
  contradiction,
  have homi : P := h hnew,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intros h h2,
  cases h2,
  cases h,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intros h h2,
  cases h,
  cases h2,
  contradiction,
  contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro h,
  split,
  intro h_1,
  have h1 : P∨Q,
    left,
    assumption,
  contradiction,
  intro h_1,
  have h1 : P∨Q,
    right,
    assumption,
  contradiction,

end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros h1 h2,
  cases h1,
  cases h2,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h,
  by_cases h2 : P,
  by_cases h3 : Q, --duas bolas de fogo são melhores que uma!
  have h4 : P ∧ Q,
  split,
  assumption,
  assumption,
  contradiction,
  left,
  assumption,
  right,
  assumption,

end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros h1 h2,
  cases h2,
  cases h1,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  --eu n sei importar teorema help
    intro h,
    by_cases h2 : P,
    by_cases h3 : Q, --duas bolas de fogo são melhores que uma!
    have h4 : P ∧ Q,
    split,
    assumption,
    assumption,
    contradiction,
    left,
    assumption,
    right,
    assumption,
  --FIM DE: eu n sei importar teorema help
  intros h h2,
  cases h2,
  cases h,
  contradiction,
  contradiction,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  intro h,
  split,
  intro h1,
  have Q : P∨Q,
    left,
    assumption,
  contradiction,
  intro h1,
  have Q : P∨Q,
    right,
    assumption,
  contradiction,
  intros h h2,
  cases h,
  cases h2,
  contradiction,
  contradiction,

end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h,
  cases h,
  cases h_right,
  left,
  split,
  assumption,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  cases h,
  cases h,
  split,
  assumption,
  left,
  assumption,
  cases h,
  split,
  assumption,
  right,
  assumption,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h,
  cases h,
  split,
  left,
  assumption,
  left,
  assumption,
  cases h,
  split,
  right,
  assumption,
  right,
  assumption,

end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h,
  cases h_left,
  cases h_right,
  left,
  assumption,
  left,
  assumption,
  cases h_right,
  left,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros h h2 h3,
  have hq : P∧Q,
    split,
    assumption,
    assumption,
  apply h,
  assumption,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros h h1,
  cases h1,
  apply h,
  assumption,
  assumption, --tendi n ;-;

end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro h,
  assumption,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro h,
  left,
  assumption,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro h,
  right,
  assumption,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro h,
  cases h,
  assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h,
  cases h,
  assumption,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro h,
  cases h,
  assumption,
  intro h,
  split,
  assumption,
  assumption,

end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro h,
  cases h,
  assumption,
  assumption,
  intro h,
  right,
  assumption,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intros h a h1,
  have h2 : (∃x, P x),
  existsi a,
  assumption,
  contradiction,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros h h2,
  cases h2 with a ha,
  have hq : ¬P a := h a,
  contradiction,

end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro h,
  -- eu n sei importar teorema help
  have h2 : ¬(∃x, ¬P x) → (∀x, P x),
    intros h_ a,
    by_cases hcases : P a,
    assumption,
    have h_2 : (∃x, ¬P x),
      existsi a,
      assumption,
    contradiction,
  --FIM DE: eu n sei importar teorema help
  by_contradiction h3,
  have h4 : (∀x, P x) := h2 h3,
  contradiction,

end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro h,
  cases h with a ha,
  intro a2,
  have hq : P a := a2 a,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  -- eu n sei importar teorema help
  intro h,
  -- eu n sei importar teorema help
  have h2 : ¬(∃x, ¬P x) → (∀x, P x),
    intros h_ a,
    by_cases hcases : P a,
    assumption,
    have h_2 : (∃x, ¬P x),
      existsi a,
      assumption,
    contradiction,
  --FIM DE: eu n sei importar teorema help
  by_contradiction h3,
  have h4 : (∀x, P x) := h2 h3,
  contradiction,
  --FIM DE: eu n sei importar teorema help
  -- eu n sei importar teorema help
  intro h,
  cases h with a ha,
  intro a2,
  have hq : P a := a2 a,
  contradiction,
  --FIM DE: eu n sei importar teorema help
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  intros h a h1,
  have h2 : (∃x, P x),
    existsi a,
    assumption,
  contradiction,
  intros h h1,
  cases h1 with a ha,
  have h2000 : ¬P a := h a,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros h h2,
  cases h with a ha,
  have hq : ¬P a := h2 a,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros h h2,
  cases h2 with a ha,
  have hq: P a := h a,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros h a,
  by_cases h2 : P a,
  assumption,
  have h3 : (∃x, ¬P x),
    existsi a,
    assumption,
  contradiction,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro h,
  by_contradiction h2,
  have h3: ¬(∃x, P x) → (∀x, ¬P x),
    intros h4 a h5,
    have h6 : (∃x, P x),
      existsi a,
      assumption,
    contradiction,
  have h4 : (∀x, ¬P x) := h3 h2,
  contradiction,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  intros h h2,
  cases h2 with a ha,
  have hq: P a := h a,
  contradiction,
  intro h,
  intro a,
  by_contradiction h2,
  have h3 : (∃x, ¬P x),
    existsi a,
    assumption,
  contradiction,

end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  intros h h2,
  cases h with a ha,
  have hq: ¬P a := h2 a,
  contradiction,
  -- eu n sei importar teorema help
  intro h,
  by_contradiction h2,
  have h3: ¬(∃x, P x) → (∀x, ¬P x),
    intros h4 a h5,
    have h6 : (∃x, P x),
      existsi a,
      assumption,
    contradiction,
  have h4 : (∀x, ¬P x) := h3 h2,
  contradiction,
  --FIM DE: eu n sei importar teorema help

end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro h,
  cases h with a ha,
  cases ha,
  split,
  existsi a,
  assumption,
  existsi a,
  assumption,

end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro h,
  cases h with a ha,
  cases ha,
  left,
  existsi a,
  assumption,
  right,
  existsi a,
  assumption,

end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro h,
  cases h,
  cases h with a ha,
  have hq : P a ∨ Q a,
    left,
    assumption,
  existsi a,
  assumption,
  cases h with a ha,
  have hq : P a ∨ Q a,
    right,
    assumption,
  existsi a,
  assumption,

end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h,
  split,
  intro a,
  have hq: P a ∧ Q a := h a,
  cases hq,
  assumption,
  intro a,
  have hq: P a ∧ Q a := h a,
  cases hq,
  assumption,

end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h,
  cases h,
  intro a,
  have hq: P a := h_left a,
  have hq2: Q a := h_right a,
  split,
  assumption,
  assumption,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro h,
  intro a,
  cases h,
  have hq: P a := h a,
  left,
  assumption,
  have hq: Q a := h a,
  right,
  assumption,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los retículos se verifica que
--     x ⊓ y = y ⊓ x
-- ----------------------------------------------------------------------

import order.lattice

variables {α : Type*} [lattice α]
variables x y z : α

-- 1ª demostración
-- ===============

lemma aux1 : x ⊓ y ≤ y ⊓ x :=
begin
  have h1 : x ⊓ y ≤ y,
    by exact inf_le_right,
  have h2 : x ⊓ y ≤ x,
    by exact inf_le_left,
  show x ⊓ y ≤ y ⊓ x,
    by exact le_inf h1 h2,
end

example : x ⊓ y = y ⊓ x :=
begin
  have h1 : x ⊓ y ≤ y ⊓ x,
    by exact aux1 x y,
  have h2 : y ⊓ x ≤ x ⊓ y,
    by exact aux1 y x,
  show x ⊓ y = y ⊓ x,
    by exact le_antisymm h1 h2,
end

-- 2ª demostración
-- ===============

lemma aux2 : x ⊓ y ≤ y ⊓ x :=
le_inf inf_le_right inf_le_left

example : x ⊓ y = y ⊓ x :=
le_antisymm (aux2 x y) (aux2 y x)

-- 3ª demostración
-- ===============

lemma aux3 : x ⊓ y ≤ y ⊓ x :=
begin
  apply le_inf,
  apply inf_le_right,
  apply inf_le_left,
end

-- Su desarrollo es
--
-- ⊢ x ⊓ y ≤ y ⊓ x
--    apply le_inf,
-- ⊢ x ⊓ y ≤ y
-- |   apply inf_le_right,
-- ⊢ x ⊓ y ≤ y
-- |   apply inf_le_left,
-- no goals

example : x ⊓ y = y ⊓ x :=
begin
  apply le_antisymm,
  apply aux3,
  apply aux3,
end

-- Su desarrollo es
--
-- ⊢ x ⊓ y = y ⊓ x
--    apply le_antisymm,
-- ⊢ x ⊓ y ≤ y ⊓ x
-- |   apply aux,
-- ⊢ y ⊓ x ≤ x ⊓ y
-- |   apply aux,
-- no goals

-- 4ª demostración
-- ===============

example : x ⊓ y = y ⊓ x :=
by apply le_antisymm; simp

-- 5ª demostración
-- ===============

example : x ⊓ y = y ⊓ x :=
-- by library_search
inf_comm

-- 6ª demostración
-- ===============

example : x ⊓ y = y ⊓ x :=
-- by hint
by finish

-- Lemas usados
-- ============

-- #check (inf_comm : x ⊓ y = y ⊓ x)
-- #check (inf_le_left : x ⊓ y ≤ x)
-- #check (inf_le_right : x ⊓ y ≤ y)
-- #check (le_antisymm : x ≤ y → y ≤ x → x = y)
-- #check (le_inf : z ≤ x → z ≤ y → z ≤ x ⊓ y)


-- begin header

import algebra.group

set_option trace.cc true
set_option trace.debug.dsimplify true
set_option trace.simplify.context true
set_option trace.simplify.rewrite true
-- set_option trace.debug.eqn_compiler true
-- set_option trace.debug true

-- end header

/-
# Hello
-/

/-
## Commutativity

The following is adapted from the default code
on <https://leanprover.github.io/live/latest/> .
-/

/- Lemma

$\mathbb{N}$ is commutative under addition.

-/
lemma ℕ_addition_commutative
(n m : ℕ) :
    n + m = m + n :=
begin
    -- $\mathbb{N}$ is a semi-group which is commutative under addition.
    apply add_comm
end

/-
    There're alternative tatics:

    * `apply add_comm`
    * `cc`
    * `simp [add_comm]`

    why `simp` failed? See:

    * <https://github.com/leanprover-community/lean/blob/master/doc/changes.md#v360c-26-feb-2020>
    * <https://github.com/leanprover-community/lean/pull/65>
-/

/- Example

$\mathbb{N}$ is commutative under multiplication.

(example is just a nameless lemma)
-/
example (n m : ℕ) :
    n * m = m * n :=
by apply mul_comm

-- The following are adapted from
-- Chapter 1, The Hitchhiker’s Guide to Logical Verification

-- 1.1.2 Terms

lemma function_currying_right_associative
(σ τ ν : Type) :
    ( σ → τ → ν ) = ( σ → (τ → ν) ) :=
by reflexivity

lemma application_left_associative
(σ τ ν : Type) (t : σ → τ → ν) (u : σ) (v : τ) :
    ( t u v ) = ( (t u) v ) :=
by reflexivity

lemma lambda_right_associative
(σ τ ν : Type) (t : ν) :
    ( λx : σ, λy : τ, t ) = ( λx : σ, (λy : τ, t) ) :=
by reflexivity

lemma lambda_grouping
(σ τ ν : Type) (t : ν) :
    ( λ(x : σ)(y : τ), t ) = ( λx : σ, λy : τ, t ) :=
by reflexivity

lemma lambda_type_grouping
(σ τ ν : Type) (t : ν) :
    ( λ(x y : σ), t ) = ( λ(x : σ)(y : σ), t ) :=
by reflexivity

constants a b : ℤ
constant f : ℤ → ℤ
constant g : ℤ → ℤ → ℤ

#check a
#check f

#check λx : ℤ, g (f (g a x)) (g x b)
#check λx, g (f (g a x)) (g x b)

constant trool : Type
constants trool.true trool.false trool.maybe : trool

#check trool.maybe

-- 1.2.1 Natural Numbers

inductive ℕat : Type
| zero : ℕat
| succ : ℕat → ℕat

#print ℕat

-- 1.2.2 Arithmetic Expressions & 1.3 Function Definitions

inductive ArithmeticExpr : Type
| num : ℤ → ArithmeticExpr
| sym : string -> ArithmeticExpr
| add : ArithmeticExpr → ArithmeticExpr → ArithmeticExpr
| sub : ArithmeticExpr → ArithmeticExpr → ArithmeticExpr
| mul : ArithmeticExpr → ArithmeticExpr → ArithmeticExpr
| div : ArithmeticExpr → ArithmeticExpr → ArithmeticExpr

def eval (env : string → ℤ) : ArithmeticExpr → ℤ
| (ArithmeticExpr.num i) := i
| (ArithmeticExpr.sym s) := env s
| (ArithmeticExpr.add e₁ e₂) := eval e₁ + eval e₂
| (ArithmeticExpr.sub e₁ e₂) := eval e₁ - eval e₂
| (ArithmeticExpr.mul e₁ e₂) := eval e₁ * eval e₂
| (ArithmeticExpr.div e₁ e₂) := eval e₁ / eval e₂

def example_env₂ (key : string) : ℤ
:= if key = "any" then 100 else string.to_nat key

def example_env : string → ℤ
| "one" := 1
| "two" := 2
| "three" := 3
| "four" := 4
| "any" := 100
| key := string.to_nat key

def example_eval : ℤ
:= (eval example_env) (ArithmeticExpr.sub
    (ArithmeticExpr.div
        (ArithmeticExpr.add
            (ArithmeticExpr.sym "any") (ArithmeticExpr.num 3)
        )
        (ArithmeticExpr.num 3)
    )
    (ArithmeticExpr.mul
        (ArithmeticExpr.num 5) (ArithmeticExpr.sym "four")
    )
)
def expected_eval : ℤ
:= (100 + 3) / 3 - 5 * 4

lemma fourteen :
    example_eval = expected_eval ∧ example_eval = 14 :=
begin
apply and.intro,
refl, -- example_eval = expected_eval
refl -- example_eval = 14
end

-- 1.2.5 Lists

inductive List (α : Type) : Type
| nil : List
| cons : α → List → List

#check List.nil
#check List.cons
#check @List.nil
#check @List.cons

#check []
#check λ(α : Type) (x : α) (xs : list α), x :: xs
#check λ(α : Type) (x_1 x_ooo x_n : α), x_1 :: x_ooo :: x_n :: []

#check []
#check λ(Animal : Type) (cat : Animal) (cats : list Animal),
    cat :: cats
#check λ(Animal : Type) (cat_1 cat_ooo cat_n : Animal),
    cat_1 :: cat_ooo :: cat_n :: []

-- 1.3 Function Definitions

def add : ℕ → ℕ → ℕ
| m nat.zero := m
| m (nat.succ n) := nat.succ (add m n)

-- #eval employs an optimized interpreter
#eval add 2 7
-- #reduce uses Lean’s inference kernel, which is less efficient
#reduce add 2 7

def mul : ℕ → ℕ → ℕ
| _ nat.zero := nat.zero
| m (nat.succ n) := add m (mul m n)

#eval mul 2 7

def power : ℕ → ℕ → ℕ
| _ nat.zero := 1
| m (nat.succ n) := mul m (power m n)

#eval power 2 3

def power₂ (m : ℕ) : ℕ → ℕ
| nat.zero := 1
| (nat.succ n) := mul m (power m n)

#eval power₂ 2 3

def iter (α : Type) (z : α) (f : α → α) : ℕ → α
| nat.zero := z
| (nat.succ n) := f (iter n)

def power₃ (m n : ℕ) : ℕ
:= iter ℕ 1 (λl, m * l) n

def list_append (α : Type) : list α → list α → list α
| list.nil xs := xs
| (list.cons x xs) ys := list.cons x (list_append xs ys)

#check list_append

#eval list_append _ [3, 1] [4, 1, 5]

def list_append₂ {α : Type} : list α → list α → list α
| list.nil xs := xs
| (list.cons x xs) ys := list.cons x (list_append₂ xs ys)

#check list_append₂
#eval list_append₂ [3, 1] [4, 1, 5]

-- The at sign (@) can be used to make the implicit arguments explicit
#check @list_append₂
#eval @list_append₂ ℤ [3, 1] [4, 1, 5]
#eval @list_append₂ _ [3, 1] [4, 1, 5]

-- We can use syntactic sugar in the definition, both in the patterns
-- on the left-hand sides of := and in the right-hand sides
def list_append₃ {α : Type} : list α → list α → list α
| [] xs := xs
| (x :: xs) ys := x :: (list_append₃ xs ys)

def reverse {α : Type} : list α → list α
| [] := []
| (x :: xs) := (reverse xs) ++ [x]

-- 1.4 Lemma Statements

lemma add_commutative (m n : ℕ) :
    add m n = add n m :=
sorry

lemma add_associative (l m n : ℕ) :
    add (add l m) n = add l (add m n) :=
sorry

lemma mul_commutative (m n : ℕ) :
    mul m n = mul n m :=
sorry

lemma mul_add_distributive (l m n : ℕ) :
    mul l (add m n) = add (mul l m) (mul l n) :=
sorry

lemma reverse_reverse {α : Type} (xs : list α) :
    reverse (reverse xs) = xs :=
sorry

axiom a_less_b :
    a < b


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.big_operators.basic
import ring_theory.polynomial.basic

/-!
# Lagrange interpolation

## Main definitions

* `lagrange.basis s x` where `s : finset F` and `x : F`: the Lagrange basis polynomial
  that evaluates to `1` at `x` and `0` at other elements of `s`.
* `lagrange.interpolate s f` where `s : finset F` and `f : s → F`: the Lagrange interpolant
  that evaluates to `f x` at `x` for `x ∈ s`.

-/

noncomputable theory
open_locale big_operators classical

universe u

namespace lagrange

variables {F : Type u} [decidable_eq F] [field F] (s : finset F)
variables {F' : Type u} [field F'] (s' : finset F')

open polynomial

/-- Lagrange basis polynomials that evaluate to 1 at `x` and 0 at other elements of `s`. -/
def basis (x : F) : polynomial F :=
∏ y in s.erase x, C (x - y)⁻¹ * (X - C y)

@[simp] theorem basis_empty (x : F) : basis ∅ x = 1 :=
rfl

@[simp] theorem eval_basis_self (x : F) : (basis s x).eval x = 1 :=
begin
  rw [basis, ← coe_eval_ring_hom, (eval_ring_hom x).map_prod, coe_eval_ring_hom,
    finset.prod_eq_one],
  intros y hy, simp_rw [eval_mul, eval_sub, eval_C, eval_X],
  exact inv_mul_cancel (sub_ne_zero_of_ne (finset.ne_of_mem_erase hy).symm)
end

@[simp] theorem eval_basis_ne (x y : F) (h1 : y ∈ s) (h2 : y ≠ x) : (basis s x).eval y = 0 :=
begin
  rw [basis,
  ← coe_eval_ring_hom, (eval_ring_hom y).map_prod, coe_eval_ring_hom,
    finset.prod_eq_zero (finset.mem_erase.2 ⟨h2, h1⟩)],
  simp_rw [eval_mul, eval_sub, eval_C, eval_X, sub_self, mul_zero]
end

theorem eval_basis (x y : F) (h : y ∈ s) : (basis s x).eval y = if y = x then 1 else 0 :=
by { split_ifs with H, { subst H, apply eval_basis_self }, { exact eval_basis_ne s x y h H } }

@[simp] theorem nat_degree_basis (x : F) (hx : x ∈ s) : (basis s x).nat_degree = s.card - 1 :=
begin
  unfold basis, generalize hsx : s.erase x = sx,
  have : x ∉ sx := hsx ▸ finset.not_mem_erase x s,
  rw [← finset.insert_erase hx, hsx, finset.card_insert_of_not_mem this, add_tsub_cancel_right],
  clear hx hsx s, revert this, apply sx.induction_on,
  { intros hx, rw [finset.prod_empty, nat_degree_one], refl },
  { intros y s hys ih hx, rw [finset.mem_insert, not_or_distrib] at hx,
    have h1 : C (x - y)⁻¹ ≠ C 0 := λ h, hx.1 (eq_of_sub_eq_zero $ inv_eq_zero.1 $ C_inj.1 h),
    have h2 : X ^ 1 - C y ≠ 0 := by convert X_pow_sub_C_ne_zero zero_lt_one y,
    rw C_0 at h1, rw pow_one at h2,
    rw [finset.prod_insert hys, nat_degree_mul (mul_ne_zero h1 h2), ih hx.2,
        finset.card_insert_of_not_mem hys, nat_degree_mul h1 h2,
        nat_degree_C, zero_add, nat_degree, degree_X_sub_C, add_comm], refl,
    rw [ne, finset.prod_eq_zero_iff], rintro ⟨z, hzs, hz⟩,
    rw mul_eq_zero at hz, cases hz with hz hz,
    { rw [← C_0, C_inj, inv_eq_zero, sub_eq_zero] at hz, exact hx.2 (hz.symm ▸ hzs) },
    { rw ← pow_one (X : polynomial F) at hz, exact X_pow_sub_C_ne_zero zero_lt_one _ hz } }
end

variables (f : s → F)

/-- Lagrange interpolation: given a finset `s` and a function `f : s → F`,
`interpolate s f` is the unique polynomial of degree `< s.card`
that takes value `f x` on all `x` in `s`. -/
def interpolate : polynomial F :=
∑ x in s.attach, C (f x) * basis s x

@[simp] theorem interpolate_empty (f) : interpolate (∅ : finset F) f = 0 :=
rfl

@[simp] theorem eval_interpolate (x) (H : x ∈ s) : eval x (interpolate s f) = f ⟨x, H⟩ :=
begin
  rw [interpolate,
  ← coe_eval_ring_hom, (eval_ring_hom x).map_sum, coe_eval_ring_hom,
      finset.sum_eq_single (⟨x, H⟩ : { x // x ∈ s })],
  { rw [eval_mul, eval_C, subtype.coe_mk, eval_basis_self, mul_one] },
  { rintros ⟨y, hy⟩ _ hyx, rw [eval_mul, subtype.coe_mk, eval_basis_ne s y x H, mul_zero],
    { rintros rfl, exact hyx rfl } },
  { intro h, exact absurd (finset.mem_attach _ _) h }
end

theorem degree_interpolate_lt : (interpolate s f).degree < s.card :=
if H : s = ∅ then by { subst H, rw [interpolate_empty, degree_zero], exact with_bot.bot_lt_coe _ }
else (degree_sum_le _ _).trans_lt $ (finset.sup_lt_iff $ with_bot.bot_lt_coe s.card).2 $ λ b _,
calc  (C (f b) * basis s b).degree
    ≤ (C (f b)).degree + (basis s b).degree : degree_mul_le _ _
... ≤ 0 + (basis s b).degree : add_le_add_right degree_C_le _
... = (basis s b).degree : zero_add _
... ≤ (basis s b).nat_degree : degree_le_nat_degree
... = (s.card - 1 : ℕ) : by { rw nat_degree_basis s b b.2 }
... < s.card : with_bot.coe_lt_coe.2 (nat.pred_lt $ mt finset.card_eq_zero.1 H)

/-- Linear version of `interpolate`. -/
def linterpolate : (s → F) →ₗ[F] polynomial F :=
{ to_fun := interpolate s,
  map_add' := λ f g, by { simp_rw [interpolate, ← finset.sum_add_distrib, ← add_mul, ← C_add],
    refl },
  map_smul' := λ c f, by { simp_rw [interpolate, finset.smul_sum, C_mul', smul_smul], refl } }

@[simp] lemma interpolate_add (f g) : interpolate s (f + g) = interpolate s f + interpolate s g :=
(linterpolate s).map_add f g

@[simp] lemma interpolate_zero : interpolate s 0 = 0 :=
(linterpolate s).map_zero

@[simp] lemma interpolate_neg (f) : interpolate s (-f) = -interpolate s f :=
(linterpolate s).map_neg f

@[simp] lemma interpolate_sub (f g) : interpolate s (f - g) = interpolate s f - interpolate s g :=
(linterpolate s).map_sub f g

@[simp] lemma interpolate_smul (c : F) (f) : interpolate s (c • f) = c • interpolate s f :=
(linterpolate s).map_smul c f

theorem eq_zero_of_eval_eq_zero {f : polynomial F'} (hf1 : f.degree < s'.card)
  (hf2 : ∀ x ∈ s', f.eval x = 0) : f = 0 :=
by_contradiction $ λ hf3, not_le_of_lt hf1 $
calc  (s'.card : with_bot ℕ)
    ≤ f.roots.to_finset.card : with_bot.coe_le_coe.2 $ finset.card_le_of_subset $ λ x hx,
        (multiset.mem_to_finset).mpr $ (mem_roots hf3).2 $ hf2 x hx
... ≤ f.roots.card : with_bot.coe_le_coe.2 $ f.roots.to_finset_card_le
... ≤ f.degree : card_roots hf3

theorem eq_of_eval_eq {f g : polynomial F'} (hf : f.degree < s'.card) (hg : g.degree < s'.card)
  (hfg : ∀ x ∈ s', f.eval x = g.eval x) : f = g :=
eq_of_sub_eq_zero $ eq_zero_of_eval_eq_zero s'
  (lt_of_le_of_lt (degree_sub_le f g) $ max_lt hf hg)
  (λ x hx, by rw [eval_sub, hfg x hx, sub_self])

theorem eq_interpolate (f : polynomial F) (hf : f.degree < s.card) :
  interpolate s (λ x, f.eval x) = f :=
eq_of_eval_eq s (degree_interpolate_lt s _) hf $ λ x hx, eval_interpolate s _ x hx

/-- Lagrange interpolation induces isomorphism between functions from `s` and polynomials
of degree less than `s.card`. -/
def fun_equiv_degree_lt : degree_lt F s.card ≃ₗ[F] (s → F) :=
{ to_fun := λ f x, f.1.eval x,
  map_add' := λ f g, funext $ λ x, eval_add,
  map_smul' := λ c f, funext $ λ x, by
    { change eval ↑x (c • f).val = (c • λ (x : s), eval ↑x f.val) x,
      rw [pi.smul_apply, smul_eq_mul, ← @eval_C F c _ x,
      ← eval_mul, eval_C, C_mul'], refl },
  inv_fun := λ f, ⟨interpolate s f, mem_degree_lt.2 $ degree_interpolate_lt s f⟩,
  left_inv := λ f, subtype.eq $ eq_interpolate s f $ mem_degree_lt.1 f.2,
  right_inv := λ f, funext $ λ ⟨x, hx⟩, eval_interpolate s f x hx }

end lagrange