open Classical

-- 1
variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  Iff.intro
  (fun h: (∀ x, p x ∧ q x) => show (∀ x, p x) ∧ (∀ x, q x) from
    And.intro (fun y: α => (h y).left) (fun y: α => (h y).right))
  (fun h: (∀ x, p x) ∧ (∀ x, q x) => show (∀ x, p x ∧ q x) from
    (fun y : α => And.intro (h.left y) (h.right y)))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  fun h : (∀ x, p x → q x) => fun h1 : (∀ x, p x) => (fun x : α => (h x) (h1 x))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  fun h : (∀ x, p x) ∨ (∀ x, q x) =>
    h.elim
    (fun h1 => fun x : α => Or.inl (h1 x))
    (fun h2 => fun x : α => Or.inr (h2 x))

-- 2
variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : α → ((∀ _ : α, r) ↔ r) :=
  fun h : α => Iff.intro
    (fun h1 => h1 h)
    (fun hr => fun _ : α => hr)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  Iff.intro
  (fun h : (∀ x, p x ∨ r) => (Or.elim (em r)
    (fun hr => Or.inr hr)
    (fun hnr => Or.inl (fun α =>
      have h1 := (h α)
      h1.elim
        (fun h2 => h2)
        (fun hr => False.elim (absurd hr hnr))))))
  (fun h : (∀ x, p x) ∨ r => h.elim
    (fun h1 => fun α => Or.inl (h1 α))
    (fun h1 => fun _ => Or.inr h1))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  Iff.intro
  (fun h : ∀ x, r → p x => fun hr => fun α => (h α) hr)
  (fun h : r → ∀ x, p x => fun α => fun hr => (h hr) α)

-- 3
variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  match (h barber) with
    | ⟨w, hw⟩ =>
      let l := shaves barber barber
      Or.elim (em l)
        (fun h1 => absurd h1 (w h1))
        (fun h1 => absurd (hw h1) h1)

-- 4
def even (n : Nat) : Prop := ∃ m, n = 2 * m

-- I would like knowing a way that allows me to check if this is correct
def prime (n : Nat) : Prop := ¬∃ m, (Nat.mod n m = 0) ∧ ¬(m = 1) ∧ ¬(m = n)

def infinitely_many_primes : Prop := ∀ n, ∃ m, (prime n) ∧ (prime m) ∧ (m > n)

def Fermat_prime (n : Nat) : Prop := ∃ m, m < 5 ∧ (Nat.pow 4 m) = n ∧ prime n

def infinitely_many_Fermat_primes : Prop := ∀ n, ∃ m, (Fermat_prime n) ∧ (Fermat_prime m) ∧ (m > n)

def goldbach_conjecture : Prop := ∀ n, ∃ m, ∃ s, n > 2 ∧ prime m ∧ prime s ∧ n = (m + s)

def Goldbach's_weak_conjecture : Prop := ∀ n: Nat, ∃ x, ∃ y, ∃ z, n > 5 ∧ (Nat.mod n 2) = 1 ∧ n = x + y + z ∧ prime x ∧ prime y ∧ prime z

def Fermat's_last_theorem : Prop := ∀ n : Nat, ¬∃ x, ¬∃ y, ¬∃ z,  n > 2 ∧ (Nat.pow x n) + (Nat.pow y n) = (Nat.pow z n)

-- 5
variable (r : Prop)

example : (∃ x : α, r) → r := fun h =>
  Exists.elim h
  (fun _ => fun r => r)
example : (∃ x : α, r) → r := fun h =>
  match h with
  | ⟨_, hw⟩ => hw

example (a : α) : r → (∃ x : α, r) := fun hr => Exists.intro a hr

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  Iff.intro
  (fun h => match h with
    | ⟨w,hw⟩ => And.intro (Exists.intro w hw.left) hw.right)
  (fun h => match h with
    | ⟨w,hw⟩ => w.elim (fun α => fun h1 => Exists.intro α (And.intro h1 hw)))

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  Iff.intro
  (fun h => match h with
  | ⟨w,hw⟩ => (hw.elim
      (fun h1 => Or.inl (Exists.intro w h1))
      (fun h1 => Or.inr (Exists.intro w h1))))
  (fun h => h.elim
    (fun h1 => match h1 with
      | ⟨w,hw⟩ => Exists.intro w (Or.inl hw))
    (fun h1 => match h1 with
      | ⟨w,hw⟩ => Exists.intro w (Or.inr hw)))

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  Iff.intro
  (fun h => fun h1 => match h1 with
    | ⟨w,hw⟩ => absurd (h w) hw)
  (fun h => fun α => byContradiction (fun h1 => absurd (Exists.intro α h1) h))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  Iff.intro
  (fun h => match h with
    | ⟨w, hw⟩ => fun h1 =>
      have hp := h1 w
      absurd hw hp)
  (fun h => byContradiction (fun h1 => absurd
    (fun α => byCases
      (fun h2 : p α => False.elim (absurd ⟨α,h2⟩ h1))
      (fun h2 => h2)) h))

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  Iff.intro
  (fun h => fun α => fun hpa => absurd (Exists.intro α hpa) h)
  (fun h => fun h1 => match h1 with
    | ⟨w, hw⟩ => absurd hw (h w))

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  Iff.intro
  (fun h => byContradiction
  (fun h1 => absurd
      (fun α => byCases
      (fun hpa : p α => hpa)
      (fun hnp => False.elim (absurd (Exists.intro α hnp) h1))) h))
  (fun h => match h with
    | ⟨w, hw⟩ => fun h1 => absurd (h1 w) hw)

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  Iff.intro
  (fun h => fun h1 => match h1 with
  | ⟨w,hw⟩ => (h w) hw)
  (fun h => fun α => fun h1 => h (Exists.intro α h1))

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  Iff.intro
  (fun ⟨b, (hb : p b → r)⟩ => fun h1 => hb (h1 b)) -- removed the exists already ?
  (fun h => byCases
    (fun hap : ∀ x, p x => Exists.intro a (fun _ => h hap))
    (fun hnap : ¬ ∀ x, p x =>
    byContradiction
      (fun hnex : ¬ ∃ x, p x → r =>
        have hap : ∀ x, p x :=
          fun x =>
          byContradiction
            (fun hnp : ¬ p x =>
              have hex : ∃ x, p x → r := ⟨x, (fun hp => absurd hp hnp)⟩
              show False from hnex hex)
        show False from hnap hap)))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  Iff.intro
  (fun h => match h with
    | ⟨w,hw⟩ => fun hr => Exists.intro w (hw hr))
(fun h => Or.elim (em r)
  (fun hr => match (h hr) with
    | ⟨x,px⟩ => Exists.intro x (fun _ => px))
  (fun hnr => Exists.intro a (fun hr => False.elim (hnr hr))))


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module data.multiset.nat_antidiagonal
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Nodup
import Mathlib.Data.List.NatAntidiagonal

/-!
# Antidiagonals in ℕ × ℕ as multisets

This file defines the antidiagonals of ℕ × ℕ as multisets: the `n`-th antidiagonal is the multiset
of pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines file `Data.List.NatAntidiagonal` and is further refined by file
`Data.Finset.NatAntidiagonal`.
-/

namespace Multiset

namespace Nat

/-- The antidiagonal of a natural number `n` is
    the multiset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : Multiset (ℕ × ℕ) :=
  List.Nat.antidiagonal n
#align multiset.nat.antidiagonal Multiset.Nat.antidiagonal

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp]
theorem mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} : x ∈ antidiagonal n ↔ x.1 + x.2 = n := by
  rw [antidiagonal, mem_coe, List.Nat.mem_antidiagonal]
#align multiset.nat.mem_antidiagonal Multiset.Nat.mem_antidiagonal

/-- The cardinality of the antidiagonal of `n` is `n+1`. -/
@[simp]
theorem card_antidiagonal (n : ℕ) : card (antidiagonal n) = n + 1 := by
  rw [antidiagonal, coe_card, List.Nat.length_antidiagonal]
#align multiset.nat.card_antidiagonal Multiset.Nat.card_antidiagonal

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp]
theorem antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
  rfl
#align multiset.nat.antidiagonal_zero Multiset.Nat.antidiagonal_zero

/-- The antidiagonal of `n` does not contain duplicate entries. -/
@[simp]
theorem nodup_antidiagonal (n : ℕ) : Nodup (antidiagonal n) :=
  coe_nodup.2 <| List.Nat.nodup_antidiagonal n
#align multiset.nat.nodup_antidiagonal Multiset.Nat.nodup_antidiagonal

@[simp]
theorem antidiagonal_succ {n : ℕ} :
    antidiagonal (n + 1) = (0, n + 1) ::ₘ (antidiagonal n).map (Prod.map Nat.succ id) := by
  simp only [antidiagonal, List.Nat.antidiagonal_succ, coe_map, cons_coe]
#align multiset.nat.antidiagonal_succ Multiset.Nat.antidiagonal_succ

theorem antidiagonal_succ' {n : ℕ} :
    antidiagonal (n + 1) = (n + 1, 0) ::ₘ (antidiagonal n).map (Prod.map id Nat.succ) := by
  rw [antidiagonal, List.Nat.antidiagonal_succ', ← coe_add, add_comm, antidiagonal, coe_map,
    coe_add, List.singleton_append, cons_coe]
#align multiset.nat.antidiagonal_succ' Multiset.Nat.antidiagonal_succ'

theorem antidiagonal_succ_succ' {n : ℕ} :
    antidiagonal (n + 2) =
      (0, n + 2) ::ₘ (n + 2, 0) ::ₘ (antidiagonal n).map (Prod.map Nat.succ Nat.succ) :=
  by
  rw [antidiagonal_succ, antidiagonal_succ', map_cons, map_map, Prod_map]
  rfl
#align multiset.nat.antidiagonal_succ_succ' Multiset.Nat.antidiagonal_succ_succ'

theorem map_swap_antidiagonal {n : ℕ} : (antidiagonal n).map Prod.swap = antidiagonal n := by
  rw [antidiagonal, coe_map, List.Nat.map_swap_antidiagonal, coe_reverse]
#align multiset.nat.map_swap_antidiagonal Multiset.Nat.map_swap_antidiagonal

end Nat

end Multiset


/-
# References

1. Avigad, Jeremy. ‘Theorem Proving in Lean’, n.d.
-/

-- Exercise 1
--
-- Prove the following identities, replacing the "sorry" placeholders with
-- actual proofs.
namespace ex1

open or

variable (p q r : Prop)

-- Commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun ⟨hp, hq⟩ => show q ∧ p from ⟨hq, hp⟩)
    (fun ⟨hq, hp⟩ => show p ∧ q from ⟨hp, hq⟩)

example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (fun h => h.elim Or.inr Or.inl)
    (fun h => h.elim Or.inr Or.inl)

-- Associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
    (fun ⟨⟨hp, hq⟩, hr⟩ => ⟨hp, hq, hr⟩)
    (fun ⟨hp, hq, hr⟩ => ⟨⟨hp, hq⟩, hr⟩)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  Iff.intro
    (fun h₁ => h₁.elim
      (fun h₂ => h₂.elim Or.inl (Or.inr ∘ Or.inl))
      (Or.inr ∘ Or.inr))
    (fun h₁ => h₁.elim
      (Or.inl ∘ Or.inl)
      (fun h₂ => h₂.elim (Or.inl ∘ Or.inr) Or.inr))

-- Distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  Iff.intro
    (fun ⟨hp, hqr⟩ => hqr.elim (Or.inl ⟨hp, ·⟩) (Or.inr ⟨hp, ·⟩))
    (fun h₁ => h₁.elim
      (fun ⟨hp, hq⟩ => ⟨hp, Or.inl hq⟩)
      (fun ⟨hp, hr⟩ => ⟨hp, Or.inr hr⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  Iff.intro
    (fun h => h.elim
      (fun hp => ⟨Or.inl hp, Or.inl hp⟩)
      (fun ⟨hq, hr⟩ => ⟨Or.inr hq, Or.inr hr⟩))
    (fun ⟨h₁, h₂⟩ => h₁.elim
      Or.inl
      (fun hq => h₂.elim Or.inl (fun hr => Or.inr ⟨hq, hr⟩)))

-- Other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
    (fun h ⟨hp, hq⟩ => h hp hq)
    (fun h hp hq => h ⟨hp, hq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
    (fun h =>
      have h₁ : p → r := h ∘ Or.inl
      have h₂ : q → r := h ∘ Or.inr
      show (p → r) ∧ (q → r) from ⟨h₁, h₂⟩)
    (fun ⟨h₁, h₂⟩ h => h.elim h₁ h₂)

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  Iff.intro
    (fun h => ⟨h ∘ Or.inl, h ∘ Or.inr⟩)
    (fun h₁ h₂ => h₂.elim (absurd · h₁.left) (absurd · h₁.right))

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  fun h₁ h₂ => h₁.elim (absurd h₂.left ·) (absurd h₂.right ·)

example : ¬(p ∧ ¬p) :=
  fun h => absurd h.left h.right

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

example : ¬p → (p → q) :=
  fun np hp => absurd hp np

example : (¬p ∨ q) → (p → q) :=
  fun npq hp => npq.elim (absurd hp ·) id

example : p ∨ False ↔ p :=
  Iff.intro (fun hpf => hpf.elim id False.elim) Or.inl

example : p ∧ False ↔ False :=
  Iff.intro (fun ⟨_, hf⟩ => hf) False.elim

example : (p → q) → (¬q → ¬p) :=
  fun hpq nq hp => absurd (hpq hp) nq

end ex1

-- Example 2
--
-- Prove the following identities, replacing the “sorry” placeholders with
-- actual proofs. These require classical reasoning.
namespace ex2

open Classical

variable (p q r s : Prop)

example (hp : p) : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  fun h => (h hp).elim
    (fun hr => Or.inl (fun _ => hr))
    (fun hs => Or.inr (fun _ => hs))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  fun npq => (em p).elim
    (fun hp => (em q).elim
      (fun hq => False.elim (npq ⟨hp, hq⟩))
      Or.inr)
    Or.inl

example : ¬(p → q) → p ∧ ¬q :=
  fun h =>
    have lhs : p := byContradiction
      fun np => h (fun (hp : p) => absurd hp np)
    ⟨lhs, fun hq => h (fun _ => hq)⟩

example : (p → q) → (¬p ∨ q) :=
  fun hpq => (em p).elim (fun hp => Or.inr (hpq hp)) Or.inl

example : (¬q → ¬p) → (p → q) :=
  fun h hp => byContradiction
    fun nq => absurd hp (h nq)

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
  fun h => byContradiction
    fun np =>
      suffices hp : p from absurd hp np
      h (fun (hp : p) => absurd hp np)

end ex2

-- Example 3
--
-- Prove `¬(p ↔ ¬p)` without using classical logic.
namespace ex3

variable (p : Prop)

example (hp : p) : ¬(p ↔ ¬p) :=
  fun h => absurd hp (Iff.mp h hp)

end ex3


/-
Copyright (c) 2020 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey
-/
import data.fintype.basic
import group_theory.order_of_element
import tactic.zify
import data.nat.totient
import data.zmod.basic

/-!
# The Lucas test for primes.

This file implements the Lucas test for primes (not to be confused with the Lucas-Lehmer test for
Mersenne primes). A number `a` witnesses that `n` is prime if `a` has order `n-1` in the
multiplicative group of integers mod `n`. This is checked by verifying that `a^(n-1) = 1 (mod n)`
and `a^d ≠ 1 (mod n)` for any divisor `d | n - 1`. This test is the basis of the Pratt primality
certificate.

## TODO

- Bonus: Show the reverse implication i.e. if a number is prime then it has a Lucas witness.
  Use `units.is_cyclic` from `ring_theory/integral_domain` to show the group is cyclic.
- Write a tactic that uses this theorem to generate Pratt primality certificates
- Integrate Pratt primality certificates into the norm_num primality verifier

## Implementation notes

Note that the proof for `lucas_primality` relies on analyzing the multiplicative group
modulo `p`. Despite this, the theorem still holds vacuously for `p = 0` and `p = 1`: In these
cases, we can take `q` to be any prime and see that `hd` does not hold, since `a^((p-1)/q)` reduces
to `1`.
-/

/--
If `a^(p-1) = 1 mod p`, but `a^((p-1)/q) ≠ 1 mod p` for all prime factors `q` of `p-1`, then `p`
is prime. This is true because `a` has order `p-1` in the multiplicative group mod `p`, so this
group must itself have order `p-1`, which only happens when `p` is prime.
-/
theorem lucas_primality (p : ℕ) (a : zmod p) (ha : a^(p-1) = 1)
  (hd : ∀ q : ℕ, q.prime → q ∣ (p-1) → a^((p-1)/q) ≠ 1) : p.prime :=
begin
  have h0 : p ≠ 0, { rintro ⟨⟩, exact hd 2 nat.prime_two (dvd_zero _) (pow_zero _) },
  have h1 : p ≠ 1, { rintro ⟨⟩, exact hd 2 nat.prime_two (dvd_zero _) (pow_zero _) },
  have hp1 : 1 < p := lt_of_le_of_ne h0.bot_lt h1.symm,
  have order_of_a : order_of a = p-1,
  { apply order_of_eq_of_pow_and_pow_div_prime _ ha hd,
    exact tsub_pos_of_lt hp1, },
  haveI fhp0 : fact (0 < p) := ⟨h0.bot_lt⟩,
  rw nat.prime_iff_card_units,
  -- Prove cardinality of `units` of `zmod p` is both `≤ p-1` and `≥ p-1`
  refine le_antisymm (nat.card_units_zmod_lt_sub_one hp1) _,
  have hp' : p - 2 + 1 = p - 1 := tsub_add_eq_add_tsub hp1,
  let a' : units (zmod p) := units.mk_of_mul_eq_one a (a ^ (p-2)) (by rw [←pow_succ, hp', ha]),
  calc p - 1 = order_of a : order_of_a.symm
  ... = order_of a' : order_of_injective (units.coe_hom (zmod p)) units.ext a'
  ... ≤ fintype.card (units (zmod p)) : order_of_le_card_univ,
end


/-
UVa CS Discrete Math (Sullivan) Homework #2
-/

/-
Note: We distribute homework assignments and
even exams as Lean files, as we do now for this
assignment. You will answer the questions in one
of two ways: by writing an answer in a comment block
(such as this one), or by writing mathematical logic
(which is what "Lean code" is). For this assignment
you will write all your answers as simple comments.
-/

/-
This assignment has three questions, each with several
parts. Be sure to read and answer all parts of all of
the questions.

Make a copy of this file in your "mywork" directory
the read and answer the questions by editing this fie.
When you are done, *save it*, then upload it to Collab.
That is how you will submit work in this class. Be sure
to double check your submission to be sure you uploaded the right file.
-/

/-
QUESTION #1 (7 Parts, A - G)

A. How many functions are there that take one
argument of type Boolean (one bit, if you prefer)
and that return one value, also of type Boolean?
Hint: We discussed this in class.

Answer here (inside this comment block): 4

B. How many functions are there that take two
arguments of type Boolean and that return
one value of type Boolean? Hint: we discussed
this in class, too.

Answer here: 16

C. How many functions are there that take three
bits of input and that return a one bit result?
Hint: We discussed this, too.

Answer here: 256

D. Give a general formula that you believe to
be valid describing the number of functions
that take n bits, for any natural number, n,
and that return one bit. Use the ^ character
to represent exponentiation.

Answer:(2^(n))^2

E. How many functions are there that take three
bits of input and that return *two* bits as a
result? Hint: think about both how many possible
combinations of input bits there are. To define
a function, you need to specify which two-bit
return value is associated with each combination
of input values. The number of functions will be
the number of ways in which you can assign output
values for each combination of input values. Give
your answer in a form that involves 3 (inputs)
and 2 (output bits).

Answer here: 4096

F. How many functions are there that take 64 bits
of input and return a 64 bit result? Give your
answer as an algebraic expression. The number is
too big to write it out explicitly.

Answer here: (2^(64))^(2^(64))

G. How many functions are there that take n bits of
input and return m bits of output, where n and m are
natural numbers? Give an algebraic expression as your
answer, involving the variables m and n.

Answer here: (2^n)^(2^m)
-/

/-
QUESTION #2 (Three parts, A - C)

Suppose you are asked to write a program, P(x), taking
one argument, x, a "natural number", and that it must
satisfy a specification, S(x), that defines a function
in a pure functional programming language.

A. Using simple English to express your answer, what
proposition that must be true for P to be accepted as a
correct implementation of S. Hint: We discussed this in
class.

Answer: P must satisfy specification s for every possible value of x.

B. Why is testing alone generally inadequate to prove
pthe correctness of such a program, P?

Answer: There are often too many testing variations to prove by testing alone

C. What kind of mathematical "thing" would be needed to
show beyond a reasonable doubt that P satisfies S? You
can give a one-word answer.

Answer: proof

-/

/-
QUESTION #3 (Four parts, A - D)

Consider a new data type, cool, that has three possible
values: true (T), false (F), and don't know (D). And now
consider the following conjecture:

For any natural number, n, the number of combinations
of values of n variables of type cool is 3^n.

Give a proof of this conjecture by induction.

A. What is the first conjecture you must prove? Hint:
substitute a specific value for n into the conjecture
and rewrite it with that value in place of n.

Answer: You have to prove the base case. In our situation that would be n=0.
When n = 0, the number of combinations should be 1. If we plug 0 into the equation 3^n we get
the value 1 out. The base case is established.

B. Prove it. Hint: One approach to proving that two
terms are equal is simply to reduce each term to its
simplest form, and then show that the reduced terms
are exactly the same. In other words, just simplify
the expressions on each side of an equals to to show
that the values are identical.

Answer here: We know that in mathematics the number of variations of zero variables is 1.
If we have n = 0, the number of variables should be 1. When we plug n = 0 into 3^n it evaluates
to 1. We can see that our base case meets our expected output.

C. What is the second conjecture that you must prove
to complete your proof by induction?

Answer here: If the states of n variables is 3^n then the states of (n+1) is equal to 3^(n+1). In
simpler terms, adding another variable should increase the number of possible combinations
by 3 times.

D. Prove it. Hint, to prove a proposition of the form,
P → Q, or P implies Q, you start by *assuming* that P
is true (whatever proposition it happens to be), and
then you show that in the context of this assumption,
that proposition Q must be true. In other words, you
want to prove that IF P is true THEN Q must be true,
too.

Answer here: If we assume that 3^n equals the number of combinations, then
it must be true for 3^(n+1). 3^(n+1) is equal to (3^n)*3. We can use use another example in
which we know the expected output to demonstrate this. The combinations with 1 variable should
be 3. 3^(1) = 3^(0)*3, 3^(0)=1, therefore, 3^1 = 3.

-/


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

! This file was ported from Lean 3 source module data.nat.choose.vandermonde
! leanprover-community/mathlib commit d6814c584384ddf2825ff038e868451a7c956f31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Coeff
import Mathlib.Data.Nat.Choose.Basic

/-!

# Vandermonde's identity

In this file we prove Vandermonde's identity (`nat.add_choose_eq`):
`(m + n).choose k = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2`

We follow the algebraic proof from
https://en.wikipedia.org/wiki/Vandermonde%27s_identity#Algebraic_proof .

-/

open BigOperators

open Polynomial Finset.Nat

/-- Vandermonde's identity -/
theorem Nat.add_choose_eq (m n k : ℕ) :
    (m + n).choose k = ∑ ij : ℕ × ℕ in antidiagonal k, m.choose ij.1 * n.choose ij.2 := by
  calc
    (m + n).choose k = ((X + 1) ^ (m + n)).coeff k := by rw [coeff_X_add_one_pow, Nat.cast_id]
    _ = ((X + 1) ^ m * (X + 1) ^ n).coeff k := by rw [pow_add]
    _ = ∑ ij : ℕ × ℕ in antidiagonal k, m.choose ij.1 * n.choose ij.2 := by
      rw [coeff_mul, Finset.sum_congr rfl]
      simp only [coeff_X_add_one_pow, Nat.cast_id, eq_self_iff_true, imp_true_iff]
#align nat.add_choose_eq Nat.add_choose_eq


import algebra.big_operators data.set.finite

definition matrix (R: Type) (n m : nat)[ring R] :=  fin n →( fin m → R )

 namespace matrix

definition add ( R : Type) [ring R] {n m: nat }(A:matrix R m n) ( B : matrix R m n): (matrix R m n):=
λ I J, A I J + B I J

definition neg ( R : Type) [ring R] {n m: nat } (A:matrix R m n) : (matrix R m n):=
λ I J, - A I J

definition zero ( R : Type) [ring R] {m n: nat }: (matrix R m n):=
λ  I J , 0

theorem add_assoc1 ( R : Type) [ring R] {m n: nat }(A:matrix R m n) ( B : matrix R m n) ( C : matrix R m n) :
 add R A (add R  B C) = add R (add R A B) C :=
begin
apply funext,
intro,
apply funext,
intro y,
unfold add,
show A x y + (B x y + C x y) = ( A x y + B x y) + C x y,
rw [add_assoc],
end

theorem add_assoc2 ( R : Type) [ring R] {m n: nat }(A:matrix R m n) ( B : matrix R m n) ( C : matrix R m n) :
 add R (add R A B) C = add R A (add R  B C)  :=
begin
apply funext,
intro,
apply funext,
intro y,
show  ( A x y + B x y) + C x y = A x y + (B x y + C x y) ,
rw[add_assoc],
end

theorem zero_add   ( R : Type) [ring R] {m n: nat }(A:matrix R m n):
add R (zero R) A = A:=
begin
apply funext,
intro,
apply funext,
intro y,
show 0 + A x y = A x y,
rw[zero_add]
end

theorem add_zero (R : Type) [ring R] {m n: nat }(A:matrix R m n):
add R A (zero R) = A:=
begin
apply funext,
intro,
apply funext,
intro y,
show  A x y + 0 = A x y,
rw[add_zero]
end

theorem add_left_neg (R : Type) [ring R] {m n: nat }(A:matrix R m n) :
add R ( neg R A) A = zero R :=
begin
apply funext,
intro,
apply funext,
intro y,
show  - A x y + A x y = 0 ,
rw[add_left_neg]
end

theorem add_comm (R : Type) [ring R] {m n: nat }(A:matrix R m n)( B : matrix R m n):
add R A B = add R B A :=
begin
apply funext,
intro,
apply funext,
intro y,
show  A x y + B x y = B x y + A x y ,
rw [add_comm]
end

instance matrices_add_comm_group ( R : Type) [ring R] {m n: nat }: add_comm_group (matrix R m n):={
add:= matrix.add R ,
add_assoc := @matrix.add_assoc2 R _ m n,
zero := matrix.zero R ,
neg := matrix.neg R,
zero_add := @matrix.zero_add R _ m n,
add_zero := @matrix.add_zero R _ m n,
add_left_neg := @matrix.add_left_neg R _ m n,
add_comm := @matrix.add_comm R _ m n
}

definition mul ( R : Type) [ring R] {n m l: nat }(A:matrix R m n) ( B : matrix R n l): (matrix R m l ):=
λ I J, finset.sum finset.univ (λ K, A I K * B K J)

theorem mul_assoc ( R : Type) [ring R] {m n l o: nat }(A:matrix R m n) ( B : matrix R n l) ( C : matrix R l o) :
mul R A (mul R B C) = mul R (mul R A B) C :=
begin
unfold mul,
apply funext,
intro x,
apply funext,
intro y,
-- This next line just rewrites the goal so that the variables we're summing over
-- are the same on both sides.

show finset.sum finset.univ (λ (K : fin n), A x K * finset.sum finset.univ (λ (J : fin l), B K J * C J y)) =
     finset.sum finset.univ (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J) * C J y),
-- So the key things we now need to use are:

-- finset.mul_sum (which says c * sum_n a_n = sum_n (c*a_n))
-- finset.sum_mul (which says the same but multiplication on the right)
-- and finset.sum_comm (which says that two finite sums can be commuted).

-- However, rw finset.sum_mul doesn't work
-- and neither does rw finset.mul_sum,
-- and until we apply these we can't commute the sums.
-- I think the reasons they don't work are that C J y, which we need to move, depends on J,
-- which is not one of our variables.

-- So here's a trick. We prove an intermediate lemma which says we can
-- move C J y into the sum, by checking the things we're summing over are the same.

have H2 : (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J) * C J y)
        = (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J * C J y)),
{ apply funext,
  intro J,
  exact finset.sum_mul,
},

-- Now we can commute the sums after using this lemma.

rw [H2],
clear H2,
rw [finset.sum_comm],

