/- Justin Cai, jc5pz -/

/-
Read, and if you have already read, then re-read, the
chapters in the notes on proofs of disjunctions and negations.
We have added some new material, especially under negation
elimination.

In proofs of bi-implications, use comments to mark the start of
the proofs of the implications in each direction. Label one as
"forward" the other other as "backward."

The collaboration policy for this homework is "no collaboration
allowed." You may study and discuss the underlying concepts with
anyone.

You may provide proofs in the style of your choice: term-style,
tactic style, or mixed. Yes, you can using tactic scripts within
terms and terms within tactic scripts. You may use any tactics
you know of. As a courtesy, we provide begin/end pairs, in case
you should want to use them. Otherwise you may delete them.
-/

/-
1. 15 points
-/
example : ∀ (P Q : Prop), P ∧ Q → P ∨ Q :=
begin
    intros P Q,
    assume paq,
    have p := paq.left,
    exact or.inl p,
end

/-
2. 15 points
-/
example :
    ∀ (P Q R : Prop), (P ∨ Q) → (Q ∨ R) → ¬ Q → (P ∧ R) :=
begin
    intros P Q R,
    assume poq,
    assume qor,
    assume nq,
    cases poq with p q,
    cases qor with q r,

        contradiction,
        exact and.intro p r,
        contradiction,
end

/-
3. 15 points
-/
example :
    ∀ (P Q R : Prop), P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=
begin
    intros P Q R,
    apply iff.intro,
    /- forward -/
        assume paqor,
        have p := paqor.1,
        have qor := paqor.2,
        cases qor with q r,
            apply or.inl,
            exact and.intro p q,
            apply or.inr,
            exact and.intro p r,
    /- backward -/
        assume paqopar,
        cases paqopar with paq par,
           have p := paq.1,
           have q := paq.2,
           exact and.intro p (or.inl q),
           have p := par.1,
           have r := par.2,
           exact and.intro p (or.inr r),
end

/-
4. 10 points
-/

example : ∀ (P Q R : Prop), P → Q → R → ¬ Q → (Q ∨ ¬ Q) :=
begin
    intros P Q R,
    assume p,
    assume q,
    assume r,
    assume nq,
    contradiction,
end

open classical      -- hint: you can now use em easily

/-
4a. 5 points. Write *your own* proof of this conjecture.
-/

example : ∀ (P Q : Prop), ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
    intros P Q,
    apply iff.intro,
    /- forward-/
        assume npoq,
        cases em P with p np,
        have f : false := npoq (or.inl p),
        exact false.elim f,
        cases em Q with q nq,
        have f : false := npoq (or.inr q),
        exact false.elim f,
        exact and.intro np nq,
    /-backward-/
        assume npanq,
        assume npoq,
        cases npoq with p q,
        have np := npanq.left,
        contradiction,
        have nq := npanq.right,
        contradiction,
end

/-
4b. 5 points. Is this theorem classically true in neither, one, or
both directions. Explain your answer in relation to your proof.

Answer:
This theorem is classically true in both directions. It's definitely
classically true in forward direction because it requires the use of em
(aka classical logic) for the proof to even work, and it's classically true
in backward direction because the backward proof is true in constructive
logic, making it also true in classical logic.
-/

/-
5. 5 points. Write *your own proof* of this conjecture.
-/
example : ∀ (P Q : Prop), ¬ (P ∧ Q) ↔ (¬ P ∨ ¬ Q) :=
begin
    intros P Q,
    apply iff.intro,
    /- forward -/
        assume npaq,
        cases em P with p np,
        cases em Q with q nq,
        have f : false := npaq (and.intro p q),
        exact false.elim f,
        exact or.inr nq,
        exact or.inl np,
    /-backward-/
        assume nponq,
        assume paq,
        cases nponq with np nq,
        have p := paq.left,
        have f : false := np p,
        exact false.elim f,
        have q := paq.right,
        have f : false := nq q,
        exact false.elim f,
end

/-
6. 10 points
-/

example : ∀ (P : Prop), (¬ ¬ P → P) ↔ (P ∨ ¬ P) :=
begin
    intro P,
    apply iff.intro,
    /-forward-/
        assume nnpp,
        cases em P with p np,
        exact or.inl p,
        exact or.inr np,
    /-backward-/
        assume ponp,
        assume nnp,
        cases ponp with p np,
        exact p,
        contradiction,
end

/-
7. 5 points

Tranlate the preceding proposition into English,
referring explicitly to the principles of negation
elimination and excluded middle. Write your sentence
here:

The proposition states that for all P of type Prop, (P implies false
implies false implies P) implies ((P or P implies false) is true), and vice
versa.

1. Assumed P
2. Applied bi-implication introduction
3. Forward proof
    a. Assumed not not P implies P
    b. Used the law of excluded middle (which states that either P or not P
    must be true) to create two cases for P to prove.
    I must prove:
        1. that if P is true then P or not P is true
        2. and that if not P is true then P or not P is true
    c. Since I am given a proof of P, I am able to apply the or introduction
    rule for the left side (which is asking for a proof of P)
    d. Since I am given a proof of not P, I am able to apply the or
    introduction rule for the right side (which is asking for a proof of
    not P)
4. Backward proof
    a. Assumed P or not P is true
    b. Assumed not not P is true
    c. Created two cases for P or not P to prove.
    I must prove:
        1. If P is true, then P is true
        2. If not P is true, then P is true
    d. Since I am given a proof of P, all I had to do was apply that proof of P to
    prove that P is true
    e. Since I am given a proof of not P and a proof of not not P, there is a
    contradiction in the proposition due to negation elimination; all I had to do
    was apply the contradiction rule
-/

/-
8. [10 points]
-/
example :
    (∀ ( P Q : Prop ), (P → Q) ↔ (¬ Q → ¬ P)) →
        ∀ (Raining Wet : Prop), (¬ Wet → ¬ Raining) →
            (Raining → Wet) :=
begin
    intros PQ,
    assume Raining Wet,
    assume nWetnRaining,
    assume Rain,
    have RainingWet := PQ Raining Wet,
    have RWback := RainingWet.2,
    exact RWback nWetnRaining Rain,
end

example :
    (∀ ( P Q : Prop ), (P → Q) ↔ (¬ Q → ¬ P)) →
        ∀ (Raining Wet : Prop), (¬ Wet → ¬ Raining) →
            (Raining → Wet) :=
begin
    intros PQnQnP Raining Wet,
    assume nwnr,
    assume r,
    have pfRW := PQnQnP Raining Wet,
    apply iff.elim_right pfRW nwnr,
    exact r,
end

/-
9. [5 points]

What is the name of the principle expressed by the
premise, (P → Q) ↔ (¬ Q → ¬ P)), in the preceding
problem? Answer here:

Proof by Contrapositive
-/


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Jeremy Avigad
-/
import data.nat.basic

/-!
#  Distance function on ℕ

This file defines a simple distance function on naturals from truncated substraction.
-/

namespace nat

/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n m : ℕ) := (n - m) + (m - n)

theorem dist.def (n m : ℕ) : dist n m = (n - m) + (m - n) := rfl

theorem dist_comm (n m : ℕ) : dist n m = dist m n :=
by simp [dist.def, add_comm]

@[simp] theorem dist_self (n : ℕ) : dist n n = 0 :=
by simp [dist.def, tsub_self]

theorem eq_of_dist_eq_zero {n m : ℕ} (h : dist n m = 0) : n = m :=
have n - m = 0, from nat.eq_zero_of_add_eq_zero_right h,
have n ≤ m, from tsub_eq_zero_iff_le.mp this,
have m - n = 0, from nat.eq_zero_of_add_eq_zero_left h,
have m ≤ n, from tsub_eq_zero_iff_le.mp this,
le_antisymm ‹n ≤ m› ‹m ≤ n›

theorem dist_eq_zero {n m : ℕ} (h : n = m) : dist n m = 0 :=
begin rw [h, dist_self] end

theorem dist_eq_sub_of_le {n m : ℕ} (h : n ≤ m) : dist n m = m - n :=
begin rw [dist.def, tsub_eq_zero_iff_le.mpr h, zero_add] end

theorem dist_eq_sub_of_le_right {n m : ℕ} (h : m ≤ n) : dist n m = n - m :=
begin rw [dist_comm], apply dist_eq_sub_of_le h end

theorem dist_tri_left (n m : ℕ) : m ≤ dist n m + n :=
le_trans le_tsub_add (add_le_add_right (nat.le_add_left _ _) _)

theorem dist_tri_right (n m : ℕ) : m ≤ n + dist n m :=
by rw add_comm; apply dist_tri_left

theorem dist_tri_left' (n m : ℕ) : n ≤ dist n m + m :=
by rw dist_comm; apply dist_tri_left

theorem dist_tri_right' (n m : ℕ) : n ≤ m + dist n m :=
by rw dist_comm; apply dist_tri_right

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
eq.trans (dist_eq_sub_of_le_right (zero_le n)) (tsub_zero n)

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
eq.trans (dist_eq_sub_of_le (zero_le n)) (tsub_zero n)

theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
calc
  dist (n + k) (m + k) = ((n + k) - (m + k)) + ((m + k)-(n + k)) : rfl
                   ... = (n - m) + ((m + k) - (n + k))   : by rw add_tsub_add_eq_tsub_right
                   ... = (n - m) + (m - n)               : by rw add_tsub_add_eq_tsub_right

theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
begin rw [add_comm k n, add_comm k m], apply dist_add_add_right end

theorem dist_eq_intro {n m k l : ℕ} (h : n + m = k + l) : dist n k = dist l m :=
calc
  dist n k = dist (n + m) (k + m) : by rw dist_add_add_right
       ... = dist (k + l) (k + m) : by rw h
       ... = dist l m             : by rw dist_add_add_left

theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
have dist n m + dist m k = (n - m) + (m - k) + ((k - m) + (m - n)),
  by simp [dist.def, add_comm, add_left_comm],
by { rw [this, dist.def], exact add_le_add tsub_le_tsub_add_tsub tsub_le_tsub_add_tsub }

theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
by rw [dist.def, dist.def, right_distrib, tsub_mul, tsub_mul]

theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
by rw [mul_comm k n, mul_comm k m, dist_mul_right, mul_comm]

-- TODO(Jeremy): do when we have max and minx
--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
--sorry
/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_le_right this])
-/

theorem dist_succ_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
by simp [dist.def, succ_sub_succ]

theorem dist_pos_of_ne {i j : nat} : i ≠ j → 0 < dist i j :=
assume hne, nat.lt_by_cases
  (assume : i < j,
     begin rw [dist_eq_sub_of_le (le_of_lt this)], apply tsub_pos_of_lt this end)
  (assume : i = j, by contradiction)
  (assume : i > j,
     begin rw [dist_eq_sub_of_le_right (le_of_lt this)], apply tsub_pos_of_lt this end)

end nat


/-
Exercise 3.
Let us define the binary relation ~> as follow:
Let X and Y be two sets, and f : X → V be some function between the sets, then ∀ x, y ∈ X, x ~> y if and only if f(x) = f(y).

Can you prove that ~> is an equivalence relation?
Replace the sorry for your proof.

Here are some basic tactics that might help : http://wwwf.imperial.ac.uk/~buzzard/xena/html/source/tactics/guide.html
-/

universe u
variables {X V : Type u}

-- Defining crel as the aforementioned binary relation with notation ~>
def crel (f : X → V) (x y : X) := f x = f y
infix ` ~> `: 50 := crel

@[simp] lemma crel_refl : ∀ f : X → V, reflexive ((~>) f) :=
begin
    sorry
end

@[simp] lemma crel_symm : ∀ f : X → V, symmetric ((~>) f) :=
begin
    sorry
end

@[simp] lemma crel_trans : ∀ f : X → V, transitive ((~>) f) :=
begin
    sorry
end

theorem crel_eq : ∀ f : X → V, equivalence ((~>) f) :=
begin
    sorry
end


import data.real.basic

variables {x y : ℝ}

#check lt_or_le
#check @abs_of_neg
#check @abs_of_nonneg

namespace my_abs

-- BEGIN

theorem abs_add : abs (x + y) ≤ abs x + abs y :=
begin
  cases lt_or_le x 0 with hx hx;
  cases lt_or_le y 0 with hy hy;
  cases lt_or_le (x + y) 0 with hxy hxy;
  simp [abs_of_neg, abs_of_nonneg, hx, hy, hxy];
  linarith,
end

-- END

end my_abs


import MyNat.Power
import MyNat.Multiplication
import PowerWorld.Level5 -- pow_add
namespace MyNat
open MyNat

/-!
# Power World

## Level 7: `pow_pow`

Boss level! What will the collectible be?

## Lemma
For all naturals `a`, `m`, `n`, we have `(a ^ m) ^ n = a ^ {mn}`.
-/
lemma pow_pow (a m n : MyNat) : (a ^ m) ^ n = a ^ (m * n) := by
  induction n with
  | zero =>
    rw [zero_is_0]
    rw [mul_zero]
    repeat rw [pow_zero]
  | succ n ih =>
    rw [pow_succ]
    rw [ih]
    rw [mul_succ]
    rw [pow_add]

/-!
Apparently Lean can't find a collectible, even though you feel like you
just finished power world so you must have proved *something*. What should the
collectible for this level be called?

But what is this? It's one of those twists where there's another
boss after the boss you thought was the final boss! Go to the next
level!

Next up [Level 8](./Level8.lean.md)
-/


variables (real : Type) [ordered_ring real]
variables (log exp : real → real)
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real): exp (x + y + z) = exp x * exp y * exp z := begin
rw [exp_add, exp_add]
end

example (y : real) (h : y > 0)  : exp (log y) = y := begin
exact exp_log_eq h
end

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y := begin
rw [
  <- exp_log_eq hx,
  <- exp_log_eq hy,
  <- exp_add (log x) (log y),
  log_exp_eq,
  log_exp_eq,
  log_exp_eq
],
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.eval
import Mathlib.tactic.interval_cases
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Theory of degrees of polynomials

