import data.zmod.parity
import number_theory.pythagorean_triples

import number_theory.quadratic_reciprocity

/-
Authors: Lisa Cenek, Brittany Gelb
-/

/-
Several useful elementary properties of primitive pythagorean triples follow nicely from the
classification theorem.

We formalize some of those properties, starting with divisibility by 3 and 4.
-/

open pythagorean_triple

/-
If x,y,z is a primitive pythagorean triple, then exactly one of x,y is 0 mod 4.
-/
theorem pythagorean_triple_exactly_one_div_four {x y z : ℤ} (h : pythagorean_triple x y z)
  (h_coprime : int.gcd x y = 1):
  ((x % 4 = 0) ∧ (y % 4 ≠ 0)) ∨ ((x % 4 ≠ 0) ∧ (y % 4 = 0))  :=
begin
  have k : pythagorean_triple x y z ∧ int.gcd x y = 1,
  split,
  exact h,
  exact h_coprime,
  rw coprime_classification at k,
  cases k with m km,
  cases km with n kmn,

  cases kmn with k1 k2,
  cases k2 with k2 k3,
  cases k3 with k3 k4,
  cases k4 with k4 k5,
  {
    cases k1 with y_even x_even,
    {
      right,
      cases y_even with x_odd y_even,
      cases k4 with k4m k4n,
      have eq1 := int.mod_add_div m 2,
      rw k4m at eq1,
      rw zero_add at eq1,
      rw ← eq1 at y_even,
      rw ← mul_assoc 2 2 (m / 2) at y_even,
      have two_mul_two : (2 : ℤ ) * 2 = 4 := by norm_num,
      rw two_mul_two at y_even,
      norm_num,
      rw mul_assoc at y_even,
      have four_div_y := dvd.intro (m / 2 * n) (eq.symm y_even),
      refine ⟨_, four_div_y⟩,
      rw ← imp_false,
      intro j,
      have four_div_one := int.dvd_gcd j four_div_y,
      rw h_coprime at four_div_one,
      norm_num at four_div_one,
    },
    {
      left,
      cases x_even with x_even y_odd,
      cases k4 with k4m k4n,
      have eq1 := int.mod_add_div m 2,
      rw k4m at eq1,
      rw zero_add at eq1,
      rw ← eq1 at x_even,
      rw ← mul_assoc 2 2 (m / 2) at x_even,
      have two_mul_two : (2 : ℤ ) * 2 = 4 := by norm_num,
      rw two_mul_two at x_even,
      norm_num,
      rw mul_assoc at x_even,
      have four_div_x := dvd.intro (m / 2 * n) (eq.symm x_even),
      refine ⟨four_div_x, _⟩,
      rw ← imp_false,
      intro j,
      have four_div_one := int.dvd_gcd four_div_x j,
      rw h_coprime at four_div_one,
      norm_num at four_div_one,
    }

  },

{
    cases k1 with y_even x_even,
    {
      right,
      cases y_even with x_odd y_even,
      cases k5 with k5m k5n,

      have eq1 := int.mod_add_div n 2,
      rw k5n at eq1,
      rw zero_add at eq1,
      rw mul_assoc at y_even,
      rw mul_comm m n at y_even,
      rw ← mul_assoc at y_even,

      rw ← eq1 at y_even,

      rw ← mul_assoc 2 2 (n / 2) at y_even,

      have two_mul_two : (2 : ℤ ) * 2 = 4 := by norm_num,

      rw two_mul_two at y_even,

      norm_num,
      rw mul_assoc at y_even,
      have four_div_y := dvd.intro (n / 2 * m) (eq.symm y_even),

      refine ⟨_, four_div_y⟩,
      rw ← imp_false,
      intro j,

      have four_div_one := int.dvd_gcd j four_div_y,
      rw h_coprime at four_div_one,
      norm_num at four_div_one,

    },
    {
      left,
      cases x_even with x_even y_odd,
      cases k5 with k5m k5n,

      have eq1 := int.mod_add_div n 2,
      rw k5n at eq1,
      rw zero_add at eq1,
      rw mul_assoc at x_even,
      rw mul_comm m n at x_even,
      rw ← mul_assoc at x_even,
      rw ← eq1 at x_even,
      rw ← mul_assoc 2 2 (n / 2) at x_even,
      have two_mul_two : (2 : ℤ ) * 2 = 4 := by norm_num,
      rw two_mul_two at x_even,

      norm_num,
      rw mul_assoc at x_even,
      have four_div_x := dvd.intro (n / 2 * m) (eq.symm x_even),

      refine ⟨four_div_x, _⟩,
      rw ← imp_false,
      intro j,

      have four_div_one := int.dvd_gcd four_div_x j,
      rw h_coprime at four_div_one,
      norm_num at four_div_one,
    }

  }

end

/-
Lemma to obtain possible values modulo 3.
(Modeled from data.nat.parity)
-/
lemma mod_three_eq_zero_or_one_or_two (n : ℤ) : n % 3 = 0 ∨ n % 3 = 1 ∨ n % 3 = 2 :=
have h : n % 3 < 3 := abs_of_nonneg (show 0 ≤ (3 : ℤ), from dec_trivial) ▸ int.mod_lt _ dec_trivial,
have h₁ : 0 ≤ n % 3 := int.mod_nonneg _ dec_trivial,
match (n % 3), h, h₁ with
| (0 : ℕ) := λ _ _ , or.inl rfl
| (1 : ℕ) := λ _ _ , or.inr (or.inl rfl)
| (2 : ℕ) := λ _ _ , or.inr (or.inr rfl)
| (k + 3 : ℕ) := λ h _, absurd h dec_trivial
| -[1+ a] := λ _ h₁, absurd h₁ dec_trivial
end

/-
If x,y,z is a primitive pythagorean triple, then exactly one of x,y is 0 mod 3.
-/
theorem pythagorean_triple_exactly_one_div_three {x y z : ℤ} (h : pythagorean_triple x y z)
  (h_coprime : int.gcd x y = 1):
  ((x % 3 = 0) ∧ (y % 3 ≠ 0)) ∨ ((x % 3 ≠ 0) ∧ (y % 3 = 0))  :=
begin
  by_contradiction H,
  rw push_neg.not_or_eq at H,
  cases H with h1 h2,
  rw push_neg.not_and_eq at h1,
  rw push_neg.not_and_eq at h2,
  rw push_neg.not_not_eq at h1,

  by_cases j : (x % 3 = 0),
  {
    have j' := h1 j,
    simp at h1 j j',
    have three_div_one := int.dvd_gcd j j',
    rw h_coprime at three_div_one,
    norm_num at three_div_one,
  },
  {
  have j' := h2 j,

  have xlem := mod_three_eq_zero_or_one_or_two x,
  have ylem := mod_three_eq_zero_or_one_or_two y,

  have xlem' := or.resolve_left xlem j,
  have ylem' := or.resolve_left ylem j',

  have pyth_mod : (x * x + y * y) % 3 = (x * x + y * y) % 3 := by refl,
  have xyz : x * x + y * y = z * z := h,

  have pyth_mod' : (x*x + y*y) % 3 = (z*z) % 3 := by {
    calc (x*x + y*y) % 3 = (x*x + y*y) % 3 : by refl
                  ...= (z*z) % 3 : by rw xyz,
        },

  cases xlem' with x1 x2,
  {
    cases ylem' with y1 y2,
    {
      have x_sq := int.mul_mod x x 3,
      rw x1 at x_sq,
      have y_sq := int.mul_mod y y 3,
      rw y1 at y_sq,
      norm_num at x_sq,
      norm_num at y_sq,

      rw int.add_mod (x*x) (y*y) 3 at pyth_mod',
      rw x_sq at pyth_mod',
      rw y_sq at pyth_mod',
      norm_num at pyth_mod',

      haveI : fact (nat.prime 3) := by sorry,
      have two_not_zero : (2 : zmod 3) ≠ 0 := dec_trivial,

      have lem := zmod.euler_criterion 3 two_not_zero,
      {
        have two_not_euler_right : ¬ ((2 : zmod 3)^(3/2) = 1):= by dec_trivial,
        rw ← not_iff_not at lem,
        rw ← lem at two_not_euler_right,
        sorry,
      },
    }, sorry,
  },
  sorry,
  },
end


/-
TODO: Add copyright information
TODO: Add proper documentations
TODO: Decide where to put this file
-/

import algebra.geom_sum
import data.finset.basic
import data.nat.prime
import number_theory.arithmetic_function
import number_theory.divisors
import number_theory.lucas_lehmer
import tactic

/-
Below are results leading up to Euclid-Euler Theorem
-/

open finset
open nat.arithmetic_function
open_locale arithmetic_function
open_locale big_operators

-- Lemma that allows us to cast mersenne numbers to integers
lemma coe_mersenne {n : ℕ} : (mersenne n : ℤ) = (2 : ℤ) ^ n - 1 :=
begin
  simp [mersenne],
end

lemma mersenne_inc {m n : ℕ} (h : m < n) : mersenne m < mersenne n :=
begin
  suffices : (mersenne m : ℤ) < mersenne n,
  { exact_mod_cast this, },
  simp [coe_mersenne],
  exact pow_lt_pow one_lt_two h,
end

-- Thank you to Kevin Buzzard, Niels Voss and Yaël Dillies for helping with this!
lemma mersenne_div {m n : ℕ} (h : m ∣ n) : mersenne m ∣ mersenne n :=
begin
  rcases h with ⟨k, rfl⟩,
  simpa only [mersenne, pow_mul, one_pow] using nat_sub_dvd_pow_sub_pow _ 1 _,
end

-- set_option pp.all true