-- Now I just rewrite the goal to show that both things are a sum over K in fin n.

show finset.sum finset.univ (λ (K : fin n), A x K * finset.sum finset.univ (λ (K_1 : fin l), B K K_1 * C K_1 y)) =
    finset.sum finset.univ (λ (K : fin n), finset.sum finset.univ (λ (x_1 : fin l), A x K * B K x_1 * C x_1 y)),

-- Now we can cancel the first sum and it's all downhill from here.

apply congr_arg _,
apply funext,
intro z,
rw finset.mul_sum, -- c*sum a_n = sum c*a_n

apply congr_arg,
apply funext,

intro w,
rw mul_assoc,
end

theorem left_distrib (R:Type) [ring R] {m n l  : nat} (A : matrix R m n) (B : matrix R n l) (C : matrix R n l ) :
mul R A (add R B C) = add R (mul R A B) (mul R A C) :=
begin
unfold mul,
unfold add,
apply funext,
intro x,
apply funext,
intro y,

have H3 :     finset.sum finset.univ (λ (K : fin n), A x K * B K y) + finset.sum finset.univ (λ (K : fin n), A x K * C K y)
            = finset.sum finset.univ (λ (K : fin n), A x K * B K y + A x K * C K y),
{simp[finset.sum_add_distrib]},

rw[H3],
clear H3,

apply congr_arg _,
apply funext,
intro z,
rw [left_distrib]
end

theorem right_distrib (R:Type) [ring R] {m n l  : nat} (A : matrix R m n) (B : matrix R m n) (C : matrix R n l ) :
mul R (add R A B) C  = add R (mul R A C) (mul R B C) :=
begin
unfold mul,
unfold add,
apply funext,
intro x,
apply funext,
intro y,

have H4 :     finset.sum finset.univ (λ (K : fin n), A x K * C K y) + finset.sum finset.univ (λ (K : fin n), B x K * C K y)
            = finset.sum finset.univ (λ (K : fin n), A x K * C K y + B x K * C K y),
{simp[finset.sum_add_distrib]},

rw[H4],
clear H4,

apply congr_arg _,
apply funext,
intro z,
rw [right_distrib]
end

definition identity_matrix ( R : Type) [ring R] { n: nat }: (matrix R n n):=
λ  I J ,
if I=J then 1
else 0

--set_option pp.all true
--set_option pp.notation false
theorem one_mul ( R : Type) [ring R] {n: nat }(A:matrix R n n):
mul R (identity_matrix R) A = A:=
begin
unfold mul,
unfold identity_matrix,
apply funext,
intro x,
apply funext,
intro y,
let xfinset : finset (fin n) := finset.singleton x,
suffices : finset.sum finset.univ (λ (K : fin n), ite (x = K) 1 0 * A K y)
            = finset.sum xfinset (λ t, A t y),
  simp [this],
--  exact finset.sum_singleton,
  apply eq.symm,
  have H1 : finset.sum xfinset (λ (t : fin n), A t y) = finset.sum xfinset (λ (K : fin n), ite (x = K) 1 0 * A K y),
    rw finset.sum_singleton,
    rw finset.sum_singleton,
    simp,
  rw H1,
  refine (finset.sum_subset (_ : xfinset ⊆ finset.univ) _),
  exact finset.subset_univ xfinset,
  intros K H H2,
  have H3 : ¬ (x = K),
    intro H4,
    apply H2,
    rw ←H4,
    apply finset.mem_singleton.2,
    refl,
  simp [H3],

end
--#check @finset.sum_subset
--finset.sum_subset :
--  ∀ {α : Type u_1} {β : Type u_2} {s₁ s₂ : finset α} {f : α → β} [_inst_1 : add_comm_monoid β],
--    s₁ ⊆ s₂ → (∀ (x : α), x ∈ s₂ → x ∉ s₁ → f x = 0) → finset.sum s₁ f = finset.sum s₂ f

theorem mul_one ( R : Type) [ring R] {n: nat }(A:matrix R n n):
mul R A (identity_matrix R) = A:=
begin
unfold mul,
unfold identity_matrix,
apply funext,
intro x,
apply funext,
intro y,
let yfinset : finset (fin n) := finset.singleton y,
suffices : finset.sum finset.univ (λ (K : fin n), A x K * ite (K = y) 1 0 )
           = finset.sum yfinset (λ t, A x t),
simp [this],
apply eq.symm,
have H1 : finset.sum yfinset (λ (t : fin n), A x t) = finset.sum yfinset (λ (K : fin n), A x K * ite (K = y) 1 0 ),
         rw finset.sum_singleton,
         rw finset.sum_singleton,
         simp,
rw H1,
refine (finset.sum_subset (_ : yfinset ⊆ finset.univ) _),
exact finset.subset_univ yfinset,
intros K H H2,
have H3 : ¬ (K = y),
         intro H4,
         apply H2,
         rw H4,
         apply finset.mem_singleton.2,
         refl,
simp[H3],
end

instance ring ( R : Type) [ring R] { n: nat }: ring (matrix R n n):={
add:= matrix.add R ,
add_assoc := @matrix.add_assoc2 R _ n n,
zero := matrix.zero R ,
neg := matrix.neg R,
zero_add := @matrix.zero_add R _ n n,
add_zero := @matrix.add_zero R _ n n,
add_left_neg := @matrix.add_left_neg R _ n n,
add_comm := @matrix.add_comm R _ n n,
mul := matrix.mul R,
mul_assoc := λ A B C, eq.symm $ @matrix.mul_assoc R _ n n n n A B C,
mul_one := @matrix.mul_one R _ n ,
one := matrix.identity_matrix R,
one_mul := @matrix.one_mul R _ n ,
left_distrib := @matrix.left_distrib R _ n n n,
right_distrib := @matrix.right_distrib R _ n n n
}

end matrix
/-

dec_trivial
finset.range
I.val
-/


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

import analysis.special_functions.integrals
open interval_integral real
open_locale real

/-! ### Simple functions -/

/- constants -/
example : ∫ x : ℝ in 8..11, (1 : ℝ) = 3 := by norm_num
example : ∫ x : ℝ in 5..19, (12 : ℝ) = 168 := by norm_num

/- the identity function -/
example : ∫ x : ℝ in (-1)..4, x = 15 / 2 := by norm_num
example : ∫ x : ℝ in 4..5, x * 2 = 9 := by norm_num

/- inverse -/
example : ∫ x : ℝ in 2..3, x⁻¹ = log (3 / 2) := by norm_num

/- natural powers -/
example : ∫ x : ℝ in 2..4, x ^ (3 : ℕ) = 60 := by norm_num

/- trigonometric functions -/
example : ∫ x in 0..π, sin x = 2 := by norm_num
example : ∫ x in 0..π/4, cos x = sqrt 2 / 2 := by simp
example : ∫ x in 0..π, 2 * sin x = 4 := by norm_num
example : ∫ x in 0..π/2, cos x / 2 = 1 / 2 := by simp
example : ∫ x : ℝ in 0..1, 1 / (1 + x ^ 2) = π / 4 := by simp
example : ∫ x in 0..2*π, sin x ^ 2 = π := by simp [mul_div_cancel_left]
example : ∫ x in 0..π/2, cos x ^ 2 / 2 = π / 8 := by norm_num [div_div]
example : ∫ x in 0..π, cos x ^ 2 - sin x ^ 2 = 0 := by simp [integral_cos_sq_sub_sin_sq]
example : ∫ x in 0..π/2, sin x ^ 3 = 2 / 3 := by norm_num
example : ∫ x in 0..π/2, cos x ^ 3 = 2 / 3 := by norm_num
example : ∫ x in 0..π, sin x * cos x = 0 := by simp
example : ∫ x in 0..π, sin x ^ 2 * cos x ^ 2 = π / 8 := by simpa using sin_nat_mul_pi 4

/- the exponential function -/
example : ∫ x in 0..2, -exp x = 1 - exp 2 := by simp

/- the logarithmic function -/
example : ∫ x in 1..2, log x = 2 * log 2 - 1 := by { norm_num, ring }

/- linear combinations (e.g. polynomials) -/
example : ∫ x : ℝ in 0..2, 6*x^5 + 3*x^4 + x^3 - 2*x^2 + x - 7 = 1048 / 15 := by norm_num
example : ∫ x : ℝ in 0..1, exp x + 9 * x^8 + x^3 - x/2 + (1 + x^2)⁻¹ = exp 1 + π / 4 := by norm_num

/-! ### Functions composed with multiplication by and/or addition of a constant -/

/- many examples are computable by `norm_num` -/
example : ∫ x in 0..2, -exp (-x) = exp (-2) - 1 := by norm_num
example : ∫ x in 1..2, exp (5*x - 5) = 1/5 * (exp 5 - 1) := by norm_num
example : ∫ x in 0..π, cos (x/2) = 2 := by norm_num
example : ∫ x in 0..π/4, sin (2*x) = 1/2 := by norm_num [mul_div_left_comm, mul_one_div]
example (ω φ : ℝ) : ω * ∫ θ in 0..π, sin (ω*θ + φ) = cos φ - cos (ω*π + φ) := by simp

/- some examples may require a bit of algebraic massaging -/
example {L : ℝ} (h : L ≠ 0) : ∫ x in 0..2/L*π, sin (L/2 * x) = 4 / L :=
begin
  norm_num [div_ne_zero h, ← mul_assoc],
  field_simp [h, mul_div_cancel],
  norm_num,
end

/- you may need to provide `norm_num` with the composition lemma you are invoking if it has a
  difficult time recognizing the function you are trying to integrate -/
example : ∫ x : ℝ in 0..2, 3 * (x + 1) ^ 2 = 26 :=
  by norm_num [integral_comp_add_right (λ x, x ^ 2)]
example : ∫ x : ℝ in -1..0, (1 + (x + 1) ^ 2)⁻¹ = π / 4 :=
  by simp [integral_comp_add_right (λ x, (1 + x ^ 2)⁻¹)]

/-! ### Compositions of functions (aka "change of variables" or "integration by substitution") -/

/- `interval_integral.integral_comp_mul_deriv` can be used to simplify integrals of the form
  `∫ x in a..b, (g ∘ f) x * f' x`, where `f'` is the derivative of `f`, to `∫ x in f a..f b, g x` -/
example {a b : ℝ} : ∫ x in a..b, exp (exp x) * exp x = ∫ x in exp a..exp b, exp x :=
integral_comp_mul_deriv (λ x hx, has_deriv_at_exp x) continuous_on_exp continuous_exp

/- if it is known (to mathlib), the integral of `g` can then be evaluated using `simp`/`norm_num` -/
example : ∫ x in 0..1, exp (exp x) * exp x = exp (exp 1) - exp 1 :=
by rw integral_comp_mul_deriv (λ x hx, has_deriv_at_exp x) continuous_on_exp continuous_exp; simp

/- a more detailed example -/
example : ∫ x in 0..2, exp (x ^ 2) * (2 * x) = exp 4 - 1 :=
begin                                                    -- let g := exp x, f := x ^ 2, f' := 2 * x
  rw integral_comp_mul_deriv (λ x hx, _),                -- simplify to ∫ x in f 0..f 2, g x
  { norm_num },                                          -- compute the integral
  { exact continuous_on_const.mul continuous_on_id },    -- show that f' is continuous on [0, 2]
  { exact continuous_exp },                              -- show that g is continuous
  { simpa using has_deriv_at_pow 2 x },                  -- show that f' = derivative of f on [0, 2]
end

/- alternatively, `interval_integral.integral_deriv_comp_mul_deriv` can be used to compute integrals
  of this same form, provided that you also know that `g` is the derivative of some function -/
example : ∫ x : ℝ in 0..1, exp (x ^ 2) * (2 * x) = exp 1 - 1 :=
begin
  rw integral_deriv_comp_mul_deriv (λ x hx, _) (λ x hx, has_deriv_at_exp (x^2)) _ continuous_exp,
  { simp },
  { simpa using has_deriv_at_pow 2 x },
  { exact continuous_on_const.mul continuous_on_id },
end


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson

! This file was ported from Lean 3 source module data.int.parity
! leanprover-community/mathlib commit e3d9ab8faa9dea8f78155c6c27d62a621f4c152d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Parity
import Mathlib.Tactic.Abel

/-!
# Parity of integers

This file contains theorems about the `Even` and `Odd` predicates on the integers.

## Tags

even, odd
-/

namespace Int

variable {m n : ℤ}

@[simp]
theorem emod_two_ne_one : ¬n % 2 = 1 ↔ n % 2 = 0 := by
  cases' emod_two_eq_zero_or_one n with h h <;> simp [h]
#align int.mod_two_ne_one Int.emod_two_ne_one

-- Porting note: This comment from mathlib3 refers to a future file, revisit it once ported:
-- euclidean_domain.mod_eq_zero uses (2 ∣ n) as normal form
@[local simp]
theorem emod_two_ne_zero : ¬n % 2 = 0 ↔ n % 2 = 1 := by
  cases' emod_two_eq_zero_or_one n with h h <;> simp [h]
#align int.mod_two_ne_zero Int.emod_two_ne_zero

theorem even_iff : Even n ↔ n % 2 = 0 :=
  ⟨fun ⟨m, hm⟩ => by simp [← two_mul, hm],
    fun h => ⟨n / 2, (emod_add_ediv n 2).symm.trans (by simp [← two_mul, h])⟩⟩
#align int.even_iff Int.even_iff

theorem odd_iff : Odd n ↔ n % 2 = 1 :=
  ⟨fun ⟨m, hm⟩ => (by rw [hm, add_emod]; norm_num),
    fun h => ⟨n / 2, (emod_add_ediv n 2).symm.trans (by rw [h]; abel)⟩⟩
#align int.odd_iff Int.odd_iff

theorem not_even_iff : ¬Even n ↔ n % 2 = 1 := by rw [even_iff, emod_two_ne_zero]
#align int.not_even_iff Int.not_even_iff

theorem not_odd_iff : ¬Odd n ↔ n % 2 = 0 := by rw [odd_iff, emod_two_ne_one]
#align int.not_odd_iff Int.not_odd_iff

theorem even_iff_not_odd : Even n ↔ ¬Odd n := by rw [not_odd_iff, even_iff]
#align int.even_iff_not_odd Int.even_iff_not_odd

@[simp]
theorem odd_iff_not_even : Odd n ↔ ¬Even n := by rw [not_even_iff, odd_iff]
#align int.odd_iff_not_even Int.odd_iff_not_even