Some of the main results include
- `nat_degree_comp_le` : The degree of the composition is at most the product of degrees

-/

namespace polynomial

theorem nat_degree_comp_le {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} : nat_degree (comp p q) ≤ nat_degree p * nat_degree q := sorry

theorem degree_map_le {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) : degree (map f p) ≤ degree p := sorry

theorem nat_degree_map_le {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) : nat_degree (map f p) ≤ nat_degree p := sorry

theorem degree_map_eq_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) : degree (map f p) = degree p := sorry

theorem nat_degree_map_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) : nat_degree (map f p) = nat_degree p :=
  nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero f hf)

theorem leading_coeff_map_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) : leading_coeff (map f p) = coe_fn f (leading_coeff p) := sorry

theorem degree_pos_of_root {R : Type u} {a : R} [semiring R] {p : polynomial R} (hp : p ≠ 0) (h : is_root p a) : 0 < degree p := sorry

theorem nat_degree_pos_of_eval₂_root {R : Type u} {S : Type v} [semiring R] [semiring S] {p : polynomial R} (hp : p ≠ 0) (f : R →+* S) {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), coe_fn f x = 0 → x = 0) : 0 < nat_degree p := sorry

theorem degree_pos_of_eval₂_root {R : Type u} {S : Type v} [semiring R] [semiring S] {p : polynomial R} (hp : p ≠ 0) (f : R →+* S) {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), coe_fn f x = 0 → x = 0) : 0 < degree p :=
  iff.mp nat_degree_pos_iff_degree_pos (nat_degree_pos_of_eval₂_root hp f hz inj)

theorem degree_map_eq_of_injective {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) (p : polynomial R) : degree (map f p) = degree p := sorry

theorem degree_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) (p : polynomial R) : degree (map f p) = degree p :=
  degree_map_eq_of_injective hf p

theorem nat_degree_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) (p : polynomial R) : nat_degree (map f p) = nat_degree p :=
  nat_degree_eq_of_degree_eq (degree_map' hf p)

theorem leading_coeff_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} (hf : function.injective ⇑f) (p : polynomial R) : leading_coeff (map f p) = coe_fn f (leading_coeff p) := sorry

theorem monomial_nat_degree_leading_coeff_eq_self {R : Type u} [semiring R] {f : polynomial R} (h : finset.card (finsupp.support f) ≤ 1) : coe_fn (monomial (nat_degree f)) (leading_coeff f) = f := sorry

theorem C_mul_X_pow_eq_self {R : Type u} [semiring R] {f : polynomial R} (h : finset.card (finsupp.support f) ≤ 1) : coe_fn C (leading_coeff f) * X ^ nat_degree f = f := sorry


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import data.fintype.card_embedding
import probability.cond_count
import probability.notation

/-!
# Birthday Problem

This file proves Theorem 93 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

As opposed to the standard probabilistic statement, we instead state the birthday problem
in terms of injective functions. The general result about `fintype.card (α ↪ β)` which this proof
uses is `fintype.card_embedding_eq`.
-/

local notation (name := finset.card)  `|` x `|` := finset.card x
local notation (name := fintype.card) `‖` x `‖` := fintype.card x

/-- **Birthday Problem**: set cardinality interpretation. -/
theorem birthday :
  2 * ‖fin 23 ↪ fin 365‖ < ‖fin 23 → fin 365‖ ∧ 2 * ‖fin 22 ↪ fin 365‖ > ‖fin 22 → fin 365‖ :=
begin
  simp only [nat.desc_factorial, fintype.card_fin, fintype.card_embedding_eq, fintype.card_fun],
  norm_num
end

section measure_theory

open measure_theory probability_theory
open_locale probability_theory ennreal

variables {n m : ℕ}

/- In order for Lean to understand that we can take probabilities in `fin 23 → fin 365`, we must
tell Lean that there is a `measurable_space` structure on the space. Note that this instance
is only for `fin m` - Lean automatically figures out that the function space `fin n → fin m`
is _also_ measurable, by using `measurable_space.pi`, and furthermore that all sets are measurable,
from `measurable_singleton_class.pi`. -/
instance : measurable_space (fin m) := ⊤
instance : measurable_singleton_class (fin m) := ⟨λ _, trivial⟩

/- We then endow the space with a canonical measure, which is called ℙ.
We define this to be the conditional counting measure. -/
noncomputable instance : measure_space (fin n → fin m) := ⟨cond_count set.univ⟩

/- The canonical measure on `fin n → fin m` is a probability measure (except on an empty space). -/
instance : is_probability_measure (ℙ : measure (fin n → fin (m + 1))) :=
cond_count_is_probability_measure set.finite_univ set.univ_nonempty

lemma fin_fin.measure_apply {s : set $ fin n → fin m} :
  ℙ s = (|s.to_finite.to_finset|) / ‖fin n → fin m‖ :=
by erw [cond_count_univ, measure.count_apply_finite]

/-- **Birthday Problem**: first probabilistic interpretation. -/
theorem birthday_measure : ℙ {f : fin 23 → fin 365 | function.injective f} < 1 / 2 :=
begin
  -- most of this proof is essentially converting it to the same form as `birthday`.
  rw [fin_fin.measure_apply],
  generalize_proofs hfin,
  have : |hfin.to_finset| = 42200819302092359872395663074908957253749760700776448000000,
  { transitivity ‖fin 23 ↪ fin 365‖,
    { simp_rw [←fintype.card_coe, set.finite.coe_sort_to_finset, set.coe_set_of],
      exact fintype.card_congr (equiv.subtype_injective_equiv_embedding _ _) },
    { simp only [fintype.card_embedding_eq, fintype.card_fin, nat.desc_factorial],
      norm_num } },
  rw [this, ennreal.lt_div_iff_mul_lt, mul_comm, mul_div, ennreal.div_lt_iff],
  rotate, iterate 2 { right, norm_num }, iterate 2 { left, norm_num },
  norm_cast,
  simp only [fintype.card_pi, fintype.card_fin],
  norm_num
end

end measure_theory


-- El punto de acumulación de las convergentes es su límite
-- ========================================================

import data.real.basic

variable  {u : ℕ → ℝ}
variables {a b: ℝ}
variables (x y : ℝ)
variable  {φ : ℕ → ℕ}

-- ----------------------------------------------------
-- Nota. Usaremos los siguientes conceptos estudiados
-- anteriormente.
-- ----------------------------------------------------

notation `|`x`|` := abs x

def limite : (ℕ → ℝ) → ℝ → Prop :=
λ u c, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| ≤ ε

lemma cero_de_abs_mn_todos
  (h : ∀ ε > 0, |x| ≤ ε)
  : x = 0 :=
abs_eq_zero.mp
  (eq_of_le_of_forall_le_of_dense (abs_nonneg x) h)

lemma ig_de_abs_sub_mne_todos
  (h : ∀ ε > 0, |x - y| ≤ ε)
  : x = y :=
sub_eq_zero.mp (cero_de_abs_mn_todos (x - y) h)

lemma unicidad_limite
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  apply ig_de_abs_sub_mne_todos,
  intros ε hε,
  cases ha (ε/2) (by linarith) with Na hNa,
  cases hb (ε/2) (by linarith) with Nb hNb,
  let N := max Na Nb,
  specialize hNa N (by finish),
  specialize hNb N (by finish),
  calc |a - b|
       = |(a - u N) + (u N - b)| : by ring
   ... ≤ |a - u N| + |u N - b|   : by apply abs_add
   ... = |u N - a| + |u N - b|   : by rw abs_sub
   ... ≤ ε                       : by linarith [hNa, hNb]
end

def extraccion : (ℕ → ℕ) → Prop
| φ := ∀ n m, n < m → φ n < φ m

lemma id_mne_extraccion
  (h : extraccion φ)
  : ∀ n, n ≤ φ n :=
begin
  intros n,
  induction n with m HI,
  { linarith },
  { exact nat.succ_le_of_lt (by linarith [h m (m+1) (by linarith)]) },
end

def punto_acumulacion : (ℕ → ℝ) → ℝ → Prop
| u a := ∃ φ, extraccion φ ∧ limite (u ∘ φ) a

lemma limite_subsucesion
  (h : limite u a)
  (hφ : extraccion φ)
  : limite (u ∘ φ) a :=
assume ε,
assume hε : ε > 0,
exists.elim (h ε hε)
 ( assume N,
   assume hN : ∀ n, n ≥ N → |u n - a| ≤ ε,
   have h1 : ∀n, n ≥ N → |(u ∘ φ) n - a| ≤ ε,
     { assume n,
       assume hn : n ≥ N,
       have h2 : N ≤ φ n, from
         calc N ≤ n   : hn
           ... ≤ φ n : id_mne_extraccion hφ n,
       show |(u ∘ φ) n - a| ≤ ε,
         from hN (φ n) h2,
     },
   show ∃ N, ∀n, n ≥ N → |(u ∘ φ) n - a| ≤ ε,
     from exists.intro N h1)

-- ----------------------------------------------------
-- Ejercicio. Demostrar que si a es un punto de
-- acumulación de una sucesión de límite b, entonces a
-- y b son iguales.
-- ----------------------------------------------------

-- 1ª demostración
example
  (ha : punto_acumulacion u a)
  (hb : limite u b)
  : a = b :=
begin
  -- unfold punto_acumulacion at ha,
  rcases ha with ⟨φ, hφ₁, hφ₂⟩,
  have hφ₃ : limite (u ∘ φ) b,
    from limite_subsucesion hb hφ₁,
  exact unicidad_limite hφ₂ hφ₃,
end

-- 2ª demostración
example
  (ha : punto_acumulacion u a)
  (hb : limite u b)
  : a = b :=
begin
  rcases ha with ⟨φ, hφ₁, hφ₂⟩,
  exact unicidad_limite hφ₂ (limite_subsucesion hb hφ₁),
end

-- 3ª demostración
example
  (ha : punto_acumulacion u a)
  (hb : limite u b)
  : a = b :=
exists.elim ha
  (λ φ hφ, unicidad_limite hφ.2 (limite_subsucesion hb hφ.1))

-- 4ª demostración
example
  (ha : punto_acumulacion u a)
  (hb : limite u b)
  : a = b :=
exists.elim ha
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    have hφ' : limite (u ∘ φ) b,
      from limite_subsucesion hb hφ.1,
    show a = b,
      from unicidad_limite hφ.2 hφ')


-- Las partes estrictas de los órdenes parciales son transitivas
-- =============================================================

-- ----------------------------------------------------
-- Ej. 1. La parte estricta de una relación R es la
-- relación R' definida por
--    R' a b := R a b ∧ a ≠ b
--
-- Demostrar que si R es un orden parcial, entonces su
-- parte estricta es transitiva.
-- ----------------------------------------------------

import tactic

section

parameter {A : Type}
parameter (R : A → A → Prop)
parameter (reflR    : reflexive R)
parameter (transR   : transitive R)
parameter (antisimR : anti_symmetric R)
variables {a b c : A}

definition R' (a b : A) : Prop :=
  R a b ∧ a ≠ b

include transR
include antisimR

-- 1ª demostración
example : transitive R' :=
begin
  rintros a b c ⟨h1,h2⟩ ⟨h3,h4⟩,
  split,
  { apply (transR h1 h3), },
  { intro h5,
    apply h4,
    apply (antisimR h3),
    rw ←h5,
    exact h1, },
end

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

local infix ≤ := R
local infix < := R'

example : transitive (<) :=
assume a b c,
assume h₁ : a < b,
assume h₂ : b < c,
have a ≤ b, from and.left h₁,
have a ≠ b, from and.right h₁,
have b ≤ c, from and.left h₂,
have b ≠ c, from and.right h₂,
have a ≤ c, from transR ‹a ≤ b› ‹b ≤ c›,
have a ≠ c, from
    assume : a = c,
    have c ≤ b, from eq.subst ‹a = c› ‹a ≤ b›,
    have b = c, from antisimR ‹b ≤ c› ‹c ≤ b›,
    show false, from ‹b ≠ c› ‹b = c›,
show a < c, from and.intro ‹a ≤ c› ‹a ≠ c›

end


import MyNat.Definition
import MyNat.Addition -- add_zero
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import AdditionWorld.Level2 -- add_assoc
import AdditionWorld.Level3 -- succ_add
import InequalityWorld.Level5 -- le_trans
import InequalityWorld.Level6 -- le_antisymm
import InequalityWorld.Level10 -- le_succ_self
import AdvancedAdditionWorld.Level13 -- ne_succ_self
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 16: equivalence of two definitions of `<`

Now let's go the other way.

## Lemma : lt_aux₂
For all naturals `a` and `b`, `succ a ≤ b  ⟹ a ≤ b ∧ ¬ (b ≤ a)`.
-/
lemma lt_aux₂ (a b : MyNat) : succ a ≤ b → a ≤ b ∧ ¬ (b ≤ a) := by
  intro h
  constructor
  {
    apply le_trans a (succ a) b
    exact le_succ_self a
    exact h
  }
  {
    intro nh
    apply ne_succ_self a
    apply le_antisymm a (succ a)
    exact le_succ_self a
    exact le_trans (succ a) b a h nh
  }

/-!
Now for the payoff.

Next up [Level 17](./Level17.lean.md)
-/


-- Conmutatividad_del_minimo.lean
-- Si a, b ∈ ℝ, entonces min(a,b) = min(b,a)
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 29-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si a, b ∈ ℝ, entonces min(a,b) = min(b,a)
-- ---------------------------------------------------------------------

import data.real.basic

variables a b : ℝ

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