-- 2^n - 1 is Mersenne prime implies n is prime
theorem mersenne_theorem {n : ℕ} (h : nat.prime (mersenne n)) : nat.prime n :=
begin
  -- Auxillary lemma
  have two_le_n : 2 ≤ n,
  {
    by_contradiction h',
    push_neg at h',

    cases nat.lt_succ_iff.1 h' with _ h',
    { simp [mersenne, nat.not_prime_one] at h, exact h, },
    { simp [mersenne, nat.eq_zero_of_le_zero h', nat.not_prime_zero] at h, exact h, }
  },

  -- Assume n is composite
  by_contradiction n_comp,
  rcases nat.exists_dvd_of_not_prime two_le_n n_comp with ⟨d, d_dvd, d_ne_one, d_ne_n⟩,

  have d_pos : 0 < d,
  { by_contradiction, simp at h, rw h at d_dvd, rw zero_dvd_iff at d_dvd, linarith, },
  have two_le_d : 2 ≤ d,
  { cases d, omega, cases d; omega,},

  -- Then mersenne n is not prime
  rcases mersenne_div d_dvd with ⟨md, hmd⟩,
  suffices : ¬nat.prime (mersenne n),
  { exact this h, },

  -- We cast to int for easier life
  apply nat.not_prime_mul' hmd.symm,
  {
    have : (2 : ℤ) ^ 1 < 2 ^ d,
    { exact pow_lt_pow one_lt_two two_le_d, },
    have : (1 : ℤ) < (mersenne d : ℤ),
    { simp [coe_mersenne], linarith, },
    exact_mod_cast this,
  },
  {
    have : mersenne d < mersenne n,
    { apply mersenne_inc, exact lt_iff_le_and_ne.2 ⟨nat.le_of_dvd (by linarith) d_dvd, d_ne_n⟩, },
    simp [hmd] at this,
    exact (lt_mul_iff_one_lt_right (mersenne_pos d_pos)).1 this,
  }
end

lemma sigma_two_pow_eq_mersenne_succ (k : ℕ) : σ 1 (2 ^ k) = 2 ^ (k + 1) - 1 :=
begin
  simp [sigma_one_apply, nat.prime_two, ← geom_sum_mul_add 1 (k+1)],
end

-- Euclid-Euler Theorem
theorem euclid_euler {n : ℕ} :
nat.perfect n ∧ even n ↔
(∃ (p : ℕ), nat.prime (2 ^ p - 1) ∧ n = 2 ^ (p - 1) * (2 ^ p - 1)) :=
begin
  split,

  -- If n is perfect and even, then
  -- n = 2^(p - 1) (2^p - 1) and (2^p - 1) is prime
  {
    contrapose!,
    intro h,
    contrapose!,
    intro n_even,
    sorry
  },
  {
    -- If (2^p - 1) is prime, then n = 2^(p - 1) (2^p - 1) is perfect and even
    rintros ⟨p, hp, hn⟩,
    let n₁ := 2 ^ (p - 1),
    let n₂ := 2 ^ p - 1,
    have n₂_pos : 1 ≤ 2 ^ p, { exact nat.one_le_two_pow p, },
    have hpr : nat.prime p, { exact mersenne_theorem hp, },

    split,
    {
      have h₂ : n₁.coprime n₂, { sorry },
      have h : σ 1 n = σ 1 n₁ * σ 1 n₂,
      { rw [hn, is_multiplicative.map_mul_of_coprime is_multiplicative_sigma h₂], },
      have hσ₁ : ∀ (n : ℕ), σ 1 (2 ^ n) = 2 ^ (n + 1) - 1,
      {
        intro n,
        simp [sigma_one_apply, nat.prime_two, ← geom_sum_mul_add 1 (n + 1)],
      },
      have hσ₂ : ∀ (p : ℕ), nat.prime p → σ 1 p = 1 + p,
      {
        intros p hpr,
        simp [sigma_one_apply, hpr, add_comm],
      },
      rw nat.perfect_iff_sum_divisors_eq_two_mul,

      -- I plan to make evaluating arithmetic functions easier
      rw [← sigma_one_apply, h, hσ₁ (p - 1), nat.sub_add_cancel (nat.prime.pos hpr)],
      simp [hσ₂ n₂ hp, n₂, ← nat.add_sub_assoc n₂_pos, hn, ← nat.pow_div (nat.prime.pos hpr)],
      rw [← nat.mul_assoc, nat.mul_div_cancel', mul_comm],
      apply nat.dvd_of_pow_dvd (nat.prime.pos hpr) (dvd_refl _),

      -- Prove n > 0
      simp [hn],
      apply nat.le_self_pow (nat.prime.ne_zero hpr) 2,
    },
    {
      -- If (2^p - 1) is prime, then n = 2^(p - 1) (2^p - 1) is even
      simp [hn, n₁, n₂] with parity_simps,
      left,
      exact nat.prime.two_le hpr,
    },
  },
end


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

import tactic
import data.zmod.algebra
import number_theory.wilson

open_locale big_operators

/-

## -1 is a square mod p if p=1 mod 4

I formalise the following constructive proof in the solutions: ((p-1)/2)! works!
Why does it work: claim 1*2*...*(p-1)/2 squared is -1
1*2*....*(p-1)/2 -- p is 1 mod 4 so this is also
-1 * -2 * ... * -((p-1)/2), and mod p this is the same
(p-1) * (p-2) * ... ((p+1)/2), so i^2=1*2*....*(p-2)*(p-1)=(p-1)!
Wilson's theorem tels us that (p-1)! = -1 mod p if p is prime.

-/

lemma exists_sqrt_neg_one_of_one_mod_four (p : ℕ) (hp : p.prime)
  (hp2 : ∃ n, p = 4 * n + 1) : ∃ i : zmod p, i^2 = -1 :=
begin
  sorry,
end


-- TOOD: Cylic is sent to Cyclic
-- TODO: Dihedral is sent to Dihedral (x C2)

import pq_to_group

import algebra.group
import data.zmod.basic
import data.int.parity

universes u v

section cyclic_pq_group

@[ext] structure cyclic (n : nat) :=
(val : zmod n)

variables {n : nat}

def cyclic_mul : cyclic n → cyclic n → cyclic n
| ⟨a⟩ ⟨b⟩ := ⟨a + b⟩

def cyclic_inv : cyclic n → cyclic n
| ⟨a⟩ := ⟨-a⟩

instance cyclic_has_mul : has_mul (cyclic n) := ⟨cyclic_mul⟩

instance cyclic_has_neg : has_inv (cyclic n) := ⟨cyclic_inv⟩

instance cyclic_has_one : has_one (cyclic n) := ⟨⟨0⟩⟩

lemma cyclic_mul_def (a b : zmod n) : (⟨a⟩ * ⟨b⟩ : cyclic n) = ⟨a + b⟩ := rfl

lemma cyclic_inv_def (a : zmod n) : (⟨a⟩⁻¹ : cyclic n) = ⟨-a⟩ := rfl

lemma cyclic_one_def : (1 : cyclic n) = ⟨0⟩ := rfl

instance cyclic_comm_group : comm_group (cyclic n) :=
{
    mul_assoc := begin
        rintros ⟨a⟩ ⟨b⟩ ⟨c⟩,
        repeat {rw cyclic_mul_def},
        apply congr_arg,
        apply add_assoc,
    end,
    one_mul := begin
        rintro ⟨a⟩,
        rw cyclic_one_def,
        rw cyclic_mul_def,
        apply congr_arg,
        apply zero_add,
    end,
    mul_one := begin
        rintro ⟨a⟩,
        rw cyclic_one_def,
        rw cyclic_mul_def,
        apply congr_arg,
        apply add_zero,
    end,
    mul_left_inv := begin
        rintro ⟨a⟩,
        rw cyclic_inv_def,
        rw cyclic_mul_def,
        rw cyclic_one_def,
        apply congr_arg,
        apply add_left_neg,
    end,
    mul_comm := begin
        intros a b,
        cases a,
        cases b,
        rw cyclic_mul_def,
        rw cyclic_mul_def,
        apply congr_arg,
        exact add_comm a b,
    end,
    ..cyclic_has_mul,
    ..cyclic_has_neg,
    ..cyclic_has_one,
}

lemma one_val : (1 : (cyclic n)).val = 0 := rfl

def generator : (cyclic n) := ⟨1⟩

lemma cyclic_as_power (x : cyclic n) : ∃ k : int, x = generator^k :=
begin
    induction x,
    use (zmod.val_min_abs x),
    --simp at *,
    have gen_pow : ∀ k : int, (⟨k⟩ : cyclic n) = generator ^ k,
    {
        intro k,
        induction k,
        {
            induction k with l hl,
            {
                refl,
            },
            {
                simp at *,
                rw gpow_add_one,
                simp,
                rw ←hl,
                refl,
            },
        },
        {
            induction k with l hl,
            {
                simp,
                refl,
            },
            {
                simp at *,
                rw pow_succ,
                simp,
                rw ←hl,
                apply congr_arg,
                ring,
            },
        },
    },
    have h := gen_pow (x.val_min_abs),
    simp at h,
    assumption,
end

lemma cyclic_counit_form : function.surjective (of : (cyclic n) → pq_group (cyclic n)) :=
begin
    intro x,
    induction x,
    {
        induction x,
        {
            use 1,
            apply quotient.sound,
            fconstructor,
            apply pre_pq_group_rel'.pow_zero,
            exact 1,
        },
        {
            use x,
            refl,
        },
        {
            cases x_ih_a with a ha,
            cases x_ih_b with b hb,
            use (a * b),
            --apply quotient.sound,
            have ha2 := cyclic_as_power a,
            have hb2 := cyclic_as_power b,
            cases ha2 with k hk,
            cases hb2 with l hl,
            rw hk,
            rw hl,
            rw ←gpow_add,
            rw of_pow_eq_pow_of,
            have hr : quot.mk setoid.r (x_a.mul x_b) = ((quot.mk setoid.r x_a) * (quot.mk setoid.r x_b) : pq_group (cyclic n)),
            {
                refl,
            },
            rw hr,
            rw ←ha,
            rw ←hb,
            rw hk,
            rw hl,
            rw of_pow_eq_pow_of,
            rw of_pow_eq_pow_of,
            rw ←gpow_add,
        },
        {
            cases x_ih with y hy,
            use (y ^ (-1 : int)),
            rw of_pow_eq_pow_of,
            rw hy,
            simp,
            refl,
        },
    },
    {refl,},
end

theorem cyclic_counit_bijective : function.bijective (counit : pq_group (cyclic n) → cyclic n) :=
begin
    split,
    {
        intros x y,
        intro hxy,
        have hx := cyclic_counit_form x,
        have hy := cyclic_counit_form y,
        cases hx with xx hxx,
        cases hy with yy hyy,
        rw ←hxx at *,
        rw ←hyy at *,
        apply congr_arg,
        repeat {rw counit_of at hxy},
        assumption,
    },
    {
        apply counit_surjective,
    }
end

noncomputable theorem comonad_cyclic_iso : pq_group (cyclic n) ≃* cyclic n :=
begin
    fapply mul_equiv.of_bijective,
    exact counit,
    exact cyclic_counit_bijective,
end

end cyclic_pq_group

section klein_pq_group

local notation `C2` := (cyclic 2)

local notation `K` := C2 × C2

local notation `g` := (⟨1⟩ : C2)

lemma cyclic2cases {p : cyclic 2 → Prop} (a : cyclic 2) (h0 : p 1) (h1 : p generator) : p a :=
begin
    cases a,
    cases a with a ha,
    cases a,
    {
        exact h0,
    },
    {
        cases a,
        {
            exact h1,
        },
        {
            exfalso,
            norm_num at ha,
            have ha' := nat.lt_of_succ_lt_succ (nat.lt_of_succ_lt_succ ha),
            exact nat.not_lt_zero a ha',
        }
    }
end

-- Stupid lemma
lemma not_zero_eq_one (c : zmod 2) (hc0 : c ≠ 0) : c = 1 :=
begin
    by_contradiction hc1,
    {
        cases c with c hc,
        cases c,
        {
            apply hc0,
            refl,
        },
        {
            cases c,
            {
                apply hc1,
                refl,
            },
            {
                clear hc0 hc1,
                norm_num at hc,
                have hc' := nat.lt_of_succ_lt_succ (nat.lt_of_succ_lt_succ hc),
                exact nat.not_lt_zero c hc'
            },
        }
    }
end

-- Stupid lemma
lemma not_one_eq_zero (c : zmod 2) (hc1 : c ≠ 1) : c = 0 :=
begin
    by_contradiction hc0,
    {
        cases c with c hc,
        cases c,
        {
            apply hc0,
            refl,
        },
        {
            cases c,
            {
                apply hc1,
                refl,
            },
            {
                clear hc0 hc1,
                norm_num at hc,
                have hc' := nat.lt_of_succ_lt_succ (nat.lt_of_succ_lt_succ hc),
                exact nat.not_lt_zero c hc'
            },
        }
    }
end

lemma pqK_of_commute (a b : K) : (of a) * (of b) = (of b) * (of a) :=
begin
    apply pq_group_commute,
    unfold commute,
    unfold semiconj_by,
    cases a with a1 a2;
    cases b with b1 b2;
    apply cyclic2cases a1;
    apply cyclic2cases a2;
    apply cyclic2cases b1;
    apply cyclic2cases b2;
    refl,
end

lemma pqK_commute (a b : pq_group K) : a * b = b * a :=
begin
    induction a,
    {
        rw quot_mk_helper,
        induction a,
        {
            rw incl_unit_eq_unit,
            simp,
        },
        {
            induction b,
            {
                rw quot_mk_helper,
                induction b,
                {
                    rw incl_unit_eq_unit,
                    simp,
                },
                {
                    apply pqK_of_commute,
                },
                {
                    rw ←mul_def,
                    rw mul_assoc,
                    rw ←b_ih_b,
                    rw ←mul_assoc,
                    rw b_ih_a,
                    rw mul_assoc,
                },
                {
                    rw ←inv_def,
                    apply commute.inv_right,
                    exact b_ih,
                },
            },
            {refl,},
        },
        {
            rw ←mul_def,
            rw mul_assoc,
            rw a_ih_b,
            rw ←mul_assoc,
            rw a_ih_a,
            rw mul_assoc,
        },
        {
            rw ←inv_def,
            apply commute.inv_left,
            exact a_ih,
        }
    },
    {refl,},
end

lemma C2_self_mul (a : C2) : a * a = 1 :=
begin
    apply cyclic2cases a;
    refl,
end

lemma C2_inv_is_self (a : C2) : a⁻¹ = a :=
begin
    apply cyclic2cases a;
    refl,
end

lemma K_self_mul (a : K) : a * a = 1 :=
begin
    cases a with a b,
    apply cyclic2cases a;
    apply cyclic2cases b;
    refl,
end

lemma pqK_self_mul (a : pq_group K) : a * a = 1 :=
begin
    induction a,
    {
        rw quot_mk_helper,
        induction a,
        {
            apply quotient.sound,
            fconstructor,
            apply pre_pq_group_rel'.mul_one,
        },
        {
            rw ←pow_two,
            rw ←gpow_of_nat,
            rw ←of_def,
            rw ←of_pow_eq_pow_of a (int.of_nat 2),
            rw gpow_of_nat,
            rw pow_two,
            rw K_self_mul,
            rw of_1_eq_unit,
        },
        {
            rw ←mul_def,
            have rw_order : ∀ c d : pq_group K, commute c d → c * d * (c * d) = c * c * (d * d),
            {
                intros c d hcd,
                have paren_rw : ∀ (a1 a2 a3 a4 : pq_group K), a1 * a2 * (a3 * a4) = a1 * (a2 * a3) * a4,
                {
                    intros a1 a2 a3 a4,
                    group,
                },
                unfold commute at hcd,
                unfold semiconj_by at hcd,
                rw paren_rw,
                rw ←hcd,
                rw ←paren_rw,
            },
            rw rw_order,
            rw a_ih_a,
            rw a_ih_b,
            rw mul_one,
            apply pqK_commute,
        },
        {
            rw ←inv_def,
            refine inv_inj.mp _,
            simp,
            exact a_ih,
        }
    },
    {refl,},
end

lemma Kpow2k : ∀ a : K, ∀ k : int, a^(2*k) = 1 :=
begin
    intros a k,
    rw mul_comm,
    rw gpow_mul,
    rw gpow_bit0,
    rw K_self_mul,
end

lemma Kpow2kplus1 : ∀ a : K, ∀ k : int, a^(2*k + 1) = a :=
begin
    intros a k,
    rw gpow_add_one,
    rw Kpow2k,
    simp only [one_mul],
end

lemma Kpow2kminus1 : ∀ a : K, ∀ k : int, a^(2*k - 1) = a :=
begin
    intros a k,
    have n_rw : 2 * k - 1 = 2*(k - 1) + 1,
    {
        ring,
    },
    rw n_rw,
    rw Kpow2kplus1,
end

open pre_pq_group

def f_pre_on_C2_fun : pre_pq_group K → C2
| unit := 1
| (incl (a, b)) := if (a.val = 1 ∧ b.val = 1) then g else 1
| (mul a b) := f_pre_on_C2_fun a * f_pre_on_C2_fun b
| (inv a) := (f_pre_on_C2_fun a)⁻¹

lemma f_pre_on_C2_fun_unit : f_pre_on_C2_fun (unit) = 1 := rfl
lemma f_pre_on_C2_fun_incl (a b : C2) : f_pre_on_C2_fun (incl (a, b)) = (if (a.val = 1 ∧ b.val = 1) then g else 1) := rfl
lemma f_pre_on_C2_fun_mul (a b : pre_pq_group K) : f_pre_on_C2_fun (mul a b) = f_pre_on_C2_fun a * f_pre_on_C2_fun b := rfl
lemma f_pre_on_C2_fun_inv (a : pre_pq_group K) : f_pre_on_C2_fun (inv a) = (f_pre_on_C2_fun a)⁻¹ := rfl

def f_on_C2_fun : pq_group K → C2 := quotient.lift f_pre_on_C2_fun (begin
    intros a b,
    intro hab,
    induction hab with c d habr,
    clear a,
    clear b,
    induction habr,
    {
        refl,
    },
    {
        apply eq.symm,
        assumption,
    },
    {
        apply eq.trans habr_ih_hab habr_ih_hbc,
    },
    {
        unfold f_pre_on_C2_fun,
        congr',
    },
    {
        unfold f_pre_on_C2_fun,
        congr',
    },
    {
        unfold f_pre_on_C2_fun,
        rw mul_assoc,
    },
    {
        unfold f_pre_on_C2_fun,
        rw one_mul,
    },
    {
        unfold f_pre_on_C2_fun,
        rw mul_one,
    },
    {
        unfold f_pre_on_C2_fun,
        rw mul_left_inv,
    },
    {
        unfold f_pre_on_C2_fun,
        simp only [mul_comm, inv_mul_cancel_left],
        congr',
        simp only [rhd_def_group, mul_comm, inv_mul_cancel_left],
    },
    {
        unfold f_pre_on_C2_fun,
        --cases habr_a with a b,
        --rw f_pre_on_C2_fun_incl,
        by_cases (even habr_n),
        {
            unfold even at h,
            cases h with k hk,
            rw hk,
            rw Kpow2k,
            rw Kpow2kminus1,
            rw C2_self_mul,
            refl,
        },
        {
            rw ←int.odd_iff_not_even at h,
            unfold odd at h,
            cases h with k hk,
            rw hk,
            simp only [add_sub_cancel],
            rw Kpow2k,
            rw Kpow2kplus1,
            group,
            refl,
        }
    },
    {
        unfold f_pre_on_C2_fun,
        by_cases (even habr_n),
        {
            unfold even at h,
            cases h with k hk,
            rw hk,
            rw Kpow2k,
            rw Kpow2kplus1,
            group,
            refl,
        },
        {
            rw ←int.odd_iff_not_even at h,
            unfold odd at h,
            cases h with k hk,
            rw hk,
            rw Kpow2kplus1,
            have n_rw : 2 * k + 1 + 1 = 2 * (k + 1),
            {
                ring,
            },
            rw n_rw,
            rw Kpow2k,
            have is_one : f_pre_on_C2_fun (incl 1) = 1,
            {
                refl,
            },
            rw is_one,
            simp,
            rw C2_inv_is_self,
        }
    },
    {
        refl,
    },
end)

lemma f_on_C2_fun_unit : f_on_C2_fun (⟦unit⟧) = 1 := rfl
lemma f_on_C2_fun_incl (a b : C2) : f_on_C2_fun (⟦incl (a, b)⟧) = (if (a.val = 1 ∧ b.val = 1) then g else 1) := rfl
lemma f_on_C2_fun_mul (a b : pre_pq_group K) : f_on_C2_fun (⟦mul a b⟧) = f_on_C2_fun ⟦a⟧ * f_on_C2_fun ⟦b⟧ := rfl
lemma f_on_C2_fun_inv (a : pre_pq_group K) : f_on_C2_fun ⟦inv a⟧ = (f_on_C2_fun ⟦a⟧)⁻¹ := rfl

lemma f_on_C2_fun_of (a b : C2) : f_on_C2_fun (of (a, b)) = (if (a.val = 1 ∧ b.val = 1) then g else 1) := rfl

def f_on_KC2_fun : pq_group K → K × C2
| a := (counit a, f_on_C2_fun a)

def f_on_KC2 : pq_group K →* K × C2 := ⟨f_on_KC2_fun, rfl, begin
    intros x y,
    unfold f_on_KC2_fun,
    simp only [true_and, monoid_hom.map_mul, prod.mk.inj_iff, eq_self_iff_true, prod.mk_mul_mk],
    induction x,
    induction y,
    {
        refl,
    },
    {refl,},
    {refl,},
end⟩

/--

Construction of inverse:
f_on_KC2 (x) = (counit x, of (g, g) -> g, 1 otherwise)

Inverse:
f_on_KC2_inv (a, b, c) = of(a, b) * (c = 1 -> (of(g, 1)of(1, g)of(g, g)))

Let's test:
We test f_on_KC2 of f_on_KC2_inv
(0, 0, 1) -> of(g, 1)of(1, g)of(g, g) -> (0, 0, 1)
(1, 1, 1) -> of(g, g)of(g, 1)of(1, g)of(g, g) -> (1, 1, 0) WRONG!!!
(1, 1, 0) -> of (1, 1) -> (1, 1, 1)

-/

def f_on_KC2_inv_fun : K × C2 → pq_group K
| (a, b) := of(a.1, 1) * of (1, a.2) * (if (b.val = 0) then 1 else of (1, g) * of (g, 1) * of (g, g))

lemma of_mul_C2_left (a b : C2) : of(a * b, (1 : C2)) = of(a, 1) * of(b, 1) :=
begin
    apply cyclic2cases a,
    {
        have one_eq2 : ((1, 1) : K) = 1 := rfl,
        rw one_eq2,
        rw of_1_eq_unit,
        simp only [mul_one, one_mul],
    },
    {
        apply cyclic2cases b,
        {
            have one_eq2 : ((1, 1) : K) = 1 := rfl,
            rw one_eq2,
            rw of_1_eq_unit,
            simp only [mul_one, one_mul],
        },
        {
            rw pqK_self_mul,
            rw C2_self_mul,
            have one_eq2 : ((1, 1) : K) = 1 := rfl,
            rw one_eq2,
            rw of_1_eq_unit,
        },
    },
end

lemma of_mul_C2_right (a b : C2) : of((1 : C2), a * b) = of(1, a) * of(1, b) :=
begin
    apply cyclic2cases a,
    {
        have one_eq2 : ((1, 1) : K) = 1 := rfl,
        rw one_eq2,
        rw of_1_eq_unit,
        simp only [mul_one, one_mul],
    },
    {
        apply cyclic2cases b,
        {
            have one_eq2 : ((1, 1) : K) = 1 := rfl,
            rw one_eq2,
            rw of_1_eq_unit,
            simp only [mul_one, one_mul],
        },
        {
            rw pqK_self_mul,
            rw C2_self_mul,
            have one_eq2 : ((1, 1) : K) = 1 := rfl,
            rw one_eq2,
            rw of_1_eq_unit,
        },
    },
end

def f_on_KC2_inv : K × C2 →* pq_group K := ⟨f_on_KC2_inv_fun, begin
    have one_eq : ((1, 1) : K × C2) = 1 := rfl,
    rw ←one_eq,
    unfold f_on_KC2_inv_fun,
    rw if_pos,
    swap, refl,
    simp only [mul_one, prod.snd_one, prod.fst_one],
    have one_eq2 : ((1, 1) : K) = 1 := rfl,
    rw one_eq2,
    rw of_1_eq_unit,
    simp only [mul_one],
end, begin
    intros x y,
    cases x with x1 x2,
    cases y with y1 y2,
    have mul_rw : (x1, x2) * (y1, y2) = (x1 * y1, x2 * y2) := rfl,
    rw mul_rw,
    clear mul_rw,
    unfold f_on_KC2_inv_fun,
    have reorder : ∀ a b c d : pq_group K, a * b * (c * d) = a * c * (b * d),
    {
        intros a b c d,
        have redo_paren : ∀ a b c d : pq_group K, a * b * (c * d) = a * (b * c) * d,
        intros a b c d, group,
        rw redo_paren,
        rw pqK_commute b c,
        rw ←redo_paren,
    },
    apply cyclic2cases x2;
    apply cyclic2cases y2;
    clear x2 y2,
    {
        rw if_pos,
        swap, refl,
        rw if_pos,
        swap, refl,
        simp only [prod.snd_mul, prod.fst_mul, mul_one],
        cases x1 with x11 x12,
        cases y1 with y11 y12,
        simp only,
        rw of_mul_C2_left,
        rw of_mul_C2_right,
        rw reorder,
    },
    {
        rw if_neg,
        swap, unfold generator, simp,
        rw if_pos,
        swap, refl,
        rw if_neg,
        swap, unfold generator, simp,
        simp only [prod.snd_mul, prod.fst_mul, mul_one],
        cases x1 with x11 x12,
        cases y1 with y11 y12,
        simp only,
        rw of_mul_C2_left,
        rw of_mul_C2_right,
        suffices : of (x11, 1) * of (y11, 1) * (of (1, x12) * of (1, y12)) = of (x11, 1) * of (1, x12) * (of (y11, 1) * of (1, y12)),
        rw this, group,
        rw reorder,
    },
    {
        rw if_neg,
        swap, unfold generator, simp,
        rw if_neg,
        swap, unfold generator, simp,
        rw if_pos,
        swap, refl,
        simp only [prod.snd_mul, prod.fst_mul, mul_one],
        cases x1 with x11 x12,
        cases y1 with y11 y12,
        simp only,
        rw of_mul_C2_left,
        rw of_mul_C2_right,
        rw pqK_commute _ ((of (y11, 1) * of (1, y12))),
        group,
        rw pqK_commute _ (of (1, y12)),
        group,
        rw pqK_commute _ (of (y11, 1)),
        group,
    },
    {
        rw if_pos,
        swap, refl,
        rw if_neg,
        swap, unfold generator, simp,
        simp only [prod.snd_mul, prod.fst_mul, mul_one],
        cases x1 with x11 x12,
        cases y1 with y11 y12,
        simp only,
        rw of_mul_C2_left,
        rw of_mul_C2_right,
        let x : pq_group K := (of (1, {val := 1}) * of ({val := 1}, 1) * of ({val := 1}, {val := 1})),
        have x_def : x = (of (1, {val := 1}) * of ({val := 1}, 1) * of ({val := 1}, {val := 1})) := rfl,
        rw ←x_def,
        rw pqK_commute (of (y11, 1) * of (1, y12)) x,
        rw reorder,
        suffices : of (x11, 1) * of (1, x12) * (of (y11, 1) * of (1, y12)) = of (x11, 1) * of (1, x12) * (x * x) * (of (y11, 1) * of (1, y12)),
        rw this, group,
        rw pqK_self_mul,
        simp only [mul_one],
    },
end⟩

theorem f_on_KC2_inv_f_on_KC2 : f_on_KC2_inv ∘ f_on_KC2 = id :=
begin
    funext,
    simp only [id.def, function.comp_app],
    induction x,
    {
        rw quot_mk_helper,
        induction x,
        {
            unfold f_on_KC2,
            simp,
            unfold f_on_KC2_fun,
            rw counit_unit,
            rw f_on_C2_fun_unit,
            unfold f_on_KC2_inv,
            simp only [monoid_hom.coe_mk],
            unfold f_on_KC2_inv_fun,
            rw if_pos,
            swap, refl,
            simp only [mul_one, prod.fst_one, prod.snd_one],
            have h1 : ((1, 1) : K) = 1 := rfl,
            rw h1,
            rw ←unit_eq_incl_1,
            apply quotient.sound,
            fconstructor,
            apply pre_pq_group_rel'.mul_one,
        },
        {
            unfold f_on_KC2,
            simp,
            unfold f_on_KC2_fun,
            rw counit_incl,
            cases x with a b,
            rw f_on_C2_fun_incl,
            by_cases (a.val = 1 ∧ b.val = 1),
            {
                rw if_pos,
                unfold f_on_KC2_inv,
                simp only [monoid_hom.coe_mk],
                unfold f_on_KC2_inv_fun,
                rw if_neg,
                {
                    simp,
                    cases h with ha hb,
                    have ha1 : a = ⟨1⟩,
                    ext, rw ha,
                    have hb1 : b = ⟨1⟩,
                    ext, rw hb,
                    rw ha1,
                    rw hb1,
                    rw ←of_def,
                    suffices : ∀ a b c : pq_group K, a * b * (b * a * c) = c,
                    apply this,
                    intros a b c,
                    have rw_order : a * b * (b * a * c) = (a * (b * b) * a) * c,
                    group,
                    rw rw_order,
                    simp only [mul_one, mul_left_eq_self, pqK_self_mul],
                },
                simp,
                exact h,
            },
            {
                rw if_neg,
                swap, assumption,
                unfold f_on_KC2_inv,
                simp only [monoid_hom.coe_mk],
                unfold f_on_KC2_inv_fun,
                rw if_pos,
                swap, refl,
                rw ←of_def,
                simp only [mul_one],
                by_cases ha1 : (a.val = 1),
                {
                    push_neg at h,
                    specialize h ha1,
                    have hb1 := not_one_eq_zero (b.val) h,
                    have ha : a = ⟨1⟩,
                    ext, rw ha1,
                    have hb : b = 1,
                    ext, rw hb1, refl,
                    rw ha,
                    rw hb,
                    simp,
                    have one_eq : ((1, 1) : K) = 1 := rfl,
                    rw one_eq,
                    rw of_1_eq_unit,
                },
                {
                    clear h,
                    have ha2 := not_one_eq_zero (a.val) ha1,
                    have ha : a = 1,
                    ext, rw ha2, refl,
                    rw ha,
                    simp only [mul_left_eq_self],
                    have one_eq : ((1, 1) : K) = 1 := rfl,
                    rw one_eq,
                    rw of_1_eq_unit,
                },
            },
        },
        {
            rw ←mul_def,
            rw monoid_hom.map_mul,
            rw monoid_hom.map_mul,
            congr',
        },
        {
            rw ←inv_def,
            rw monoid_hom.map_inv,
            rw monoid_hom.map_inv,
            congr',
        },
    },
    {refl,},
end

theorem f_on_KC2_f_on_KC2_inv : f_on_KC2 ∘ f_on_KC2_inv = id :=
begin
    funext,
    simp only [id.def, function.comp_app],
    cases x with y c,
    by_cases (c.val = 0),
    {
        unfold f_on_KC2_inv,
        simp only [monoid_hom.coe_mk],
        unfold f_on_KC2_inv_fun,
        rw if_pos,
        swap, exact h,
        unfold f_on_KC2,
        simp,
        unfold f_on_KC2_fun,
        rw counit_of,
        rw counit_of,
        rw f_on_C2_fun_of,
        rw if_neg,
        swap, push_neg, intro, rw one_val, norm_num,
        rw f_on_C2_fun_of,
        rw if_neg,
        swap, push_neg, rw one_val, norm_num,
        simp,
        cases c,
        simp at h,
        rw h,
        refl,
    },
    {
        unfold f_on_KC2_inv,
        simp only [monoid_hom.coe_mk],
        unfold f_on_KC2_inv_fun,
        rw if_neg,
        swap, exact h,
        unfold f_on_KC2,
        simp,
        unfold f_on_KC2_fun,
        repeat {rw counit_of,},
        repeat {rw f_on_C2_fun_of,},
        rw if_neg,
        swap, push_neg, rw one_val, norm_num,
        rw if_neg,
        swap, push_neg, rw one_val, norm_num,
        rw if_neg,
        swap, push_neg, rw one_val, norm_num,
        rw if_neg,
        swap, push_neg, rw one_val, norm_num,
        rw if_pos,
        swap, split, refl, refl,
        simp,
        split,
        refl,
        cases c,
        simp at *,
        apply eq.symm,
        apply not_zero_eq_one c h,
    },
end

theorem klein_pq_group_iso_klein_c2 : pq_group K ≃* K × C2 :=
{ to_fun := f_on_KC2,
  inv_fun := f_on_KC2_inv,
  left_inv := congr_fun f_on_KC2_inv_f_on_KC2,
  right_inv := congr_fun f_on_KC2_f_on_KC2_inv,
  map_mul' := is_mul_hom.map_mul ⇑f_on_KC2 }

end klein_pq_group


theorem contrapositive (P Q : Prop) :
(P → Q) →  (¬ Q → ¬ P) :=
λ HPQ HnQ HP, HnQ (HPQ HP)

-- what about the converse?
theorem of_contrapositive (P Q : Prop) :
 (¬ Q → ¬ P) → (P → Q) :=
begin
  intro H1,
  intro HP,
  cc,
end


example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  exact
    have hp: p, from h.left,
    have hqr: q ∨ r, from h.right,
    show (p ∧ q) ∨ (p ∧ r),
    begin
      cases hqr with hq hr,
        exact or.inl ⟨hp, hq⟩,
        exact or.inr ⟨hp, hr⟩
    end
end


import ..exercises.love02_backward_proofs_exercise_sheet

/-! # LoVe Homework 2: Backward Proofs

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1 (4 points): Connectives and Quantifiers

1.1 (3 points). Complete the following proofs using basic tactics such as
`intro`, `apply`, and `exact`.

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

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

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

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

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

/-! 1.2 (1 point). Prove the following lemma using basic tactics. -/

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

/-! ## Question 2 (6 points): Logical Connectives

2.1 (2 points). Prove the following properties about logical connectives using
basic tactics.

Hints:

* Keep in mind that `¬ a` is the same as `a → false`. You can start by invoking
  `rw not_def` if this helps you.

* You will need to apply the elimination rules for `∨` and `false` at some
  point. -/

lemma about_implication (a b : Prop) :
  ¬ a ∨ b → a → b :=
sorry

lemma about_negation (a b : Prop) :
  a → ¬ (¬ a ∧ b) :=
sorry

/-! 2.2 (2 points). Prove the missing link in our chain of classical axiom
implications.

Hints:

* You can use `rw double_negation` to unfold the definition of
  `double_negation`, and similarly for the other definitions.

* You will need to apply the double negation hypothesis for `a ∨ ¬ a`. You will
  also need the left and right introduction rules for `∨` at some point. -/

#check excluded_middle
#check peirce
#check double_negation

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

/-! 2.3 (2 points). We have proved three of the six possible implications
between `excluded_middle`, `peirce`, and `double_negation`. State and prove the
three missing implications, exploiting the three theorems we already have. -/

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

-- enter your solution here

end backward_proofs

/-! ## Question 3 (3 points): Equality

You may hear it said that equality is the smallest *reflexive*, *symmetric*,
*transitive* relation. The following exercise shows that in the presence of
reflexivity, the rules for symmetry and transitivity are equivalent to a single
rule, "symmtrans". -/

axiom symmtrans {A : Type} {a b c : A} : a = b → c = b → a = c

-- You can now use `symmtrans` as a rule.

example (A : Type) (a b c : A) (h1 : a = b) (h2 : c = b) : a = c :=
begin
  apply symmtrans,
  apply h1,
  apply h2
end

section

variable {A : Type}
variables {a b c : A}

/-! Replace the `sorry`s below with proofs, using `symmtrans` and `rfl`, without
using `eq.symm` or `eq.trans`. -/

theorem my_symm (h : b = a) : a = b :=
sorry

theorem my_trans (h1 : a = b) (h2 : b = c) : a = c :=
sorry

end

/-! ## Question 4 (3 points): Pythagorean Triples

Recall that a Pythagorean triple is a 'triple' of three natural numbers a, b,
and c such that a² + b² = c², i.e. integer sides of a right triangle.-/

def isPythagoreanTriple (a b c : ℕ) : Prop :=
  a^2 + b^2 = c^2

/- By assuming Fermat's Last Theorem
(https://en.wikipedia.org/wiki/Fermat%27s_Last_Theorem), we can show that if
`a`, `b`, and `c` form a Pythagorean triple, then `a`, `b`, and `c` can't all be
perfect squares. Use the definitions below to prove this. -/

axiom fermats_last_theorem (x y n : ℕ) :
  (n ≥ 3) → ¬∃ (z : ℕ), x^n + y^n = z^n

def isSquare (n : ℕ) : Prop := ∃ (u : ℕ), n = u^2

-- You may use the following lemma in your proof.
lemma square_square (a b c : ℕ) :
  (a^2)^2 + (b^2)^2 = (c^2)^2 → a^4 + b^4 = c^4 :=
by intro h; rw [←pow_mul, ←pow_mul, ←pow_mul] at h; exact h

/-! Hints:
* You can use `and.elim` to extract both terms from a conjunction.
* If you have a hypothesis `h : a = b` and want to replace `b` with `a` in your
  goal (instead of `a` with `b`), use `rw ←h` (note the `←`).
* You can use `dec_trivial` to prove that 4 ≥ 3.
-/

theorem pythagoren_triple_not_all_squares (a b c : ℕ) :
  isPythagoreanTriple a b c → ¬(isSquare a ∧ isSquare b ∧ isSquare c) :=
sorry

end LoVe


import MyNat.Definition
namespace MyNat
/-!

# Tutorial world

## Level 2: The `rewrite` tactic

The `rewrite` tactic is the way to "substitute in" the value of a variable. In general, if you have a
hypothesis of the form `A = B`, and your goal mentions the left hand side `A` somewhere, then the
rewrite tactic will replace the `A` in your goal with a `B`. Below is a theorem which cannot be proved
using `rfl` -- you need a `rewrite` first.

Take a look in the InfoView at what you have. The variables
`x` and `y` are natural numbers, and there is a proof `h` that `y = x + 7`.
Your goal then is to prove that `2y = 2(x + 7)`. This goal is obvious -- you just substitute in
`y = x + 7` and you're done. In Lean, you do this substitution using the `rewrite` tactic.

## Lemma

If `x` and `y` are natural numbers, and `y = x + 7`, then `2y = 2(x + 7)`.
-/
lemma example2 (x y : MyNat) (h : y = x + 7) : 2 * y = 2 * (x + 7) := by
  rewrite [h]
  rfl

/-!
Did you see what happened to the goal? (Put your cursor at the end of the `rewrite` line).
The goal doesn't close, but it *changes* from `⊢ 2 * y = 2 * (x + 7)` to `⊢ 2 * (x + 7) = 2 * (x + 7)`.
And since these are now identical you can just close this goal with `rfl`.

You should now see "Goals accomplished 🎉" (with cursor at the end of the `rfl` line).
The square brackets here is a `List` object
because `rewrite` can rewrite using multiple hypotheses in sequence.

If you are reading this book online you can move the mouse over each bubble that is
added to the end of each line (that look like this: )
to see what the tactic state is at that point in the proof.

The other way you know the goal is complete is to look a the Visual Studio Code
Problems list window, if there are no error saying "unsolved goals" then you are done.

The documentation for `rewrite` will appear when you hover the mouse over it. We have also included
a [Tactics Section](../Tactics.lean.md) that lists all the tactics we use in this tutorial.

Now, Lean has another similar tactic named `rw` which does both the `rewrite`
and the `rfl`.  Try changing to `rw` above and you will see the `rfl` is
no longer needed.

## Details

Now you are ready for [Level3.lean](./Level3.lean.md).
-/


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import algebra.big_operators.basic
import data.finset.sym

/-!
# Stars and bars

In this file, we prove the case `n = 2` of stars and bars.

## Informal statement

If we have `n` objects to put in `k` boxes, we can do so in exactly `(n + k - 1).choose n` ways.

## Formal statement

We can identify the `k` boxes with the elements of a fintype `α` of card `k`. Then placing `n`
elements in those boxes corresponds to choosing how many of each element of `α` appear in a multiset
of card `n`. `sym α n` being the subtype of `multiset α` of multisets of card `n`, writing stars
and bars using types gives
```lean
-- TODO: this lemma is not yet proven
lemma stars_and_bars {α : Type*} [fintype α] (n : ℕ) :
  card (sym α n) = (card α + n - 1).choose (card α) := sorry
```

## TODO

Prove the general case of stars and bars.

## Tags

stars and bars
-/

open finset fintype

namespace sym2
variables {α : Type*} [decidable_eq α]

/-- The `diag` of `s : finset α` is sent on a finset of `sym2 α` of card `s.card`. -/
lemma card_image_diag (s : finset α) : (s.diag.image quotient.mk).card = s.card :=
begin
  rw [card_image_of_inj_on, diag_card],
  rintro ⟨x₀, x₁⟩ hx _ _ h,
  cases quotient.eq.1 h,
  { refl },
  { simp only [mem_coe, mem_diag] at hx,
    rw hx.2 }
end

lemma two_mul_card_image_off_diag (s : finset α) :
  2 * (s.off_diag.image quotient.mk).card = s.off_diag.card :=
begin
  rw [card_eq_sum_card_fiberwise
    (λ x, mem_image_of_mem _ : ∀ x ∈ s.off_diag, quotient.mk x ∈ s.off_diag.image quotient.mk),
    sum_const_nat (quotient.ind _), mul_comm],
  rintro ⟨x, y⟩ hxy,
  simp_rw [mem_image, exists_prop, mem_off_diag, quotient.eq] at hxy,
  obtain ⟨a, ⟨ha₁, ha₂, ha⟩, h⟩ := hxy,
  obtain ⟨hx, hy, hxy⟩ : x ∈ s ∧ y ∈ s ∧ x ≠ y,
  { cases h; have := ha.symm; exact ⟨‹_›, ‹_›, ‹_›⟩ },
  have hxy' : y ≠ x := hxy.symm,
  have : s.off_diag.filter (λ z, ⟦z⟧ = ⟦(x, y)⟧) = ({(x, y), (y, x)} : finset _),
  { ext ⟨x₁, y₁⟩,
    rw [mem_filter, mem_insert, mem_singleton, sym2.eq_iff, prod.mk.inj_iff, prod.mk.inj_iff,
      and_iff_right_iff_imp],
    rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩); rw mem_off_diag; exact ⟨‹_›, ‹_›, ‹_›⟩ }, -- hxy' is used here
  rw [this, card_insert_of_not_mem, card_singleton],
  simp only [not_and, prod.mk.inj_iff, mem_singleton],
  exact λ _, hxy',
end

/-- The `off_diag` of `s : finset α` is sent on a finset of `sym2 α` of card `s.off_diag.card / 2`.
This is because every element `⟦(x, y)⟧` of `sym2 α` not on the diagonal comes from exactly two
pairs: `(x, y)` and `(y, x)`. -/
lemma card_image_off_diag (s : finset α) :
  (s.off_diag.image quotient.mk).card = s.card.choose 2 :=
by rw [nat.choose_two_right, mul_tsub, mul_one, ←off_diag_card,
  nat.div_eq_of_eq_mul_right zero_lt_two (two_mul_card_image_off_diag s).symm]

lemma card_subtype_diag [fintype α] :
  card {a : sym2 α // a.is_diag} = card α :=
begin
  convert card_image_diag (univ : finset α),
  rw [fintype.card_of_subtype, ←filter_image_quotient_mk_is_diag],
  rintro x,
  rw [mem_filter, univ_product_univ, mem_image],
  obtain ⟨a, ha⟩ := quotient.exists_rep x,
  exact and_iff_right ⟨a, mem_univ _, ha⟩,
end

lemma card_subtype_not_diag [fintype α] :
  card {a : sym2 α // ¬a.is_diag} = (card α).choose 2 :=
begin
  convert card_image_off_diag (univ : finset α),
  rw [fintype.card_of_subtype, ←filter_image_quotient_mk_not_is_diag],
  rintro x,
  rw [mem_filter, univ_product_univ, mem_image],
  obtain ⟨a, ha⟩ := quotient.exists_rep x,
  exact and_iff_right ⟨a, mem_univ _, ha⟩,
end

/-- Finset **stars and bars** for the case `n = 2`. -/
lemma _root_.finset.card_sym2 (s : finset α) : s.sym2.card = s.card * (s.card + 1) / 2 :=
begin
  rw [←image_diag_union_image_off_diag, card_union_eq, sym2.card_image_diag,
    sym2.card_image_off_diag, nat.choose_two_right, add_comm, ←nat.triangle_succ, nat.succ_sub_one,
    mul_comm],
  rintro m he,
  rw [inf_eq_inter, mem_inter, mem_image, mem_image] at he,
  obtain ⟨⟨a, ha, rfl⟩, b, hb, hab⟩ := he,
  refine not_is_diag_mk_of_mem_off_diag hb _,
  rw hab,
  exact is_diag_mk_of_mem_diag ha,
end

/-- Type **stars and bars** for the case `n = 2`. -/
protected lemma card [fintype α] : card (sym2 α) = card α * (card α + 1) / 2 := finset.card_sym2 _

end sym2


import .love02_backward_proofs_exercise_sheet

/- # LoVe Homework 3: Forward Proofs

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1 (6 points + 1 bonus point): Connectives and Quantifiers

1.1 (2 points). We have proved or stated three of the six possible implications
between `excluded_middle`, `peirce`, and `double_negation`. Prove the three
missing implications using structured proofs, exploiting the three theorems we
already have. -/

namespace backward_proofs

#check peirce_of_em
#check dn_of_peirce
#check sorry_lemmas.em_of_dn

lemma peirce_of_dn :
  double_negation → peirce :=
sorry

lemma em_of_peirce :
  peirce → excluded_middle :=
sorry

lemma dn_of_em :
  excluded_middle → double_negation :=
sorry

end backward_proofs

/- 1.2 (4 points). Supply a structured proof of the commutativity of `∧` under
an `∃` quantifier, using no other lemmas than the introduction and elimination
rules for `∃`, `∧`, and `↔`. -/

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

/- 1.3 (1 bonus point). Supply a structured proof of the following property,
which can be used pull a `∀`-quantifier past an `∃`-quantifier. -/

lemma forall_exists_of_exists_forall {α : Type} (p : α → α → Prop) :
  (∃x, ∀y, p x y) → (∀y, ∃x, p x y) :=
sorry

/- ## Question 2 (3 points): Fokkink Logic Puzzles

If you have studied "Logic and Sets" with Prof. Fokkink, you will know he is
very fond of logic puzzles. This question is meant as a tribute.

Recall the following tactical proof: -/

lemma weak_peirce :
  ∀a b : Prop, ((((a → b) → a) → a) → b) → b :=
begin
  intros a b habaab,
  apply habaab,
  intro habaa,
  apply habaa,
  intro ha,
  apply habaab,
  intro haba,
  apply ha
end

/- 2.1 (1 point). Prove the same lemma again, this time by providing a proof
term.

Hint: There is an easy way. -/

lemma weak_peirce₂ :
  ∀a b : Prop, ((((a → b) → a) → a) → b) → b :=
sorry

/- 2.2 (2 points). Prove the same Fokkink lemma again, this time by providing a
structured proof, with `assume`s and `show`s. -/

lemma weak_peirce₃ :
  ∀a b : Prop, ((((a → b) → a) → a) → b) → b :=
sorry

end LoVe


import mynat.le -- import definition of ≤
import game.world9.level4 -- hide
import game.world4.level8 -- hide
namespace mynat -- hide
/- Axiom : le_iff_exists_add (a b : mynat)
  a ≤ b ↔ ∃ (c : mynat), b = a + c
-/

/- Tactic : use
## Summary

`use` works on the goal. If your goal is `⊢ ∃ c : mynat, 1 + x = x + c`
then `use 1` will turn the goal into `⊢ 1 + x = x + 1`, and the rather
more unwise `use 0` will turn it into the impossible-to-prove
`⊢ 1 + x = x + 0`.

## Details

`use` is a tactic which works on goals of the form `⊢ ∃ c, P(c)` where
`P(c)` is some proposition which depends on `c`. With a goal of this
form, `use 0` will turn the goal into `⊢ P(0)`, `use x + y` (assuming
`x` and `y` are natural numbers in your local context) will turn
the goal into `P(x + y)` and so on.
-/

/-

# Inequality world.

A new import, giving us a new definition. If `a` and `b` are naturals,
`a ≤ b` is *defined* to mean

`∃ (c : mynat), b = a + c`

The upside-down E means "there exists". So in words, $a\le b$
if and only if there exists a natural $c$ such that $b=a+c$.

If you really want to change an `a ≤ b` to `∃ c, b = a + c` then
you can do so with `rw le_iff_exists_add`:

```
le_iff_exists_add (a b : mynat) :
  a ≤ b ↔ ∃ (c : mynat), b = a + c
```

But because `a ≤ b` is *defined as* `∃ (c : mynat), b = a + c`, you
do not need to `rw le_iff_exists_add`, you can just pretend when you see `a ≤ b`
that it says `∃ (c : mynat), b = a + c`. You will see a concrete
example of this below.

A new construction like `∃` means that we need to learn how to manipulate it.
There are two situations. Firstly we need to know how to solve a goal
of the form `⊢ ∃ c, ...`, and secondly we need to know how to use a hypothesis
of the form `∃ c, ...`.

## Level 1: the `use` tactic.

The goal below is to prove $x\le 1+x$ for any natural number $x$.
First let's turn the goal explicitly into an existence problem with

`rw le_iff_exists_add,`

and now the goal has become `∃ c : mynat, 1 + x = x + c`. Clearly
this statement is true, and the proof is that $c=1$ will work (we also
need the fact that addition is commutative, but we proved that a long
time ago). How do we make progress with this goal?

The `use` tactic can be used on goals of the form `∃ c, ...`. The idea
is that we choose which natural number we want to use, and then we use it.
So try

`use 1,`

and now the goal becomes `⊢ 1 + x = x + 1`. You can solve this by
`exact add_comm 1 x`, or if you are lazy you can just use the `ring` tactic,
which is a powerful AI which will solve any equality in algebra which can
be proved using the standard rules of addition and multiplication. Now
look at your proof. We're going to remove a line.

## Important

An important time-saver here is to note that because `a ≤ b` is *defined*
as `∃ c : mynat, b = a + c`, you *do not need to write* `rw le_iff_exists_add`.
The `use` tactic will work directly on a goal of the form `a ≤ b`. Just
use the difference `b - a` (note that we have not defined subtraction so
this does not formally make sense, but you can do the calculation in your head).
If you have written `rw le_iff_exists_add` below, then just put two minus signs `--`
before it and comment it out. See that the proof still compiles.
-/

/- Lemma : no-side-bar
If $x$ is a natural number, then $x\le 1+x$.
-/
lemma one_add_le_self (x : mynat) : x ≤ 1 + x :=
begin
  rw le_iff_exists_add,
  use 1,
  ring,

end
end mynat -- hide


/-
Copyright (c) 2022 Kevin H. Wilson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin H. Wilson
-/
import order.filter.prod

/-!
# Curried Filters

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

This file provides an operation (`filter.curry`) on filters which provides the equivalence
`∀ᶠ a in l, ∀ᶠ b in l', p (a, b) ↔ ∀ᶠ c in (l.curry l'), p c` (see `filter.eventually_curry_iff`).

To understand when this operation might arise, it is helpful to think of `∀ᶠ` as a combination of
the quantifiers `∃ ∀`. For instance, `∀ᶠ n in at_top, p n ↔ ∃ N, ∀ n ≥ N, p n`. A curried filter
yields the quantifier order `∃ ∀ ∃ ∀`. For instance,
`∀ᶠ n in at_top.curry at_top, p n ↔ ∃ M, ∀ m ≥ M, ∃ N, ∀ n ≥ N, p (m, n)`.

This is different from a product filter, which instead yields a quantifier order `∃ ∃ ∀ ∀`. For
instance, `∀ᶠ n in at_top ×ᶠ at_top, p n ↔ ∃ M, ∃ N, ∀ m ≥ M, ∀ n ≥ N, p (m, n)`. This makes it
clear that if something eventually occurs on the product filter, it eventually occurs on the curried
filter (see `filter.curry_le_prod` and `filter.eventually.curry`), but the converse is not true.

Another way to think about the curried versus the product filter is that tending to some limit on
the product filter is a version of uniform convergence (see `tendsto_prod_filter_iff`) whereas
tending to some limit on a curried filter is just iterated limits (see `tendsto.curry`).

## Main definitions

* `filter.curry`: A binary operation on filters which represents iterated limits

## Main statements

* `filter.eventually_curry_iff`: An alternative definition of a curried filter
* `filter.curry_le_prod`: Something that is eventually true on the a product filter is eventually
   true on the curried filter

## Tags

uniform convergence, curried filters, product filters
-/

namespace filter

variables {α β γ : Type*}

/-- This filter is characterized by `filter.eventually_curry_iff`:
`(∀ᶠ (x : α × β) in f.curry g, p x) ↔ ∀ᶠ (x : α) in f, ∀ᶠ (y : β) in g, p (x, y)`. Useful
in adding quantifiers to the middle of `tendsto`s. See
`has_fderiv_at_of_tendsto_uniformly_on_filter`. -/
def curry (f : filter α) (g : filter β) : filter (α × β) :=
{ sets := { s | ∀ᶠ (a : α) in f, ∀ᶠ (b : β) in g, (a, b) ∈ s },
  univ_sets := (by simp only [set.mem_set_of_eq, set.mem_univ, eventually_true]),
  sets_of_superset := begin
    intros x y hx hxy,
    simp only [set.mem_set_of_eq] at hx ⊢,
    exact hx.mono (λ a ha, ha.mono(λ b hb, set.mem_of_subset_of_mem hxy hb)),
  end,
  inter_sets := begin
    intros x y hx hy,
    simp only [set.mem_set_of_eq, set.mem_inter_iff] at hx hy ⊢,
    exact (hx.and hy).mono (λ a ha, (ha.1.and ha.2).mono (λ b hb, hb)),
  end, }

lemma eventually_curry_iff {f : filter α} {g : filter β} {p : α × β → Prop} :
  (∀ᶠ (x : α × β) in f.curry g, p x) ↔ ∀ᶠ (x : α) in f, ∀ᶠ (y : β) in g, p (x, y) :=
iff.rfl

lemma curry_le_prod {f : filter α} {g : filter β} :
  f.curry g ≤ f.prod g :=
begin
  intros u hu,
  rw ←eventually_mem_set at hu ⊢,
  rw eventually_curry_iff,
  exact hu.curry,
end

lemma tendsto.curry {f : α → β → γ} {la : filter α} {lb : filter β} {lc : filter γ} :
  (∀ᶠ a in la, tendsto (λ b : β, f a b) lb lc) → tendsto ↿f (la.curry lb) lc :=
begin
  intros h,
  rw tendsto_def,
  simp only [curry, filter.mem_mk, set.mem_set_of_eq, set.mem_preimage],
  simp_rw tendsto_def at h,
  refine (λ s hs, h.mono (λ a ha, eventually_iff.mpr _)),
  simpa [function.has_uncurry.uncurry, set.preimage] using ha s hs,
end

end filter


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import algebra.order.monoid.canonical.defs
import algebra.order.group.defs
import algebra.order.monoid.order_dual

/-!
# Lemmas about densely linearly ordered groups.

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

variables {α : Type*}

section densely_ordered
variables [group α] [linear_order α]
variables [covariant_class α α (*) (≤)]
variables [densely_ordered α] {a b c : α}

@[to_additive]
lemma le_of_forall_lt_one_mul_le (h : ∀ ε < 1, a * ε ≤ b) : a ≤ b :=
@le_of_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _ _ _ h

@[to_additive]
lemma le_of_forall_one_lt_div_le (h : ∀ ε : α, 1 < ε → a / ε ≤ b) : a ≤ b :=
le_of_forall_lt_one_mul_le $ λ ε ε1,
  by simpa only [div_eq_mul_inv, inv_inv]  using h ε⁻¹ (left.one_lt_inv_iff.2 ε1)

@[to_additive]
lemma le_iff_forall_one_lt_le_mul : a ≤ b ↔ ∀ ε, 1 < ε → a ≤ b * ε :=
⟨λ h ε ε_pos, le_mul_of_le_of_one_le h ε_pos.le, le_of_forall_one_lt_le_mul⟩

@[to_additive]
lemma le_iff_forall_lt_one_mul_le : a ≤ b ↔ ∀ ε < 1, a * ε ≤ b :=
@le_iff_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _

end densely_ordered


/-
As another example of overloading, this short course module
introduces a typeclass, has_truish (α : Type), that enables
overloading of a function, truish : α → bool, that takes any
value of a type, α, to one of type Boolean, thereby allowing
values of any such a type, α,to be used where Booleans are
expected, e.g., as conditions in conditional expressions or
statements. For example, in C and C++, the integer value, 0,
will be interpreted (converted to) false, while any other
integer value will be interpreted as true when used as the
condition in a conditional (if/then/else) statement.
-/

/-
The has_truish typeclass enables overloading of the
"truish" operator for any type, α, for which there is
a typeclass instance.
-/
class has_truish (α : Type) :=
(truish : α → bool)

-- overload truish for bool
instance : has_truish bool :=
⟨ λ b, b ⟩

-- overload truish for string
instance : has_truish string :=
⟨
  λ s,
    match s with
    | "" := ff
    | _ := tt
    end
⟩

-- overload truish for nat
instance : has_truish nat :=
⟨
  λ s,
    match s with
    | 0 := ff
    | _ := tt
    end
⟩

/-
A function polymorphic in any α for which truish is defined that takes
a value, a, of this type and returns a Boolean true or false (tt or ff)
value, reflecting the truishness of a.
-/
-- open has_truish

def is_truish { α : Type } [has_truish α] (a : α) : bool := has_truish.truish a

/-
Examples of ad hoc polymorphism
-/
#eval is_truish tt
#eval is_truish ff
#eval is_truish 0
#eval is_truish 18
#eval is_truish ""
#eval is_truish "Hello, Lean!"

def if_truish_then_else { α β : Type } [has_truish α] (c : α) (t f : β) : β :=
if is_truish c then t else f

--                        ad hoc  parametric
#eval if_truish_then_else   tt    "Yep" "Nope"
#eval if_truish_then_else   ff    "Yep" "Nope"
#eval if_truish_then_else   0     tt    ff
#eval if_truish_then_else   1     tt    ff

/-
Classic example. See YesNo in Learn You a Haskell.
-/


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.star
import analysis.normed_space.pointwise
import analysis.seminorm
import tactic.congrm

/-!
# The Minkowksi functional

This file defines the Minkowski functional, aka gauge.

The Minkowski functional of a set `s` is the function which associates each point to how much you
need to scale `s` for `x` to be inside it. When `s` is symmetric, convex and absorbent, its gauge is
a seminorm. Reciprocally, any seminorm arises as the gauge of some set, namely its unit ball. This
induces the equivalence of seminorms and locally convex topological vector spaces.

## Main declarations

For a real vector space,
* `gauge`: Aka Minkowksi functional. `gauge s x` is the least (actually, an infimum) `r` such
  that `x ∈ r • s`.
* `gauge_seminorm`: The Minkowski functional as a seminorm, when `s` is symmetric, convex and
  absorbent.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

Minkowski functional, gauge
-/

open normed_field set
open_locale pointwise

noncomputable theory

variables {E : Type*}

section add_comm_group
variables [add_comm_group E] [module ℝ E]

/--The Minkowski functional. Given a set `s` in a real vector space, `gauge s` is the functional
which sends `x : E` to the smallest `r : ℝ` such that `x` is in `s` scaled by `r`. -/
def gauge (s : set E) (x : E) : ℝ := Inf {r : ℝ | 0 < r ∧ x ∈ r • s}

variables {s t : set E} {a : ℝ} {x : E}

lemma gauge_def : gauge s x = Inf {r ∈ set.Ioi 0 | x ∈ r • s} := rfl

/-- An alternative definition of the gauge using scalar multiplication on the element rather than on
the set. -/
lemma gauge_def' : gauge s x = Inf {r ∈ set.Ioi 0 | r⁻¹ • x ∈ s} :=
begin
  congrm Inf (λ r, _),
  exact and_congr_right (λ hr, mem_smul_set_iff_inv_smul_mem₀ hr.ne' _ _),
end

private lemma gauge_set_bdd_below : bdd_below {r : ℝ | 0 < r ∧ x ∈ r • s} := ⟨0, λ r hr, hr.1.le⟩

/-- If the given subset is `absorbent` then the set we take an infimum over in `gauge` is nonempty,
which is useful for proving many properties about the gauge.  -/
lemma absorbent.gauge_set_nonempty (absorbs : absorbent ℝ s) :
  {r : ℝ | 0 < r ∧ x ∈ r • s}.nonempty :=
let ⟨r, hr₁, hr₂⟩ := absorbs x in ⟨r, hr₁, hr₂ r (real.norm_of_nonneg hr₁.le).ge⟩

lemma gauge_mono (hs : absorbent ℝ s) (h : s ⊆ t) : gauge t ≤ gauge s :=
λ x, cInf_le_cInf gauge_set_bdd_below hs.gauge_set_nonempty $ λ r hr, ⟨hr.1, smul_set_mono h hr.2⟩

lemma exists_lt_of_gauge_lt (absorbs : absorbent ℝ s) (h : gauge s x < a) :
  ∃ b, 0 < b ∧ b < a ∧ x ∈ b • s :=
begin
  obtain ⟨b, ⟨hb, hx⟩, hba⟩ := exists_lt_of_cInf_lt absorbs.gauge_set_nonempty h,
  exact ⟨b, hb, hba, hx⟩,
end

/-- The gauge evaluated at `0` is always zero (mathematically this requires `0` to be in the set `s`
but, the real infimum of the empty set in Lean being defined as `0`, it holds unconditionally). -/
@[simp] lemma gauge_zero : gauge s 0 = 0 :=
begin
  rw gauge_def',
  by_cases (0 : E) ∈ s,
  { simp only [smul_zero, sep_true, h, cInf_Ioi] },
  { simp only [smul_zero, sep_false, h, real.Inf_empty] }
end

@[simp] lemma gauge_zero' : gauge (0 : set E) = 0 :=
begin
  ext,
  rw gauge_def',
  obtain rfl | hx := eq_or_ne x 0,
  { simp only [cInf_Ioi, mem_zero, pi.zero_apply, eq_self_iff_true, sep_true, smul_zero] },
  { simp only [mem_zero, pi.zero_apply, inv_eq_zero, smul_eq_zero],
    convert real.Inf_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ r hr, hr.2.elim (ne_of_gt hr.1) hx) }
end

@[simp] lemma gauge_empty : gauge (∅ : set E) = 0 :=
by { ext, simp only [gauge_def', real.Inf_empty, mem_empty_eq, pi.zero_apply, sep_false] }

lemma gauge_of_subset_zero (h : s ⊆ 0) : gauge s = 0 :=
by { obtain rfl | rfl := subset_singleton_iff_eq.1 h, exacts [gauge_empty, gauge_zero'] }

/-- The gauge is always nonnegative. -/
lemma gauge_nonneg (x : E) : 0 ≤ gauge s x := real.Inf_nonneg _ $ λ x hx, hx.1.le

lemma gauge_neg (symmetric : ∀ x ∈ s, -x ∈ s) (x : E) : gauge s (-x) = gauge s x :=
begin
  have : ∀ x, -x ∈ s ↔ x ∈ s := λ x, ⟨λ h, by simpa using symmetric _ h, symmetric x⟩,
  rw [gauge_def', gauge_def'],
  simp_rw [smul_neg, this],
end

lemma gauge_le_of_mem (ha : 0 ≤ a) (hx : x ∈ a • s) : gauge s x ≤ a :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [mem_singleton_iff.1 (zero_smul_set_subset _ hx), gauge_zero] },
  { exact cInf_le gauge_set_bdd_below ⟨ha', hx⟩ }
end

lemma gauge_le_eq (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : absorbent ℝ s) (ha : 0 ≤ a) :
  {x | gauge s x ≤ a} = ⋂ (r : ℝ) (H : a < r), r • s :=
begin
  ext,
  simp_rw [set.mem_Inter, set.mem_set_of_eq],
  refine ⟨λ h r hr, _, λ h, le_of_forall_pos_lt_add (λ ε hε, _)⟩,
  { have hr' := ha.trans_lt hr,
    rw mem_smul_set_iff_inv_smul_mem₀ hr'.ne',
    obtain ⟨δ, δ_pos, hδr, hδ⟩ := exists_lt_of_gauge_lt hs₂ (h.trans_lt hr),
    suffices : (r⁻¹ * δ) • δ⁻¹ • x ∈ s,
    { rwa [smul_smul, mul_inv_cancel_right₀ δ_pos.ne'] at this },
    rw mem_smul_set_iff_inv_smul_mem₀ δ_pos.ne' at hδ,
    refine hs₁.smul_mem_of_zero_mem hs₀ hδ
      ⟨mul_nonneg (inv_nonneg.2 hr'.le) δ_pos.le, _⟩,
    rw [inv_mul_le_iff hr', mul_one],
    exact hδr.le },
  { have hε' := (lt_add_iff_pos_right a).2 (half_pos hε),
    exact (gauge_le_of_mem (ha.trans hε'.le) $ h _ hε').trans_lt
      (add_lt_add_left (half_lt_self hε) _) }
end

lemma gauge_lt_eq' (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r : ℝ) (H : 0 < r) (H : r < a), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_eq (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r ∈ set.Ioo 0 (a : ℝ)), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop, mem_Ioo, and_assoc],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_one_subset_self (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) :
  {x | gauge s x < 1} ⊆ s :=
begin
  rw gauge_lt_eq absorbs,
  refine set.Union₂_subset (λ r hr _, _),
  rintro ⟨y, hy, rfl⟩,
  exact hs.smul_mem_of_zero_mem h₀ hy (Ioo_subset_Icc_self hr),
end

lemma gauge_le_one_of_mem {x : E} (hx : x ∈ s) : gauge s x ≤ 1 :=
gauge_le_of_mem zero_le_one $ by rwa one_smul

lemma self_subset_gauge_le_one : s ⊆ {x | gauge s x ≤ 1} := λ x, gauge_le_one_of_mem

lemma convex.gauge_le (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) (a : ℝ) :
  convex ℝ {x | gauge s x ≤ a} :=
begin
  by_cases ha : 0 ≤ a,
  { rw gauge_le_eq hs h₀ absorbs ha,
    exact convex_Inter (λ i, convex_Inter (λ hi, hs.smul _)) },
  { convert convex_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ x hx, ha $ (gauge_nonneg _).trans hx) }
end

lemma balanced.star_convex (hs : balanced ℝ s) : star_convex ℝ 0 s :=
star_convex_zero_iff.2 $ λ x hx a ha₀ ha₁,
  hs _ (by rwa real.norm_of_nonneg ha₀) (smul_mem_smul_set hx)

lemma le_gauge_of_not_mem (hs₀ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ a • s) :
  a ≤ gauge s x :=
begin
  rw star_convex_zero_iff at hs₀,
  obtain ⟨r, hr, h⟩ := hs₂,
  refine le_cInf ⟨r, hr, singleton_subset_iff.1 $ h _ (real.norm_of_nonneg hr.le).ge⟩ _,
  rintro b ⟨hb, x, hx', rfl⟩,
  refine not_lt.1 (λ hba, hx _),
  have ha := hb.trans hba,
  refine ⟨(a⁻¹ * b) • x, hs₀ hx' (mul_nonneg (inv_nonneg.2 ha.le) hb.le) _, _⟩,
  { rw ←div_eq_inv_mul,
    exact div_le_one_of_le hba.le ha.le },
  { rw [←mul_smul, mul_inv_cancel_left₀ ha.ne'] }
end

lemma one_le_gauge_of_not_mem (hs₁ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ s) :
  1 ≤ gauge s x :=
le_gauge_of_not_mem hs₁ hs₂ $ by rwa one_smul

section linear_ordered_field
variables {α : Type*} [linear_ordered_field α] [mul_action_with_zero α ℝ] [ordered_smul α ℝ]

lemma gauge_smul_of_nonneg [mul_action_with_zero α E] [is_scalar_tower α ℝ (set E)] {s : set E}
  {a : α} (ha : 0 ≤ a) (x : E) :
  gauge s (a • x) = a • gauge s x :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul, gauge_zero, zero_smul] },
  rw [gauge_def', gauge_def', ←real.Inf_smul_of_nonneg ha],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_eq],
  split,
  { rintro ⟨hr, hx⟩,
    simp_rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos (inv_pos.2 ha') hr,
    refine ⟨a⁻¹ • r, ⟨this, _⟩, smul_inv_smul₀ ha'.ne' _⟩,
    rwa [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc,
      mem_smul_set_iff_inv_smul_mem₀ (inv_ne_zero ha'.ne'), inv_inv] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos ha' hr,
    refine ⟨this, _⟩,
    rw [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc],
    exact smul_mem_smul_set hx }
end

/-- In textbooks, this is the homogeneity of the Minkowksi functional. -/
lemma gauge_smul [module α E] [is_scalar_tower α ℝ (set E)] {s : set E}
  (symmetric : ∀ x ∈ s, -x ∈ s) (r : α) (x : E) :
  gauge s (r • x) = abs r • gauge s x :=
begin
  rw ←gauge_smul_of_nonneg (abs_nonneg r),
  obtain h | h := abs_choice r,
  { rw h },
  { rw [h, neg_smul, gauge_neg symmetric] },
  { apply_instance }
end

lemma gauge_smul_left_of_nonneg [mul_action_with_zero α E] [smul_comm_class α ℝ ℝ]
  [is_scalar_tower α ℝ ℝ] [is_scalar_tower α ℝ E] {s : set E} {a : α} (ha : 0 ≤ a) :
  gauge (a • s) = a⁻¹ • gauge s :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [inv_zero, zero_smul, gauge_of_subset_zero (zero_smul_set_subset _)] },
  ext,
  rw [gauge_def', pi.smul_apply, gauge_def', ←real.Inf_smul_of_nonneg (inv_nonneg.2 ha)],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_eq],
  split,
  { rintro ⟨hr, y, hy, h⟩,
    simp_rw [mem_Ioi] at ⊢ hr,
    refine ⟨a • r, ⟨smul_pos ha' hr, _⟩, inv_smul_smul₀ ha'.ne' _⟩,
    rwa [smul_inv₀, smul_assoc, ←h, inv_smul_smul₀ ha'.ne'] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    have := smul_pos ha' hr,
    refine ⟨smul_pos (inv_pos.2 ha') hr, r⁻¹ • x, hx, _⟩,
    rw [smul_inv₀, smul_assoc, inv_inv] }
end

lemma gauge_smul_left [module α E] [smul_comm_class α ℝ ℝ] [is_scalar_tower α ℝ ℝ]
  [is_scalar_tower α ℝ E] {s : set E} (symmetric : ∀ x ∈ s, -x ∈ s) (a : α) :
  gauge (a • s) = |a|⁻¹ • gauge s :=
begin
  rw ←gauge_smul_left_of_nonneg (abs_nonneg a),
  obtain h | h := abs_choice a,
  { rw h },
  { rw [h, set.neg_smul_set, ←set.smul_set_neg],
    congr,
    ext y,
    refine ⟨symmetric _, λ hy, _⟩,
    rw ←neg_neg y,
    exact symmetric _ hy },
  { apply_instance }
end

end linear_ordered_field

section topological_space
variables [topological_space E] [has_continuous_smul ℝ E]

lemma interior_subset_gauge_lt_one (s : set E) : interior s ⊆ {x | gauge s x < 1} :=
begin
  intros x hx,
  let f : ℝ → E := λ t, t • x,
  have hf : continuous f,
  { continuity },
  let s' := f ⁻¹' (interior s),
  have hs' : is_open s' := hf.is_open_preimage _ is_open_interior,
  have one_mem : (1 : ℝ) ∈ s',
  { simpa only [s', f, set.mem_preimage, one_smul] },
  obtain ⟨ε, hε₀, hε⟩ := (metric.nhds_basis_closed_ball.1 _).1
    (is_open_iff_mem_nhds.1 hs' 1 one_mem),
  rw real.closed_ball_eq_Icc at hε,
  have hε₁ : 0 < 1 + ε := hε₀.trans (lt_one_add ε),
  have : (1 + ε)⁻¹ < 1,
  { rw inv_lt_one_iff,
    right,
    linarith },
  refine (gauge_le_of_mem (inv_nonneg.2 hε₁.le) _).trans_lt this,
  rw mem_inv_smul_set_iff₀ hε₁.ne',
  exact interior_subset
    (hε ⟨(sub_le_self _ hε₀.le).trans ((le_add_iff_nonneg_right _).2 hε₀.le), le_rfl⟩),
end

lemma gauge_lt_one_eq_self_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s) :
  {x | gauge s x < 1} = s :=
begin
  refine (gauge_lt_one_subset_self hs₁ ‹_› $ absorbent_nhds_zero $ hs₂.mem_nhds hs₀).antisymm _,
  convert interior_subset_gauge_lt_one s,
  exact hs₂.interior_eq.symm,
end

lemma gauge_lt_one_of_mem_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s)
  {x : E} (hx : x ∈ s) :
  gauge s x < 1 :=
by rwa ←gauge_lt_one_eq_self_of_open hs₁ hs₀ hs₂ at hx

lemma gauge_lt_of_mem_smul (x : E) (ε : ℝ) (hε : 0 < ε) (hs₀ : (0 : E) ∈ s)
  (hs₁ : convex ℝ s) (hs₂ : is_open s) (hx : x ∈ ε • s) :
  gauge s x < ε :=
begin
  have : ε⁻¹ • x ∈ s,
  { rwa ←mem_smul_set_iff_inv_smul_mem₀ hε.ne' },
  have h_gauge_lt := gauge_lt_one_of_mem_of_open hs₁ hs₀ hs₂ this,
  rwa [gauge_smul_of_nonneg (inv_nonneg.2 hε.le), smul_eq_mul, inv_mul_lt_iff hε, mul_one]
    at h_gauge_lt,
  apply_instance
end

end topological_space

lemma gauge_add_le (hs : convex ℝ s) (absorbs : absorbent ℝ s) (x y : E) :
  gauge s (x + y) ≤ gauge s x + gauge s y :=
begin
  refine le_of_forall_pos_lt_add (λ ε hε, _),
  obtain ⟨a, ha, ha', hx⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s x) (half_pos hε)),
  obtain ⟨b, hb, hb', hy⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s y) (half_pos hε)),
  rw mem_smul_set_iff_inv_smul_mem₀ ha.ne' at hx,
  rw mem_smul_set_iff_inv_smul_mem₀ hb.ne' at hy,
  suffices : gauge s (x + y) ≤ a + b,
  { linarith },
  have hab : 0 < a + b := add_pos ha hb,
  apply gauge_le_of_mem hab.le,
  have := convex_iff_div.1 hs hx hy ha.le hb.le hab,
  rwa [smul_smul, smul_smul, ←mul_div_right_comm, ←mul_div_right_comm, mul_inv_cancel ha.ne',
    mul_inv_cancel hb.ne', ←smul_add, one_div, ←mem_smul_set_iff_inv_smul_mem₀ hab.ne'] at this,
end

/-- `gauge s` as a seminorm when `s` is symmetric, convex and absorbent. -/
@[simps] def gauge_seminorm (hs₀ : ∀ x ∈ s, -x ∈ s) (hs₁ : convex ℝ s) (hs₂ : absorbent ℝ s) :
  seminorm ℝ E :=
seminorm.of (gauge s) (gauge_add_le hs₁ hs₂)
  (λ r x, by rw [gauge_smul hs₀, real.norm_eq_abs, smul_eq_mul]; apply_instance)

section gauge_seminorm
variables {hs₀ : ∀ x ∈ s, -x ∈ s} {hs₁ : convex ℝ s} {hs₂ : absorbent ℝ s}

section topological_space
variables [topological_space E] [has_continuous_smul ℝ E]

lemma gauge_seminorm_lt_one_of_open (hs : is_open s) {x : E} (hx : x ∈ s) :
  gauge_seminorm hs₀ hs₁ hs₂ x < 1 :=
gauge_lt_one_of_mem_of_open hs₁ hs₂.zero_mem hs hx

end topological_space
end gauge_seminorm

/-- Any seminorm arises as the gauge of its unit ball. -/
@[simp] protected lemma seminorm.gauge_ball (p : seminorm ℝ E) : gauge (p.ball 0 1) = p :=
begin
  ext,
  obtain hp | hp := {r : ℝ | 0 < r ∧ x ∈ r • p.ball 0 1}.eq_empty_or_nonempty,
  { rw [gauge, hp, real.Inf_empty],
    by_contra,
    have hpx : 0 < p x := (p.nonneg x).lt_of_ne h,
    have hpx₂ : 0 < 2 * p x := mul_pos zero_lt_two hpx,
    refine hp.subset ⟨hpx₂, (2 * p x)⁻¹ • x, _, smul_inv_smul₀ hpx₂.ne' _⟩,
    rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpx₂), inv_mul_lt_iff hpx₂,
      mul_one],
    exact lt_mul_of_one_lt_left hpx one_lt_two },
  refine is_glb.cInf_eq ⟨λ r, _, λ r hr, le_of_forall_pos_le_add $ λ ε hε, _⟩ hp,
  { rintro ⟨hr, y, hy, rfl⟩,
    rw p.mem_ball_zero at hy,
    rw [p.smul, real.norm_eq_abs, abs_of_pos hr],
    exact mul_le_of_le_one_right hr.le hy.le },
  { have hpε : 0 < p x + ε := add_pos_of_nonneg_of_pos (p.nonneg _) hε,
    refine hr ⟨hpε, (p x + ε)⁻¹ • x, _, smul_inv_smul₀ hpε.ne' _⟩,
    rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpε), inv_mul_lt_iff hpε,
      mul_one],
    exact lt_add_of_pos_right _ hε }
end

lemma seminorm.gauge_seminorm_ball (p : seminorm ℝ E) :
  gauge_seminorm (λ x, p.symmetric_ball_zero 1) (p.convex_ball 0 1)
    (p.absorbent_ball_zero zero_lt_one) = p := fun_like.coe_injective p.gauge_ball

end add_comm_group

section norm
variables [semi_normed_group E] [normed_space ℝ E] {s : set E} {r : ℝ} {x : E}

lemma gauge_unit_ball (x : E) : gauge (metric.ball (0 : E) 1) x = ∥x∥ :=
begin
  obtain rfl | hx := eq_or_ne x 0,
  { rw [norm_zero, gauge_zero] },
  refine (le_of_forall_pos_le_add $ λ ε hε, _).antisymm _,
  { have := add_pos_of_nonneg_of_pos (norm_nonneg x) hε,
    refine gauge_le_of_mem this.le _,
    rw [smul_ball this.ne', smul_zero, real.norm_of_nonneg this.le, mul_one, mem_ball_zero_iff],
    exact lt_add_of_pos_right _ hε },
  refine le_gauge_of_not_mem balanced_ball_zero.star_convex
    (absorbent_ball_zero zero_lt_one).absorbs (λ h, _),
  obtain hx' | hx' := eq_or_ne (∥x∥) 0,
  { rw hx' at h,
    exact hx (zero_smul_set_subset _ h) },
  { rw [mem_smul_set_iff_inv_smul_mem₀ hx', mem_ball_zero_iff, norm_smul, norm_inv, norm_norm,
      inv_mul_cancel hx'] at h,
    exact lt_irrefl _ h }
end

lemma gauge_ball (hr : 0 < r) (x : E) : gauge (metric.ball (0 : E) r) x = ∥x∥ / r :=
begin
  rw [←smul_unit_ball_of_pos hr, gauge_smul_left, pi.smul_apply, gauge_unit_ball, smul_eq_mul,
    abs_of_nonneg hr.le, div_eq_inv_mul],
  simp_rw [mem_ball_zero_iff, norm_neg],
  exact λ _, id,
end

lemma mul_gauge_le_norm (hs : metric.ball (0 : E) r ⊆ s) : r * gauge s x ≤ ∥x∥ :=
begin
  obtain hr | hr := le_or_lt r 0,
  { exact (mul_nonpos_of_nonpos_of_nonneg hr $ gauge_nonneg _).trans (norm_nonneg _) },
  rw [mul_comm, ←le_div_iff hr, ←gauge_ball hr],
  exact gauge_mono (absorbent_ball_zero hr) hs x,
end

end norm


import data.real.basic

-- TODO: Move.
lemma mul_Inf {K : ℝ} (hK : 0 ≤ K) {p : ℝ → Prop}
(h : ∃ x, 0 ≤ x ∧ p x) (hp : p (Inf {x | 0 ≤ x ∧ p x}))
: K * Inf {x | 0 ≤ x ∧ p x} = Inf {y | ∃ x, (y : ℝ) = K * x ∧ 0 ≤ x ∧ p x} :=
begin
  rcases h with ⟨i, hnni, hpi⟩,
  let S := {y | ∃ x, y = K * x ∧ 0 ≤ x ∧ p x},
  apply le_antisymm,
  { have h1 : (∃ (x : ℝ), x ∈ S) := ⟨K * i, ⟨i, rfl, hnni, hpi⟩⟩,
    have h2 : (∃ (x : ℝ), ∀ (y : ℝ), y ∈ S → x ≤ y),
    { existsi (0 : ℝ), rintros y ⟨x, hy, hnnx, hpx⟩,
      rw hy, exact mul_nonneg hK hnnx, },
    rw real.le_Inf S h1 h2, rintros z ⟨w, hz, hnnw, hpw⟩,
    rw hz, mono,
    { refine cInf_le _ ⟨hnnw, hpw⟩, use 0, intros a ha, exact ha.1, },
    { apply le_cInf,
      { use [i, ⟨hnni, hpi⟩], },
      { intros b hb, exact hb.1, }, }, },
  { apply real.Inf_le,
    { use [0], intros y hy, rcases hy with ⟨x, ⟨hy, hnnx, hpx⟩⟩,
      rw hy, exact mul_nonneg hK hnnx, },
    { use [Inf {x : ℝ | 0 ≤ x ∧ p x}], refine ⟨rfl, _, _⟩,
      { apply le_cInf,
        { use [i, ⟨hnni, hpi⟩], },
        { intros b hb, exact hb.1, }, },
      { exact hp, }, }, },
end


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

! This file was ported from Lean 3 source module topology.algebra.order.extr_closure
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.LocalExtr
import Mathlib.Topology.Order.Basic

/-!
# Maximum/minimum on the closure of a set

In this file we prove several versions of the following statement: if `f : X → Y` has a (local or
not) maximum (or minimum) on a set `s` at a point `a` and is continuous on the closure of `s`, then
`f` has an extremum of the same type on `Closure s` at `a`.
-/

open Filter Set

open Topology

variable {X Y : Type _} [TopologicalSpace X] [TopologicalSpace Y] [Preorder Y]
  [OrderClosedTopology Y] {f g : X → Y} {s : Set X} {a : X}

protected theorem IsMaxOn.closure (h : IsMaxOn f s a) (hc : ContinuousOn f (closure s)) :
    IsMaxOn f (closure s) a := fun x hx =>
  ContinuousWithinAt.closure_le hx ((hc x hx).mono subset_closure) continuousWithinAt_const h
#align is_max_on.closure IsMaxOn.closure

protected theorem IsMinOn.closure (h : IsMinOn f s a) (hc : ContinuousOn f (closure s)) :
    IsMinOn f (closure s) a :=
  h.dual.closure hc
#align is_min_on.closure IsMinOn.closure

protected theorem IsExtrOn.closure (h : IsExtrOn f s a) (hc : ContinuousOn f (closure s)) :
    IsExtrOn f (closure s) a :=
  h.elim (fun h => Or.inl <| h.closure hc) fun h => Or.inr <| h.closure hc
#align is_extr_on.closure IsExtrOn.closure

protected theorem IsLocalMaxOn.closure (h : IsLocalMaxOn f s a) (hc : ContinuousOn f (closure s)) :
    IsLocalMaxOn f (closure s) a := by
  rcases mem_nhdsWithin.1 h with ⟨U, Uo, aU, hU⟩
  refine' mem_nhdsWithin.2 ⟨U, Uo, aU, _⟩
  rintro x ⟨hxU, hxs⟩
  refine' ContinuousWithinAt.closure_le _ _ continuousWithinAt_const hU
  · rwa [mem_closure_iff_nhdsWithin_neBot, nhdsWithin_inter_of_mem, ←
      mem_closure_iff_nhdsWithin_neBot]
    exact nhdsWithin_le_nhds (Uo.mem_nhds hxU)
  · exact (hc _ hxs).mono ((inter_subset_right _ _).trans subset_closure)
#align is_local_max_on.closure IsLocalMaxOn.closure

protected theorem IsLocalMinOn.closure (h : IsLocalMinOn f s a) (hc : ContinuousOn f (closure s)) :
    IsLocalMinOn f (closure s) a :=
  IsLocalMaxOn.closure h.dual hc
#align is_local_min_on.closure IsLocalMinOn.closure

protected theorem IsLocalExtrOn.closure (h : IsLocalExtrOn f s a)
    (hc : ContinuousOn f (closure s)) : IsLocalExtrOn f (closure s) a :=
  h.elim (fun h => Or.inl <| h.closure hc) fun h => Or.inr <| h.closure hc
#align is_local_extr_on.closure IsLocalExtrOn.closure


-- We import all of Lean's standard tactics
import tactic

/-!
# Logic

We will develop the basic theory of following five basic logical symbols

* `→` ("implies" -- type with `\l`)
* `¬` ("not" -- type with `\not` or `\n`)
* `∧` ("and" -- type with `\and` or `\an`)
* `↔` ("iff" -- type with `\iff` or `\lr`)
* `∨` ("or" -- type with `\or` or `\v`

# Tactics you will need to know

* `intro`
* `exact`
* `apply`
* `rw`
* `cases`
* `split`
* `left`
* `right`

See `README.md` in `src/week_1` for an explanation of what these
tactics do.

Note that there are plenty of other tactics, and indeed once you've
"got the hang of it" you might want to try tactics such as `cc`,
`tauto` and its variant `tauto!`, `finish`, and `library_search`.

# What to do

The `example`s are to demonstrate things to you. They sometimes
use tactics you don't know. You can look at them but you don't
need to touch them.

The `theorem`s and `lemma`s are things which have no proof. You need to change
the `sorry`s into proofs which Lean will accept.

This paragraph is a comment, by the way. One-line comments
are preceded with `--`.
-/

-- We work in a "namespace". All this means is that whenever it
-- looks like we've defined a new theorem called `id`, its full
-- name is `xena.id`. Which is good because `id` is already
-- defined in Lean.
namespace xena

-- Throughout this namespace, P Q and R will be arbitrary (variable)
-- true-false statements.
variables (P Q R : Prop)

/-!
## implies (→)

To prove the theorems in this section, you will need to know about
the tactics `intro`, `apply` and `exact`. You might also like
the `assumption` tactic.
-/

/-- Every proposition implies itself. -/
theorem id : P → P :=
begin
  -- let hP be a proof of P
  intro hP,
  -- then hP is a proof of P!
  exact hP
end

/-
Note that → isn't associative!
Try working out `false → (false → false) and (false → false) → false
-/

example : (false → (false → false)) ↔ true := by simp
example : ((false → false) → false) ↔ false := by simp

-- in Lean, `P → Q → R` is _defined_ to mean `P → (Q → R)`
-- Here's a proof of what I just said.
example : (P → Q → R) ↔ (P → (Q → R)) :=
begin
  -- look at the goal!
  refl -- true because ↔ is reflexive
end

theorem imp_intro : P → Q → P :=
begin
  -- remember that by definition the goal is P → (Q → P),
  -- so it's P implies something, so let's assume
  -- that P is true and call this hypothesis hP.
  intro hP,
  -- Now we have to prove that Q implies P, so let's
  -- assume that Q is true, and let's call this hypothesis hQ
  intro hQ,
  -- We now have to prove that P is true.
  -- But this is exactly our hypothesis hP.
  exact hP,
end

/-- If we know `P`, and we also know `P → Q`, we can deduce `Q`. -/
lemma modus_ponens : P → (P → Q) → Q :=
begin
  -- remember this means "P implies that ((P implies Q) implies Q)"
  -- so let's assume P is true
  intro hP,
  -- and let's assume hypothesis hPQ, that P implies Q
  intro hPQ,
  -- now `hPQ` says `P → Q` and we're trying to prove `Q`!
  -- So by applying the hypothesis `hPQ`, we can reduce
  -- this puzzle to proving `P`.
  apply hPQ,
  -- Now we have to prove `P`. But this is just an assumption
  exact hP, -- or `assumption`
end

/-- implication is transitive -/
lemma imp_trans : (P → Q) → (Q → R) → (P → R) :=
begin
  -- intros will let you intro many things at once
  intros hPQ hQR hP,
  -- The goal is now `⊢ R`, and `hQR : Q → R` so `apply hQR` reduces the goal to `Q`
  apply hQR,
  -- similarly `apply hPQ` reduces the goal to `P`.
  apply hPQ,
  -- We are kind of proving this result backwards! We already have
  -- a proof of P.
  exact hP
end

-- This one is a "relative modus ponens" -- in the
-- presence of P, if Q -> R and Q then R.
lemma forall_imp : (P → Q → R) → (P → Q) → (P → R) :=
begin
  -- Let `hPQR` be the hypothesis that `P → Q → R`.
  intro hPQR,
  -- We now need to prove that `(P → Q)` implies something.
  -- So let `hPQ` be hypothesis that `P → Q`
  intro hPQ,
  -- We now need to prove that `P` implies something, so
  -- let `hP` be the hypothesis that `P` is true.
  intro hP,
  -- We now have to prove `R`.
  -- We know the hypothesis `hPQR : P → (Q → R)`.
  -- If you think about this, it's the same as `(P ∧ Q) → R`
  -- So perhaps it's not surprising that after
  apply hPQR,
    -- we now have two goals!
    -- The first goal is just to prove P, and this is an assumption
    exact hP,
  -- The number of goals is just one again.
  -- the remaining goal is to prove `Q`.
  -- But recall that `hPQ` is the hypothesis that `P` implies `Q`
  -- so by applying it,
  apply hPQ,
  -- we change our goal to proving `P`. And this is a hypothesis
  exact hP,
end

/-

### not

`not P`, with notation `¬ P`, is *defined* to mean `P → false` in Lean,
i.e., the proposition that P implies false. You can easily check with
a truth table that P → false and ¬ P are equivalent.

We develop a basic interface for `¬`.
-/

-- I'll prove this one for you
theorem not_def : ¬ P ↔ (P → false) :=
begin
  -- true by definition
  refl
end

theorem not_not_intro : P → ¬ (¬ P) :=
begin
  intro hP,
  -- You can use `rw not_def` to change `¬ X` into `X → false`.
  rw not_def, rw not_def, -- but it's not necessary really,
  intro hnP,
  apply hnP,
  exact hP,
end

-- Here is a funny alternative proof! Can you work out how it works?
example : P → ¬ (¬ P) :=
begin
  apply modus_ponens,
end

-- Here is a proof which does not use tactics at all, but uses lambda calculus.
-- It is called a "term mode" proof. We will not be discussing term mode
-- much in this course. It is a cool way to do basic logic proofs, but
-- it does not scale well in practice.
example : P → ¬ (¬ P) :=
λ hP hnP, hnP hP

-- This is "modus tollens". Some mathematicians think of it as
-- "proof by contradiction".
theorem modus_tollens : (P → Q) → (¬ Q → ¬ P) :=
begin
  -- this is (P → Q) → (Q → false) → (P → false) so we can just...
  apply imp_trans,
end

-- This one cannot be proved using constructive mathematics!
-- You _have_ to use a tactic like `by_contra` (or, if you're happy
-- to cheat, the full "truth table" tactic `tauto!`.
-- Try it without using these, and you'll get stuck!
theorem double_negation_elimination : ¬ (¬ P) → P :=
begin
  intro hnnP,
  by_contra h,
  -- hnnP is ¬ P → false, and the goal is ⊢ false, so we can do this
  apply hnnP,
  exact h,
end

/-!

### and

The hypothesis `hPaQ : P ∧ Q` in Lean, is equivalent to
hypotheses `hP : P` and `hQ : Q`.

If you have `hPaQ` as a hypothesis, and you want to get to
`hP` and `hQ`, you can use the `cases` tactic.

If you have `⊢ P ∧ Q` as a goal, and want to turn the goal
into two goals `⊢ P` and `⊢ Q`, then use the `split` tactic.

Note that after `split` it's good etiquette to use braces
e.g.

example (hP : P) (hQ : Q) : P ∧ Q :=
begin
  split,
  { exact hP },
  { exact hQ }
end

but for this sort of stuff I think principled indentation
is OK

```
example (hP : P) (hQ : Q) : P ∧ Q :=
begin
  split,
    exact hP,
  exact hQ
end
```

-/

theorem and.elim_left : P ∧ Q → P :=
begin
  intro hPaQ,
  cases hPaQ with hP hQ,
  exact hP,
end

theorem and.elim_right : P ∧ Q → Q :=
begin
  intro hPaQ,
  -- here's a shortcut
  exact hPaQ.2, -- if `h : P ∧ Q` then `h.1 : P` and `h.2 : Q`
end

-- fancy term mode proof
example : P ∧ Q → Q := λ hPaQ, hPaQ.2

theorem and.intro : P → Q → P ∧ Q :=
begin
  intros hP hQ,
  split,
  { assumption },
  { assumption }
end

/-- the eliminator for `∧` -/
theorem and.elim : P ∧ Q → (P → Q → R) → R :=
begin
  -- `rintro` does `intro` and `cases` in one go
  rintro ⟨hP, hQ⟩ hPQR,
  -- hPQR is a function, so we can give it some inputs
  exact hPQR hP hQ,
end

/-- The recursor for `∧` -/
theorem and.rec : (P → Q → R) → P ∧ Q → R :=
begin
  rintro hPQR ⟨hP, hQ⟩,
  exact hPQR hP hQ,
end

/-- `∧` is symmetric -/
theorem and.symm : P ∧ Q → Q ∧ P :=
begin
  -- see how quickly we can do this using ⟨_, _⟩
  rintro ⟨hP, hQ⟩,
  exact ⟨hQ, hP⟩
end

-- term mode proof
example : P ∧ Q → Q ∧ P :=
λ ⟨hP, hQ⟩, ⟨hQ, hP⟩

/-- `∧` is transitive -/
theorem and.trans : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  rintro ⟨hP, hQ⟩ ⟨hQ', hR⟩,
  exact ⟨hP, hR⟩,
end

/-
Recall that the convention for the implies sign →
is that it is _right associative_, by which
I mean that `P → Q → R` means `P → (Q → R)` by definition.
Now note that if `P` implies `Q → R`
then this means that `P` and `Q` together, imply `R`,
so `P → Q → R` is logically equivalent to `(P ∧ Q) → R`.

We proved that `P → Q → R` implied `(P ∧ Q) → R`; this was `and.rec`.
Let's go the other way.
-/

lemma imp_imp_of_and_imp : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  intros h hP hQ,
  exact h ⟨hP, hQ⟩
end

/-!

### iff

The basic theory of `iff`.

In Lean, to prove `P ∧ Q` you have to prove `P` and `Q`.
Similarly, to prove `P ↔ Q` in Lean, you have to prove `P → Q`
and `Q → P`. Just like `∧`, you can uses `cases h` if you have
a hypothesis `h : P ↔ Q`, and `split` if you have a goal `⊢ P ↔ Q`.
-/

/-- `P ↔ P` is true for all propositions `P`, i.e. `↔` is reflexive. -/
theorem iff.refl : P ↔ P :=
begin
  split,
  -- recall that we already proved `id : P → P`
  { apply id },
  { apply id }
end

-- If you get stuck, there is always the "truth table" tactic `tauto!`
example : P ↔ P :=
begin
  tauto!, -- the "truth table" tactic.
end

-- refl tactic also works
example : P ↔ P :=
begin
  refl -- `refl` knows that `=` and `↔` are reflexive.
end

/-- `↔` is symmetric -/
theorem iff.symm : (P ↔ Q) → (Q ↔ P) :=
begin
  intro h,
  /-
  h: P ↔ Q
  ⊢ Q ↔ P
  -/
  rw h,
  -- This changes the goal to `Q ↔ Q`, which is automatically closed by `refl`
  -- because `rw` tries a cheeky `refl` after every invocation, just to see
  -- if it closes the goal
end

-- show-off term mode proof
example : (P ↔ Q) → (Q ↔ P) :=
λ ⟨hPQ, hQP⟩, ⟨hQP, hPQ⟩

/-- `↔` is commutative -/
theorem iff.comm : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  split,
  { apply iff.symm },
  { apply iff.symm }
end

-- without rw or cc this is painful!
/-- `↔` is transitive -/
theorem iff.trans :  (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intros hPQ hQR,
  -- ⊢ P ↔ R
  rw hPQ,
  -- ⊢ Q ↔ R
  exact hQR,
end

-- This can be done constructively, but it's hard. You'll need to know
-- about the `have` tactic to do it. Alternatively the truth table
-- tactic `tauto!` will do it.
theorem iff.boss : ¬ (P ↔ ¬ P) :=
begin
  rintro ⟨h1, h2⟩,
  have hnP : ¬ P,
  { intro hP,
    exact h1 hP hP,
  },
  have hP : P := h2 hnP,
  exact hnP hP,
end

-- Now we have iff we can go back to and.

/-!
### ↔ and ∧
-/

/-- `∧` is commutative -/
theorem and.comm : P ∧ Q ↔ Q ∧ P :=
begin
  split; -- semicolon means "apply next tactic to all goals generated by this one"
  apply and.symm,
end

-- fancy term-mode proof
example : P ∧ Q ↔ Q ∧ P :=
⟨and.symm _ _, and.symm _ _⟩

-- Note that ∧ is "right associative" in Lean, which means
-- that `P ∧ Q ∧ R` is _defined to mean_ `P ∧ (Q ∧ R)`.
-- Associativity can hence be written like this:
/-- `∧` is associative -/
theorem and_assoc : ((P ∧ Q) ∧ R) ↔ (P ∧ Q ∧ R) :=
begin
  split,
  { rintro ⟨⟨hP, hQ⟩, hR⟩,
    exact ⟨hP, hQ, hR⟩ },
  { rintro ⟨hP, hQ, hR⟩,
    exact ⟨⟨hP, hQ⟩, hR⟩ },
end

/-!

## Or

`P ∨ Q` is true when at least one of `P` and `Q` are true.
Here is how to work with `∨` in Lean.

If you have a hypothesis `hPoQ : P ∨ Q` then you
can break into the two cases `hP : P` and `hQ : Q` using
`cases hPoQ with hP hQ`

If you have a _goal_ of the form `⊢ P ∨ Q` then you
need to decide whether you're going to prove `P` or `Q`.
If you want to prove `P` then use the `left` tactic,
and if you want to prove `Q` then use the `right` tactic.

-/

-- recall that P, Q, R are Propositions. We'll need S for this one.
variable (S : Prop)

-- You will need to use the `left `tactic for this one.
theorem or.intro_left : P → P ∨ Q :=
begin
  intro P,
  left,
  -- `assumption` means `exact <choose the correct hypothesis>`
  assumption,
end

theorem or.intro_right : Q → P ∨ Q :=
begin
  intro Q,
  right,
  assumption,
end

/-- the eliminator for `∨`. -/
theorem or.elim : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  intros hPoQ hPR hQR,
  cases hPoQ with hP hQ,
  { exact hPR hP },
  { exact hQR hQ }
end

/-- `∨` is symmetric -/
theorem or.symm : P ∨ Q → Q ∨ P :=
begin
  intro hPoQ,
  cases hPoQ with hP hQ,
  { right, assumption },
  { left, assumption }
end

/-- `∨` is commutative -/
theorem or.comm : P ∨ Q ↔ Q ∨ P :=
begin
  split; -- note semicolon
  apply or.symm,
end

/-- `∨` is associative -/
theorem or.assoc : (P ∨ Q) ∨ R ↔ P ∨ Q ∨ R :=
begin
  split,
  { -- rintro can do intro+cases in one go
    rintro ((hP | hQ) | hR),
    { left, assumption },
    { right, left, assumption },
    { right, right, assumption } },
  { rintro (hP | hQ | hR),
    { left, left, assumption },
    { left, right, assumption },
    { right, assumption } }
end

/-!
### More about → and ∨
-/

theorem or.imp : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  rintro hPR hQS (hP | hQ),
  { left, exact hPR hP },
  { right, exact hQS hQ }
end

theorem or.imp_left : (P → Q) → P ∨ R → Q ∨ R :=
begin
  rintro hPQ (hP | hR),
  { left, exact hPQ hP },
  { right, assumption },
end

theorem or.imp_right : (P → Q) → R ∨ P → R ∨ Q :=
begin
  -- reduce to previous lemma
  rw or.comm R,
  rw or.comm R,
  apply or.imp_left,
end

theorem or.left_comm : P ∨ Q ∨ R ↔ Q ∨ P ∨ R :=
begin
  rw [or.comm P, or.assoc, or.comm R],
end

/-- the recursor for `∨` -/
theorem or.rec : (P → R) → (Q → R) → P ∨ Q → R :=
begin
  intros hPR hQR hPoQ,
  exact or.elim _ _ _ hPoQ hPR hQR,
end

theorem or_congr : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  rintro hPR hQS,
  rw [hPR, hQS],
end

/-!

### true and false

`true` is a true-false statement, which can be proved with the `trivial` tactic.

`false` is a true-false statment which can only be proved if you manage
to find a contradiction within your assumptions.

If you manage to end up with a hypothesis `h : false` then there's quite
a funny way to proceed, which we now explain.

If you have `h : P ∧ Q` then you can uses `cases h with hP hQ` to split
into two cases.

If you have `h : false` then what do you think happens if we do `cases h`?
Hint: how many cases are there?
-/

/-- eliminator for `false` -/
theorem false.elim : false → P :=
begin
  intro h,
  cases h,
end

theorem and_true_iff : P ∧ true ↔ P :=
begin
  split,
  { rintro ⟨hP, -⟩,
    exact hP },
  { intro hP,
    split,
    { exact hP },
    { trivial } }
end

theorem or_false_iff : P ∨ false ↔ P :=
begin
  split,
  { rintro (hP | h),
    { assumption },
    { cases h} },
  { intro hP,
    left,
    exact hP }
end

-- false.elim is handy for this one
theorem or.resolve_left : P ∨ Q → ¬P → Q :=
begin
  rintro (hP | hQ) hnP,
  { apply false.elim,
    exact hnP hP },
  { exact hQ },
end

-- this one you can't do constructively
theorem or_iff_not_imp_left : P ∨ Q ↔ ¬P → Q :=
begin
  split,
  { apply or.resolve_left },
  { intro hnPQ,
    -- TODO : document this tactic
    by_cases h : P,
    { left, assumption },
    { right, exact hnPQ h} }
end

end xena