theorem isCompl_even_odd : IsCompl { n : ℤ | Even n } { n | Odd n } := by
  simp [← Set.compl_setOf, isCompl_compl]
#align int.is_compl_even_odd Int.isCompl_even_odd

theorem even_or_odd (n : ℤ) : Even n ∨ Odd n :=
  Or.imp_right odd_iff_not_even.2 <| em <| Even n
#align int.even_or_odd Int.even_or_odd

theorem even_or_odd' (n : ℤ) : ∃ k, n = 2 * k ∨ n = 2 * k + 1 := by
  simpa only [two_mul, exists_or, Odd, Even] using even_or_odd n
#align int.even_or_odd' Int.even_or_odd'

theorem even_xor'_odd (n : ℤ) : Xor' (Even n) (Odd n) := by
  cases even_or_odd n with
  | inl h => exact Or.inl ⟨h, even_iff_not_odd.mp h⟩
  | inr h => exact Or.inr ⟨h, odd_iff_not_even.mp h⟩
#align int.even_xor_odd Int.even_xor'_odd

theorem even_xor'_odd' (n : ℤ) : ∃ k, Xor' (n = 2 * k) (n = 2 * k + 1) := by
  rcases even_or_odd n with (⟨k, rfl⟩ | ⟨k, rfl⟩) <;> use k
  · simpa only [← two_mul, Xor', true_and_iff, eq_self_iff_true, not_true, or_false_iff,
      and_false_iff] using (succ_ne_self (2 * k)).symm
  · simp only [Xor', add_right_eq_self, false_or_iff, eq_self_iff_true, not_true, not_false_iff,
      one_ne_zero, and_self_iff]
#align int.even_xor_odd' Int.even_xor'_odd'

@[simp]
theorem two_dvd_ne_zero : ¬2 ∣ n ↔ n % 2 = 1 :=
  even_iff_two_dvd.symm.not.trans not_even_iff
#align int.two_dvd_ne_zero Int.two_dvd_ne_zero

instance : DecidablePred (Even : ℤ → Prop) := fun _ => decidable_of_iff _ even_iff.symm

instance : DecidablePred (Odd : ℤ → Prop) := fun _ => decidable_of_iff _ odd_iff_not_even.symm

@[simp]
theorem not_even_one : ¬Even (1 : ℤ) := by
  rw [even_iff]
  norm_num
#align int.not_even_one Int.not_even_one

@[parity_simps]
theorem even_add : Even (m + n) ↔ (Even m ↔ Even n) := by
  cases' emod_two_eq_zero_or_one m with h₁ h₁ <;>
  cases' emod_two_eq_zero_or_one n with h₂ h₂ <;>
  simp [even_iff, h₁, h₂, Int.add_emod]
#align int.even_add Int.even_add

theorem even_add' : Even (m + n) ↔ (Odd m ↔ Odd n) := by
  rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not]
#align int.even_add' Int.even_add'

set_option linter.deprecated false in

@[simp, deprecated]
theorem not_even_bit1 (n : ℤ) : ¬Even (bit1 n) := by simp [bit1, parity_simps]
#align int.not_even_bit1 Int.not_even_bit1

theorem two_not_dvd_two_mul_add_one (n : ℤ) : ¬2 ∣ 2 * n + 1 := by
  simp [add_emod]
#align int.two_not_dvd_two_mul_add_one Int.two_not_dvd_two_mul_add_one

@[parity_simps]
theorem even_sub : Even (m - n) ↔ (Even m ↔ Even n) := by
  simp [sub_eq_add_neg, parity_simps]
#align int.even_sub Int.even_sub

theorem even_sub' : Even (m - n) ↔ (Odd m ↔ Odd n) := by
  rw [even_sub, even_iff_not_odd, even_iff_not_odd, not_iff_not]
#align int.even_sub' Int.even_sub'

@[parity_simps]
theorem even_add_one : Even (n + 1) ↔ ¬Even n := by
  simp [even_add]
#align int.even_add_one Int.even_add_one

@[parity_simps]
theorem even_mul : Even (m * n) ↔ Even m ∨ Even n := by
  cases' emod_two_eq_zero_or_one m with h₁ h₁ <;>
  cases' emod_two_eq_zero_or_one n with h₂ h₂ <;>
  simp [even_iff, h₁, h₂, Int.mul_emod]
#align int.even_mul Int.even_mul

theorem odd_mul : Odd (m * n) ↔ Odd m ∧ Odd n := by simp [not_or, parity_simps]
#align int.odd_mul Int.odd_mul

theorem Odd.of_mul_left (h : Odd (m * n)) : Odd m :=
  (odd_mul.mp h).1
#align int.odd.of_mul_left Int.Odd.of_mul_left

theorem Odd.of_mul_right (h : Odd (m * n)) : Odd n :=
  (odd_mul.mp h).2
#align int.odd.of_mul_right Int.Odd.of_mul_right

@[parity_simps]
theorem even_pow {n : ℕ} : Even (m ^ n) ↔ Even m ∧ n ≠ 0 := by
  induction' n with n ih <;> simp [*, even_mul, pow_succ]
  tauto
#align int.even_pow Int.even_pow

theorem even_pow' {n : ℕ} (h : n ≠ 0) : Even (m ^ n) ↔ Even m :=
  even_pow.trans <| and_iff_left h
#align int.even_pow' Int.even_pow'

@[parity_simps]
theorem odd_add : Odd (m + n) ↔ (Odd m ↔ Even n) := by
  rw [odd_iff_not_even, even_add, not_iff, odd_iff_not_even]
#align int.odd_add Int.odd_add

theorem odd_add' : Odd (m + n) ↔ (Odd n ↔ Even m) := by
  rw [add_comm, odd_add]
#align int.odd_add' Int.odd_add'

theorem ne_of_odd_add (h : Odd (m + n)) : m ≠ n :=
  fun hnot => by simp [hnot, parity_simps] at h
#align int.ne_of_odd_add Int.ne_of_odd_add

@[parity_simps]
theorem odd_sub : Odd (m - n) ↔ (Odd m ↔ Even n) := by
  rw [odd_iff_not_even, even_sub, not_iff, odd_iff_not_even]
#align int.odd_sub Int.odd_sub

theorem odd_sub' : Odd (m - n) ↔ (Odd n ↔ Even m) := by
  rw [odd_iff_not_even, even_sub, not_iff, not_iff_comm, odd_iff_not_even]
#align int.odd_sub' Int.odd_sub'

theorem even_mul_succ_self (n : ℤ) : Even (n * (n + 1)) := by
  simpa [even_mul, parity_simps] using n.even_or_odd
#align int.even_mul_succ_self Int.even_mul_succ_self

@[simp, norm_cast]
theorem even_coe_nat (n : ℕ) : Even (n : ℤ) ↔ Even n := by
  rw_mod_cast [even_iff, Nat.even_iff]
#align int.even_coe_nat Int.even_coe_nat

-- Porting note: was simp. simp can prove this.
@[norm_cast]
theorem odd_coe_nat (n : ℕ) : Odd (n : ℤ) ↔ Odd n := by
  rw [odd_iff_not_even, Nat.odd_iff_not_even, even_coe_nat]
#align int.odd_coe_nat Int.odd_coe_nat

@[simp]
theorem natAbs_even : Even n.natAbs ↔ Even n := by
  simp [even_iff_two_dvd, dvd_natAbs, coe_nat_dvd_left.symm]
#align int.nat_abs_even Int.natAbs_even

-- Porting note: was simp. simp can prove this.
--@[simp]
theorem natAbs_odd : Odd n.natAbs ↔ Odd n := by
  rw [odd_iff_not_even, Nat.odd_iff_not_even, natAbs_even]
#align int.nat_abs_odd Int.natAbs_odd

alias natAbs_even ↔ _ _root_.Even.natAbs
#align even.nat_abs Even.natAbs

alias natAbs_odd ↔ _ _root_.Odd.natAbs
#align odd.nat_abs Odd.natAbs

-- Porting note: "protected"-attribute not implemented yet.
-- mathlib3 had:
-- `attribute [protected] Even.natAbs Odd.natAbs`

theorem four_dvd_add_or_sub_of_odd {a b : ℤ} (ha : Odd a) (hb : Odd b) :
    4 ∣ a + b ∨ 4 ∣ a - b := by
  obtain ⟨m, rfl⟩ := ha
  obtain ⟨n, rfl⟩ := hb
  obtain h | h := Int.even_or_odd (m + n)
  · right
    rw [Int.even_add, ← Int.even_sub] at h
    obtain ⟨k, hk⟩ := h
    convert dvd_mul_right 4 k using 1
    rw [eq_add_of_sub_eq hk, mul_add, add_assoc, add_sub_cancel, ← two_mul, ← mul_assoc]
    rfl
  · left
    obtain ⟨k, hk⟩ := h
    convert dvd_mul_right 4 (k + 1) using 1
    rw [eq_sub_of_add_eq hk, add_right_comm, ← add_sub, mul_add, mul_sub, add_assoc, add_assoc,
      sub_add, add_assoc, ← sub_sub (2 * n), sub_self, zero_sub, sub_neg_eq_add, ← mul_assoc,
      mul_add]
    rfl
#align int.four_dvd_add_or_sub_of_odd Int.four_dvd_add_or_sub_of_odd

theorem two_mul_ediv_two_of_even : Even n → 2 * (n / 2) = n :=
  fun h => Int.mul_ediv_cancel' (even_iff_two_dvd.mp h)
#align int.two_mul_div_two_of_even Int.two_mul_ediv_two_of_even

theorem ediv_two_mul_two_of_even : Even n → n / 2 * 2 = n :=
  fun h => Int.ediv_mul_cancel (even_iff_two_dvd.mp h)
#align int.div_two_mul_two_of_even Int.ediv_two_mul_two_of_even

theorem two_mul_ediv_two_add_one_of_odd : Odd n → 2 * (n / 2) + 1 = n := by
  rintro ⟨c, rfl⟩
  rw [mul_comm]
  convert Int.ediv_add_emod' (2 * c + 1) 2
  simp [Int.add_emod]
#align int.two_mul_div_two_add_one_of_odd Int.two_mul_ediv_two_add_one_of_odd

theorem ediv_two_mul_two_add_one_of_odd : Odd n → n / 2 * 2 + 1 = n := by
  rintro ⟨c, rfl⟩
  convert Int.ediv_add_emod' (2 * c + 1) 2
  simp [Int.add_emod]
#align int.div_two_mul_two_add_one_of_odd Int.ediv_two_mul_two_add_one_of_odd

theorem add_one_ediv_two_mul_two_of_odd : Odd n → 1 + n / 2 * 2 = n := by
  rintro ⟨c, rfl⟩
  rw [add_comm]
  convert Int.ediv_add_emod' (2 * c + 1) 2
  simp [Int.add_emod]
#align int.add_one_div_two_mul_two_of_odd Int.add_one_ediv_two_mul_two_of_odd

theorem two_mul_ediv_two_of_odd (h : Odd n) : 2 * (n / 2) = n - 1 :=
  eq_sub_of_add_eq (two_mul_ediv_two_add_one_of_odd h)
#align int.two_mul_div_two_of_odd Int.two_mul_ediv_two_of_odd

-- Here are examples of how `parity_simps` can be used with `int`.
example (m n : ℤ) (h : Even m) : ¬Even (n + 3) ↔ Even (m ^ 2 + m + n) := by
  simp [*, (by decide : ¬2 = 0), parity_simps]

example : ¬Even (25394535 : ℤ) := by simp

end Int


import tactic

-- Let `Ω` be a "big underlying set" and let `X` and `Y` and `Z` be subsets

variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

namespace xena

/-!

# subsets

Let's think about `X ⊆ Y`. Typeset `⊆` with `\sub` or `\ss`
-/

-- `X ⊆ Y` is the same as `∀ a, a ∈ X → a ∈ Y` , by definition.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  -- true by definition
  refl
end

lemma subset_refl : X ⊆ X :=
begin
  rw subset_def,
  -- goal now "for all a, ..." and `intro` makes progress with this.
  intros a ha,
  exact ha,
end

lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  rw subset_def at *,
  intros a ha,
  -- ⊢ a ∈ Z
  -- hYZ says: a ∈ Y → a ∈ Z. So...
  apply hYZ,
  -- ⊢ a ∈ Y
  apply hXY,
  exact ha,
end

/-!

# Equality of sets