example : min a b = min b a :=
begin
  apply le_antisymm,
  { show min a b ≤ min b a,
    apply le_min,
    { apply min_le_right },
    { apply min_le_left }},
  { show min b a ≤ min a b,
    apply le_min,
    { apply min_le_right },
    { apply min_le_left }},
end

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

example : min a b = min b a :=
begin
  have h : ∀ x y : ℝ, min x y ≤ min y x,
  { intros x y,
    apply le_min,
    { apply min_le_right },
    { apply min_le_left }},
  apply le_antisymm,
  apply h,
  apply h,
end

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

example : min a b = min b a :=
begin
  have h : ∀ {x y : ℝ}, min x y ≤ min y x,
  { intros x y,
    exact le_min (min_le_right x y) (min_le_left x y) },
  exact le_antisymm h h,
end

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

example : min a b = min b a :=
begin
  apply le_antisymm,
  repeat {
    apply le_min,
    apply min_le_right,
    apply min_le_left },
end


import .love12_basic_mathematical_structures_demo

/- # LoVe Exercise 12: Basic Mathematical Structures -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Type Classes

Recall the inductive type `btree` we introduced earlier: -/

#check btree

/- The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

def btree.graft {α : Type} : btree α → btree α → btree α
| btree.empty        u := u
| (btree.node a l r) u := btree.node a (btree.graft l u) (btree.graft r u)

#reduce btree.graft (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

/- 1.1. Prove the following two lemmas by structural induction on `t`. -/

lemma btree.graft_assoc {α : Type} (t u v : btree α) :
  btree.graft (btree.graft t u) v = btree.graft t (btree.graft u v) :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [btree.graft, ih_l, ih_r] }
end

lemma btree.graft_empty {α : Type} (t : btree α) :
  btree.graft t btree.empty = t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [btree.graft, ih_l, ih_r] }
end

/- 1.2. Declare btree an instance of `add_monoid` using `graft` as addition
operator. -/

#print add_monoid

@[instance] def btree.add_monid {α : Type} : add_monoid (btree α) :=
{ add       := btree.graft,
  add_assoc := btree.graft_assoc,
  zero      := btree.empty,
  add_zero  := btree.graft_empty,
  zero_add  := by intro x; refl }

/- 1.3. Explain why `btree` with `graft` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/- No matter how we define `neg` (`-`), we will not be able to prove
`add_left_neg`, which amounts to the following property:

    `∀t, btree.graft (btree.neg t) t = btree.empty`

However, if `t` is a nonempty tree, `btree.graft _ t` cannot possibly be equal
to `btree.empty`, no matter what the first argument is. -/

/- 1.4 (**optional**). Prove the following lemma illustrating why `btree` with
`graft` as addition does not constitute an `add_group`. -/

lemma btree.add_left_neg_counterexample :
  ∃x : btree ℕ, ∀ y : btree ℕ, btree.graft y x ≠ btree.empty :=
begin
  apply exists.intro (btree.node 0 btree.empty btree.empty),
  intros y hy,
  cases' y,
  { cases' hy },
  { cases' hy }
end

/- ## Question 2: Multisets and Finsets

Recall the following definitions from the lecture: -/

#check multiset.elems
#check finset.elems
#check list.elems

/- 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hints:

* Perform structural induction on `t`.

* The `cc` tactic also works with set operations. -/

lemma multiset.elems_mirror (t : btree ℕ) :
  multiset.elems (mirror t) = multiset.elems t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    rw multiset.elems,
    rw mirror,
    rw ←ih_l,
    rw ←ih_r,
    rw multiset.elems,
    cc }
end

/- 2.2. Prove that the finite set of nodes does not change when mirroring a
tree. -/

lemma finset.elems_mirror (t : btree ℕ) :
  finset.elems (mirror t) = finset.elems t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    rw finset.elems,
    rw mirror,
    rw ←ih_l,
    rw ←ih_r,
    rw finset.elems,
    cc }
end

/- 2.3. Show that this does not hold for the list of nodes by providing a
tree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

If you define a suitable counterexample, the proof below will succeed. -/