Two sets are equal if and only if they have the same elements.
The name of this theorem is `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

-- In practice, you often have a goal `⊢ X = Y` and you want to reduce
-- it to `a ∈ X ↔ a ∈ Y` for an arbitary `a : Ω`. This can be done with
-- the `ext` tactic.

lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  ext a,
  split,
  { apply hXY },
  { apply hYX }
end

/-!

### Unions and intersections

Type `\cup` or `\un` for `∪`, and `\cap` or `\i` for `∩`

-/

lemma mem_union_iff : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  -- true by definition
  refl,
end

lemma mem_inter_iff : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  -- true by definition
  refl,
end

-- You can rewrite with those lemmas above if you're not comfortable with
-- assuming they're true by definition.

-- union lemmas
-- if you want to use `mem_union_iff` you should start with `ext`

lemma union_self : X ∪ X = X :=
begin
  ext a,
  rw mem_union_iff,
  split,
  { intro h,
    cases h with ha ha;
    exact ha },
  { intro ha,
    left,
    exact ha }
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  rw subset_def,
  intros a haX,
  rw mem_union_iff,
  left,
  assumption,
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  -- don't need to rewrite subset_def or mem_union_iff
  -- as they're both true by definition
  intros a haY,
  right,
  assumption,
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  -- NB Lean's simplifier `simp` solves this (and many others)
  -- as do the tactics `finish` and `tidy`
  -- We will talk a bit more about `simp` in week 2.
  split,
  { intro h,
    split,
    { intros a haX,
      apply h,
      left,
      assumption },
    { intros a haY,
      apply h,
      right,
      assumption },
  },
  { rintros ⟨hXZ, hYZ⟩ a (haX | haY),
    { exact hXZ haX },
    { exact hYZ haY } }
end

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  rintros a (haW | haY),
  { left,
    exact hWX haW },
  { right,
    exact hYZ haY }
end

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  rintros a (haX | haZ),
  { left,
    exact hXY haX },
  { right,
    assumption }
end

-- etc etc

-- intersection lemmas

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  rintro a ⟨haX, haY⟩,
  assumption,
end

-- don't forget `ext` to make progress with equalities of sets

lemma inter_self : X ∩ X = X :=
begin
  ext a,
  split,
  { rintro ⟨ha, -⟩,
    assumption },
  { intro ha,
    exact ⟨ha, ha⟩ }
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  ext a,
  split;
  { rintro ⟨h1, h2⟩,
    exact ⟨h2, h1⟩ }
end

lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
--  finish,
  -- tidy works too,
  ext a,
  split,
  { rintro ⟨hx, hy, hz⟩, -- try `rintro?` to see the syntax
    exact ⟨⟨hx, hy⟩, hz⟩ },
  { rintro ⟨⟨hx, hy⟩, hz⟩,
    exact ⟨hx, hy, hz⟩ },
end

/-!

### Forall and exists

-/

lemma not_exists_iff_forall_not : ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  split,
  { intros h b hb,
    apply h,
    use b,
    assumption },
  { rintro h ⟨a, ha⟩,
    exact h a ha },
end

example : ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  split,
  { -- you need classical logic to do this part
    -- `contrapose!` is a way of making progress
    -- `finish` does it completely.
    -- We use `by_contra`, which
    -- turns a goal `⊢ P` into
    -- a hypothesis `h : ¬ P` and
    -- a goal of `false`
    intro h,
    by_contra hnX,
    apply h,
    intro a,
    by_contra hXa,
    apply hnX,
    use a, },
  { intro h,
    cases h with b hb,
    intro h,
    apply hb,
    apply h }
end

end xena


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.nat
open nat

definition fib : nat → nat
| 0     := 1
| 1     := 1
| (n+2) := fib (n+1) + fib n

private definition fib_fast_aux : nat → (nat × nat)
| 0     := (0, 1)
| 1     := (1, 1)
| (n+2) :=
  match fib_fast_aux (n+1) with
  | (fn, fn1) := (fn1, fn1 + fn)
  end

open prod.ops -- Get .1 .2 notation for pairs

definition fib_fast (n : nat) := (fib_fast_aux n).2

-- We now prove that fib_fast and fib are equal

lemma fib_fast_aux_lemma : ∀ n, (fib_fast_aux (succ n)).1 = (fib_fast_aux n).2
| 0               := rfl
| 1               := rfl
| (succ (succ n)) :=
  begin
    unfold fib_fast_aux at {1},
    rewrite [-prod.eta (fib_fast_aux _)],
  end

theorem fib_eq_fib_fast : ∀ n, fib_fast n = fib n
| 0               := rfl
| 1               := rfl
| (succ (succ n)) :=
  begin
    have feq  : fib_fast n = fib n,               from fib_eq_fib_fast n,
    have f1eq : fib_fast (succ n) = fib (succ n), from fib_eq_fib_fast (succ n),
    unfold [fib, fib_fast, fib_fast_aux],
    rewrite [-prod.eta (fib_fast_aux _)],
    fold fib_fast (succ n), rewrite f1eq,
    rewrite fib_fast_aux_lemma,
    fold fib_fast n, rewrite feq,
  end


namespace hidden

-- BEGIN
inductive nat : Type
| zero : nat
| succ : nat → nat
-- END

def Z := nat.zero
def S := nat.succ

def K₁ := S Z
def K₂ := S K₁
def K₃ := S K₂
def K₄ := S K₃
def K₅ := S K₄

def pred (n: nat): nat := begin
cases n,
case nat.zero: { exact Z },
case nat.succ: m { exact m }
end

theorem pr₀ : pred Z = Z := rfl.
theorem pr₁ : pred K₁ = Z := rfl.
theorem pr₂ : pred K₂ = K₁ := rfl.

theorem pred_succ_zero (n: nat): pred (S n) = n := rfl.

def sub (n m: nat): nat := nat.rec_on m n (λ m n_sub_m, pred n_sub_m).

#reduce sub Z K₂
#reduce sub K₅ K₂

example: sub nat.zero K₅ = nat.zero := rfl
theorem sub_n_0 (n: nat): sub n Z = n := rfl
theorem sub_0_m (m: nat): sub Z m = Z := begin
induction m,
case nat.zero: { reflexivity },
case nat.succ: m ih {
  calc sub Z (S m) = pred (sub Z m): rfl
   ... = pred Z: by rw ih
}
end

lemma sub_succ (n m: nat): sub (S n) (S m) = sub n m := begin
induction m,
case nat.zero: {
  reflexivity
},
case nat.succ: m ih {
  have: sub (S n) (S (S m)) = pred (sub (S n) (S m)), from rfl,
  have: sub (S n) (S (S m)) = pred (sub n m), by rw[this, ih],
  have: pred (sub n m) = sub n (S m), by reflexivity,
  assumption
}
end

theorem sub_n_n (n: nat): sub n n = Z := begin
induction n,
case nat.zero: { reflexivity },
case nat.succ: n ih {
  have: sub (nat.succ n) (nat.succ n) = sub n n, from sub_succ n n,
  rw [this], assumption
}
end

def add (m n : nat) : nat := nat.rec_on n m (λ n add_m_n, S add_m_n)

lemma add_n_succ (m n: nat): add m (nat.succ n) = nat.succ (add m n) := rfl.
lemma add_m_succ (m n: nat): add (nat.succ m) n = nat.succ (add m n) := begin
induction n, reflexivity,
case nat.succ: n ih {
  simp[add_n_succ], assumption
}
end

lemma add_m_0 (m: nat): add m Z = m := rfl.
lemma add_0_n (n: nat): add Z n = n := begin
induction n, reflexivity,
case nat.succ: n ih {
  simp[add_n_succ], assumption
}
end

theorem add_assoc (a b c: nat): add (add a b) c = add a (add b c) := begin
induction c, reflexivity,
case nat.succ: c ih {
  simp [add_n_succ], assumption,
}
end

theorem add_comm (m n : nat) : add m n = add n m :=
begin
  induction n,
  case nat.zero : { rw[<-Z, add_m_0, add_0_n] },
  case nat.succ : n ih { rw [add_n_succ, add_m_succ, ih] }
end

#reduce add K₁ K₂

def mul (m n: nat): nat := nat.rec_on n Z (λ n acc, add m acc)

#reduce mul Z K₂
#reduce mul K₂ Z
#reduce mul K₁ K₂
#reduce mul K₂ K₂
#reduce mul K₅ K₂

lemma mul_succ_n (m n: nat): mul m (nat.succ n) = add m (mul m n) := rfl.
lemma mul_succ_m (m n: nat): mul (nat.succ m) n = add (mul m n) n := begin
induction n, reflexivity,
case nat.succ: n ih {
  simp [mul_succ_n],
  rw ih,
  simp [add_n_succ, add_m_succ],
  simp [add_assoc],
}
end

theorem mul_m_0 (m: nat): mul m Z = Z := rfl.
theorem mul_0_n (n: nat): mul Z n = Z := begin
induction n,
  case nat.zero: {reflexivity},
  case nat.succ: n ih {
    rw [mul_succ_n Z n],
    rw ih, reflexivity
  }
end

theorem mul_m_1 (m: nat): mul m K₁ = m := rfl
theorem mul_1_n (n: nat): mul K₁ n = n := begin
  rw [K₁, S, Z],
  simp [mul_succ_m],
  rw [<-Z, mul_0_n n, add_0_n]
end

theorem mul_comm (m n: nat): mul m n = mul n m := begin
induction m,
case nat.zero {
  rw [<-Z, mul_m_0, mul_0_n],
},
case nat.succ: m ih {
  rw [mul_succ_n, mul_succ_m, ih, add_comm],
}
end

theorem mul_dist (a b c: nat): mul a (add b c) = add (mul a b) (mul a c) := begin
induction a,
case nat.zero {
  rw [<-Z, mul_0_n, mul_0_n, mul_0_n], reflexivity
},
case nat.succ: a ih {
  rw [mul_succ_m, mul_succ_m, mul_succ_m, ih],
  repeat { rw [add_assoc] },
  repeat { rw [<-add_assoc]},
  repeat { rw [add_assoc] },
  rw [<-add_assoc (mul a c), <-add_assoc b, add_comm (mul a c)],
}
end

theorem mul_assoc (a b c: nat): mul (mul a b) c = mul a (mul b c) := begin
induction c, reflexivity,
case nat.succ: c ih {
  rw [mul_succ_n, ih, mul_succ_n, mul_dist]
}
end

theorem succ_nonzero (n: nat): S n ≠ Z := by trivial.
def nonzero := {n: nat // n ≠ Z}
def nonzero.mk (n: nat) (h: n ≠ Z): nonzero := ⟨n,h⟩
def nz := nonzero.mk.
#check nz K₂ (by apply succ_nonzero)

def pow (m: nonzero) (n: nat): nat := nat.rec_on n K₁ (λ n acc, mul m.val acc)

def nzK₁ := nz (S Z) (by apply succ_nonzero)
def nzK₂ := nz (S K₁) (by apply succ_nonzero)
def nzK₃ := nz (S K₂) (by apply succ_nonzero)
def nzK₄ := nz (S K₃) (by apply succ_nonzero)
def nzK₅ := nz (S K₄) (by apply succ_nonzero)

#reduce pow nzK₂ Z
#reduce pow nzK₁ K₂
#reduce pow nzK₂ K₂
#reduce pow nzK₅ K₂

theorem pow_by_0 (m: nonzero): pow m Z = K₁ := rfl.
theorem pow_by_1 (m: nonzero): pow m K₁ = m.val := rfl.
theorem pow_by_succ (m: nonzero) (n: nat): pow m (nat.succ n) = mul m.val (pow m n) := rfl.
theorem pow_of_1 (n: nat): pow nzK₁ n = K₁ := begin
induction n, reflexivity,
case nat.succ: n ih {
  have o: nzK₁.val = K₁, from rfl,
  have: pow nzK₁ (nat.succ n) = mul nzK₁.val (pow nzK₁ n), by rw [pow_by_succ],
  rw [o, mul_1_n] at this,
  rw [this, ih]
}
end

theorem pow_by_add (m: nonzero) (a b: nat): pow m (add a b) = mul (pow m a) (pow m b) := begin
induction b, reflexivity,
case nat.succ: b ih {
  have sab: add a (nat.succ b) = nat.succ (add a b), by reflexivity,
  calc pow m (add a (nat.succ b)) = pow m (nat.succ (add a b)): by rw sab
    ... = mul m.val (pow m (add a b)): by rw pow_by_succ
    ... = mul m.val (mul (pow m a) (pow m b)): by rw ih
    ... = mul (mul m.val (pow m b)) (pow m a): by rw [mul_comm (pow m a), mul_assoc]
    ... = mul (pow m (nat.succ b)) (pow m a): by rw <-pow_by_succ
    ... = mul (pow m a) (pow m (nat.succ b)): by rw mul_comm
}
end

end hidden


/-
Copyright (c) 2022 Wrenna Robson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wrenna Robson

! This file was ported from Lean 3 source module information_theory.hamming
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Analysis.Normed.Group.Basic

/-!
# Hamming spaces

The Hamming metric counts the number of places two members of a (finite) Pi type
differ. The Hamming norm is the same as the Hamming metric over additive groups, and
counts the number of places a member of a (finite) Pi type differs from zero.

This is a useful notion in various applications, but in particular it is relevant
in coding theory, in which it is fundamental for defining the minimum distance of a
code.

## Main definitions
* `hammingDist x y`: the Hamming distance between `x` and `y`, the number of entries which differ.
* `hammingNorm x`: the Hamming norm of `x`, the number of non-zero entries.
* `Hamming β`: a type synonym for `Π i, β i` with `dist` and `norm` provided by the above.
* `Hamming.toHamming`, `Hamming.ofHamming`: functions for casting between `Hamming β` and
`Π i, β i`.
* the Hamming norm forms a normed group on `Hamming β`.
-/

section HammingDistNorm

open Finset Function

variable {α ι : Type _} {β : ι → Type _} [Fintype ι] [∀ i, DecidableEq (β i)]

variable {γ : ι → Type _} [∀ i, DecidableEq (γ i)]

/-- The Hamming distance function to the naturals. -/
def hammingDist (x y : ∀ i, β i) : ℕ :=
  (univ.filter fun i => x i ≠ y i).card
#align hamming_dist hammingDist

/-- Corresponds to `dist_self`. -/
@[simp]
theorem hammingDist_self (x : ∀ i, β i) : hammingDist x x = 0 := by
  rw [hammingDist, card_eq_zero, filter_eq_empty_iff]
  exact fun _ _ H => H rfl
#align hamming_dist_self hammingDist_self

/-- Corresponds to `dist_nonneg`. -/
theorem hammingDist_nonneg {x y : ∀ i, β i} : 0 ≤ hammingDist x y :=
  zero_le _
#align hamming_dist_nonneg hammingDist_nonneg

/-- Corresponds to `dist_comm`. -/
theorem hammingDist_comm (x y : ∀ i, β i) : hammingDist x y = hammingDist y x := by
  simp_rw [hammingDist, ne_comm]
#align hamming_dist_comm hammingDist_comm

/-- Corresponds to `dist_triangle`. -/
theorem hammingDist_triangle (x y z : ∀ i, β i) :
    hammingDist x z ≤ hammingDist x y + hammingDist y z := by
  classical
    unfold hammingDist
    refine le_trans (card_mono ?_) (card_union_le _ _)
    rw [← filter_or]
    exact monotone_filter_right _ fun i h ↦ (h.ne_or_ne _).imp_right Ne.symm
#align hamming_dist_triangle hammingDist_triangle

/-- Corresponds to `dist_triangle_left`. -/
theorem hammingDist_triangle_left (x y z : ∀ i, β i) :
    hammingDist x y ≤ hammingDist z x + hammingDist z y := by
  rw [hammingDist_comm z]
  exact hammingDist_triangle _ _ _
#align hamming_dist_triangle_left hammingDist_triangle_left

/-- Corresponds to `dist_triangle_right`. -/
theorem hammingDist_triangle_right (x y z : ∀ i, β i) :
    hammingDist x y ≤ hammingDist x z + hammingDist y z := by
  rw [hammingDist_comm y]
  exact hammingDist_triangle _ _ _
#align hamming_dist_triangle_right hammingDist_triangle_right

/-- Corresponds to `swap_dist`. -/
theorem swap_hammingDist : swap (@hammingDist _ β _ _) = hammingDist := by
  funext x y
  exact hammingDist_comm _ _
#align swap_hamming_dist swap_hammingDist

/-- Corresponds to `eq_of_dist_eq_zero`. -/
theorem eq_of_hammingDist_eq_zero {x y : ∀ i, β i} : hammingDist x y = 0 → x = y := by
  simp_rw [hammingDist, card_eq_zero, filter_eq_empty_iff, Classical.not_not, funext_iff, mem_univ,
    forall_true_left, imp_self]
#align eq_of_hamming_dist_eq_zero eq_of_hammingDist_eq_zero

/-- Corresponds to `dist_eq_zero`. -/
@[simp]
theorem hammingDist_eq_zero {x y : ∀ i, β i} : hammingDist x y = 0 ↔ x = y :=
  ⟨eq_of_hammingDist_eq_zero, fun H => by
    rw [H]
    exact hammingDist_self _⟩
#align hamming_dist_eq_zero hammingDist_eq_zero

/-- Corresponds to `zero_eq_dist`. -/
@[simp]
theorem hamming_zero_eq_dist {x y : ∀ i, β i} : 0 = hammingDist x y ↔ x = y := by
  rw [eq_comm, hammingDist_eq_zero]
#align hamming_zero_eq_dist hamming_zero_eq_dist

/-- Corresponds to `dist_ne_zero`. -/
theorem hammingDist_ne_zero {x y : ∀ i, β i} : hammingDist x y ≠ 0 ↔ x ≠ y :=
  hammingDist_eq_zero.not
#align hamming_dist_ne_zero hammingDist_ne_zero

/-- Corresponds to `dist_pos`. -/
@[simp]
theorem hammingDist_pos {x y : ∀ i, β i} : 0 < hammingDist x y ↔ x ≠ y := by
  rw [← hammingDist_ne_zero, iff_not_comm, not_lt, le_zero_iff]
#align hamming_dist_pos hammingDist_pos

-- @[simp] -- Porting note: simp can prove this
theorem hammingDist_lt_one {x y : ∀ i, β i} : hammingDist x y < 1 ↔ x = y := by
  rw [Nat.lt_one_iff, hammingDist_eq_zero]
#align hamming_dist_lt_one hammingDist_lt_one

theorem hammingDist_le_card_fintype {x y : ∀ i, β i} : hammingDist x y ≤ Fintype.card ι :=
  card_le_univ _
#align hamming_dist_le_card_fintype hammingDist_le_card_fintype

theorem hammingDist_comp_le_hammingDist (f : ∀ i, γ i → β i) {x y : ∀ i, γ i} :
    (hammingDist (fun i => f i (x i)) fun i => f i (y i)) ≤ hammingDist x y :=
  card_mono (monotone_filter_right _ fun i H1 H2 => H1 <| congr_arg (f i) H2)
#align hamming_dist_comp_le_hamming_dist hammingDist_comp_le_hammingDist

theorem hammingDist_comp (f : ∀ i, γ i → β i) {x y : ∀ i, γ i} (hf : ∀ i, Injective (f i)) :
    (hammingDist (fun i => f i (x i)) fun i => f i (y i)) = hammingDist x y :=
  le_antisymm (hammingDist_comp_le_hammingDist _) <|
    card_mono (monotone_filter_right _ fun i H1 H2 => H1 <| hf i H2)
#align hamming_dist_comp hammingDist_comp

theorem hammingDist_smul_le_hammingDist [∀ i, SMul α (β i)] {k : α} {x y : ∀ i, β i} :
    hammingDist (k • x) (k • y) ≤ hammingDist x y :=
  hammingDist_comp_le_hammingDist fun i => (k • · : β i → β i)
#align hamming_dist_smul_le_hamming_dist hammingDist_smul_le_hammingDist

/-- Corresponds to `dist_smul` with the discrete norm on `α`. -/
theorem hammingDist_smul [∀ i, SMul α (β i)] {k : α} {x y : ∀ i, β i}
    (hk : ∀ i, IsSMulRegular (β i) k) : hammingDist (k • x) (k • y) = hammingDist x y :=
  hammingDist_comp (fun i => (k • · : β i → β i)) hk
#align hamming_dist_smul hammingDist_smul

section Zero

variable [∀ i, Zero (β i)] [∀ i, Zero (γ i)]

/-- The Hamming weight function to the naturals. -/
def hammingNorm (x : ∀ i, β i) : ℕ :=
  (univ.filter (x · ≠ 0)).card
#align hamming_norm hammingNorm

/-- Corresponds to `dist_zero_right`. -/
@[simp]
theorem hammingDist_zero_right (x : ∀ i, β i) : hammingDist x 0 = hammingNorm x :=
  rfl
#align hamming_dist_zero_right hammingDist_zero_right

/-- Corresponds to `dist_zero_left`. -/
@[simp]
theorem hammingDist_zero_left : hammingDist (0 : ∀ i, β i) = hammingNorm :=
  funext fun x => by rw [hammingDist_comm, hammingDist_zero_right]
#align hamming_dist_zero_left hammingDist_zero_left

/-- Corresponds to `norm_nonneg`. -/
-- @[simp] -- Porting note: simp can prove this
theorem hammingNorm_nonneg {x : ∀ i, β i} : 0 ≤ hammingNorm x :=
  zero_le _
#align hamming_norm_nonneg hammingNorm_nonneg

/-- Corresponds to `norm_zero`. -/
@[simp]
theorem hammingNorm_zero : hammingNorm (0 : ∀ i, β i) = 0 :=
  hammingDist_self _
#align hamming_norm_zero hammingNorm_zero

/-- Corresponds to `norm_eq_zero`. -/
@[simp]
theorem hammingNorm_eq_zero {x : ∀ i, β i} : hammingNorm x = 0 ↔ x = 0 :=
  hammingDist_eq_zero
#align hamming_norm_eq_zero hammingNorm_eq_zero

/-- Corresponds to `norm_ne_zero_iff`. -/
theorem hammingNorm_ne_zero_iff {x : ∀ i, β i} : hammingNorm x ≠ 0 ↔ x ≠ 0 :=
  hammingNorm_eq_zero.not
#align hamming_norm_ne_zero_iff hammingNorm_ne_zero_iff

/-- Corresponds to `norm_pos_iff`. -/
@[simp]
theorem hammingNorm_pos_iff {x : ∀ i, β i} : 0 < hammingNorm x ↔ x ≠ 0 :=
  hammingDist_pos
#align hamming_norm_pos_iff hammingNorm_pos_iff

-- @[simp] -- Porting note: simp can prove this
theorem hammingNorm_lt_one {x : ∀ i, β i} : hammingNorm x < 1 ↔ x = 0 :=
  hammingDist_lt_one
#align hamming_norm_lt_one hammingNorm_lt_one

theorem hammingNorm_le_card_fintype {x : ∀ i, β i} : hammingNorm x ≤ Fintype.card ι :=
  hammingDist_le_card_fintype
#align hamming_norm_le_card_fintype hammingNorm_le_card_fintype

theorem hammingNorm_comp_le_hammingNorm (f : ∀ i, γ i → β i) {x : ∀ i, γ i} (hf : ∀ i, f i 0 = 0) :
    (hammingNorm fun i => f i (x i)) ≤ hammingNorm x := by
  simpa only [← hammingDist_zero_right, hf] using hammingDist_comp_le_hammingDist f (y := fun _ ↦ 0)
#align hamming_norm_comp_le_hamming_norm hammingNorm_comp_le_hammingNorm

theorem hammingNorm_comp (f : ∀ i, γ i → β i) {x : ∀ i, γ i} (hf₁ : ∀ i, Injective (f i))
    (hf₂ : ∀ i, f i 0 = 0) : (hammingNorm fun i => f i (x i)) = hammingNorm x := by
  simpa only [← hammingDist_zero_right, hf₂] using hammingDist_comp f hf₁ (y := fun _ ↦ 0)
#align hamming_norm_comp hammingNorm_comp

theorem hammingNorm_smul_le_hammingNorm [Zero α] [∀ i, SMulWithZero α (β i)] {k : α}
    {x : ∀ i, β i} : hammingNorm (k • x) ≤ hammingNorm x :=
  hammingNorm_comp_le_hammingNorm (fun i (c : β i) => k • c) fun i => by simp_rw [smul_zero]
#align hamming_norm_smul_le_hamming_norm hammingNorm_smul_le_hammingNorm

theorem hammingNorm_smul [Zero α] [∀ i, SMulWithZero α (β i)] {k : α}
    (hk : ∀ i, IsSMulRegular (β i) k) (x : ∀ i, β i) : hammingNorm (k • x) = hammingNorm x :=
  hammingNorm_comp (fun i (c : β i) => k • c) hk fun i => by simp_rw [smul_zero]
#align hamming_norm_smul hammingNorm_smul

end Zero

/-- Corresponds to `dist_eq_norm`. -/
theorem hammingDist_eq_hammingNorm [∀ i, AddGroup (β i)] (x y : ∀ i, β i) :
    hammingDist x y = hammingNorm (x - y) := by
  simp_rw [hammingNorm, hammingDist, Pi.sub_apply, sub_ne_zero]
#align hamming_dist_eq_hamming_norm hammingDist_eq_hammingNorm

end HammingDistNorm

/-! ### The `Hamming` type synonym -/

/-- Type synonym for a Pi type which inherits the usual algebraic instances, but is equipped with
the Hamming metric and norm, instead of `Pi.normedAddCommGroup` which uses the sup norm. -/
def Hamming {ι : Type _} (β : ι → Type _) : Type _ :=
  ∀ i, β i
#align hamming Hamming

namespace Hamming

variable {α ι : Type _} {β : ι → Type _}

/-! Instances inherited from normal Pi types. -/

instance [∀ i, Inhabited (β i)] : Inhabited (Hamming β) :=
  ⟨fun _ => default⟩

instance [DecidableEq ι] [Fintype ι] [∀ i, Fintype (β i)] : Fintype (Hamming β) :=
  Pi.fintype

instance [Inhabited ι] [∀ i, Nonempty (β i)] [Nontrivial (β default)] : Nontrivial (Hamming β) :=
  Pi.nontrivial

instance [Fintype ι] [∀ i, DecidableEq (β i)] : DecidableEq (Hamming β) :=
  Fintype.decidablePiFintype

instance [∀ i, Zero (β i)] : Zero (Hamming β) :=
  Pi.instZero

instance [∀ i, Neg (β i)] : Neg (Hamming β) :=
  Pi.instNeg

instance [∀ i, Add (β i)] : Add (Hamming β) :=
  Pi.instAdd

instance [∀ i, Sub (β i)] : Sub (Hamming β) :=
  Pi.instSub

instance [∀ i, SMul α (β i)] : SMul α (Hamming β) :=
  Pi.instSMul

instance [Zero α] [∀ i, Zero (β i)] [∀ i, SMulWithZero α (β i)] : SMulWithZero α (Hamming β) :=
  Pi.smulWithZero _

instance [∀ i, AddMonoid (β i)] : AddMonoid (Hamming β) :=
  Pi.addMonoid

instance [∀ i, AddCommMonoid (β i)] : AddCommMonoid (Hamming β) :=
  Pi.addCommMonoid

instance [∀ i, AddCommGroup (β i)] : AddCommGroup (Hamming β) :=
  Pi.addCommGroup

instance (α) [Semiring α] (β : ι → Type _) [∀ i, AddCommMonoid (β i)] [∀ i, Module α (β i)] :
    Module α (Hamming β) :=
  Pi.module _ _ _

/-! API to/from the type synonym. -/

/-- `Hamming.toHamming` is the identity function to the `Hamming` of a type.  -/
@[match_pattern]
def toHamming : (∀ i, β i) ≃ Hamming β :=
  Equiv.refl _
#align hamming.to_hamming Hamming.toHamming

/-- `Hamming.ofHamming` is the identity function from the `Hamming` of a type.  -/
@[match_pattern]
def ofHamming : Hamming β ≃ ∀ i, β i :=
  Equiv.refl _
#align hamming.of_hamming Hamming.ofHamming

@[simp]
theorem toHamming_symm_eq : (@toHamming _ β).symm = ofHamming :=
  rfl
#align hamming.to_hamming_symm_eq Hamming.toHamming_symm_eq

@[simp]
theorem ofHamming_symm_eq : (@ofHamming _ β).symm = toHamming :=
  rfl
#align hamming.of_hamming_symm_eq Hamming.ofHamming_symm_eq

@[simp]
theorem toHamming_ofHamming (x : Hamming β) : toHamming (ofHamming x) = x :=
  rfl
#align hamming.to_hamming_of_hamming Hamming.toHamming_ofHamming

@[simp]
theorem ofHamming_toHamming (x : ∀ i, β i) : ofHamming (toHamming x) = x :=
  rfl
#align hamming.of_hamming_to_hamming Hamming.ofHamming_toHamming

--@[simp] --Porting note: removing `simp`, `simp` can prove it and `dsimp` cannot use `Iff.rfl`
theorem toHamming_inj {x y : ∀ i, β i} : toHamming x = toHamming y ↔ x = y :=
  Iff.rfl
#align hamming.to_hamming_inj Hamming.toHamming_inj

--@[simp] --Porting note: removing `simp`, `simp` can prove it and `dsimp` cannot use `Iff.rfl`
theorem ofHamming_inj {x y : Hamming β} : ofHamming x = ofHamming y ↔ x = y :=
  Iff.rfl
#align hamming.of_hamming_inj Hamming.ofHamming_inj

@[simp]
theorem toHamming_zero [∀ i, Zero (β i)] : toHamming (0 : ∀ i, β i) = 0 :=
  rfl
#align hamming.to_hamming_zero Hamming.toHamming_zero

@[simp]
theorem ofHamming_zero [∀ i, Zero (β i)] : ofHamming (0 : Hamming β) = 0 :=
  rfl
#align hamming.of_hamming_zero Hamming.ofHamming_zero

@[simp]
theorem toHamming_neg [∀ i, Neg (β i)] {x : ∀ i, β i} : toHamming (-x) = -toHamming x :=
  rfl
#align hamming.to_hamming_neg Hamming.toHamming_neg

@[simp]
theorem ofHamming_neg [∀ i, Neg (β i)] {x : Hamming β} : ofHamming (-x) = -ofHamming x :=
  rfl
#align hamming.of_hamming_neg Hamming.ofHamming_neg

@[simp]
theorem toHamming_add [∀ i, Add (β i)] {x y : ∀ i, β i} :
    toHamming (x + y) = toHamming x + toHamming y :=
  rfl
#align hamming.to_hamming_add Hamming.toHamming_add

@[simp]
theorem ofHamming_add [∀ i, Add (β i)] {x y : Hamming β} :
    ofHamming (x + y) = ofHamming x + ofHamming y :=
  rfl
#align hamming.of_hamming_add Hamming.ofHamming_add

@[simp]
theorem toHamming_sub [∀ i, Sub (β i)] {x y : ∀ i, β i} :
    toHamming (x - y) = toHamming x - toHamming y :=
  rfl
#align hamming.to_hamming_sub Hamming.toHamming_sub

@[simp]
theorem ofHamming_sub [∀ i, Sub (β i)] {x y : Hamming β} :
    ofHamming (x - y) = ofHamming x - ofHamming y :=
  rfl
#align hamming.of_hamming_sub Hamming.ofHamming_sub

@[simp]
theorem toHamming_smul [∀ i, SMul α (β i)] {r : α} {x : ∀ i, β i} :
    toHamming (r • x) = r • toHamming x :=
  rfl
#align hamming.to_hamming_smul Hamming.toHamming_smul

@[simp]
theorem ofHamming_smul [∀ i, SMul α (β i)] {r : α} {x : Hamming β} :
    ofHamming (r • x) = r • ofHamming x :=
  rfl
#align hamming.of_hamming_smul Hamming.ofHamming_smul

section

/-! Instances equipping `Hamming` with `hammingNorm` and `hammingDist`. -/

variable [Fintype ι] [∀ i, DecidableEq (β i)]

instance : Dist (Hamming β) :=
  ⟨fun x y => hammingDist (ofHamming x) (ofHamming y)⟩

@[simp, push_cast]
theorem dist_eq_hammingDist (x y : Hamming β) :
    dist x y = hammingDist (ofHamming x) (ofHamming y) :=
  rfl
#align hamming.dist_eq_hamming_dist Hamming.dist_eq_hammingDist

instance : PseudoMetricSpace (Hamming β) where
  dist_self := by
    push_cast
    exact_mod_cast hammingDist_self
  dist_comm := by
    push_cast
    exact_mod_cast hammingDist_comm
  dist_triangle := by
    push_cast
    exact_mod_cast hammingDist_triangle
  edist_dist _ _ := by exact ENNReal.coe_nnreal_eq _
  toUniformSpace := ⊥
  uniformity_dist := uniformity_dist_of_mem_uniformity _ _ fun s => by
    push_cast
    constructor
    · refine' fun hs => ⟨1, zero_lt_one, fun hab => _⟩
      rw_mod_cast [hammingDist_lt_one]  at hab
      rw [ofHamming_inj, ← mem_idRel] at hab
      exact hs hab
    · rintro ⟨_, hε, hs⟩ ⟨_, _⟩ hab
      rw [mem_idRel] at hab
      rw [hab]
      refine' hs (lt_of_eq_of_lt _ hε)
      exact_mod_cast hammingDist_self _
  toBornology := ⟨⊥, bot_le⟩
  cobounded_sets := by
    ext
    push_cast
    refine' iff_of_true (Filter.mem_sets.mpr Filter.mem_bot) ⟨Fintype.card ι, fun _ _ _ _ => _⟩
    exact_mod_cast hammingDist_le_card_fintype

@[simp, push_cast]
theorem nndist_eq_hammingDist (x y : Hamming β) :
    nndist x y = hammingDist (ofHamming x) (ofHamming y) :=
  rfl
#align hamming.nndist_eq_hamming_dist Hamming.nndist_eq_hammingDist

-- porting note: new
instance : DiscreteTopology (Hamming β) := ⟨rfl⟩

instance : MetricSpace (Hamming β) := .ofT0PseudoMetricSpace _

instance [∀ i, Zero (β i)] : Norm (Hamming β) :=
  ⟨fun x => hammingNorm (ofHamming x)⟩

@[simp, push_cast]
theorem norm_eq_hammingNorm [∀ i, Zero (β i)] (x : Hamming β) : ‖x‖ = hammingNorm (ofHamming x) :=
  rfl
#align hamming.norm_eq_hamming_norm Hamming.norm_eq_hammingNorm

-- porting note: merged `SeminormedAddCommGroup` and `NormedAddCommGroup` instances

instance [∀ i, AddCommGroup (β i)] : NormedAddCommGroup (Hamming β) where
  dist_eq := by push_cast; exact_mod_cast hammingDist_eq_hammingNorm

@[simp, push_cast]
theorem nnnorm_eq_hammingNorm [∀ i, AddCommGroup (β i)] (x : Hamming β) :
    ‖x‖₊ = hammingNorm (ofHamming x) :=
  rfl
#align hamming.nnnorm_eq_hamming_norm Hamming.nnnorm_eq_hammingNorm

end

end Hamming


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.convex.star
import topology.homotopy.contractible

/-!
# A convex set is contractible

In this file we prove that a (star) convex set in a real topological vector space is a contractible
topological space.
-/

variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E]
  [has_continuous_add E] [has_continuous_smul ℝ E] {s : set E} {x : E}

/-- A non-empty star convex set is a contractible space. -/
protected lemma star_convex.contractible_space (h : star_convex ℝ x s) (hne : s.nonempty) :
  contractible_space s :=
begin
  refine (contractible_iff_id_nullhomotopic _).2 ⟨⟨x, h.mem hne⟩,
    ⟨⟨⟨λ p, ⟨p.1.1 • x + (1 - p.1.1) • p.2, _⟩, _⟩, λ x, _, λ x, _⟩⟩⟩,
  { exact h p.2.2 p.1.2.1 (sub_nonneg.2 p.1.2.2) (add_sub_cancel'_right _ _) },
  { exact continuous_subtype_mk _
      (((continuous_subtype_val.comp continuous_fst).smul continuous_const).add
        ((continuous_const.sub $ continuous_subtype_val.comp continuous_fst).smul
          (continuous_subtype_val.comp continuous_snd))) },
  { ext1, simp },
  { ext1, simp }
end

/-- A non-empty convex set is a contractible space. -/
protected lemma convex.contractible_space (hs : convex ℝ s) (hne : s.nonempty) :
  contractible_space s :=
let ⟨x, hx⟩ := hne in (hs.star_convex hx).contractible_space hne

@[priority 100] instance real_topological_vector_space.contractible_space : contractible_space E :=
(homeomorph.set.univ E).contractible_space_iff.mp $ convex_univ.contractible_space set.univ_nonempty


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/
import analysis.locally_convex.basic
import topology.bornology.basic

/-!
# Von Neumann Boundedness

This file defines natural or von Neumann bounded sets and proves elementary properties.

## Main declarations

* `bornology.is_vonN_bounded`: A set `s` is von Neumann-bounded if every neighborhood of zero
absorbs `s`.
* `bornology.vonN_bornology`: The bornology made of the von Neumann-bounded sets.

## Main results

* `bornology.is_vonN_bounded_of_topological_space_le`: A coarser topology admits more
von Neumann-bounded sets.

## References

* [Bourbaki, *Topological Vector Spaces*][bourbaki1987]

-/

variables {𝕜 E ι : Type*}

open_locale topological_space pointwise

namespace bornology

section semi_normed_ring

section has_zero

variables (𝕜)
variables [semi_normed_ring 𝕜] [has_scalar 𝕜 E] [has_zero E]
variables [topological_space E]

/-- A set `s` is von Neumann bounded if every neighborhood of 0 absorbs `s`. -/
def is_vonN_bounded (s : set E) : Prop := ∀ ⦃V⦄, V ∈ 𝓝 (0 : E) → absorbs 𝕜 V s

variables (E)

@[simp] lemma is_vonN_bounded_empty : is_vonN_bounded 𝕜 (∅ : set E) :=
λ _ _, absorbs_empty

variables {𝕜 E}

lemma is_vonN_bounded_iff (s : set E) : is_vonN_bounded 𝕜 s ↔ ∀ V ∈ 𝓝 (0 : E), absorbs 𝕜 V s :=
iff.rfl

lemma _root_.filter.has_basis.is_vonN_bounded_basis_iff {q : ι → Prop} {s : ι → set E} {A : set E}
  (h : (𝓝 (0 : E)).has_basis q s) :
  is_vonN_bounded 𝕜 A ↔ ∀ i (hi : q i), absorbs 𝕜 (s i) A :=
begin
  refine ⟨λ hA i hi, hA (h.mem_of_mem hi), λ hA V hV, _⟩,
  rcases h.mem_iff.mp hV with ⟨i, hi, hV⟩,
  exact (hA i hi).mono_left hV,
end

/-- Subsets of bounded sets are bounded. -/
lemma is_vonN_bounded.subset {s₁ s₂ : set E} (h : s₁ ⊆ s₂) (hs₂ : is_vonN_bounded 𝕜 s₂) :
  is_vonN_bounded 𝕜 s₁ :=
λ V hV, (hs₂ hV).mono_right h

/-- The union of two bounded sets is bounded. -/

end has_zero

end semi_normed_ring

section multiple_topologies

variables [semi_normed_ring 𝕜] [add_comm_group E] [module 𝕜 E]

/-- If a topology `t'` is coarser than `t`, then any set `s` that is bounded with respect to
`t` is bounded with respect to `t'`. -/
lemma is_vonN_bounded.of_topological_space_le {t t' : topological_space E} (h : t ≤ t') {s : set E}
  (hs : @is_vonN_bounded 𝕜 E _ _ _ t s) : @is_vonN_bounded 𝕜 E _ _ _ t' s :=
λ V hV, hs $ (le_iff_nhds t t').mp h 0 hV

end multiple_topologies

section normed_field

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]
variables [topological_space E] [has_continuous_smul 𝕜 E]

/-- Singletons are bounded. -/
lemma is_vonN_bounded_singleton (x : E) : is_vonN_bounded 𝕜 ({x} : set E) :=
λ V hV, (absorbent_nhds_zero hV).absorbs

/-- The union of all bounded set is the whole space. -/
lemma is_vonN_bounded_covers : ⋃₀ (set_of (is_vonN_bounded 𝕜)) = (set.univ : set E) :=
set.eq_univ_iff_forall.mpr (λ x, set.mem_sUnion.mpr
  ⟨{x}, is_vonN_bounded_singleton _, set.mem_singleton _⟩)

variables (𝕜 E)

/-- The von Neumann bornology defined by the von Neumann bounded sets.

Note that this is not registered as an instance, in order to avoid diamonds with the
metric bornology.-/
@[reducible] -- See note [reducible non-instances]
def vonN_bornology : bornology E :=
bornology.of_bounded (set_of (is_vonN_bounded 𝕜)) (is_vonN_bounded_empty 𝕜 E)
  (λ _ hs _ ht, hs.subset ht) (λ _ hs _, hs.union) is_vonN_bounded_singleton