def rotten_tree : btree ℕ :=
btree.node 0 (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

#eval list.elems rotten_tree
#eval list.elems (mirror rotten_tree)

lemma list.elems_mirror_counterexample :
  ∃t : btree ℕ, list.elems t ≠ list.elems (mirror t) :=
begin
  apply exists.intro rotten_tree,
  exact dec_trivial
end

end LoVe


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import algebra.gcd_monoid.finset
import number_theory.padics.padic_val

/-!
# Basic results about setwise gcds on ℕ

This file proves some basic results about `finset.gcd` on `ℕ`.

## Main results
* `finset.coprime_of_div_gcd`: The elements of a set divided through by their gcd are coprime.

-/

instance : is_idempotent ℕ gcd_monoid.gcd := ⟨nat.gcd_self⟩

namespace finset

theorem coprime_of_div_gcd (s : finset ℕ) {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) :
  s.gcd (/ (s.gcd id)) = 1 :=
begin
  rw nat.eq_one_iff_not_exists_prime_dvd,
  intros p hp hdvd,
  haveI : fact p.prime := ⟨hp⟩,
  rw dvd_gcd_iff at hdvd,
  replace hdvd : ∀ b ∈ s, s.gcd id * p ∣ b,
  { intros b hb,
    specialize hdvd b hb,
    rwa nat.dvd_div_iff at hdvd,
    apply gcd_dvd hb },
  have : s.gcd id ≠ 0 := (not_iff_not.mpr gcd_eq_zero_iff).mpr (λ h, hnz $ h x hx),
  apply @pow_succ_padic_val_nat_not_dvd p _ _ this.bot_lt,
  apply dvd_gcd,
  intros b hb,
  obtain ⟨k, rfl⟩ := hdvd b hb,
  rw [id, mul_right_comm, pow_succ', mul_dvd_mul_iff_right hp.ne_zero],
  apply dvd_mul_of_dvd_left,
  exact pow_padic_val_nat_dvd
end

end finset


import data.set

open set

namespace mth1001

variable A : Type*
variables (S T : set A)

#check powerset
#check mem_set_of_eq
#check mem_union_eq
#check subset_def
#check subset_union_left

/-
Type `𝒫` as `\power`
-/

example : (𝒫 S) ∪ (𝒫 T) ⊆ 𝒫 (S ∪ T) :=
begin
  -- Using the definition of subset, we must show, `∀ x, x ∈ 𝒫 S ∪ 𝒫 T → x ∈ 𝒫 (S ∪ T)`.
--  rw subset_def,
  intro x, -- Assume `x : U`.
  intro h, -- Assume `h : x ∈ 𝒫 S ∪ 𝒫 T`.
  rw mem_union_eq at h, -- By definition, `h : x ∈ 𝒫 S ∨ 𝒫 T`.
  /-
  By or elim., it suffices to prove the goal under the assumptions
  1. `h₂ : x ∈ 𝒫 S`,
  2. `h₃ : x ∈ 𝒫 T`.
  -/
  -- By repeated definion of 𝒫 and ∈, `h : x ⊆ S ∨ x ⊆ T`. The goal is `x ⊆ S ∪ T`.
  repeat { rw [powerset, mem_set_of_eq] at *, },
  cases h with h₂ h₃,
  { have h₄ : S ⊆ S ∪ T, from set.subset_union_left S T,
    transitivity,
    { exact h₂,},
    { exact h₄, }, },
  { transitivity,
    { exact h₃, },
    { exact set.subset_union_right S T, }, },
end

/-
The converse of the above result is *not* true. Here's a proof by counterexample.
-/
example : ¬(∀ A : Type*, ∀ S T : set A, 𝒫 (S ∪ T) ⊆  (𝒫 S) ∪ (𝒫 T)) :=
begin
  push_neg, -- Negating, the goal is `∃ A, ∃ S T : set A, ¬(𝒫 (S ∪ T) ⊆ 𝒫 S ∪ 𝒫 T)`.
  use [ℤ, {1}, {2}], -- We'll take `A` as `ℤ`, `S` as `{1}` and `T` as `{2}`.
  repeat { rw powerset },    -- Apply repeatedly the definitions of powerset
  repeat { rw subset_def },  -- and subset,
  norm_num, -- negating and noting `{1} ∪ {2} = {2, 1}`, the goal is to prove
  -- `∃ (x : set ℤ), x ⊆ {2, 1} ∧ ¬(x ⊆ {1} ∨ x ⊆ {2})`
  use {1, 2}, -- We take `{1, 2}` for `x`.
  split, /- It suffices to prove the two goals:
  1. `{1, 2} ⊆ {2, 1}` and
  2. `({1, 2} ⊆ {1} ∨ {1, 2} ⊆ {2})`
  -/
  { rw subset_def, -- We solve the first subgoal by definition of subset
    finish, },     -- and rules of logic.
  { repeat { rw subset_def }, -- By repeated application of the definition of subset
    push_neg, -- and negating, we must show
    -- `(∃ (x : ℤ), x ∈ {1, 2} ∧ x ∉ {1}) ∧ ∃ (x : ℤ), x ∈ {1, 2} ∧ x ∉ {2}`.
    split, /- By and introduction, this splits into two subgoals:
    2.1. `∃ (x : ℤ), x ∈ {1, 2} ∧ x ∉ {1}`.
    2.2. `∃ (x : ℤ), x ∈ {1, 2} ∧ x ∉ {2}`.
    -/
    { use 2, finish, }, -- We close the goal by showing `2 ∈ {1, 2} ∧ 2 ∉ {1}`.
    { use 1, finish, }, }, -- We close the goal by showing `1 ∈ {1, 2} ∧ 1 ∉ {2}`.
end

-- Exercise 141:
example : (𝒫 S) ∩ (𝒫 T) ⊆ 𝒫 (S ∩ T) :=
begin
  sorry
end

-- Exercise 142:
example : 𝒫 (S ∩ T) ⊆ (𝒫 S) ∩ (𝒫 T) :=
begin
  sorry
end

end mth1001


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel
-/
import analysis.special_functions.pow_deriv
import analysis.special_functions.sqrt

/-!
# Collection of convex functions

In this file we prove that the following functions are convex:

* `strict_convex_on_exp` : The exponential function is strictly convex.
* `even.convex_on_pow`, `even.strict_convex_on_pow` : For an even `n : ℕ`, `λ x, x ^ n` is convex
  and strictly convex when `2 ≤ n`.
* `convex_on_pow`, `strict_convex_on_pow` : For `n : ℕ`, `λ x, x ^ n` is convex on $[0, +∞)$ and
  strictly convex when `2 ≤ n`.
* `convex_on_zpow`, `strict_convex_on_zpow` : For `m : ℤ`, `λ x, x ^ m` is convex on $[0, +∞)$ and
  strictly convex when `m ≠ 0, 1`.
* `convex_on_rpow`, `strict_convex_on_rpow` : For `p : ℝ`, `λ x, x ^ p` is convex on $[0, +∞)$ when
  `1 ≤ p` and strictly convex when `1 < p`.
* `strict_concave_on_log_Ioi`, `strict_concave_on_log_Iio`: `real.log` is strictly concave on
  $(0, +∞)$ and $(-∞, 0)$ respectively.

## TODO

For `p : ℝ`, prove that `λ x, x ^ p` is concave when `0 ≤ p ≤ 1` and strictly concave when
`0 < p < 1`.
-/

open real set
open_locale big_operators nnreal

/-- `exp` is strictly convex on the whole real line. -/
lemma strict_convex_on_exp : strict_convex_on ℝ univ exp :=
strict_convex_on_univ_of_deriv2_pos continuous_exp (λ x, (iter_deriv_exp 2).symm ▸ exp_pos x)

/-- `exp` is convex on the whole real line. -/
lemma convex_on_exp : convex_on ℝ univ exp := strict_convex_on_exp.convex_on

/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/
lemma even.convex_on_pow {n : ℕ} (hn : even n) : convex_on ℝ set.univ (λ x : ℝ, x^n) :=
begin
  apply convex_on_univ_of_deriv2_nonneg (differentiable_pow n),
  { simp only [deriv_pow', differentiable.mul, differentiable_const, differentiable_pow] },
  { intro x,
    obtain ⟨k, hk⟩ := (hn.tsub $ even_bit0 _).exists_two_nsmul _,
    rw [iter_deriv_pow, finset.prod_range_cast_nat_sub, hk, nsmul_eq_mul, pow_mul'],
    exact mul_nonneg (nat.cast_nonneg _) (pow_two_nonneg _) }
end

/-- `x^n`, `n : ℕ` is strictly convex on the whole real line whenever `n ≠ 0` is even. -/
lemma even.strict_convex_on_pow {n : ℕ} (hn : even n) (h : n ≠ 0) :
  strict_convex_on ℝ set.univ (λ x : ℝ, x^n) :=
begin
  apply strict_mono.strict_convex_on_univ_of_deriv (continuous_pow n),
  rw deriv_pow',
  replace h := nat.pos_of_ne_zero h,
  exact strict_mono.const_mul (odd.strict_mono_pow $ nat.even.sub_odd h hn $ nat.odd_iff.2 rfl)
    (nat.cast_pos.2 h),
end

/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/
lemma convex_on_pow (n : ℕ) : convex_on ℝ (Ici 0) (λ x : ℝ, x^n) :=
begin
  apply convex_on_of_deriv2_nonneg (convex_Ici _) (continuous_pow n).continuous_on
    (differentiable_on_pow n),
  { simp only [deriv_pow'], exact (@differentiable_on_pow ℝ _ _ _).const_mul (n : ℝ) },
  { intros x hx,
    rw [iter_deriv_pow, finset.prod_range_cast_nat_sub],
    exact mul_nonneg (nat.cast_nonneg _) (pow_nonneg (interior_subset hx) _) }
end

/-- `x^n`, `n : ℕ` is strictly convex on `[0, +∞)` for all `n` greater than `2`. -/
lemma strict_convex_on_pow {n : ℕ} (hn : 2 ≤ n) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^n) :=
begin
  apply strict_mono_on.strict_convex_on_of_deriv (convex_Ici _) (continuous_on_pow _),
  rw [deriv_pow', interior_Ici],
  exact λ x (hx : 0 < x) y hy hxy, mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_left hxy hx.le $
    nat.sub_pos_of_lt hn) (nat.cast_pos.2 $ zero_lt_two.trans_le hn),
end

/-- Specific case of Jensen's inequality for sums of powers -/
lemma real.pow_sum_div_card_le_sum_pow {α : Type*} {s : finset α} {f : α → ℝ} (n : ℕ)
  (hf : ∀ a ∈ s, 0 ≤ f a) : (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, (f x) ^ (n + 1) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | hs,
  { simp_rw [finset.sum_empty, zero_pow' _ (nat.succ_ne_zero n), zero_div] },
  { have hs0 : 0 < (s.card : ℝ) := nat.cast_pos.2 hs.card_pos,
    suffices : (∑ x in s, f x / s.card) ^ (n + 1) ≤ ∑ x in s, (f x ^ (n + 1) / s.card),
    { rwa [← finset.sum_div, ← finset.sum_div, div_pow, pow_succ' (s.card : ℝ),
        ← div_div, div_le_iff hs0, div_mul, div_self hs0.ne', div_one] at this },
    have := @convex_on.map_sum_le ℝ ℝ ℝ α _ _ _ _ _ _ (set.Ici 0) (λ x, x ^ (n + 1)) s
      (λ _, 1 / s.card) (coe ∘ f) (convex_on_pow (n + 1)) _ _ (λ i hi, set.mem_Ici.2 (hf i hi)),
    { simpa only [inv_mul_eq_div, one_div, algebra.id.smul_eq_mul] using this },
    { simp only [one_div, inv_nonneg, nat.cast_nonneg, implies_true_iff] },
    { simpa only [one_div, finset.sum_const, nsmul_eq_mul] using mul_inv_cancel hs0.ne' } }
end

lemma nnreal.pow_sum_div_card_le_sum_pow {α : Type*} (s : finset α) (f : α → ℝ≥0) (n : ℕ) :
  (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, (f x) ^ (n + 1) :=
by simpa only [← nnreal.coe_le_coe, nnreal.coe_sum, nonneg.coe_div, nnreal.coe_pow] using
  @real.pow_sum_div_card_le_sum_pow α s (coe ∘ f) n (λ _ _, nnreal.coe_nonneg _)

lemma finset.prod_nonneg_of_card_nonpos_even
  {α β : Type*} [linear_ordered_comm_ring β]
  {f : α → β} [decidable_pred (λ x, f x ≤ 0)]
  {s : finset α} (h0 : even (s.filter (λ x, f x ≤ 0)).card) :
  0 ≤ ∏ x in s, f x :=
calc 0 ≤ (∏ x in s, ((if f x ≤ 0 then (-1:β) else 1) * f x)) :
  finset.prod_nonneg (λ x _, by
    { split_ifs with hx hx, by simp [hx], simp at hx ⊢, exact le_of_lt hx })
... = _ : by rw [finset.prod_mul_distrib, finset.prod_ite, finset.prod_const_one,
  mul_one, finset.prod_const, neg_one_pow_eq_pow_mod_two, nat.even_iff.1 h0, pow_zero, one_mul]

lemma int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) :
  0 ≤ ∏ k in finset.range n, (m - k) :=
begin
  rcases hn with ⟨n, rfl⟩,
  induction n with n ihn, { simp },
  rw ← two_mul at ihn,
  rw [← two_mul, nat.succ_eq_add_one, mul_add, mul_one, bit0, ← add_assoc, finset.prod_range_succ,
    finset.prod_range_succ, mul_assoc],
  refine mul_nonneg ihn _, generalize : (1 + 1) * n = k,
  cases le_or_lt m k with hmk hmk,
  { have : m ≤ k + 1, from hmk.trans (lt_add_one ↑k).le,
    convert mul_nonneg_of_nonpos_of_nonpos (sub_nonpos_of_le hmk) _,
    convert sub_nonpos_of_le this },
  { exact mul_nonneg (sub_nonneg_of_le hmk.le) (sub_nonneg_of_le hmk) }
end

lemma int_prod_range_pos {m : ℤ} {n : ℕ} (hn : even n) (hm : m ∉ Ico (0 : ℤ) n) :
  0 < ∏ k in finset.range n, (m - k) :=
begin
  refine (int_prod_range_nonneg m n hn).lt_of_ne (λ h, hm _),
  rw [eq_comm, finset.prod_eq_zero_iff] at h,
  obtain ⟨a, ha, h⟩ := h,
  rw sub_eq_zero.1 h,
  exact ⟨int.coe_zero_le _, int.coe_nat_lt.2 $ finset.mem_range.1 ha⟩,
end

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/
lemma convex_on_zpow (m : ℤ) : convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) :=
begin
  have : ∀ n : ℤ, differentiable_on ℝ (λ x, x ^ n) (Ioi (0 : ℝ)),
    from λ n, differentiable_on_zpow _ _ (or.inl $ lt_irrefl _),
  apply convex_on_of_deriv2_nonneg (convex_Ioi 0);
    try { simp only [interior_Ioi, deriv_zpow'] },
  { exact (this _).continuous_on },
  { exact this _ },
  { exact (this _).const_mul _ },
  { intros x hx,
    rw iter_deriv_zpow,
    refine mul_nonneg _ (zpow_nonneg (le_of_lt hx) _),
    exact_mod_cast int_prod_range_nonneg _ _ (even_bit0 1) }
end

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` except `0` and `1`. -/
lemma strict_convex_on_zpow {m : ℤ} (hm₀ : m ≠ 0) (hm₁ : m ≠ 1) :
  strict_convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) :=
begin
  apply strict_convex_on_of_deriv2_pos' (convex_Ioi 0),
  { exact (continuous_on_zpow₀ m).mono (λ x hx, ne_of_gt hx) },
  intros x hx,
  rw iter_deriv_zpow,
  refine mul_pos _ (zpow_pos_of_pos hx _),
  exact_mod_cast int_prod_range_pos (even_bit0 1) (λ hm, _),
  norm_cast at hm,
  rw ← finset.coe_Ico at hm,
  fin_cases hm; cc,
end

lemma convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on ℝ (Ici 0) (λ x : ℝ, x^p) :=
begin
  have A : deriv (λ (x : ℝ), x ^ p) = λ x, p * x^(p-1), by { ext x, simp [hp] },
  apply convex_on_of_deriv2_nonneg (convex_Ici 0),
  { exact continuous_on_id.rpow_const (λ x _, or.inr (zero_le_one.trans hp)) },
  { exact (differentiable_rpow_const hp).differentiable_on },
  { rw A,
    assume x hx,
    replace hx : x ≠ 0, by { simp at hx, exact ne_of_gt hx },
    simp [differentiable_at.differentiable_within_at, hx] },
  { assume x hx,
    replace hx : 0 < x, by simpa using hx,
    suffices : 0 ≤ p * ((p - 1) * x ^ (p - 1 - 1)), by simpa [ne_of_gt hx, A],
    apply mul_nonneg (le_trans zero_le_one hp),
    exact mul_nonneg (sub_nonneg_of_le hp) (rpow_nonneg_of_nonneg hx.le _) }
end

lemma strict_convex_on_rpow {p : ℝ} (hp : 1 < p) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^p) :=
begin
  have A : deriv (λ (x : ℝ), x ^ p) = λ x, p * x^(p-1), by { ext x, simp [hp.le] },
  apply strict_convex_on_of_deriv2_pos (convex_Ici 0),
  { exact continuous_on_id.rpow_const (λ x _, or.inr (zero_le_one.trans hp.le)) },
  rw interior_Ici,
  rintro x (hx : 0 < x),
  suffices : 0 < p * ((p - 1) * x ^ (p - 1 - 1)), by simpa [ne_of_gt hx, A],
  exact mul_pos (zero_lt_one.trans hp) (mul_pos (sub_pos_of_lt hp) (rpow_pos_of_pos hx _)),
end

lemma strict_concave_on_log_Ioi : strict_concave_on ℝ (Ioi 0) log :=
begin
  have h₁ : Ioi 0 ⊆ ({0} : set ℝ)ᶜ,
  { exact λ x (hx : 0 < x) (hx' : x = 0), hx.ne' hx' },
  refine strict_concave_on_of_deriv2_neg' (convex_Ioi 0)
    (continuous_on_log.mono h₁) (λ x (hx : 0 < x), _),
  rw [function.iterate_succ, function.iterate_one],
  change (deriv (deriv log)) x < 0,
  rw [deriv_log', deriv_inv],
  exact neg_neg_of_pos (inv_pos.2 $ sq_pos_of_ne_zero _ hx.ne'),
end

lemma strict_concave_on_log_Iio : strict_concave_on ℝ (Iio 0) log :=
begin
  have h₁ : Iio 0 ⊆ ({0} : set ℝ)ᶜ,
  { exact λ x (hx : x < 0) (hx' : x = 0), hx.ne hx' },
  refine strict_concave_on_of_deriv2_neg' (convex_Iio 0)
    (continuous_on_log.mono h₁) (λ x (hx : x < 0), _),
  rw [function.iterate_succ, function.iterate_one],
  change (deriv (deriv log)) x < 0,
  rw [deriv_log', deriv_inv],
  exact neg_neg_of_pos (inv_pos.2 $ sq_pos_of_ne_zero _ hx.ne),
end

section sqrt_mul_log

lemma has_deriv_at_sqrt_mul_log {x : ℝ} (hx : x ≠ 0) :
  has_deriv_at (λ x, sqrt x * log x) ((2 + log x) / (2 * sqrt x)) x :=
begin
  convert (has_deriv_at_sqrt hx).mul (has_deriv_at_log hx),
  rw [add_div, div_mul_right (sqrt x) two_ne_zero, ←div_eq_mul_inv, sqrt_div_self',
      add_comm, div_eq_mul_one_div, mul_comm],
end

lemma deriv_sqrt_mul_log (x : ℝ) : deriv (λ x, sqrt x * log x) x = (2 + log x) / (2 * sqrt x) :=
begin
  cases lt_or_le 0 x with hx hx,
  { exact (has_deriv_at_sqrt_mul_log hx.ne').deriv },
  { rw [sqrt_eq_zero_of_nonpos hx, mul_zero, div_zero],
    refine has_deriv_within_at.deriv_eq_zero _ (unique_diff_on_Iic 0 x hx),
    refine (has_deriv_within_at_const x _ 0).congr_of_mem (λ x hx, _) hx,
    rw [sqrt_eq_zero_of_nonpos hx, zero_mul] },
end

lemma deriv_sqrt_mul_log' : deriv (λ x, sqrt x * log x) = λ x, (2 + log x) / (2 * sqrt x) :=
funext deriv_sqrt_mul_log

lemma deriv2_sqrt_mul_log (x : ℝ) :
  deriv^[2] (λ x, sqrt x * log x) x = -log x / (4 * sqrt x ^ 3) :=
begin
  simp only [nat.iterate, deriv_sqrt_mul_log'],
  cases le_or_lt x 0 with hx hx,
  { rw [sqrt_eq_zero_of_nonpos hx, zero_pow zero_lt_three, mul_zero, div_zero],
    refine has_deriv_within_at.deriv_eq_zero _ (unique_diff_on_Iic 0 x hx),
    refine (has_deriv_within_at_const _ _ 0).congr_of_mem (λ x hx, _) hx,
    rw [sqrt_eq_zero_of_nonpos hx, mul_zero, div_zero] },
  { have h₀ : sqrt x ≠ 0, from sqrt_ne_zero'.2 hx,
    convert (((has_deriv_at_log hx.ne').const_add 2).div
      ((has_deriv_at_sqrt hx.ne').const_mul 2) $ mul_ne_zero two_ne_zero h₀).deriv using 1,
    nth_rewrite 2 [← mul_self_sqrt hx.le],
    field_simp, ring },
end

lemma strict_concave_on_sqrt_mul_log_Ioi : strict_concave_on ℝ (set.Ioi 1) (λ x, sqrt x * log x) :=
begin
  apply strict_concave_on_of_deriv2_neg' (convex_Ioi 1) _ (λ x hx, _),
  { exact continuous_sqrt.continuous_on.mul
      (continuous_on_log.mono (λ x hx, ne_of_gt (zero_lt_one.trans hx))) },
  { rw [deriv2_sqrt_mul_log x],
    exact div_neg_of_neg_of_pos (neg_neg_of_pos (log_pos hx))
      (mul_pos four_pos (pow_pos (sqrt_pos.mpr (zero_lt_one.trans hx)) 3)) },
end

end sqrt_mul_log

open_locale real

lemma strict_concave_on_sin_Icc : strict_concave_on ℝ (Icc 0 π) sin :=
begin
  apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_sin (λ x hx, _),
  rw interior_Icc at hx,
  simp [sin_pos_of_mem_Ioo hx],
end

lemma strict_concave_on_cos_Icc : strict_concave_on ℝ (Icc (-(π/2)) (π/2)) cos :=
begin
  apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_cos (λ x hx, _),
  rw interior_Icc at hx,
  simp [cos_pos_of_mem_Ioo hx],
end


/-
Copyright (c) 2023 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import analysis.quaternion
import analysis.normed_space.exponential
import analysis.inner_product_space.pi_L2
import analysis.special_functions.trigonometric.series

/-!
# Lemmas about `exp` on `quaternion`s

This file contains results about `exp` on `quaternion ℝ`.

## Main results

* `quaternion.exp_eq`: the general expansion of the quaternion exponential in terms of `real.cos`
  and `real.sin`.
* `quaternion.exp_of_re_eq_zero`: the special case when the quaternion has a zero real part.
* `quaternion.norm_exp`: the norm of the quaternion exponential is the norm of the exponential of
  the real part.

-/

open_locale quaternion nat

namespace quaternion

lemma conj_exp (q : ℍ[ℝ]) : conj (exp ℝ q) = exp ℝ (conj q) := star_exp q

@[simp, norm_cast] lemma exp_coe (r : ℝ) : exp ℝ (r : ℍ[ℝ]) = ↑(exp ℝ r) :=
(map_exp ℝ (algebra_map ℝ ℍ[ℝ]) (continuous_algebra_map _ _) _).symm

/-- Auxiliary result; if the power series corresponding to `real.cos` and `real.sin` evaluated
at `‖q‖` tend to `c` and `s`, then the exponential series tends to `c + (s / ‖q‖)`. -/
lemma has_sum_exp_series_of_imaginary
  {q : quaternion ℝ} (hq : q.re = 0) {c s : ℝ}
  (hc : has_sum (λ n, (-1)^n * ‖q‖^(2 * n) / (2 * n)!) c)
  (hs : has_sum (λ n, (-1)^n * ‖q‖^(2 * n + 1) / (2 * n + 1)!) s) :
  has_sum (λ n, exp_series ℝ _ n (λ _, q)) (↑c + (s / ‖q‖) • q) :=
begin
  replace hc := has_sum_coe.mpr hc,
  replace hs := (hs.div_const ‖q‖).smul_const q,
  obtain rfl | hq0 := eq_or_ne q 0,
  { simp_rw [exp_series_apply_zero, norm_zero, div_zero, zero_smul, add_zero],
    simp_rw [norm_zero] at hc,
    convert hc,
    ext (_ | n) : 1,
    { rw [pow_zero, mul_zero, pow_zero, nat.factorial_zero, nat.cast_one, div_one, one_mul,
        pi.single_eq_same, coe_one], },
    { rw [zero_pow (mul_pos two_pos (nat.succ_pos _)), mul_zero, zero_div,
        pi.single_eq_of_ne (n.succ_ne_zero), coe_zero], } },
  simp_rw exp_series_apply_eq,
  have hq2 : q^2 = -norm_sq q := sq_eq_neg_norm_sq.mpr hq,
  have hqn := norm_ne_zero_iff.mpr hq0,
  refine has_sum.even_add_odd _ _,
  { convert hc using 1,
    ext n : 1,
    let k : ℝ := ↑(2 * n)!,
    calc k⁻¹ • q ^ (2 * n)
        = k⁻¹ • ((-norm_sq q) ^ n) : by rw [pow_mul, hq2]
    ... = k⁻¹ • ↑((-1) ^ n * ‖q‖ ^ (2 * n)) : _
    ... = ↑((-1) ^ n * ‖q‖ ^ (2 * n) / k) : _,
    { congr' 1,
      rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq],
      push_cast },
    { rw [←coe_mul_eq_smul, div_eq_mul_inv],
      norm_cast,
      ring_nf } },
  { convert hs using 1,
    ext n : 1,
    let k : ℝ := ↑(2 * n + 1)!,
    calc k⁻¹ • q ^ (2 * n + 1)
        = k⁻¹ • ((-norm_sq q) ^ n * q) : by rw [pow_succ', pow_mul, hq2]
    ... = k⁻¹ • ((-1) ^ n * ‖q‖ ^ (2 * n)) • q : _
    ... = ((-1) ^ n * ‖q‖ ^ (2 * n + 1) / k / ‖q‖) • q : _,
    { congr' 1,
      rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq, ←coe_mul_eq_smul],
      push_cast },
    { rw smul_smul,
      congr' 1,
      simp_rw [pow_succ', mul_div_assoc, div_div_cancel_left' hqn],
      ring } },
end

/-- The closed form for the quaternion exponential on imaginary quaternions. -/
lemma exp_of_re_eq_zero (q : quaternion ℝ) (hq : q.re = 0) :
  exp ℝ q = ↑(real.cos ‖q‖) + (real.sin ‖q‖ / ‖q‖) • q :=
begin
  rw [exp_eq_tsum],
  refine has_sum.tsum_eq _,
  simp_rw ← exp_series_apply_eq,
  exact has_sum_exp_series_of_imaginary hq (real.has_sum_cos _) (real.has_sum_sin _),
end

/-- The closed form for the quaternion exponential on arbitrary quaternions. -/
lemma exp_eq (q : quaternion ℝ) :
  exp ℝ q = exp ℝ q.re • (↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im) :=
begin
  rw [←exp_of_re_eq_zero q.im q.im_re, ←coe_mul_eq_smul, ←exp_coe, ←exp_add_of_commute, re_add_im],
  exact algebra.commutes q.re (_ : ℍ[ℝ]),
end

lemma re_exp (q : ℍ[ℝ]) : (exp ℝ q).re = exp ℝ q.re * (real.cos ‖q - q.re‖) :=
by simp [exp_eq]

lemma im_exp (q : ℍ[ℝ]) : (exp ℝ q).im = (exp ℝ q.re * (real.sin ‖q.im‖ / ‖q.im‖)) • q.im :=
by simp [exp_eq, smul_smul]

lemma norm_sq_exp (q : ℍ[ℝ]) : norm_sq (exp ℝ q) = (exp ℝ q.re)^2 :=
calc norm_sq (exp ℝ q)
    = norm_sq (exp ℝ q.re • (↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im))
    : by rw exp_eq
... = (exp ℝ q.re)^2 * norm_sq ((↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im))
    : by rw [norm_sq_smul]
... = (exp ℝ q.re)^2 * ((real.cos ‖q.im‖) ^ 2 + (real.sin ‖q.im‖)^2)
    : begin
      congr' 1,
      obtain hv | hv := eq_or_ne (‖q.im‖) 0,
      { simp [hv] },
      rw [norm_sq_add, norm_sq_smul, conj_smul, coe_mul_eq_smul, smul_re, smul_re, conj_re, im_re,
        smul_zero, smul_zero, mul_zero, add_zero, div_pow, norm_sq_coe, norm_sq_eq_norm_sq, ←sq,
        div_mul_cancel _ (pow_ne_zero _ hv)],
    end
... = (exp ℝ q.re)^2 : by rw [real.cos_sq_add_sin_sq, mul_one]

/-- Note that this implies that exponentials of pure imaginary quaternions are unit quaternions
since in that case the RHS is `1` via `exp_zero` and `norm_one`. -/
@[simp] lemma norm_exp (q : ℍ[ℝ]) : ‖exp ℝ q‖ = ‖exp ℝ q.re‖ :=
by rw [norm_eq_sqrt_real_inner (exp ℝ q), inner_self, norm_sq_exp, real.sqrt_sq_eq_abs,
  real.norm_eq_abs]

end quaternion


import linear_algebra.projection
import linear_algebra.dual

universes u v w

variables {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M]

/-- The first isomorphism theorem for surjective linear maps. -/
noncomputable def linear_map.quot_ker_equiv_of_surjective
  {R : Type u} {M : Type v} {M₂ : Type w} [comm_ring R]
  [add_comm_group M] [add_comm_group M₂] [module R M] [module R M₂]
  (f : M →ₗ[R] M₂) (hf : function.surjective f) : f.ker.quotient ≃ₗ[R] M₂ :=
f.quot_ker_equiv_range.trans
  (linear_equiv.of_top f.range (linear_map.range_eq_top.2 hf))

namespace submodule

variable {W : submodule R M}

/-- The `dual_annihilator` of a submodule `W` is the set of linear maps `φ` such
  that `φ w = 0` for all `w ∈ W`. -/
def dual_annihilator {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M]
  [module R M] (W : submodule R M) : submodule R $ module.dual R M :=
{ carrier := { φ | ∀ w ∈ W, φ w = 0 },
  zero_mem' := by simp,
  add_mem' :=  by { intros φ ψ hφ hψ w hw,
    rw [linear_map.add_apply, hφ w hw, hψ w hw, add_zero] },
  smul_mem' := by { intros c φ hφ w hw,
    rw [linear_map.smul_apply, hφ w hw, smul_zero] } }

@[simp] lemma mem_dual_annihilator (φ : module.dual R M) :
  φ ∈ W.dual_annihilator ↔ ∀ w ∈ W, φ w = 0 := iff.rfl

/-- The `dual_restrict` of a submodule `W` of `M` is the linear map from the
  dual of `M` to the dual of `W` such that the domain of each linear map is
  restricted to `W`. -/
def dual_restrict (W : submodule R M) :
  module.dual R M →ₗ[R] module.dual R W :=
{ to_fun := λ φ, φ.dom_restrict W,
  map_add' := by simp [linear_map.ext_iff],
  map_smul' := by simp [linear_map.ext_iff] }.

@[simp] lemma dual_restrict_apply
  (W : submodule R M) (φ : module.dual R M) (x : W) :
  W.dual_restrict φ x = φ x.1 := rfl

lemma dual_restrict_ker_eq_dual_anihilator
  (W : submodule R M) : W.dual_restrict.ker = W.dual_annihilator :=
begin
  ext φ, split; intro hφ,
  { intros w hw,
    rw linear_map.mem_ker at hφ,
    rw [← W.dual_restrict_apply φ ⟨w, hw⟩, hφ], refl },
  { ext, exact hφ x.1 x.2 }
end

end submodule

namespace subspace

open submodule linear_map

variables {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]

-- We work in vector spaces because `exists_is_compl` only hold for vector spaces
/-- Given a subspace `W` of `V` and an element of its dual `φ`, `dual_lift W φ` is
  the natural extenstion of `φ` to an element of the dual of `V`. -/
noncomputable def dual_lift
  (W : subspace K V) (φ : module.dual K W) : module.dual K V :=
let h := classical.indefinite_description _ W.exists_is_compl in of_is_compl h.2 φ 0

variable {W : subspace K V}

@[simp] lemma dual_lift_of_subtype {φ : module.dual K W} (w : W) :
  W.dual_lift φ (w : V) = φ w :=
by erw of_is_compl_left_apply _ w

lemma dual_lift_of_mem {φ : module.dual K W} {w : V} (hw : w ∈ W) :
  W.dual_lift φ w = φ ⟨w, hw⟩ :=
dual_lift_of_subtype ⟨w, hw⟩

@[simp] lemma dual_lift_zero : W.dual_lift 0 = 0 := by simp [dual_lift]

@[simp] lemma dual_lift_add (φ ψ : module.dual K W) :
  W.dual_lift (φ + ψ) = W.dual_lift φ + W.dual_lift ψ :=
begin
  -- `change` is significantly slower than `show`
  show of_is_compl _ _ 0 = of_is_compl _ φ 0 + of_is_compl _ ψ 0,
  rw [← zero_add (0 : _ →ₗ[K] _), of_is_compl_add], simp
end

@[simp] lemma dual_lift_smul (c : K) (φ : module.dual K W) :
  W.dual_lift (c • φ) = c • W.dual_lift φ :=
begin
  show of_is_compl _ _ 0 = c • of_is_compl _ _ 0,
  rw [← smul_zero c, of_is_compl_smul], simp
end

lemma dual_restrict_surjective :
  function.surjective W.dual_restrict :=
begin
  intros φ, refine ⟨W.dual_lift φ, _⟩, ext,
  erw [dual_restrict_apply, dual_lift, of_is_compl_left_apply],
end

lemma dual_lift_injective : function.injective W.dual_lift :=
begin
  rintro _ _ h,
  ext, rw [← dual_lift_of_subtype, h, dual_lift_of_subtype],
end

-- V* / U∘ ≅ U*

/-- The quotient by the `dual_annihilator` of a subspace is isomorphic to the
  dual of that subspace. -/
noncomputable def quot_annihilator_equiv (W : subspace K V) :
  W.dual_annihilator.quotient ≃ₗ[K] module.dual K W :=
(quot_equiv_of_eq _ _ W.dual_restrict_ker_eq_dual_anihilator).symm.trans $
  W.dual_restrict.quot_ker_equiv_of_surjective dual_restrict_surjective

/-- The representation of the dual of a subspace `W` of `V` as a subspace of
  the dual of `V`. -/
def dual (W : subspace K V) : subspace K (module.dual K V) :=
{ carrier := { φ | ∃ ψ : module.dual K W, φ = W.dual_lift ψ },
  zero_mem' := ⟨0, dual_lift_zero.symm⟩,
  add_mem' :=
    by { rintro _ _ ⟨ψ₁, rfl⟩ ⟨ψ₂, rfl⟩,
         exact ⟨ψ₁ + ψ₂, (dual_lift_add ψ₁ ψ₂).symm⟩ },
  smul_mem' :=
    by { rintro c _ ⟨ψ, rfl⟩,
         exact ⟨c • ψ, (dual_lift_smul c ψ).symm⟩ } }

@[simp] lemma mem_dual_iff (φ : module.dual K V) : φ ∈ W.dual ↔
  ∃ ψ : module.dual K W, φ = W.dual_lift ψ := iff.rfl

/-- The natural linear map from the dual of a subspace `W` to `W.dual`. -/
noncomputable def dual_to_subspace_dual (W : subspace K V) :
  module.dual K W →ₗ[K] W.dual :=
{ to_fun := λ φ, ⟨W.dual_lift φ, ⟨φ, rfl⟩⟩,
  map_add' := by { intros _ _, simp_rw [dual_lift_add], refl },
  map_smul' := by { intros _ _, simp_rw [dual_lift_smul], refl } }

@[simp] lemma dual_to_subspace_dual_apply (φ : module.dual K W) :
  W.dual_to_subspace_dual φ = ⟨W.dual_lift φ, ⟨φ, rfl⟩⟩ := rfl

lemma dual_to_subspace_ker_eq_bot :
  W.dual_to_subspace_dual.ker = ⊥ :=
linear_map.ker_eq_bot.2 $ λ φ ψ h, dual_lift_injective (subtype.mk_eq_mk.1 h)

lemma dual_to_subspace_range_eq_top :
  W.dual_to_subspace_dual.range = ⊤ :=
linear_map.range_eq_top.2 $ λ ⟨φ, hφ⟩, let ⟨ψ, hψ⟩ := hφ in
  ⟨ψ, by rw [dual_to_subspace_dual_apply, subtype.mk_eq_mk, hψ]⟩

/-- The natural isomorphism forom the dual of a subspace `W` to `W.dual`. -/
noncomputable def dual_equiv_dual (W : subspace K V) :
  module.dual K W ≃ₗ[K] W.dual :=
linear_equiv.of_bijective W.dual_to_subspace_dual
  dual_to_subspace_ker_eq_bot dual_to_subspace_range_eq_top

/- Next step
  V* / U∘ ≅ U*
  → V* / U* ≅ U∘
  → V / U ≅ U∘ ≅ U⊥
-/

section

open_locale classical

open finite_dimensional

variables {V₁ : Type*} [add_comm_group V₁] [vector_space K V₁]
variables [finite_dimensional K V] [finite_dimensional K V₁]

/-- Given isomorphic subspaces `p q` of vector spaces `V` and `V₁` respectively,
  `p.quotient` is isomorphic to `q.quotient`. -/
noncomputable def linear_equiv.quot_equiv_of_equiv
  {p : subspace K V} {q : subspace K V₁}
  (f₁ : p ≃ₗ[K] q) (f₂ : V ≃ₗ[K] V₁) : p.quotient ≃ₗ[K] q.quotient :=
linear_equiv.of_findim_eq _ _
begin
  rw [← @add_right_cancel_iff _ _ (findim K p), findim_quotient_add_findim,
    linear_equiv.findim_eq f₁, findim_quotient_add_findim, linear_equiv.findim_eq f₂],
end

/-- Given the subspaces `p q`, if `p.quotient ≃ₗ[K] q`, then `q.quotient ≃ₗ[K] p` -/
noncomputable def linear_equiv.quot_equiv_of_quot_equiv
  {p q : subspace K V} (f : p.quotient ≃ₗ[K] q) : q.quotient ≃ₗ[K] p :=
linear_equiv.of_findim_eq _ _
begin
  rw [← @add_right_cancel_iff _ _ (findim K q), findim_quotient_add_findim,
    ← linear_equiv.findim_eq f, add_comm, findim_quotient_add_findim]
end

-- dependency
instance [H : finite_dimensional K V] : finite_dimensional K (module.dual K V) :=
begin
  refine @linear_equiv.finite_dimensional _ _ _ _ _ _ _ _ _ H,
  have hB := classical.some_spec (exists_is_basis_finite K V),
  haveI := classical.choice hB.2,
  exact is_basis.to_dual_equiv _ hB.1
end

/-- The quotient by the dual is isomorphic to its dual annihilator.  -/
noncomputable def quot_dual_equiv_annihilator (W : subspace K V) :
  W.dual.quotient ≃ₗ[K] W.dual_annihilator :=
linear_equiv.quot_equiv_of_quot_equiv $
  linear_equiv.trans W.quot_annihilator_equiv W.dual_equiv_dual

/-- The quotient by a subspace is isomorphic to its dual annihilator. -/
noncomputable def quot_equiv_annihilator (W : subspace K V) :
  W.quotient ≃ₗ[K] W.dual_annihilator :=
begin
  refine linear_equiv.trans _ W.quot_dual_equiv_annihilator,
  refine linear_equiv.quot_equiv_of_equiv _ _,
  { refine linear_equiv.trans _ W.dual_equiv_dual,
    have hB := classical.some_spec (exists_is_basis_finite K W),
    haveI := classical.choice hB.2,
    exact is_basis.to_dual_equiv _ hB.1 },
  { have hB := classical.some_spec (exists_is_basis_finite K V),
    haveI := classical.choice hB.2,
    exact is_basis.to_dual_equiv _ hB.1 },
end

end

end subspace


import data.real.basic

namespace xena -- hide

open function
open real

open_locale classical

/-
Classic eps-delta definition of continuity is equivalent to
the definition using sequences.
-/

notation `|` x `|` := abs x
def is_limit (a : ℕ → ℝ) (l : ℝ) :=
    ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - l| < ε

def continuous_at_x (f : ℝ → ℝ) (x : ℝ) :=
    ∀ ε : ℝ, 0 < ε → ∃ δ : ℝ, 0 < δ ∧ ∀ y : ℝ, |y - x| < δ → |f y - f x| < ε
def seq_continuous_at_x (f : ℝ → ℝ) (x : ℝ) :=
    ∀ (a : ℕ → ℝ), is_limit a x → is_limit ( λ n : ℕ, f (a n) ) (f x)

/- Lemma
The two definitions of continuity are equivalent.
-/
lemma cont_iff_seq_cont (f : ℝ → ℝ) :
    ∀ x : ℝ, continuous_at_x f x ↔ seq_continuous_at_x f x :=
begin
    intro x,
    split,
    { -- classical continuity def -> sequence def
        intros H a hax e he,
        have h1 := H e he,
        cases h1 with d hdd,
        cases hdd with hd hy,
        have h2 := hax d hd,
        cases h2 with N hN,
        use N,
        intros n hn,
        have hnd := hN n hn,
        have G := hy (a n) hnd, exact G,
    },
    { -- sequence def -> classical def is a little trickier
      -- contrapositive
      contrapose!,
      intro H, unfold continuous_at_x at H,
      push_neg at H,
      cases H with e hee,
      cases hee with he hdd,
      unfold seq_continuous_at_x, push_neg,
      -- using these hypotheses, choose a sequence
      have k : ∀ n : ℕ, ∃ y : ℝ, |y - x| < (1:ℝ)/(n+1) ∧ e ≤ | f y - f x|,
        intro n,
        have g1 := hdd ( (1:ℝ)/(n+1) ),
        cases g1 with g11 g12,
        exfalso,
        {  -- this seems complicated, but other ways got into coercion problems
            have f1 : ∀ m : ℕ, 0 < m+1,
                intro m, exact nat.succ_pos m,
            have f2 : ∀ m : ℕ, 0 < ( (m+1): ℝ),
                intro m,
                have f21 := f1 m,
                norm_cast, linarith,
            have f3 : ∀ m : ℕ, 0 < 1 / ( (m+1): ℝ),
                intro m,
                have f31 := one_div_pos_of_pos (f2 m),
                exact f31,
            have f4 := f3 n,
            linarith,
        },
        exact g12,
      choose a ha using k,
      use a,
      -- prove this sequence does converge to x
      split,
      {
        intros ε hε,
        set N := nat_ceil ( (1:ℝ)/ ε ) with hN,
        use N,
        intros n hn,
        have H := ha n,
        cases H with h1 h2,
        have hN1 := le_nat_ceil ( (1:ℝ)/ε), rw ← hN at hN1,
        have hN2 : ((1:ℝ) / ↑N) ≤ ε,
            exact one_div_le_of_one_div_le_of_pos hε hN1,
        have hN3 : ((1:ℝ)/(↑n+1)) < ((1:ℝ) / ↑N),
            have hN31 : (n + 1) > N, linarith,
            have hN32 : 0 < (n+1), linarith,
            have hN33 : 0 < N,
                have hN34 : 0 < ( (1:ℝ)/ε ), exact one_div_pos_of_pos hε,
                have hN35 := lt_of_lt_of_le hN34 hN1,
                norm_cast at hN35, exact hN35,
            apply one_div_lt_one_div_of_lt,
            norm_cast, linarith, norm_cast, linarith,
        have hN4 : ((1:ℝ)/(↑n+1)) < ε, linarith,
        linarith,
      },

      { -- but f(a n) does not converge to f(x)
        unfold is_limit, push_neg,
        use e, split, exact he,
        intro N, use N, split, linarith,
        have G := ha N, cases G with G1 G2, exact G2,
      },
      done
    },
    done
end

end xena -- hide


-- Let's first prove some simple example lemmas with the logical connectives we learned in the lecture.
section
-- Variables in sections determine the type of certain variables for the remainder of the section, saving us a bit of space.
variable (p q r : Prop)

example : p → p := fun hp => hp

example : p → (q → p) := fun hp => fun _ => hp

-- Note: `→` associates to the right, so the above proposition is equivalent to
-- `p → q → p`

example : (p → False) → (p → q) := fun hnp => fun hp => nomatch hnp hp

example : (p ∨ p) → p := fun h =>
  match h with
  | Or.inr hp => hp
  | Or.inl hp => hp

example : (p → q → r) → (p ∧ q → r) := fun h => fun hpq => h hpq.1 hpq.2

example : (p ∧ q → r) → (p → q → r) := fun h => fun hp => fun hq => h ⟨hp,hq⟩

example : p → (p → q) → p ∧ q := fun hp => fun hpq => ⟨hp, hpq hp⟩

theorem imp_and : (p → q ∧ r) → (p → q) ∧ (p → r) := fun h =>
  And.intro (fun hp => (h hp).1) (fun hp => (h hp).2)

-- Matching on `And.intro` can quickly become tedious, so you can use the following helper functions from now on:
#check And.left
#check And.right

/- BIIMPLICATION -/

-- Biimplication ("if and only if") is written \iff.
-- It is defined as a data type on the constructor
-- Iff.intro : (A → B) → (B → A) → (A ↔ B)
-- Can you recover the proof for A → B by a match expression?

example (hpq : p ↔ q) : (p → q) := fun hp =>
  match hpq with
  | ⟨hpq',_⟩ => hpq' hp

-- Like for `And`, we have names for both directions of the biimplication:
#check Iff.mp
#check Iff.mpr

-- Prove the following biimplications using the threorem from above!
-- Note: `↔` is defined to bind less tightly than other connectives such as `∧` or `∨`.

theorem iff_and : (p → q ∧ r) ↔ (p → q) ∧ (p → r) :=
  Iff.intro
  (fun h => ⟨fun hp => (h hp).1, fun hp => (h hp).2⟩)
  (fun h hp => ⟨h.left hp, h.right hp⟩)

theorem or_and : (p ∨ q → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
  (fun h => ⟨fun hp => h (Or.inl hp), fun hq => h (Or.inr hq)⟩)
  (fun h hpq =>
    match hpq with
    | Or.inl hp => h.left hp
    | Or.inr hq => h.right hq
  )

theorem iff_and_false : False ↔ p ∧ False :=
  Iff.intro
  (fun h => ⟨nomatch h, h⟩)
  (fun h => h.2)

/- NEGATION -/

-- Negation is defined by ¬ A := (A → False).
-- How is that a good choice? Let us check some basic properties of negation:

example : ¬False := fun h => h

theorem imp_not_not : p → ¬¬p := fun hp hnp => hnp hp

example : ¬(p ∧ ¬p) := fun hpnp => hpnp.2 hpnp.1

theorem not_or_not : (¬p ∨ ¬q) → ¬(p ∧ q) := fun h h1 =>
  match h with
  | Or.inl hnp => hnp h1.1
  | Or.inr hnq => hnq h1.2

-- The following ones are a harder to prove. Don't hesitate to skip them or ask your
-- tutors if you get stuck

example : ¬(p ↔ ¬p) := fun h =>
    -- (fun hp => h.1 hp) this is an implication
    have hp : p := h.2 (fun hp => h.1 hp hp)
    h.1 hp hp

-- example : ¬¬(¬¬p → p) := fun h => nomatch h (fun h1 => _)
example : ¬¬(¬¬p → p) :=
  fun hnnnpp => hnnnpp fun hnnp => False.elim (hnnp (fun hp => hnnnpp fun _ => hp))

/- CLASSICAL AXIOMS -/

-- Some tautologies about negation cannot be proven by just assuming the logical
-- connectives as algebraic propositions. Instead, we need to assume these facts
-- as axioms. To have access to these, we need to open a namespace called "Classical".
-- We will learn more about constructive versus classical logic in week 5.
open Classical

-- The following statement is called the _law of excluded middle_.
-- It is assumed as an axiom, which means that it doesn't have to be proved.

#check em p

-- Now use the law of excluded middle to show that the theorem not_or_not is reversible:

theorem not_and : ¬(p ∧ q) → (¬ p ∨ ¬ q) := fun h =>
  match (em p) with
  | Or.inr hnp => Or.inl hnp
  | Or.inl hp =>
    match (em q) with
    | Or.inr hnq => Or.inr hnq
    | Or.inl hq => Or.inr (nomatch h ⟨hp,hq⟩)

-- Also, we can now deal better with double negations:

example : ¬¬p ↔ p :=
  match (em p) with
  | Or.inr hnp => ⟨fun hnnp => nomatch hnnp hnp, fun hp hnp => hnp hp⟩
  | Or.inl hp => ⟨fun _ => hp, fun _ hnp => hnp hp⟩

end


import tactic

namespace binomial

def binomial : ℕ → ℕ → ℕ
  | _ 0 := 1
  | 0 _ := 0
  | (n+1) (k+1) := binomial n (k+1) + binomial n k

@[simp] lemma choose_zero_is_one (n : ℕ) : binomial n 0 = 1 := by {
  induction n with d hd,
  {
    refl,
  },
  {
    refl,
  }
}

@[simp] lemma zero_choose_succ_is_zero (n : ℕ) : binomial 0 (n+1) = 0 := by {cases n, refl, refl,}

@[simp] lemma pascal_identity (n : ℕ) (k : ℕ) : binomial (n+1) (k+1) = binomial n (k+1) + binomial n k := by refl

@[simp] lemma choose_one_is_self (n : ℕ) : binomial n 1 = n :=
begin
  induction n with d hd,
  refl,
  rw binomial,
  rw hd,
  simp,
end

@[simp] lemma n_choose_gt_n_is_zero (n : ℕ) : ∀ (k : ℕ), n < k → binomial n k = 0 := by {
  induction n with d hd,
  {
    intro k,
    intro hkpos,
    cases k,
    {
      have f : false := nat.lt_asymm hkpos hkpos,
      exact false.rec (binomial 0 0 = 0) f,
    },
    refl,
  },
  {
    intro k,
    cases k,
    {
      intro h,
      have f : false := nat.not_lt_zero d.succ h,
      exact false.rec (binomial (nat.succ d) 0 = 0) f,
    },
    {
      rw binomial,
      intro hdsks,
      have hdk : d < k := nat.succ_lt_succ_iff.mp hdsks,
      have hdks : d < k.succ := nat.lt.step hdk,
      rw hd k hdk,
      rw hd _ hdks,
    }
  }
}

@[simp] lemma choose_self_is_one (n : ℕ) : binomial n n = 1 :=
begin
  induction n with d hd,
  refl,
  rw binomial,
  rw hd,
  simp,
end

@[simp] lemma choose_succ_equals_succ (n : ℕ) : binomial n.succ n = n.succ := by {
  induction n with d hd,
  simp,
  rw binomial,
  rw hd,
  simp,
  exact (nat.succ d).one_add,
}

@[simp] lemma choose_lt_zero_is_zero (n : ℕ) : ∀ (k : ℕ), k < 0 → binomial n k = 0 := by {
  induction n with d hd,
  {
    intro k,
    intro hkltzero,
    cases k,
    {
      have f : false := nat.lt_asymm hkltzero hkltzero,
      exact false.rec (binomial 0 0 = 0) f,
    },
    refl,
  },
  {
    intro k,
    intro hkltzero,
    cases k,
    {
      have f : false := nat.lt_asymm hkltzero hkltzero,
      exact false.rec (binomial (nat.succ d) 0 = 0) f,
    },
    {
      rw binomial,
      have hk_ltzero : k < 0 := nat.lt_of_succ_lt hkltzero,
      rw hd _ hk_ltzero,
      rw hd _ hkltzero,
    }
  }
}

lemma choose_pos (n : ℕ) : ∀ {k : ℕ}, k ≤ n → 0 < binomial n k := by {
  induction n with d hd,
  {
    intro k,
    intro kzero,
    cases k,
    {
      simp,
    },
    {
      simp,
      exact nat.not_succ_le_zero k kzero,
    },
  },
  {
    intro k,
    intro hkltds,
    cases k,
    {
      simp,
    },
    {
      rw binomial,
      have hkld : k ≤ d := nat.succ_le_succ_iff.mp hkltds,
      have hbindkpos : 0 < binomial d k := hd hkld,
      linarith,
    }
  }
}

lemma pascal_identity_with_conditions (n : ℕ) (k : ℕ) : (0 < k) → binomial n k + binomial n (k-1) = binomial n.succ k :=
begin
  intro hkpos,
  have h_pred : ∃ (m : ℕ), k = m.succ :=
  begin
    refine nat.exists_eq_succ_of_ne_zero _,
    linarith,
  end,
  cases h_pred with m hm,
  rw hm at *,
  rw pascal_identity,
  simp,
end

theorem binomial_symm (n : ℕ) : ∀ (k : ℕ), k ≤ n → binomial n k = binomial n (n - k) :=
begin
  induction n with d hd,
  {
    intro k,
    intro hkleqzero,
    cases k,
    {
      refl,
    },
    {
      have f : false := nat.not_succ_le_zero k hkleqzero,
      exact congr_arg (binomial 0) (congr_fun (false.rec (nat.succ = λ (k : ℕ), 0 - k.succ) f) k),
    }
  },
  {
    intro k,
    intro hkleqds,
    cases k,
    {
      simp,
    },
    {
      rw binomial,
      have hkld : k ≤ d := nat.succ_le_succ_iff.mp hkleqds,
      rw hd _ hkld,
      cases hkleqds,
      {
        simp,
      },
      {
        rw hd _ hkleqds_ᾰ,
        rw add_comm,
        have hdks : (d - k.succ) = ((d - k) - 1) := by {
          rw nat.succ_eq_add_one,
          exact (nat.sub_sub d k 1).symm,
        },
        rw hdks,
        have dk_succ_diff : d.succ - k.succ = d - k := nat.succ_sub_succ d k,
        rw dk_succ_diff,
        have hksleqd : k + 1 ≤ d := hkleqds_ᾰ,
        have dk_diff_pos : 0 < d-k := by {
          refine nat.succ_le_iff.mp _,
          exact nat.le_sub_left_of_add_le hksleqd,
        },
        exact pascal_identity_with_conditions d (d-k) dk_diff_pos,
      }
    }
  }
end

end binomial


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro p,
  intro np,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro nnp,
  by_cases p: P,
  exact p,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,

  intro nnp,
  by_contradiction,
  contradiction,

  intro p,
  intro np,
  contradiction,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro pouq,
  cases pouq,
  right,
  assumption,
  left,
  assumption,

end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro peq,
  cases peq,
  split,
  assumption,
  assumption,
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro npouq,
  intro p,
  cases npouq,

  contradiction,

  assumption,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro pouq,
  intro np,
  cases pouq with hp hq,

  contradiction,

  assumption,

end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro pimplq,
  intro nq,
  intro p,
  have q : Q := pimplq p,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro nqimplnp,
  intro p,
  by_contradiction,
  have np := nqimplnp h,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,

  intro pimplq,
  intro nq,
  intro p,
  have q := pimplq p,
  contradiction,

  intro nqimplnp,
  intro p,
  by_contradiction,
  have np := nqimplnp h,
  contradiction,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro npounp,
  have pounp : P ∨ ¬P,
  right,
  intro p,
  have lem: P ∨ ¬P,
  left,
  assumption,
  contradiction,
  contradiction,

end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro pimplqimplp,
  intro np,
  have pimplq: P → Q,
  intro p,
  contradiction,

  have p := pimplqimplp pimplq,
  contradiction,
end

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro pouq,
  intro npenq,
  cases npenq with np nq,
  cases pouq with p q,
  contradiction,
  contradiction,

end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro peq,
  intro npounq,
  cases peq with p q,
  cases npounq with np nq,
  contradiction,
  contradiction,
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro npouq,
  split,

  intro p,
  have pouq: P∨Q,
  left,
  assumption,
  contradiction,

  intro q,
  have pouq: P∨Q,
  right,
  assumption,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro npenq,
  intro pouq,
  cases  npenq with np nq,
  cases pouq with p q,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  sorry,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  sorry,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  sorry,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  sorry,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  sorry,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  sorry,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  sorry,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  sorry,
end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  sorry,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  sorry,
end

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

theorem impl_refl :
  P → P  :=
begin
  sorry,
end

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

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  sorry,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  sorry,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  sorry,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  sorry,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  sorry,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  sorry,
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
  sorry,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  sorry,
end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  sorry,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  sorry,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  sorry,
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
  sorry,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  sorry,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  sorry,
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


/-
Copyright (c) 2021 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster, Eric Wieser
-/
import algebra.char_p.basic
import ring_theory.localization
import algebra.free_algebra

/-!
# Characteristics of algebras

In this file we describe the characteristic of `R`-algebras.

In particular we are interested in the characteristic of free algebras over `R`
and the fraction field `fraction_ring R`.

## Main results

- `char_p_of_injective_algebra_map` If `R →+* A` is an injective algebra map
  then `A` has the same characteristic as `R`.

Instances constructed from this result:
- Any `free_algebra R X` has the same characteristic as `R`.
- The `fraction_ring R` of an integral domain `R` has the same characteristic as `R`.

-/

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) (p : ℕ) [char_p R p] : char_p A p :=
{ cast_eq_zero_iff := λx,
  begin
    rw ←char_p.cast_eq_zero_iff R p x,
    change algebra_map ℕ A x = 0 ↔ algebra_map ℕ R x = 0,
    rw is_scalar_tower.algebra_map_apply ℕ R A x,
    refine iff.trans _ h.eq_iff,
    rw ring_hom.map_zero,
  end }

/-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/
lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) [char_zero R] : char_zero A :=
{ cast_injective := λ x y hxy,
  begin
    change algebra_map ℕ A x = algebra_map ℕ A y at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A x at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A y at hxy,
    exact char_zero.cast_injective (h hxy),
  end }
-- `char_p.char_p_to_char_zero A _ (char_p_of_injective_algebra_map h 0)` does not work
-- here as it would require `ring A`.

section

variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L]

lemma algebra.char_p_iff (p : ℕ) : char_p K p ↔ char_p L p :=
(algebra_map K L).char_p_iff_char_p p

end

namespace free_algebra

variables {R X : Type*} [comm_semiring R] (p : ℕ)

/-- If `R` has characteristic `p`, then so does `free_algebra R X`. -/
instance char_p [char_p R p] : char_p (free_algebra R X) p :=
char_p_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective p

/-- If `R` has characteristic `0`, then so does `free_algebra R X`. -/
instance char_zero [char_zero R] : char_zero (free_algebra R X) :=
char_zero_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective

end free_algebra

namespace is_fraction_ring

variables (R : Type*) {K : Type*} [comm_ring R]
  [field K] [algebra R K] [is_fraction_ring R K]
variables (p : ℕ)

/-- If `R` has characteristic `p`, then so does Frac(R). -/

/-- If `R` has characteristic `0`, then so does Frac(R). -/
lemma char_zero_of_is_fraction_ring [char_zero R] : char_zero K :=
@char_p.char_p_to_char_zero K _ (char_p_of_is_fraction_ring R 0)

variables [is_domain R]

/-- If `R` has characteristic `p`, then so does `fraction_ring R`. -/
instance char_p [char_p R p] : char_p (fraction_ring R) p :=
char_p_of_is_fraction_ring R p

/-- If `R` has characteristic `0`, then so does `fraction_ring R`. -/
instance char_zero [char_zero R] : char_zero (fraction_ring R) :=
char_zero_of_is_fraction_ring R

end is_fraction_ring


/-
Copyright (c) 2023 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import data.set.basic

/--  First-order semantics for Aristotle's assertoric syllogisms
A first-order logic semantics is a variant of a set-theoretic semantics.
See, for instance Malink (2013, ch. 3).
Terms are interpreted as non-empty subsets of some set of individuals. -/

variable {α : Type}
variable {x : α}
variables {A B C : α → Prop}

/-- semantics of the `a` relation -/
def universal_affirmative (A: α → Prop) (B: α → Prop) : Prop :=
  ∀x, B x → A x
infixr ` a ` : 80 := universal_affirmative

/-- semantics of the `e` relation -/
def universal_negative (A: α → Prop) (B: α → Prop) : Prop :=
  ∀x, B x → ¬ A x
infixr ` e ` : 80 := universal_negative

/-- semantics of the `i` relation -/
def particular_affirmative (A: α → Prop) (B: α → Prop) : Prop :=
  ∃x, A x ∧ B x
-- existential import needs to be stipulated
infixr ` i ` : 80 := particular_affirmative

/-- semantics of the `o` relation -/
def particular_negative (A: α → Prop) (B: α → Prop) : Prop :=
  ∃x, B x ∧ ¬ A x
infixr ` o ` : 80 := particular_negative

/-- semantics of contradictory: contradictory is defined as negation -/
def c (p : Prop) : Prop := ¬ p

/--  We prove the soundness of the axiom system DR -/

lemma Barbara₁ : A a B → B a C → A a C :=
begin
intros h1 h2,
rw universal_affirmative,
{ intros p h3,
  have h4 : B p := by exact h2 p h3,
  exact h1 p h4 },
end

lemma Celarent₁ : A e B → B a C → A e C :=
begin
  intros h1 h2 p h3,
  have h4 : B p := by exact h2 p h3,
  exact h1 p h4
end

lemma e_conv : A e B → B e A :=
begin
intros h1 b h2,
by_contra,
show false, from (h1 b h) h2,
end

lemma a_conv (hex: ∃x, B x) : A a B → B i A :=
  begin
  intro h1,
  rw universal_affirmative at h1,
  rw particular_affirmative,
  cases hex with p hp,
  apply exists.intro p (and.intro hp (h1 p hp))
  end

lemma contr {p r : Prop} : (c r → c p) → p → r :=
begin
intros h1,
contrapose,
assumption
end

/-- We can also prove the contradictories axioms -/

lemma contr_a : c (A a B) = A o B := by simp [c, particular_negative, universal_affirmative]

lemma contr_e : c (A e B) = A i B :=
begin
simp [c, particular_affirmative, universal_negative],
finish
end

lemma contr_i : c (A i B) = A e B :=
begin
simp [c, particular_affirmative, universal_negative],
finish
end

lemma contr_o : c (A o B) = A a B := by simp [c, particular_negative, universal_affirmative]

/--  it is, of course, also possible to prove the redundant axioms  -/

lemma Darii₁ : A a B → B i C → A i C :=
begin
intros h1 h2,
cases h2 with p h,
apply exists.intro p,
exact and.intro (h1 p h.1) h.2
end

lemma Ferio₁ : A e B → B i C → A o C :=
begin
  intros h1 h2,
  cases h2 with p h,
  --rw universal_denial at h1,
  have h3 : ¬ A p := by exact h1 p h.1,
  --rw particular_denial,
  apply exists.intro p (and.intro h.2 h3)
end

lemma i_conv : A i B → B i A :=
begin
intros h1,
cases h1 with p h2,
cases h2 with q r,
apply exists.intro p (and.intro r q)
end

#lint


import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]
variables a b c : R

#check zero_add
#check zero_add c
#check add_zero
#check add_zero b
#check add_comm
#check add_comm c
#check add_assoc
#check add_right_neg
#check add_right_neg b

-- BEGIN
theorem add_left_cancel {a b c : R} (h : a + b = a + c) : b = c :=
begin
  rw [← zero_add b, ← zero_add c, ← add_right_neg a],
  rw [add_comm a, add_assoc, h, ← add_assoc],
end

theorem add_right_cancel {a b c : R} (h : a + b = c + b) : a = c :=
begin
  rw [← add_zero a, ← add_zero c, ← add_right_neg b],
  sorry,
end
-- END

#check @add_left_cancel
#check @add_right_cancel

end my_ring


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.nondegenerate
! leanprover-community/mathlib commit 2a32c70c78096758af93e997b978a5d461007b4f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basic
import Mathbin.LinearAlgebra.Matrix.Determinant
import Mathbin.LinearAlgebra.Matrix.Adjugate

/-!
# Matrices associated with non-degenerate bilinear forms

## Main definitions

* `matrix.nondegenerate A`: the proposition that when interpreted as a bilinear form, the matrix `A`
  is nondegenerate.

-/

namespace Matrix

variable {m R A : Type _} [Fintype m] [CommRing R]

/-- A matrix `M` is nondegenerate if for all `v ≠ 0`, there is a `w ≠ 0` with `w ⬝ M ⬝ v ≠ 0`. -/
def Nondegenerate (M : Matrix m m R) :=
  ∀ v, (∀ w, Matrix.dotProduct v (mulVec M w) = 0) → v = 0
#align matrix.nondegenerate Matrix.Nondegenerate

/-- If `M` is nondegenerate and `w ⬝ M ⬝ v = 0` for all `w`, then `v = 0`. -/
theorem Nondegenerate.eq_zero_of_ortho {M : Matrix m m R} (hM : Nondegenerate M) {v : m → R}
    (hv : ∀ w, Matrix.dotProduct v (mulVec M w) = 0) : v = 0 :=
  hM v hv
#align matrix.nondegenerate.eq_zero_of_ortho Matrix.Nondegenerate.eq_zero_of_ortho

/-- If `M` is nondegenerate and `v ≠ 0`, then there is some `w` such that `w ⬝ M ⬝ v ≠ 0`. -/
theorem Nondegenerate.exists_not_ortho_of_ne_zero {M : Matrix m m R} (hM : Nondegenerate M)
    {v : m → R} (hv : v ≠ 0) : ∃ w, Matrix.dotProduct v (mulVec M w) ≠ 0 :=
  not_forall.mp (mt hM.eq_zero_of_ortho hv)
#align matrix.nondegenerate.exists_not_ortho_of_ne_zero Matrix.Nondegenerate.exists_not_ortho_of_ne_zero

variable [CommRing A] [IsDomain A]

/-- If `M` has a nonzero determinant, then `M` as a bilinear form on `n → A` is nondegenerate.

See also `bilin_form.nondegenerate_of_det_ne_zero'` and `bilin_form.nondegenerate_of_det_ne_zero`.
-/
theorem nondegenerate_of_det_ne_zero [DecidableEq m] {M : Matrix m m A} (hM : M.det ≠ 0) :
    Nondegenerate M := by
  intro v hv
  ext i
  specialize hv (M.cramer (Pi.single i 1))
  refine' (mul_eq_zero.mp _).resolve_right hM
  convert hv
  simp only [mul_vec_cramer M (Pi.single i 1), dot_product, Pi.smul_apply, smul_eq_mul]
  rw [Finset.sum_eq_single i, Pi.single_eq_same, mul_one]
  · intro j _ hj
    simp [hj]
  · intros
    have := Finset.mem_univ i
    contradiction
#align matrix.nondegenerate_of_det_ne_zero Matrix.nondegenerate_of_det_ne_zero

theorem eq_zero_of_vecMul_eq_zero [DecidableEq m] {M : Matrix m m A} (hM : M.det ≠ 0) {v : m → A}
    (hv : M.vecMul v = 0) : v = 0 :=
  (nondegenerate_of_det_ne_zero hM).eq_zero_of_ortho fun w => by
    rw [dot_product_mul_vec, hv, zero_dot_product]
#align matrix.eq_zero_of_vec_mul_eq_zero Matrix.eq_zero_of_vecMul_eq_zero

theorem eq_zero_of_mulVec_eq_zero [DecidableEq m] {M : Matrix m m A} (hM : M.det ≠ 0) {v : m → A}
    (hv : M.mulVec v = 0) : v = 0 :=
  eq_zero_of_vecMul_eq_zero (by rwa [det_transpose]) ((vecMul_transpose M v).trans hv)
#align matrix.eq_zero_of_mul_vec_eq_zero Matrix.eq_zero_of_mulVec_eq_zero

end Matrix


inductive bin : nat -> Prop
| bin_epsilon : bin 0
| bin_0 : ∀ n, bin n -> bin (2 * n)
| bin_1 : ∀ n, bin n -> bin (2 * n + 1)

definition is_expressible_in_binary_notation := bin.

lemma zero_or_one {n} (h: n < 2): n = 0 ∨ n = 1
:=
begin
  cases h,
  right, trivial,
  left,
  apply nat.eq_zero_of_le_zero,
  exact nat.le_of_succ_le_succ h_a,
end

lemma two_gt_zero: 2 > 0 := nat.zero_lt_succ 1

lemma half_lt {x} (h: 0 < x): x / 2 < x
:=
begin
  apply (nat.div_lt_iff_lt_mul x x two_gt_zero).2,
  have h: x * 1 < x * 2, from nat.mul_lt_mul_of_pos_left dec_trivial h,
  rw mul_one at h,
  exact h
end

example: ∀ n, is_expressible_in_binary_notation n
:=
begin
  intro n,
  unfold is_expressible_in_binary_notation,
  apply well_founded.induction nat.lt_wf n _; clear n,
  intros x ih,
  let q := x / 2,
  let r := x % 2,
  have hx: x = 2 * q + r, {
    apply symm,
    rw nat.add_comm,
    exact nat.mod_add_div x 2,
  },
  have hq: x = 0 ∨ q < x, {
    cases nat.eq_zero_or_pos x with h0 hp,
      left,
      exact h0,
    right,
    exact half_lt hp
  },
  cases hq with hx0 hqltx, {
    rw hx0,
    exact bin.bin_epsilon,
  },
  have r_lt_two: r < 2, {
    apply nat.mod_lt,
    exact nat.zero_lt_succ 1,
  },
  rw hx,
  cases zero_or_one r_lt_two with hr0 hr1,
  {
    rw hr0,
    simp,
    apply bin.bin_0 q _,
    exact ih q hqltx,
  },
  {
    rw hr1,
    apply bin.bin_1 q _,
    exact ih q hqltx,
  }
end


import linear_algebra.basic
import data.real.basic
import data.set.basic
import tactic.interactive
import .inner_product_space

noncomputable theory
local attribute [instance] classical.prop_decidable

section basic

variables
  {α : Type*}
  [has_scalar ℝ α]
  {ι : Sort _}
  (A : set α) (B : set α) (x : α)

open set

-- Cones

def cone (A : set α) : Prop :=
  ∀x ∈ A, ∀(c : ℝ), 0 ≤ c → c • x ∈ A

lemma cone_empty :
  cone ({} : set α) :=
by finish

lemma cone_univ :
  cone (univ : set α) :=
by finish

lemma cone_inter (hA: cone A) (hB: cone B) :
  cone (A ∩ B) :=
λ x hx c hc,
  mem_inter (hA _ (mem_of_mem_inter_left  hx) _ hc)
            (hB _ (mem_of_mem_inter_right hx) _ hc)

lemma cone_Inter {s: ι → set α} (h: ∀ i : ι, cone (s i)) :
  cone (Inter s) :=
begin
 intros x hx c hc,
 rw mem_Inter at hx |-,
 exact (λ i, h i x (hx i) c hc)
end

lemma cone_union (hA: cone A) (hB: cone B) :
  cone (A ∪ B) :=
begin
  intros x hx c hc,
  apply or.elim (mem_or_mem_of_mem_union hx),
  { intro h,
    apply mem_union_left,
    apply hA _ h _ hc },
  { intro h,
    apply mem_union_right,
    apply hB _ h _ hc }
end

lemma cone_Union {s: ι → set α} (h: ∀ i : ι, cone (s i)) :
  cone (Union s) :=
begin
  intros x hx c hc,
  apply exists.elim (mem_Union.1 hx),
  intros i hi,
  apply mem_Union.2,
  use i,
  apply h i _ hi _ hc
end

end basic

section vector_space

variables
  {α : Type*}
  [add_comm_group α] [vector_space ℝ α]
  (A : set α) (B : set α) (x : α)

open set

lemma cone_subspace {s : subspace ℝ α} :
  cone (s.carrier) :=
λ x hx c hc, s.smul c hx

lemma cone_contains_0 (hA : cone A) :
  A ≠ ∅ ↔ (0 : α) ∈ A :=
begin
 apply iff.intro,
 { intros h,
   apply exists.elim (exists_mem_of_ne_empty h),
   intros x hx, rw ←zero_smul ℝ,
   apply hA x hx 0 (le_refl 0) },
 { intros h,
   exact ne_empty_of_mem h }
end

lemma cone_0 {α : Type*} [add_comm_group α] [semimodule ℝ α] : cone ({0} : set α) :=
begin
  intros x hx c hc,
  apply mem_singleton_of_eq,
  convert smul_zero c,
  exact eq_of_mem_singleton hx
end

end vector_space

section dual_cone

def dual_cone {α : Type*} [has_inner ℝ α] (A : set α) : set α :=
{ y | ∀ x ∈ A, 0 ≤ ⟪ x, y ⟫ }

open real_inner_product_space

variables {α : Type*}
  [real_inner_product_space α]
  (A : set α) (B : set α)

lemma cone_dual_cone : cone (dual_cone A) :=
begin
  intros x ha c hc z hz,
  rw inner_smul_right,
  apply mul_nonneg' hc,
  exact ha _ hz
end

end dual_cone


/-
Copyright (c) 2022 John Nicol. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: John Nicol
-/
import number_theory.legendre_symbol.gauss_eisenstein_lemmas

/-!
# Wilson's theorem.

This file contains a proof of Wilson's theorem.

The heavy lifting is mostly done by the previous `wilsons_lemma`,
but here we also prove the other logical direction.

This could be generalized to similar results about finite abelian groups.

## References

* [Wilson's Theorem](https://en.wikipedia.org/wiki/Wilson%27s_theorem)

## TODO

* Move `wilsons_lemma` into this file, and give it a descriptive name.
-/

open_locale nat

namespace nat
variable {n : ℕ}

/-- For `n ≠ 1`, `(n-1)!` is congruent to `-1` modulo `n` only if n is prime. -/
lemma prime_of_fac_equiv_neg_one
  (h : ((n - 1)! : zmod n) = -1) (h1 : n ≠ 1) : prime n :=
begin
  rcases eq_or_ne n 0 with rfl | h0,
  { norm_num at h },
  replace h1 : 1 < n := n.two_le_iff.mpr ⟨h0, h1⟩,
  by_contradiction h2,
  obtain ⟨m, hm1, hm2 : 1 < m, hm3⟩ := exists_dvd_of_not_prime2 h1 h2,
  have hm : m ∣ (n - 1)! := nat.dvd_factorial (pos_of_gt hm2) (le_pred_of_lt hm3),
  refine hm2.ne' (nat.dvd_one.mp ((nat.dvd_add_right hm).mp (hm1.trans _))),
  rw [←zmod.nat_coe_zmod_eq_zero_iff_dvd, cast_add, cast_one, h, add_left_neg],
end

/-- **Wilson's Theorem**: For `n ≠ 1`, `(n-1)!` is congruent to `-1` modulo `n` iff n is prime. -/
theorem prime_iff_fac_equiv_neg_one (h : n ≠ 1) :
  prime n ↔ ((n - 1)! : zmod n) = -1 :=
begin
  refine ⟨λ h1, _, λ h2, prime_of_fac_equiv_neg_one h2 h⟩,
  haveI := fact.mk h1,
  exact zmod.wilsons_lemma n,
end

end nat


import algebra.group group_theory.subgroup

-- `G` and `H` are groups
variables {G H : Type} [group G] [group H]

open subgroup

-- `A` and `B` are normal subgroups of `G` and `H` respectively.
variables {A : subgroup G} [normal A] {B : subgroup H} [normal B]

-- The following is, essentially, the definition of normal subgroup.
--lemma normal_def : ∀ n ∈ A, ∀ g : G, g * n * g⁻¹ ∈ A:= normal.conj_mem infer_instance

lemma normal_def {K : subgroup G} : normal K ↔ ∀ n ∈ K, ∀ g : G, g * n * g⁻¹ ∈ K :=
⟨λ h, h.conj_mem, λ h, ⟨h⟩⟩

lemma conj_mem_of_normal {K : subgroup G} [normal K] : ∀ n ∈ K, ∀ g : G, g * n * g⁻¹ ∈ K
  := normal_def.mp infer_instance

-- We now prove that `A × B` is a normal subgroup of `G × H`
-- Note that the (subgroup) product is written `prod A B` rather than `A × B`.

lemma normal_prod : normal (prod A B) :=
{ conj_mem := begin
  rintros ⟨a, b⟩ hin ⟨g, h⟩,
  rw prod.inv_mk, -- The result that `(s, t)⁻¹ = (t⁻¹, s⁻¹)`
  rw prod.mk_mul_mk, -- The result that `(p, q) * (s, t) = (p * s, q * t)`
  rw prod.mk_mul_mk,
  rw mem_prod at hin ⊢, -- The result that `(u, v) ∈ prod U V ↔ u ∈ U ∧ v ∈ V`.
  dsimp at hin ⊢, -- Make things look nicer.
  rcases hin with ⟨ha, hb⟩,
  split,
  { apply conj_mem_of_normal, apply ha, },
  { apply conj_mem_of_normal, apply hb },
end
}