variables {E}

@[simp] lemma is_bounded_iff_is_vonN_bounded {s : set E} :
  @is_bounded _ (vonN_bornology 𝕜 E) s ↔ is_vonN_bounded 𝕜 s :=
is_bounded_of_bounded_iff _

end normed_field

end bornology


import .love02_backward_proofs_demo

/-! # LoVe Exercise 2: Backward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

Hint: Some strategies for carrying out such proofs are described at the end of
Section 2.3 in the Hitchhiker's Guide. -/

lemma I (a : Prop) :
  a → a :=
sorry

lemma K (a b : Prop) :
  a → b → b :=
sorry

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
sorry

lemma proj_1st (a : Prop) :
  a → a → a :=
sorry

/-! Please give a different answer than for `proj_1st`: -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
sorry

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
sorry

/-! 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
sorry

/-! 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

Hint: This exercise is tricky, especially the right-to-left direction. Some
forward reasoning, like in the proof of `and_swap₂` in the lecture, might be
necessary. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
sorry

/-! ## Question 2: Natural Numbers

2.1. Prove the following recursive equations on the first argument of the
`mul` operator defined in lecture 1. -/

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
sorry

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
sorry

/-! 2.2. Prove commutativity and associativity of multiplication using the
`induction'` tactic. Choose the induction variable carefully. -/

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

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

/-! 2.3. Prove the symmetric variant of `mul_add` using `rw`. To apply
commutativity at a specific position, instantiate the rule by passing some
arguments (e.g., `mul_comm _ l`). -/

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

/-! ## Question 3 (**optional**): Intuitionistic Logic

Intuitionistic logic is extended to classical logic by assuming a classical
axiom. There are several possibilities for the choice of axiom. In this
question, we are concerned with the logical equivalence of three different
axioms: -/

def excluded_middle : Prop :=
∀a : Prop, a ∨ ¬ a

def peirce : Prop :=
∀a b : Prop, ((a → b) → a) → a

def double_negation : Prop :=
∀a : Prop, (¬¬ a) → a

/-! For the proofs below, please avoid using lemmas from Lean's `classical`
namespace, as this would defeat the purpose of the exercise.

3.1 (**optional**). Prove the following implication using tactics.

Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
sorry

/-! 3.2 (**optional**). Prove the following implication using tactics. -/

lemma dn_of_peirce :
  peirce → double_negation :=
sorry

/-! We leave the remaining implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


-- Section 3.1: Propositions as Types
namespace s31
    constant and : Prop → Prop → Prop
    constant or : Prop → Prop → Prop
    constant not : Prop → Prop
    constant implies : Prop → Prop → Prop

    variables p q r A B: Prop
    #check and p q                      -- Prop
    #check or (and p q) r               -- Prop
    #check implies (and p q) (and q p)  -- Prop

    constant Proof : Prop → Type

    constant and_comm : Π p q : Prop,
    Proof (implies (and p q) (and q p))

    #check and_comm p q      -- Proof (implies (and p q) (and q p))

    constant modus_ponens :
    Π p q : Prop, Proof (implies p q) →  Proof p → Proof q

    constant implies_intro :
    Π p q : Prop, (Proof p → Proof q) → Proof (implies p q).

end s31

-- Section 3.2: Working with P. as T.
namespace s32

    constants p q r s: Prop
    -- Similar to 'def' but for Prop, not Type
    theorem t1_ : p → q → p := λ hp : p, λ hq : q, hp
    #print t1_

    -- Written with other syntax for readability
    theorem t1' : p → q → p :=
    assume hp : p,
    assume hq : q,
    show p, from hp

    -- Can also say "lemma" instead of theorem
    lemma t1'' : p → q → p := λ hp : p, λ hq : q, hp

    -- Can also move arguments to left of colon, like with defs
    lemma t1'''  (hp : p) (hq : q):  p := hp

    axiom hp : p -- same as constant

    theorem t2' : q → p := t1' hp
    #print t2'

    -- Want our theorem to be true for any p q, not just those particular constants

    theorem t1 (p q : Prop) (hp : p) (hq : q) : p := hp
    -- Apply to other constants
    #check t1 p q                -- p → q → p
    #check t1 r s                -- r → s → r
    #check t1 (r → s) (s → r)    -- (r → s) → (s → r) → r → s

    variable h : r → s
    #check t1 (r → s) (s → r) h  -- (s → r) → r → s

    -- Function composition says that "implies" is transitive
    theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r :=
    assume h₃ : p,
    show r, from h₁ (h₂ h₃)

end s32

-- Section 3.3: Propositional logic
namespace s33
    variables p q r : Prop

    #check p → q → p ∧ q
    #check ¬p → p ↔ false
    #check p ∨ q → q ∨ p

    -- Conjunction
    --------------

    -- 'example' states a theorem without naming/storing it. Essentially is just a typecheck
    example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

    #check assume (hp : p) (hq : q), and.intro hp hq

    example (h : p ∧ q) : p := and.elim_left h
    example (h : p ∧ q) : q := and.elim_right h

    -- Common abbreviation for elim_left/right
    example (h : p ∧ q) : q ∧ p :=
    and.intro (and.right h) (and.left h)

    -- Anonymous constructor

    variables  (hp : p) (hq : q)
    #check (⟨hp, hq⟩ : p ∧ q)
    example : p ∧ q := (|hp, hq|) -- ascii version

    -- Dot syntax
    variable l : list ℕ

    #check list.head l
    #check l.head -- equivalent, easier to write

    -- Dot syntax for propositions
    example (h : p ∧ q) : q ∧ p :=
    ⟨h.right, h.left⟩

    -- Disjunction
    --------------
    --intro
    example (hp : p) : p ∨ q := or.intro_left q hp
    example (hq : q) : p ∨ q := or.intro_right p hq
    --elim
    example (h : p ∨ q) : q ∨ p :=
    or.elim h
    (λ hp : p,
        show q ∨ p, from or.intro_right q hp)
    (assume hq : q,
        show q ∨ p, from or.intro_left p hq)

    -- intro
    example (h : p ∨ q) : q ∨ p :=
    or.elim h (λ hp, or.inr hp) (λ hq, or.inl hq)

    -- or has two constructors,so can't use anonymous constructor
    -- still write h.elim instead of or.elim h:
    example (h : p ∨ q) : q ∨ p :=
    h.elim
    (assume hp : p, or.inr hp)
    (assume hq : q, or.inl hq)

    -- Negation/falsity
    example (hpq : p → q) (hnq : ¬q) : ¬p :=
    assume hp : p,
    show false, from hnq (hpq hp)
    -- explosion (q is implicit argument in false.elim)
    example (hp : p) (hnp : ¬p) : q := false.elim (hnp hp)
    -- Shorthand for explosion
    example (hp : p) (hnp : ¬p) : q := absurd hp hnp

    -- proof of ¬p → q → (q → p) → r:

    example (hnp : ¬p) (hq : q) (hqp : q → p) : r :=
    absurd (hqp hq) hnp

    -- Logical equivalence
    -----------------------
    theorem and_swap : p ∧ q ↔ q ∧ p :=
    iff.intro
    (assume h : p ∧ q,
        show q ∧ p, from and.intro (and.right h) (and.left h))
    (assume h : q ∧ p,
        show p ∧ q, from and.intro (and.right h) (and.left h))

    #check and_swap p q    -- p ∧ q ↔ q ∧ p

    -- Modus ponens
    variable h : p ∧ q
    example : q ∧ p := iff.mp (and_swap p q) h

end s33

-- Section 3.4: Auxiliary Subgoals
namespace s34
    variables p q : Prop

    example (h : p ∧ q) : q ∧ p :=
    have hp : p, from and.left h,
    have hq : q, from and.right h,
    show q ∧ p, from and.intro hq hp

    -- suffices for backwards reasoning from a goal
    example (h : p ∧ q) : q ∧ p :=
    have hp : p, from and.left h,
    suffices hq : q, from and.intro hq hp,
    show q, from and.right h
    -- suffices hq : q leaves us with two goals.
    --- show that it indeed suffices to show q, by proving the original goal of q ∧ p with the additional hypothesis hq : q.
    --- show q.

end s34

-- Section 3.5: Classical logic
namespace s35
    open classical
    -- Excluded middle
    variables p q : Prop
    #check em p
    -- Double negation as consequence
    theorem dne {p : Prop} (h : ¬¬p) : p :=
    or.elim (em p)
    (assume hp : p, hp)
    (assume hnp : ¬p, absurd hnp h)
    -- This allows us to construct proofs by contradiction
    example (h : ¬¬p) : p :=
    by_cases
    (assume h1 : p, h1)
    (assume h1 : ¬p, absurd h1 h)
    example (h : ¬¬p) : p :=
    by_contradiction
    (assume h1 : ¬p,
        show false, from h h1)

    example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
    or.elim (em p)
    (assume hp : p,
        or.inr
        (show ¬q, from
            assume hq : q,
            h ⟨hp, hq⟩))
    (assume hp : ¬p,
        or.inl hp)

end s35

-- Section 3.6: Examples of propositional validities
namespace s36
    open classical
    -- We can use sorry or an underscore to allow us to incrementally build up a proof (with warnings, not errors) to make sure the large structure is correct before tackling subgoals.
    variables p q r : Prop

    -- distributivity
    example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    iff.intro
    (assume h : p ∧ (q ∨ r),
        have hp : p, from h.left,
        or.elim (h.right)
        (assume hq : q,
            show (p ∧ q) ∨ (p ∧ r), from or.inl ⟨hp, hq⟩)
        (assume hr : r,
            show (p ∧ q) ∨ (p ∧ r), from or.inr ⟨hp, hr⟩))
    (assume h : (p ∧ q) ∨ (p ∧ r),
        or.elim h
        (assume hpq : p ∧ q,
            have hp : p, from hpq.left,
            have hq : q, from hpq.right,
            show p ∧ (q ∨ r), from ⟨hp, or.inl hq⟩)
        (assume hpr : p ∧ r,
            have hp : p, from hpr.left,
            have hr : r, from hpr.right,
            show p ∧ (q ∨ r), from ⟨hp, or.inr hr⟩))

    -- an example that requires classical reasoning
    example : ¬(p ∧ ¬q) → (p → q) :=
    assume h : ¬(p ∧ ¬q),
    assume hp : p,
    show q, from
    or.elim (em q)
        (assume hq : q, hq)
        (assume hnq : ¬q, absurd (and.intro hp hnq) h)

end s36

-- Exercises
namespace s3x
-- 1

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := iff.intro
    (λ hpq, and.intro hpq.right hpq.left)
    (λ hpq, and.intro hpq.right hpq.left)

example : p ∨ q ↔ q ∨ p := iff.intro
    (λ hporq, or.elim hporq
        (assume hp: p, or.inr hp)
        (assume hq: q, or.inl hq))
    (λ hqorp, or.elim hqorp
        (assume hq: q, or.inr hq)
        (assume hp: p, or.inl hp))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := iff.intro
    (assume hpq_r : (p ∧ q) ∧ r,
        and.intro hpq_r.left.left (and.intro hpq_r.left.right hpq_r.right))
    (assume hp_qr : p ∧ (q ∧ r),
        and.intro (and.intro hp_qr.left hp_qr.right.left) hp_qr.right.right)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := iff.intro
    (assume hpq_r : (p ∨ q) ∨ r, or.elim hpq_r
        (assume hpq: (p ∨ q), or.elim hpq
            (assume hp : p, (or.inl hp))
            (assume hq : q, or.inr (or.inl hq)))
        (assume hr : r, or.inr (or.inr hr)))
    (assume hp_qr : p ∨ (q ∨ r), or.elim hp_qr
        (assume hp : p, or.inl (or.inl hp))
        (assume hqr: (q ∨ r), or.elim hqr
            (assume hq : q, or.inl (or.inr hq))
            (assume hr : r, or.inr hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := iff.intro
(assume hpqr : p ∧ (q ∨ r),
    have hp:p, from and.left hpqr,
        show (p ∧ q) ∨ (p ∧ r), from or.elim
            (and.right hpqr)
            (assume hq : q, or.inl (and.intro hp hq))
            (assume hr : r, or.inr (and.intro hp hr)))
(assume hpqpr : (p ∧ q) ∨ (p ∧ r), or.elim hpqpr
    (assume hpq : p ∧ q, and.intro
        hpq.left
        (or.inl hpq.right))
    (assume hpr : p ∧ r, and.intro
        hpr.left
        (or.inr hpr.right)))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := iff.intro
(assume hpqr : p ∨ (q ∧ r), or.elim hpqr
    (assume hp : p, and.intro
        (or.inl hp)
        (or.inl hp))
    (assume hqr : q ∧ r, and.intro
        (or.inr hqr.left)
        (or.inr hqr.right)))
(assume hpqpr: (p ∨ q) ∧ (p ∨ r),
    show p ∨ (q ∧ r), from or.elim hpqpr.left
    (assume hp: p, or.inl hp)
    (assume hq: q,
        or.elim hpqpr.right
        (assume hp: p, or.inl hp)
        (assume hr: r, or.inr (and.intro hq hr))))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := iff.intro
(assume hpqr : p → (q → r),
    (assume hpr : p ∧ q, hpqr hpr.left hpr.right))
(assume hpqr : p ∧ q → r,
    (assume hp : p,
        (assume hq : q,
            have hpq : p ∧ q, from and.intro hp hq,
            hpqr hpq)))

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := iff.intro
(assume hpqr : (p ∨ q) → r,
    have hpr : p → r, from
        (assume hp: p, hpqr (or.inl hp)),
    have hqr : q → r, from
        (assume hq : q, hpqr (or.inr hq)),
    and.intro hpr hqr)
(assume hprqr : (p → r) ∧ (q → r),
    (assume hpq : p ∨ q, or.elim hpq
     (assume hp: p, hprqr.left hp)
     (assume hq: q, hprqr.right hq)))

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := iff.intro
(assume hnpq : ¬(p ∨ q),
    have hnp: ¬p, from
        (assume hp: p, hnpq (or.inl hp)),
    have hnq: ¬q, from
        (assume hq: q, hnpq (or.inr hq)),
    and.intro hnp hnq)
(assume hnpnq : ¬p ∧ ¬q,
    (assume hpq : p ∨ q, or.elim hpq
        (assume hp :p, hnpnq.left hp)
        (assume hq: q, hnpnq.right hq)))

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    (assume hnpnq : ¬p ∨ ¬q,
        (assume hpq : p ∧ q, or.elim hnpnq
            (assume hnp :¬p, hnp hpq.left)
            (assume hnq :¬q, hnq hpq.right)))

example : ¬(p ∧ ¬p) :=
    (assume hpnp: p ∧ ¬p, hpnp.right hpnp.left)

example : p ∧ ¬q → ¬(p → q) :=
    assume hpnq : p ∧ ¬q,
        assume hpq : p → q,
            have hp : p, from hpnq.left,
            have hq : q, from hpq hp,
            have hnq : ¬ q, from hpnq.right,
            hnq hq

example : ¬p → (p → q) :=
    assume hnp : ¬p,
    assume hp : p,
    absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
    assume hnpq : ¬p ∨ q,
        assume hp : p,
        or.elim hnpq
            (assume hnp : ¬p, absurd hp hnp)
            id

example : p ∨ false ↔ p := iff.intro
(assume hpf : p ∨ false, or.elim hpf
    (assume hp : p, hp)
    (assume f: false,
    false.elim f))
(assume hp : p, or.inl hp)

example : p ∧ false ↔ false := iff.intro
(assume hpf: p ∧ false, hpf.right)
(assume hf : false, false.elim hf)

example : (p → q) → (¬q → ¬p) :=
    assume hpq : p → q,
    assume hnq : ¬q,
    assume hp : p,
    absurd (hpq hp) hnq

-- 3

--2 (use classical reasoning)
open classical

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
    assume hprs: p → r ∨ s,
    have hpnp : p ∨ ¬ p, from em p,
    or.elim hpnp
    (assume hp : p,
        have hrs : r ∨ s, from hprs hp,
        or.elim hrs
        (assume hr : r, or.inl (assume _ : p, hr))
        (assume hs: s, or.inr (assume _ : p, hs)))
    (assume hnp : ¬ p, or.inl
        (assume hp : p, absurd hp hnp))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    assume hnpq : ¬(p ∧ q) ,
    have emp : p ∨ ¬p , from em p ,
    or.elim emp
    (assume hp : p,
        have emq : q ∨ ¬q , from em q ,
        or.elim emq
        (assume hq : q, absurd (and.intro hp hq) hnpq)
        (assume hnq : ¬q, or.inr hnq))
    (assume hnp : ¬p, or.inl hnp)

example : ¬(p → q) → p ∧ ¬q :=
    assume h : ¬(p → q),
    have emp : p ∨ ¬p , from em p ,
    or.elim emp
        (assume hp : p,
            have emq : q ∨ ¬q , from em q ,
            or.elim emq
                (assume hq : q,
                    have imp: p → q, from (λ x: p, hq ),
                    absurd imp h)
                (assume hnq : ¬q, and.intro hp hnq))
        (assume hnp : ¬p,
            have imp : p → q, from (λ x: p, absurd x hnp),
            absurd imp h)

example : (p → q) → (¬p ∨ q) :=
    assume hpq : p → q,
    have emp : p ∨ ¬p , from em p ,
    or.elim emp
    (assume hp : p, or.inr (hpq hp))
    (assume hnp : ¬p, or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
    assume hnqnp : ¬q → ¬p,
    assume hp: p,
    have emq : q ∨ ¬q , from em q ,
    or.elim emq
    id
    (assume hnq : ¬q, absurd hp (hnqnp hnq))

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
    assume hpqp : (p → q) → p,
    have hem : p ∨ ¬p, from em p,
    or.elim hem
        (assume hp: p, id hp)
        (assume hnp: ¬p,
            absurd
            (have hpq: p → q, from
                (assume hp: p, absurd hp hnp),
            hpqp hpq)
            hnp)

end s3x