/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

! This file was ported from Lean 3 source module number_theory.padics.padic_norm
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Field.Power
import Mathlib.NumberTheory.Padics.PadicVal

/-!
# p-adic norm

This file defines the `p`-adic norm on `ℚ`.

The `p`-adic valuation on `ℚ` is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on `p`.

The valuation induces a norm on `ℚ`. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[Fact p.Prime]` as a type class argument.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

/-- If `q ≠ 0`, the `p`-adic norm of a rational `q` is `p ^ (-padicValRat p q)`.
If `q = 0`, the `p`-adic norm of `q` is `0`. -/
def padicNorm (p : ℕ) (q : ℚ) : ℚ :=
  if q = 0 then 0 else (p : ℚ) ^ (-padicValRat p q)
#align padic_norm padicNorm

namespace padicNorm

open padicValRat

variable {p : ℕ}

/-- Unfolds the definition of the `p`-adic norm of `q` when `q ≠ 0`. -/
@[simp]
protected theorem eq_zpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
    padicNorm p q = (p : ℚ) ^ (-padicValRat p q) := by simp [hq, padicNorm]
#align padic_norm.eq_zpow_of_nonzero padicNorm.eq_zpow_of_nonzero

/-- The `p`-adic norm is nonnegative. -/
protected theorem nonneg (q : ℚ) : 0 ≤ padicNorm p q :=
  if hq : q = 0 then by simp [hq, padicNorm]
  else by
    unfold padicNorm
    split_ifs
    apply zpow_nonneg
    exact_mod_cast Nat.zero_le _
#align padic_norm.nonneg padicNorm.nonneg

/-- The `p`-adic norm of `0` is `0`. -/
@[simp]
protected theorem zero : padicNorm p 0 = 0 := by simp [padicNorm]
#align padic_norm.zero padicNorm.zero

/-- The `p`-adic norm of `1` is `1`. -/
-- @[simp] -- Porting note: simp can prove this
protected theorem one : padicNorm p 1 = 1 := by simp [padicNorm]
#align padic_norm.one padicNorm.one

/-- The `p`-adic norm of `p` is `p⁻¹` if `p > 1`.

See also `padicNorm.padicNorm_p_of_prime` for a version assuming `p` is prime. -/
theorem padicNorm_p (hp : 1 < p) : padicNorm p p = (p : ℚ)⁻¹ := by
  simp [padicNorm, (pos_of_gt hp).ne', padicValNat.self hp]
#align padic_norm.padic_norm_p padicNorm.padicNorm_p

/-- The `p`-adic norm of `p` is `p⁻¹` if `p` is prime.

See also `padicNorm.padicNorm_p` for a version assuming `1 < p`. -/
@[simp]
theorem padicNorm_p_of_prime [Fact p.Prime] : padicNorm p p = (p : ℚ)⁻¹ :=
  padicNorm_p <| Nat.Prime.one_lt Fact.out
#align padic_norm.padic_norm_p_of_prime padicNorm.padicNorm_p_of_prime

/-- The `p`-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
theorem padicNorm_of_prime_of_ne {q : ℕ} [p_prime : Fact p.Prime] [q_prime : Fact q.Prime]
    (neq : p ≠ q) : padicNorm p q = 1 := by
  have p : padicValRat p q = 0 := by exact_mod_cast padicValNat_primes neq
  rw [padicNorm, p]
  simp [q_prime.1.ne_zero]
#align padic_norm.padic_norm_of_prime_of_ne padicNorm.padicNorm_of_prime_of_ne

/-- The `p`-adic norm of `p` is less than `1` if `1 < p`.

See also `padicNorm.padicNorm_p_lt_one_of_prime` for a version assuming `p` is prime. -/
theorem padicNorm_p_lt_one (hp : 1 < p) : padicNorm p p < 1 := by
  rw [padicNorm_p hp, inv_lt_one_iff]
  exact_mod_cast Or.inr hp
#align padic_norm.padic_norm_p_lt_one padicNorm.padicNorm_p_lt_one

/-- The `p`-adic norm of `p` is less than `1` if `p` is prime.

See also `padicNorm.padicNorm_p_lt_one` for a version assuming `1 < p`. -/
theorem padicNorm_p_lt_one_of_prime [Fact p.Prime] : padicNorm p p < 1 :=
  padicNorm_p_lt_one <| Nat.Prime.one_lt Fact.out
#align padic_norm.padic_norm_p_lt_one_of_prime padicNorm.padicNorm_p_lt_one_of_prime

/-- `padicNorm p q` takes discrete values `p ^ -z` for `z : ℤ`. -/
protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padicNorm p q = (p : ℚ) ^ (-z) :=
  ⟨padicValRat p q, by simp [padicNorm, hq]⟩
#align padic_norm.values_discrete padicNorm.values_discrete

/-- `padicNorm p` is symmetric. -/
@[simp]
protected theorem neg (q : ℚ) : padicNorm p (-q) = padicNorm p q :=
  if hq : q = 0 then by simp [hq] else by simp [padicNorm, hq]
#align padic_norm.neg padicNorm.neg

variable [hp : Fact p.Prime]

/-- If `q ≠ 0`, then `padicNorm p q ≠ 0`. -/
protected theorem nonzero {q : ℚ} (hq : q ≠ 0) : padicNorm p q ≠ 0 := by
  rw [padicNorm.eq_zpow_of_nonzero hq]
  apply zpow_ne_zero_of_ne_zero
  exact_mod_cast ne_of_gt hp.1.pos
#align padic_norm.nonzero padicNorm.nonzero

/-- If the `p`-adic norm of `q` is 0, then `q` is `0`. -/
theorem zero_of_padicNorm_eq_zero {q : ℚ} (h : padicNorm p q = 0) : q = 0 := by
  apply by_contradiction; intro hq
  unfold padicNorm at h; rw [if_neg hq] at h
  apply absurd h
  apply zpow_ne_zero_of_ne_zero
  exact_mod_cast hp.1.ne_zero
#align padic_norm.zero_of_padic_norm_eq_zero padicNorm.zero_of_padicNorm_eq_zero

/-- The `p`-adic norm is multiplicative. -/
@[simp]
protected theorem mul (q r : ℚ) : padicNorm p (q * r) = padicNorm p q * padicNorm p r :=
  if hq : q = 0 then by simp [hq]
  else
    if hr : r = 0 then by simp [hr]
    else by
      have : (p : ℚ) ≠ 0 := by simp [hp.1.ne_zero]
      simp [padicNorm, *, padicValRat.mul, zpow_add₀ this, mul_comm]
#align padic_norm.mul padicNorm.mul

/-- The `p`-adic norm respects division. -/
@[simp]
protected theorem div (q r : ℚ) : padicNorm p (q / r) = padicNorm p q / padicNorm p r :=
  if hr : r = 0 then by simp [hr]
  else eq_div_of_mul_eq (padicNorm.nonzero hr) (by rw [← padicNorm.mul, div_mul_cancel _ hr])
#align padic_norm.div padicNorm.div

/-- The `p`-adic norm of an integer is at most `1`. -/
protected theorem of_int (z : ℤ) : padicNorm p z ≤ 1 :=
  if hz : z = 0 then by simp [hz, zero_le_one]
  else by
    unfold padicNorm
    rw [if_neg _]
    · refine' zpow_le_one_of_nonpos _ _
      · exact_mod_cast le_of_lt hp.1.one_lt
      · rw [padicValRat.of_int, neg_nonpos]
        norm_cast
        simp
    exact_mod_cast hz
#align padic_norm.of_int padicNorm.of_int

private theorem nonarchimedean_aux {q r : ℚ} (h : padicValRat p q ≤ padicValRat p r) :
    padicNorm p (q + r) ≤ max (padicNorm p q) (padicNorm p r) :=
  have hnqp : padicNorm p q ≥ 0 := padicNorm.nonneg _
  have hnrp : padicNorm p r ≥ 0 := padicNorm.nonneg _
  if hq : q = 0 then by simp [hq, max_eq_right hnrp, le_max_right]
  else
    if hr : r = 0 then by simp [hr, max_eq_left hnqp, le_max_left]
    else
      if hqr : q + r = 0 then le_trans (by simpa [hqr] using hnqp) (le_max_left _ _)
      else by
        unfold padicNorm; split_ifs
        apply le_max_iff.2
        left
        apply zpow_le_of_le
        · exact_mod_cast le_of_lt hp.1.one_lt
        · apply neg_le_neg
          have : padicValRat p q = min (padicValRat p q) (padicValRat p r) := (min_eq_left h).symm
          rw [this]
          exact min_le_padicValRat_add hqr

/-- The `p`-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p`
and the norm of `q`. -/
protected theorem nonarchimedean {q r : ℚ} :
    padicNorm p (q + r) ≤ max (padicNorm p q) (padicNorm p r) := by
  wlog hle : padicValRat p q ≤ padicValRat p r generalizing q r
  · rw [add_comm, max_comm]
    exact this (le_of_not_le hle)
  exact nonarchimedean_aux hle
#align padic_norm.nonarchimedean padicNorm.nonarchimedean

/-- The `p`-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of
`p` plus the norm of `q`. -/
theorem triangle_ineq (q r : ℚ) : padicNorm p (q + r) ≤ padicNorm p q + padicNorm p r :=
  calc
    padicNorm p (q + r) ≤ max (padicNorm p q) (padicNorm p r) := padicNorm.nonarchimedean
    _ ≤ padicNorm p q + padicNorm p r :=
      max_le_add_of_nonneg (padicNorm.nonneg _) (padicNorm.nonneg _)
#align padic_norm.triangle_ineq padicNorm.triangle_ineq

/-- The `p`-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the `p`-adic norm. -/
protected theorem sub {q r : ℚ} : padicNorm p (q - r) ≤ max (padicNorm p q) (padicNorm p r) := by
  rw [sub_eq_add_neg, ← padicNorm.neg r]
  exact padicNorm.nonarchimedean
#align padic_norm.sub padicNorm.sub

/-- If the `p`-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max
of the norms of `q` and `r`. -/
theorem add_eq_max_of_ne {q r : ℚ} (hne : padicNorm p q ≠ padicNorm p r) :
    padicNorm p (q + r) = max (padicNorm p q) (padicNorm p r) := by
  wlog hlt : padicNorm p r < padicNorm p q
  · rw [add_comm, max_comm]
    exact this hne.symm (hne.lt_or_lt.resolve_right hlt)
  have : padicNorm p q ≤ max (padicNorm p (q + r)) (padicNorm p r) :=
    calc
      padicNorm p q = padicNorm p (q + r + (-r)) := by ring_nf
      _ ≤ max (padicNorm p (q + r)) (padicNorm p (-r)) := padicNorm.nonarchimedean
      _ = max (padicNorm p (q + r)) (padicNorm p r) := by simp
  have hnge : padicNorm p r ≤ padicNorm p (q + r) := by
    apply le_of_not_gt
    intro hgt
    rw [max_eq_right_of_lt hgt] at this
    exact not_lt_of_ge this hlt
  have : padicNorm p q ≤ padicNorm p (q + r) := by rwa [max_eq_left hnge] at this
  apply _root_.le_antisymm
  · apply padicNorm.nonarchimedean
  · rwa [max_eq_left_of_lt hlt]
#align padic_norm.add_eq_max_of_ne padicNorm.add_eq_max_of_ne

/-- The `p`-adic norm is an absolute value: positive-definite and multiplicative, satisfying the
triangle inequality. -/
instance : IsAbsoluteValue (padicNorm p)
    where
  abv_nonneg' := padicNorm.nonneg
  abv_eq_zero' := ⟨zero_of_padicNorm_eq_zero, fun hx ↦ by simp [hx]⟩
  abv_add' := padicNorm.triangle_ineq
  abv_mul' := padicNorm.mul

theorem dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p ^ n) ∣ z ↔ padicNorm p z ≤ (p : ℚ) ^ (-n : ℤ) := by
  unfold padicNorm; split_ifs with hz
  · norm_cast at hz
    simp [hz]
  · rw [zpow_le_iff_le, neg_le_neg_iff, padicValRat.of_int,
      padicValInt.of_ne_one_ne_zero hp.1.ne_one _]
    · norm_cast
      rw [← PartENat.coe_le_coe, PartENat.natCast_get, ← multiplicity.pow_dvd_iff_le_multiplicity,
        Nat.cast_pow]
      exact_mod_cast hz
    · exact_mod_cast hp.1.one_lt
#align padic_norm.dvd_iff_norm_le padicNorm.dvd_iff_norm_le

/-- The `p`-adic norm of an integer `m` is one iff `p` doesn't divide `m`. -/
theorem int_eq_one_iff (m : ℤ) : padicNorm p m = 1 ↔ ¬(p : ℤ) ∣ m := by
  nth_rw 2 [← pow_one p]
  simp only [dvd_iff_norm_le, Int.cast_ofNat, Nat.cast_one, zpow_neg, zpow_one, not_le]
  constructor
  · intro h
    rw [h, inv_lt_one_iff_of_pos] <;> norm_cast
    · exact Nat.Prime.one_lt Fact.out
    · exact Nat.Prime.pos Fact.out
  · simp only [padicNorm]
    split_ifs
    · rw [inv_lt_zero, ← Nat.cast_zero, Nat.cast_lt]
      intro h
      exact (Nat.not_lt_zero p h).elim
    · have : 1 < (p : ℚ) := by norm_cast; exact Nat.Prime.one_lt (Fact.out : Nat.Prime p)
      rw [← zpow_neg_one, zpow_lt_iff_lt this]
      have : 0 ≤ padicValRat p m
      simp only [of_int, Nat.cast_nonneg]
      intro h
      rw [← zpow_zero (p : ℚ), zpow_inj] <;> linarith
#align padic_norm.int_eq_one_iff padicNorm.int_eq_one_iff

theorem int_lt_one_iff (m : ℤ) : padicNorm p m < 1 ↔ (p : ℤ) ∣ m := by
  rw [← not_iff_not, ← int_eq_one_iff, eq_iff_le_not_lt]
  simp only [padicNorm.of_int, true_and_iff]
#align padic_norm.int_lt_one_iff padicNorm.int_lt_one_iff

theorem of_nat (m : ℕ) : padicNorm p m ≤ 1 :=
  padicNorm.of_int (m : ℤ)
#align padic_norm.of_nat padicNorm.of_nat

/-- The `p`-adic norm of a natural `m` is one iff `p` doesn't divide `m`. -/
theorem nat_eq_one_iff (m : ℕ) : padicNorm p m = 1 ↔ ¬p ∣ m := by
  rw [← Int.coe_nat_dvd, ← int_eq_one_iff, Int.cast_ofNat]
#align padic_norm.nat_eq_one_iff padicNorm.nat_eq_one_iff

open BigOperators

theorem sum_lt {α : Type _} {F : α → ℚ} {t : ℚ} {s : Finset α} :
    s.Nonempty → (∀ i ∈ s, padicNorm p (F i) < t) → padicNorm p (∑ i in s, F i) < t := by
  classical
    refine' s.induction_on (by rintro ⟨-, ⟨⟩⟩) _
    rintro a S haS IH - ht
    by_cases hs : S.Nonempty
    · rw [Finset.sum_insert haS]
      exact
        lt_of_le_of_lt padicNorm.nonarchimedean
          (max_lt (ht a (Finset.mem_insert_self a S))
            (IH hs fun b hb ↦ ht b (Finset.mem_insert_of_mem hb)))
    · simp_all
#align padic_norm.sum_lt padicNorm.sum_lt

theorem sum_le {α : Type _} {F : α → ℚ} {t : ℚ} {s : Finset α} :
    s.Nonempty → (∀ i ∈ s, padicNorm p (F i) ≤ t) → padicNorm p (∑ i in s, F i) ≤ t := by
  classical
    refine' s.induction_on (by rintro ⟨-, ⟨⟩⟩) _
    rintro a S haS IH - ht
    by_cases hs : S.Nonempty
    · rw [Finset.sum_insert haS]
      exact
        padicNorm.nonarchimedean.trans
          (max_le (ht a (Finset.mem_insert_self a S))
            (IH hs fun b hb ↦ ht b (Finset.mem_insert_of_mem hb)))
    · simp_all
#align padic_norm.sum_le padicNorm.sum_le

theorem sum_lt' {α : Type _} {F : α → ℚ} {t : ℚ} {s : Finset α}
    (hF : ∀ i ∈ s, padicNorm p (F i) < t) (ht : 0 < t) : padicNorm p (∑ i in s, F i) < t := by
  obtain rfl | hs := Finset.eq_empty_or_nonempty s
  · simp [ht]
  · exact sum_lt hs hF
#align padic_norm.sum_lt' padicNorm.sum_lt'

theorem sum_le' {α : Type _} {F : α → ℚ} {t : ℚ} {s : Finset α}
    (hF : ∀ i ∈ s, padicNorm p (F i) ≤ t) (ht : 0 ≤ t) : padicNorm p (∑ i in s, F i) ≤ t := by
  obtain rfl | hs := Finset.eq_empty_or_nonempty s
  · simp [ht]
  · exact sum_le hs hF
#align padic_norm.sum_le' padicNorm.sum_le'

end padicNorm


import set_theory_world.image_Union -- hide
open function -- hide
open_locale big_operators -- hide
/-
## The preimage of a function

Given a function `f : X → Y`, the preimage of a subset $B ⊆ Y$ is written
as `f⁻¹' B`. We will also need to refer to $X$ as a subset of itself. It is
called `univ` in Lean. The following lemma is very well known.
-/
variables{X Y: Type} -- hide
variables {B : set Y}
variables {x : X} -- hide
variables {f : X → Y} -- hide

lemma mem_preimage : x ∈ f ⁻¹' B ↔ f x ∈ B
:= set.mem_preimage

/- Axiom:
mem_preimage : x ∈ f ⁻¹' B ↔ f x ∈ B
-/

/- Lemma
The image of the preimage of a set $B$ is $B ∩ \textrm{Im}(f)$.
-/
lemma image_preimage (B : set Y) :
f '' (f⁻¹' B ) = B ∩ f '' set.univ :=
begin
  ext y,
  split,
  {
    intro h,
    rw mem_image at h,
    obtain ⟨x, ⟨hx1, hx2⟩⟩ := h,
    rw mem_preimage at hx1,
    dsimp,
    split,
    {
      rw ←hx2,
      assumption,
    },
    {
      use x,
      split,
      {
        apply set.mem_univ,
      },
      {
        assumption,
      }
    }
  },
  {
    intro h,
    cases h with h1 h2,
    obtain ⟨x, ⟨hx1, hx2⟩⟩ := h2,
    use x,
    split,
    {
      rw mem_preimage,
      rw hx2,
      assumption,
    },
    {
      assumption,
    }
  }
end


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Yaël Dillies
-/
import algebra.punit_instances
import tactic.abel
import tactic.ring
import order.hom.lattice

/-!
# Boolean rings

A Boolean ring is a ring where multiplication is idempotent. They are equivalent to Boolean
algebras.

## Main declarations

* `boolean_ring`: a typeclass for rings where multiplication is idempotent.
* `boolean_ring.to_boolean_algebra`: Turn a Boolean ring into a Boolean algebra.
* `boolean_algebra.to_boolean_ring`: Turn a Boolean algebra into a Boolean ring.
* `as_boolalg`: Type-synonym for the Boolean algebra associated to a Boolean ring.
* `as_boolring`: Type-synonym for the Boolean ring associated to a Boolean algebra.

## Implementation notes

We provide two ways of turning a Boolean algebra/ring into a Boolean ring/algebra:
* Instances on the same type accessible in locales `boolean_algebra_of_boolean_ring` and
  `boolean_ring_of_boolean_algebra`.
* Type-synonyms `as_boolalg` and `as_boolring`.

At this point in time, it is not clear the first way is useful, but we keep it for educational
purposes and because it is easier than dealing with
`of_boolalg`/`to_boolalg`/`of_boolring`/`to_boolring` explicitly.

## Tags

boolean ring, boolean algebra
-/

variables {α β γ : Type*}

/-- A Boolean ring is a ring where multiplication is idempotent. -/
class boolean_ring α extends ring α :=
(mul_self : ∀ a : α, a * a = a)

section boolean_ring
variables [boolean_ring α] (a b : α)

instance : is_idempotent α (*) := ⟨boolean_ring.mul_self⟩

@[simp] lemma mul_self : a * a = a := boolean_ring.mul_self _

@[simp] lemma add_self : a + a = 0 :=
have a + a = a + a + (a + a) :=
  calc a + a = (a+a) * (a+a)           : by rw mul_self
         ... = a*a + a*a + (a*a + a*a) : by rw [add_mul, mul_add]
         ... = a + a + (a + a)         : by rw mul_self,
by rwa self_eq_add_left at this

@[simp] lemma neg_eq : -a = a :=
calc -a = -a + 0      : by rw add_zero
    ... = -a + -a + a : by rw [←neg_add_self, add_assoc]
    ... = a           : by rw [add_self, zero_add]

lemma add_eq_zero : a + b = 0 ↔ a = b :=
calc a + b = 0 ↔ a = -b : add_eq_zero_iff_eq_neg
           ... ↔ a = b  : by rw neg_eq

@[simp] lemma mul_add_mul : a*b + b*a = 0 :=
have a + b = a + b + (a*b + b*a) :=
  calc a + b = (a + b) * (a + b)       : by rw mul_self
         ... = a*a + a*b + (b*a + b*b) : by rw [add_mul, mul_add, mul_add]
         ... = a + a*b + (b*a + b)     : by simp only [mul_self]
         ... = a + b + (a*b + b*a)     : by abel,
by rwa self_eq_add_right at this

@[simp] lemma sub_eq_add : a - b = a + b :=
by rw [sub_eq_add_neg, add_right_inj, neg_eq]

@[simp] lemma mul_one_add_self : a * (1 + a) = 0 := by rw [mul_add, mul_one, mul_self, add_self]

@[priority 100] -- Note [lower instance priority]
instance boolean_ring.to_comm_ring : comm_ring α :=
{ mul_comm := λ a b, by rw [←add_eq_zero, mul_add_mul],
  .. (infer_instance : boolean_ring α) }

end boolean_ring

instance : boolean_ring punit := ⟨λ _, subsingleton.elim _ _⟩

/-! ### Turning a Boolean ring into a Boolean algebra -/

section ring_to_algebra

/-- Type synonym to view a Boolean ring as a Boolean algebra. -/
def as_boolalg (α : Type*) := α

/-- The "identity" equivalence between `as_boolalg α` and `α`. -/
def to_boolalg : α ≃ as_boolalg α := equiv.refl _

/-- The "identity" equivalence between `α` and `as_boolalg α`. -/
def of_boolalg : as_boolalg α ≃ α := equiv.refl _

@[simp] lemma to_boolalg_symm_eq : (@to_boolalg α).symm = of_boolalg := rfl
@[simp] lemma of_boolalg_symm_eq : (@of_boolalg α).symm = to_boolalg := rfl
@[simp] lemma to_boolalg_of_boolalg (a : as_boolalg α) : to_boolalg (of_boolalg a) = a := rfl
@[simp] lemma of_boolalg_to_boolalg (a : α) : of_boolalg (to_boolalg a) = a := rfl
@[simp] lemma to_boolalg_inj {a b : α} : to_boolalg a = to_boolalg b ↔ a = b := iff.rfl
@[simp] lemma of_boolalg_inj {a b : as_boolalg α} : of_boolalg a = of_boolalg b ↔ a = b := iff.rfl

instance [inhabited α] : inhabited (as_boolalg α) := ‹inhabited α›

variables [boolean_ring α] [boolean_ring β] [boolean_ring γ]

namespace boolean_ring

/-- The join operation in a Boolean ring is `x + y + x * y`. -/
def has_sup : has_sup α := ⟨λ x y, x + y + x * y⟩
/-- The meet operation in a Boolean ring is `x * y`. -/
def has_inf : has_inf α := ⟨(*)⟩

-- Note [lower instance priority]
localized "attribute [instance, priority 100] boolean_ring.has_sup" in
  boolean_algebra_of_boolean_ring
localized "attribute [instance, priority 100] boolean_ring.has_inf" in
  boolean_algebra_of_boolean_ring

lemma sup_comm (a b : α) : a ⊔ b = b ⊔ a := by { dsimp only [(⊔)], ring }
lemma inf_comm (a b : α) : a ⊓ b = b ⊓ a := by { dsimp only [(⊓)], ring }

lemma sup_assoc (a b c : α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) := by { dsimp only [(⊔)], ring }
lemma inf_assoc (a b c : α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by { dsimp only [(⊓)], ring }

lemma sup_inf_self (a b : α) : a ⊔ a ⊓ b = a :=
by { dsimp only [(⊔), (⊓)], assoc_rw [mul_self, add_self, add_zero] }
lemma inf_sup_self (a b : α) : a ⊓ (a ⊔ b) = a :=
begin
  dsimp only [(⊔), (⊓)],
  rw [mul_add, mul_add, mul_self, ←mul_assoc, mul_self, add_assoc, add_self, add_zero]
end

lemma le_sup_inf (a b c : α) : (a ⊔ b) ⊓ (a ⊔ c) ⊔ (a ⊔ b ⊓ c) = a ⊔ b ⊓ c :=
by { dsimp only [(⊔), (⊓)], rw [le_sup_inf_aux, add_self, mul_self, zero_add] }

/--
The Boolean algebra structure on a Boolean ring.

The data is defined so that:
* `a ⊔ b` unfolds to `a + b + a * b`
* `a ⊓ b` unfolds to `a * b`
* `a ≤ b` unfolds to `a + b + a * b = b`
* `⊥` unfolds to `0`
* `⊤` unfolds to `1`
* `aᶜ` unfolds to `1 + a`
* `a \ b` unfolds to `a * (1 + b)`
-/
def to_boolean_algebra : boolean_algebra α :=
{ le_sup_inf := le_sup_inf,
  top := 1,
  le_top := λ a, show a + 1 + a * 1 = 1, by assoc_rw [mul_one, add_comm, add_self, add_zero],
  bot := 0,
  bot_le := λ a, show 0 + a + 0 * a = a, by rw [zero_mul, zero_add, add_zero],
  compl := λ a, 1 + a,
  inf_compl_le_bot := λ a,
    show a*(1+a) + 0 + a*(1+a)*0 = 0,
    by norm_num [mul_add, mul_self, add_self],
  top_le_sup_compl := λ a,
    begin
      change 1 + (a + (1+a) + a*(1+a)) + 1*(a + (1+a) + a*(1+a)) = a + (1+a) + a*(1+a),
      norm_num [mul_add, mul_self],
      rw [←add_assoc, add_self],
    end,
  .. lattice.mk' sup_comm sup_assoc inf_comm inf_assoc sup_inf_self inf_sup_self }

localized "attribute [instance, priority 100] boolean_ring.to_boolean_algebra" in
  boolean_algebra_of_boolean_ring

end boolean_ring

instance : boolean_algebra (as_boolalg α) := @boolean_ring.to_boolean_algebra α _

@[simp] lemma of_boolalg_top : of_boolalg (⊤ : as_boolalg α) = 1 := rfl
@[simp] lemma of_boolalg_bot : of_boolalg (⊥ : as_boolalg α) = 0 := rfl

@[simp] lemma of_boolalg_sup (a b : as_boolalg α) :
  of_boolalg (a ⊔ b) = of_boolalg a + of_boolalg b + of_boolalg a * of_boolalg b := rfl

@[simp] lemma of_boolalg_inf (a b : as_boolalg α) :
  of_boolalg (a ⊓ b) = of_boolalg a * of_boolalg b := rfl

@[simp] lemma of_boolalg_compl (a : as_boolalg α) : of_boolalg aᶜ = 1 + of_boolalg a := rfl

@[simp] lemma of_boolalg_sdiff (a b : as_boolalg α) :
  of_boolalg (a \ b) = of_boolalg a * (1 + of_boolalg b) := rfl

private lemma of_boolalg_symm_diff_aux (a b : α) : (a + b + a * b) * (1 + a * b) = a + b :=
calc (a + b + a * b) * (1 + a * b)
      = a + b + (a * b + (a * b) * (a * b)) + (a * (b * b) + (a * a) * b) : by ring
  ... = a + b : by simp only [mul_self, add_self, add_zero]

@[simp] lemma of_boolalg_symm_diff (a b : as_boolalg α) :
  of_boolalg (a ∆ b) = of_boolalg a + of_boolalg b :=
by { rw symm_diff_eq_sup_sdiff_inf, exact of_boolalg_symm_diff_aux _ _ }

@[simp] lemma of_boolalg_mul_of_boolalg_eq_left_iff {a b : as_boolalg α} :
  of_boolalg a * of_boolalg b = of_boolalg a ↔ a ≤ b :=
@inf_eq_left (as_boolalg α) _ _ _

@[simp] lemma to_boolalg_zero : to_boolalg (0 : α) = ⊥ := rfl
@[simp] lemma to_boolalg_one : to_boolalg (1 : α) = ⊤ := rfl

@[simp] lemma to_boolalg_mul (a b : α) :
  to_boolalg (a * b) = to_boolalg a ⊓ to_boolalg b := rfl

-- `to_boolalg_add` simplifies the LHS but this lemma is eligible to `dsimp`
@[simp, nolint simp_nf] lemma to_boolalg_add_add_mul (a b : α) :
  to_boolalg (a + b + a * b) = to_boolalg a ⊔ to_boolalg b := rfl

@[simp] lemma to_boolalg_add (a b : α) : to_boolalg (a + b) = to_boolalg a ∆ to_boolalg b :=
(of_boolalg_symm_diff _ _).symm

/-- Turn a ring homomorphism from Boolean rings `α` to `β` into a bounded lattice homomorphism
from `α` to `β` considered as Boolean algebras. -/
@[simps] protected def ring_hom.as_boolalg (f : α →+* β) :
  bounded_lattice_hom (as_boolalg α) (as_boolalg β) :=
{ to_fun := to_boolalg ∘ f ∘ of_boolalg,
  map_sup' := λ a b, begin
    dsimp,
    simp_rw [map_add f, map_mul f],
    refl,
  end,
  map_inf' := f.map_mul',
  map_top' := f.map_one',
  map_bot' := f.map_zero' }

@[simp] lemma ring_hom.as_boolalg_id : (ring_hom.id α).as_boolalg = bounded_lattice_hom.id _ := rfl

@[simp] lemma ring_hom.as_boolalg_comp (g : β →+* γ) (f : α →+* β) :
  (g.comp f).as_boolalg = g.as_boolalg.comp f.as_boolalg := rfl

end ring_to_algebra

/-! ### Turning a Boolean algebra into a Boolean ring -/

section algebra_to_ring

/-- Type synonym to view a Boolean ring as a Boolean algebra. -/
def as_boolring (α : Type*) := α

/-- The "identity" equivalence between `as_boolring α` and `α`. -/
def to_boolring : α ≃ as_boolring α := equiv.refl _

/-- The "identity" equivalence between `α` and `as_boolring α`. -/
def of_boolring : as_boolring α ≃ α := equiv.refl _

@[simp] lemma to_boolring_symm_eq : (@to_boolring α).symm = of_boolring := rfl
@[simp] lemma of_boolring_symm_eq : (@of_boolring α).symm = to_boolring := rfl
@[simp] lemma to_boolring_of_boolring (a : as_boolring α) : to_boolring (of_boolring a) = a := rfl
@[simp] lemma of_boolring_to_boolring (a : α) : of_boolring (to_boolring a) = a := rfl
@[simp] lemma to_boolring_inj {a b : α} : to_boolring a = to_boolring b ↔ a = b := iff.rfl
@[simp] lemma of_boolring_inj {a b : as_boolring α} : of_boolring a = of_boolring b ↔ a = b :=
iff.rfl

instance [inhabited α] : inhabited (as_boolring α) := ‹inhabited α›

/-- Every generalized Boolean algebra has the structure of a non unital commutative ring with the
following data:

* `a + b` unfolds to `a ∆ b` (symmetric difference)
* `a * b` unfolds to `a ⊓ b`
* `-a` unfolds to `a`
* `0` unfolds to `⊥`
-/
@[reducible] -- See note [reducible non-instances]
def generalized_boolean_algebra.to_non_unital_comm_ring [generalized_boolean_algebra α] :
  non_unital_comm_ring α :=
{ add := (∆),
  add_assoc := symm_diff_assoc,
  zero := ⊥,
  zero_add := bot_symm_diff,
  add_zero := symm_diff_bot,
  zero_mul := λ _, bot_inf_eq,
  mul_zero := λ _, inf_bot_eq,
  neg := id,
  add_left_neg := symm_diff_self,
  add_comm := symm_diff_comm,
  mul := (⊓),
  mul_assoc := λ _ _ _, inf_assoc,
  mul_comm := λ _ _, inf_comm,
  left_distrib := inf_symm_diff_distrib_left,
  right_distrib := inf_symm_diff_distrib_right }

instance [generalized_boolean_algebra α] : non_unital_comm_ring (as_boolring α) :=
@generalized_boolean_algebra.to_non_unital_comm_ring α _

variables [boolean_algebra α] [boolean_algebra β] [boolean_algebra γ]

/-- Every Boolean algebra has the structure of a Boolean ring with the following data:

* `a + b` unfolds to `a ∆ b` (symmetric difference)
* `a * b` unfolds to `a ⊓ b`
* `-a` unfolds to `a`
* `0` unfolds to `⊥`
* `1` unfolds to `⊤`
-/
@[reducible] -- See note [reducible non-instances]
def boolean_algebra.to_boolean_ring : boolean_ring α :=
{ one := ⊤,
  one_mul := λ _, top_inf_eq,
  mul_one := λ _, inf_top_eq,
  mul_self := λ b, inf_idem,
  ..generalized_boolean_algebra.to_non_unital_comm_ring }

localized "attribute [instance, priority 100] generalized_boolean_algebra.to_non_unital_comm_ring
  boolean_algebra.to_boolean_ring" in boolean_ring_of_boolean_algebra

instance : boolean_ring (as_boolring α) := @boolean_algebra.to_boolean_ring α _

@[simp] lemma of_boolring_zero : of_boolring (0 : as_boolring α) = ⊥ := rfl
@[simp] lemma of_boolring_one : of_boolring (1 : as_boolring α) = ⊤ := rfl

-- `sub_eq_add` proves this lemma but it is eligible for `dsimp`
@[simp, nolint simp_nf] lemma of_boolring_neg (a : as_boolring α) :
  of_boolring (-a) = of_boolring a := rfl

@[simp] lemma of_boolring_add (a b : as_boolring α) :
  of_boolring (a + b) = of_boolring a ∆ of_boolring b := rfl

-- `sub_eq_add` simplifies the LHS but this lemma is eligible for `dsimp`
@[simp, nolint simp_nf] lemma of_boolring_sub (a b : as_boolring α) :
  of_boolring (a - b) = of_boolring a ∆ of_boolring b := rfl

@[simp] lemma of_boolring_mul (a b : as_boolring α) :
  of_boolring (a * b) = of_boolring a ⊓ of_boolring b := rfl

@[simp] lemma of_boolring_le_of_boolring_iff {a b : as_boolring α} :
  of_boolring a ≤ of_boolring b ↔ a * b = a := inf_eq_left.symm

@[simp] lemma to_boolring_bot : to_boolring (⊥ : α) = 0 := rfl
@[simp] lemma to_boolring_top : to_boolring (⊤ : α) = 1 := rfl
@[simp] lemma to_boolring_inf (a b : α) : to_boolring (a ⊓ b) = to_boolring a * to_boolring b := rfl

@[simp] lemma to_boolring_symm_diff (a b : α) :
  to_boolring (a ∆ b) = to_boolring a + to_boolring b := rfl

/-- Turn a bounded lattice homomorphism from Boolean algebras `α` to `β` into a ring homomorphism
from `α` to `β` considered as Boolean rings. -/
@[simps] protected def bounded_lattice_hom.as_boolring (f : bounded_lattice_hom α β) :
  as_boolring α →+* as_boolring β :=
{ to_fun := to_boolring ∘ f ∘ of_boolring,
  map_zero' := f.map_bot',
  map_one' := f.map_top',
  map_add' := map_symm_diff' f,
  map_mul' := f.map_inf' }

@[simp] lemma bounded_lattice_hom.as_boolring_id :
  (bounded_lattice_hom.id α).as_boolring = ring_hom.id _ := rfl

@[simp] lemma bounded_lattice_hom.as_boolring_comp (g : bounded_lattice_hom β γ)
  (f : bounded_lattice_hom α β) :
  (g.comp f).as_boolring = g.as_boolring.comp f.as_boolring := rfl

end algebra_to_ring

/-! ### Equivalence between Boolean rings and Boolean algebras -/

/-- Order isomorphism between `α` considered as a Boolean ring considered as a Boolean algebra and
`α`. -/
@[simps] def order_iso.as_boolalg_as_boolring (α : Type*) [boolean_algebra α] :
  as_boolalg (as_boolring α) ≃o α :=
⟨of_boolalg.trans of_boolring, λ a b,
  of_boolring_le_of_boolring_iff.trans of_boolalg_mul_of_boolalg_eq_left_iff⟩

/-- Ring isomorphism between `α` considered as a Boolean algebra considered as a Boolean ring and
`α`. -/
@[simps] def ring_equiv.as_boolring_as_boolalg (α : Type*) [boolean_ring α] :
  as_boolring (as_boolalg α) ≃+* α :=
{ map_mul' := λ a b, rfl,
  map_add' := of_boolalg_symm_diff,
  ..of_boolring.trans of_boolalg }

open bool

instance : boolean_ring bool :=
{ add := bxor,
  add_assoc := bxor_assoc,
  zero := ff,
  zero_add := ff_bxor,
  add_zero := bxor_ff,
  neg := id,
  sub := bxor,
  sub_eq_add_neg := λ _ _, rfl,
  add_left_neg := bxor_self,
  add_comm := bxor_comm,
  one := tt,
  mul := band,
  mul_assoc := band_assoc,
  one_mul := tt_band,
  mul_one := band_tt,
  left_distrib := band_bxor_distrib_left,
  right_distrib := band_bxor_distrib_right,
  mul_self := band_self }


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import topology.basic
import topology.constructions
import topology.algebra.ordered.basic

/-!
# Topological lattices

In this file we define mixin classes `has_continuous_inf` and `has_continuous_sup`. We define the
class `topological_lattice` as a topological space and lattice `L` extending `has_continuous_inf`
and `has_continuous_sup`.

## References

* [Gierz et al, A Compendium of Continuous Lattices][GierzEtAl1980]

## Tags

topological, lattice
-/

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be an infimum. Then `L` is said to have *(jointly) continuous infimum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_inf (L : Type*) [topological_space L] [has_inf L] : Prop :=
(continuous_inf : continuous (λ p : L × L, p.1 ⊓ p.2))

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be a supremum. Then `L` is said to have *(jointly) continuous supremum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_sup (L : Type*) [topological_space L] [has_sup L] : Prop :=
(continuous_sup : continuous (λ p : L × L, p.1 ⊔ p.2))

/--
Let `L` be a topological space with a supremum. If the order dual has a continuous infimum then the
supremum is continuous.
-/
@[priority 100] -- see Note [lower instance priority]
instance has_continuous_inf_dual_has_continuous_sup
  (L : Type*) [topological_space L] [has_sup L] [h: has_continuous_inf (order_dual L)] :
  has_continuous_sup  L :=
{ continuous_sup :=
    @has_continuous_inf.continuous_inf (order_dual L) _ _ h }

/--
Let `L` be a lattice equipped with a topology such that `L` has continuous infimum and supremum.
Then `L` is said to be a *topological lattice*.
-/
class topological_lattice (L : Type*) [topological_space L] [lattice L]
  extends has_continuous_inf L, has_continuous_sup L

variables {L : Type*} [topological_space L]
variables {X : Type*} [topological_space X]

@[continuity] lemma continuous_inf [has_inf L] [has_continuous_inf L] :
  continuous (λp:L×L, p.1 ⊓ p.2) :=
has_continuous_inf.continuous_inf

@[continuity] lemma continuous.inf [has_inf L] [has_continuous_inf L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊓ g x) :=
continuous_inf.comp (hf.prod_mk hg : _)

@[continuity] lemma continuous_sup [has_sup L] [has_continuous_sup L] :
  continuous (λp:L×L, p.1 ⊔ p.2) :=
has_continuous_sup.continuous_sup

@[continuity] lemma continuous.sup [has_sup L] [has_continuous_sup L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊔ g x) :=
continuous_sup.comp (hf.prod_mk hg : _)


theorem Ex003_1 (a b: Prop) : ¬a → a → b :=
assume A:¬a,
  assume B:a,
  have C:false, from  A B,
  show b, from false.elim C

theorem Ex003_2 (a b : Prop) : ¬a → a → b :=
begin
  intro,
  intro,
  contradiction
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.mean_value
import Mathlib.PostPort

namespace Mathlib

/-!
# Darboux's theorem

In this file we prove that the derivative of a differentiable function on an interval takes all
intermediate values. The proof is based on the
[Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem.
-/

/-- Darboux's theorem: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_gt_of_lt {a : ℝ} {b : ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ} (hab : a ≤ b) (hf : ∀ (x : ℝ), x ∈ set.Icc a b → has_deriv_within_at f (f' x) (set.Icc a b) x) {m : ℝ} (hma : f' a < m) (hmb : m < f' b) : m ∈ f' '' set.Icc a b := sorry

/-- Darboux's theorem: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_lt_of_gt {a : ℝ} {b : ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ} (hab : a ≤ b) (hf : ∀ (x : ℝ), x ∈ set.Icc a b → has_deriv_within_at f (f' x) (set.Icc a b) x) {m : ℝ} (hma : m < f' a) (hmb : f' b < m) : m ∈ f' '' set.Icc a b := sorry

/-- Darboux's theorem: the image of a convex set under `f'` is a convex set. -/
theorem convex_image_has_deriv_at {f : ℝ → ℝ} {f' : ℝ → ℝ} {s : set ℝ} (hs : convex s) (hf : ∀ (x : ℝ), x ∈ s → has_deriv_at f (f' x) x) : convex (f' '' s) := sorry

/-- If the derivative of a function is never equal to `m`, then either
it is always greater than `m`, or it is always less than `m`. -/
theorem deriv_forall_lt_or_forall_gt_of_forall_ne {f : ℝ → ℝ} {f' : ℝ → ℝ} {s : set ℝ} (hs : convex s) (hf : ∀ (x : ℝ), x ∈ s → has_deriv_at f (f' x) x) {m : ℝ} (hf' : ∀ (x : ℝ), x ∈ s → f' x ≠ m) : (∀ (x : ℝ), x ∈ s → f' x < m) ∨ ∀ (x : ℝ), x ∈ s → m < f' x := sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.apply_fun
import ring_theory.matrix_algebra
import ring_theory.polynomial_algebra
import linear_algebra.nonsingular_inverse
import tactic.squeeze

/-!
# Characteristic polynomials and the Cayley-Hamilton theorem

We define characteristic polynomials of matrices and
prove the Cayley–Hamilton theorem over arbitrary commutative rings.

## Main definitions

* `char_poly` is the characteristic polynomial of a matrix.

## Implementation details

We follow a nice proof from http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
-/

noncomputable theory

universes u v w

open polynomial matrix
open_locale big_operators

variables {R : Type u} [comm_ring R]
variables {n : Type w} [decidable_eq n] [fintype n]

open finset

/--
The "characteristic matrix" of `M : matrix n n R` is the matrix of polynomials $t I - M$.
The determinant of this matrix is the characteristic polynomial.
-/
def char_matrix (M : matrix n n R) : matrix n n (polynomial R) :=
matrix.scalar n (X : polynomial R) - (C : R →+* polynomial R).map_matrix M

@[simp] lemma char_matrix_apply_eq (M : matrix n n R) (i : n) :
  char_matrix M i i = (X : polynomial R) - C (M i i) :=
by simp only [char_matrix, sub_left_inj, pi.sub_apply, scalar_apply_eq,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

@[simp] lemma char_matrix_apply_ne (M : matrix n n R) (i j : n) (h : i ≠ j) :
  char_matrix M i j = - C (M i j) :=
by simp only [char_matrix, pi.sub_apply, scalar_apply_ne _ _ _ h, zero_sub,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

lemma mat_poly_equiv_char_matrix (M : matrix n n R) :
  mat_poly_equiv (char_matrix M) = X - C M :=
begin
  ext k i j,
  simp only [mat_poly_equiv_coeff_apply, coeff_sub, pi.sub_apply],
  by_cases h : i = j,
  { subst h, rw [char_matrix_apply_eq, coeff_sub],
    simp only [coeff_X, coeff_C],
    split_ifs; simp, },
  { rw [char_matrix_apply_ne _ _ _ h, coeff_X, coeff_neg, coeff_C, coeff_C],
    split_ifs; simp [h], }
end

/--
The characteristic polynomial of a matrix `M` is given by $\det (t I - M)$.
-/
def char_poly (M : matrix n n R) : polynomial R :=
(char_matrix M).det

/--
The Cayley-Hamilton theorem, that the characteristic polynomial of a matrix,
applied to the matrix itself, is zero.

This holds over any commutative ring.
-/
-- This proof follows http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
theorem aeval_self_char_poly (M : matrix n n R) :
  aeval M (char_poly M) = 0 :=
begin
  -- We begin with the fact $χ_M(t) I = adjugate (t I - M) * (t I - M)$,
  -- as an identity in `matrix n n (polynomial R)`.
  have h : (char_poly M) • (1 : matrix n n (polynomial R)) =
    adjugate (char_matrix M) * (char_matrix M) :=
    (adjugate_mul _).symm,
  -- Using the algebra isomorphism `matrix n n (polynomial R) ≃ₐ[R] polynomial (matrix n n R)`,
  -- we have the same identity in `polynomial (matrix n n R)`.
  apply_fun mat_poly_equiv at h,
  simp only [mat_poly_equiv.map_mul,
    mat_poly_equiv_char_matrix] at h,
  -- Because the coefficient ring `matrix n n R` is non-commutative,
  -- evaluation at `M` is not multiplicative.
  -- However, any polynomial which is a product of the form $N * (t I - M)$
  -- is sent to zero, because the evaluation function puts the polynomial variable
  -- to the right of any coefficients, so everything telescopes.
  apply_fun (λ p, p.eval M) at h,
  rw eval_mul_X_sub_C at h,
  -- Now $χ_M (t) I$, when thought of as a polynomial of matrices
  -- and evaluated at some `N` is exactly $χ_M (N)$.
  rw [mat_poly_equiv_smul_one, eval_map] at h,
  -- Thus we have $χ_M(M) = 0$, which is the desired result.
  exact h,
end


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

import topology.bases               -- definition of topological bases
import topology.metric_space.basic  -- facts about intervals in ℝ
import topology.algebra.order.floor -- facts about floor function, fractional part function etc

noncomputable theory

/-!

# Topological Spaces in Lean

For any `X : Type`, a topology on `X` is defined as:
```
@[protect_proj] structure topological_space (α : Type u) :=
(is_open        : set α → Prop)
(is_open_univ   : is_open univ)
(is_open_inter  : ∀s t, is_open s → is_open t → is_open (s ∩ t))
(is_open_sUnion : ∀s, (∀t∈s, is_open t) → is_open (⋃₀ s))
```

In this sheet, the following can be found:
- defining several topological spaces;
- proof or disproof of some functions being continuous;
- denseness, compactness;
- homeomorphism
-/

universe u

namespace topological_space

variables (X : Type u)

/--
The discrete topology is the one the most open sets.
-/
def discrete : topological_space X :=
{ is_open := λ _, true,
  is_open_univ := ⟨⟩,
  is_open_inter := λ _ _ _ _, ⟨⟩,
  is_open_sUnion := λ _ _, ⟨⟩ }

/--
The indiscrete topology is the one with the least open sets.
-/
def indiscrete : topological_space X :=
{ is_open := λ s, s = set.univ ∨ s = ∅,
  is_open_univ := or.intro_left _ rfl,
  is_open_inter := by rintros _ _ (rfl|rfl) (rfl|rfl); simp,
  is_open_sUnion :=
  begin
    intros S h,
    by_cases h' : set.univ ∈ S,
    { left,
      refine le_antisymm (λ _ _, ⟨⟩) (λ x _, _),
      rw [set.mem_sUnion],
      refine ⟨_, h', ⟨⟩⟩, },
    { right,
      simp_rw [set.eq_empty_iff_forall_not_mem, set.mem_sUnion],
      push_neg,
      rintros _ s hs,
      exact (h s hs).elim (λ H, false.elim $ h' $ by rwa H at hs)
        (λ H, H.symm ▸ id), },
  end }

/--
                `1`
`(X, discrete) ----->  (X, indiscrete)` is continuous
-/
example : @@continuous (discrete X) (indiscrete X) id :=
{ is_open_preimage := λ _ _, ⟨⟩ }

/--
But is
                   `1`
`(X, indiscrete) ------> (X, discrete)` continuous?
-/
example (x y : X) (h : x ≠ y) : ¬ @@continuous (indiscrete X) (discrete X) id :=
begin
  rw continuous_def,
  push_neg,
  refine ⟨{x}, ⟨⟩, not_or (_ : _ ≠ _) $ λ r, set.eq_empty_iff_forall_not_mem.mp r x rfl⟩,
  rw set.ne_univ_iff_exists_not_mem,
  refine ⟨y, λ r', h (set.mem_singleton_iff.mp (set.mem_preimage.mp r')).symm⟩,
end

/--
Finite sets only have finitely many possible topology on them.
-/
instance finitely_many_topologies [fintype X] : fintype (topological_space X) :=
let i : topological_space X → set (set X) := λ τ, τ.is_open in
have inj_i : function.injective i, by { intros τ1 τ2 h, ext1, exact h },
begin
  haveI : fintype (set (set X)) := infer_instance,
  exact fintype.of_injective i inj_i,
end

/--
The upper bound is 2^2^|X|
-/
lemma card_topology_le [fintype X] :
  fintype.card (topological_space X) ≤ 2 ^ (2 ^ fintype.card X):=
let i : topological_space X → set (set X) := λ τ, τ.is_open in
have inj_i : function.injective i, by { intros τ1 τ2 h, ext1, exact h },
begin
  refine le_trans (fintype.card_le_of_injective i inj_i) _,
  rw [fintype.card_set, fintype.card_set],
end

/--
`ℝ` has a basis consisted of all open intervals
-/
example : is_topological_basis { I | ∃ (a b : ℝ), I = set.Ioo a b } :=
is_topological_basis_of_open_of_nhds
  (by { rintros _ ⟨a, b, rfl⟩, rw real.Ioo_eq_ball, exact metric.is_open_ball }) $
λ x s hx hs,
begin
  rw metric.is_open_iff at hs,
  obtain ⟨ε, hε, subset1⟩ := hs x hx,
  rw real.ball_eq_Ioo at subset1,
  exact ⟨_, ⟨_, _, rfl⟩, ⟨show x - ε < x, by linarith, by linarith⟩, subset1⟩,
end

/--
`ℚ ⊆ ℝ` is dense
-/
lemma dense_ℚ : dense (algebra_map ℚ ℝ '' set.univ) :=
begin
  intros x,
  rw mem_closure_iff,
  intros v hv hx,
  rw metric.is_open_iff at hv,
  specialize hv x hx,
  obtain ⟨ε, hε, subset1⟩ := hv,
  rw real.ball_eq_Ioo at subset1,
  obtain ⟨q, hq⟩ := exists_rat_near x hε,
  rw abs_lt at hq,
  cases hq,
  refine ⟨q, subset1 ⟨_, _⟩, ⟨_, ⟨⟩, rfl⟩⟩;
  linarith,
end

/--
Hence functions `ℝ → ℝ` is uniquely determined on `ℚ`.
-/
example (f g : ℝ → ℝ) (hf : continuous f) (hg : continuous g)
  (heq : ∀ (x : ℚ), f x = g x) : f = g :=
continuous.ext_on dense_ℚ hf hg $ λ _ ⟨q, ⟨⟩, h⟩, h ▸ heq q

/--
An algebraic interpretation of unit circle `S¹` defined as `ℝ ⧸ ℤ` with the quotient topology,
i.e. `V ⊆ S¹` is open iff `π ⁻¹ V` is open in `ℝ` where `π : ℝ → ℝ ⧸ ℤ`.
-/
@[derive [topological_space, add_comm_group, inhabited]]
def circle := ℝ ⧸ (algebra_map ℤ ℝ).to_add_monoid_hom.range

namespace circle

/-- π -/
def from_real : ℝ → circle := quotient.mk'

/-- `[0, 1) → ℝ → S¹` -/
def from_Ico : set.Ico (0 : ℝ) 1 → circle :=
from_real ∘ subtype.val

@[continuity]
lemma continuous_from_real : continuous from_real := ⟨λ _, id⟩

@[continuity]
lemma continuous_on_from_real : continuous_on from_real (set.Ico 0 1) :=
continuous.continuous_on ⟨λ s, id⟩

@[continuity]
lemma continuous_from_Ico : continuous from_Ico :=
begin
  rw continuous_iff_continuous_on_univ,
  refine continuous_on.comp _ _ _,
  { exact set.Ico 0 1 },
  { exact continuous_on_from_real },
  { refine continuous.continuous_on _, continuity, },
  { intros x hx, exact x.2, },
end

lemma from_Ico_inj : function.injective from_Ico :=
begin
  rintros ⟨x, hx1, hx2⟩ ⟨y, hy1, hy2⟩ h,
  dsimp only [from_Ico, from_real, function.comp_apply] at h,
  rw [quotient.eq', quotient_add_group.left_rel_eq] at h,
  obtain ⟨z, (hz : ↑z = -(x : ℝ) + y)⟩ := h,
  rw neg_add_eq_sub at hz,
  have ineq1 : abs (y - x : ℝ) < 1,
  { rw abs_lt, split; linarith, },
  rw ←hz at ineq1,
  norm_cast at ineq1,
  rw int.abs_lt_one_iff at ineq1,
  rw ineq1 at hz,
  norm_cast at hz,
  replace hz := hz.symm,
  rw sub_eq_zero at hz,
  simp_rw hz,
  refl,
end

lemma from_Ico_surj : function.surjective from_Ico :=
begin
  intros x,
  induction x using quotient.induction_on',
  dsimp only [from_Ico, from_real, function.comp_apply],
  refine ⟨⟨int.fract x, int.fract_nonneg _, int.fract_lt_one _⟩, _⟩,
  rw quotient.eq',
  rw [quotient_add_group.left_rel_eq, neg_add_eq_sub, int.self_sub_fract],
  exact ⟨_, rfl⟩,
end

/--
`S¹` is compact.
-/
instance is_compact : compact_space circle :=
{ is_compact_univ :=
  begin
    rw show set.univ = from_real '' (set.Icc 0 1), from _,
    { exact is_compact.image is_compact_Icc ⟨λ s h, h⟩, },
    symmetry,
    rw set.eq_univ_iff_forall,
    intros x,
    induction x using quotient.induction_on',
    dsimp only [from_Ico, from_real, function.comp_apply],
    refine ⟨int.fract x, ⟨int.fract_nonneg _, le_of_lt $ int.fract_lt_one _⟩, _⟩,
    rw quotient.eq',
    rw [quotient_add_group.left_rel_eq, neg_add_eq_sub, int.self_sub_fract],
    exact ⟨_, rfl⟩,
  end }

/--
The half open interval `[0, 1)` continuously bijects to `S¹`.
-/
def equiv_Ico : set.Ico (0 : ℝ) 1 ≃ circle :=
equiv.of_bijective from_Ico ⟨from_Ico_inj, from_Ico_surj⟩

/--
However, its inverse is not continuous.
-/
lemma not_cont_inv : ¬ continuous equiv_Ico.symm :=
have nc : ¬ compact_space (set.Ico (0 : ℝ) 1),
begin
  intros r,
  have seteq : (subtype.val : set.Ico (0 : ℝ) 1 → ℝ) '' set.univ = set.Ico 0 1,
  { refine set.ext (λ x, ⟨_, _⟩),
    { rintros ⟨y, ⟨⟨⟩, rfl⟩⟩, exact y.2 },
    { rintros ⟨hx1, hx2⟩, exact ⟨⟨x, hx1, hx2⟩, ⟨⟩, rfl⟩, }, },
  have c' : is_compact (set.Ico (0 : ℝ) 1),
  { rw ←seteq, exact r.1.image (by continuity), },
  have c'' := c'.is_closed.closure_eq,
  rw [closure_Ico (by norm_num : (0 : ℝ) ≠ 1), set.ext_iff] at c'',
  linarith [((c'' 1).mp ⟨zero_le_one, le_refl _⟩).2],
end,
begin
  contrapose! nc,
  let i : homeomorph (set.Ico (0 : ℝ) 1) circle :=
  { continuous_to_fun := by continuity,
    continuous_inv_fun := nc, ..equiv_Ico },
  exact i.symm.compact_space,
end

end circle

end topological_space


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau, Robert Y. Lewis
-/

import tactic.interactive

universe u

namespace eckmann_hilton
variables {X : Type u}

local notation a `<`m`>` b := m a b

class is_unital (m : X → X → X) (e : X) : Prop :=
(one_mul : ∀ x : X, (e <m> x) = x)
(mul_one : ∀ x : X, (x <m> e) = x)

lemma group.is_unital [G : group X] : is_unital (*) (1 : X) := { ..G }

variables {m₁ m₂ : X → X → X} {e₁ e₂ : X}
variables (h₁ : is_unital m₁ e₁) (h₂ : is_unital m₂ e₂)
variables (distrib : ∀ a b c d, ((a <m₂> b) <m₁> (c <m₂> d)) = ((a <m₁> c) <m₂> (b <m₁> d)))
include h₁ h₂ distrib

lemma one : e₁ = e₂ :=
by simpa only [h₁.one_mul, h₁.mul_one, h₂.one_mul, h₂.mul_one] using distrib e₂ e₁ e₁ e₂

lemma mul : (m₁ = m₂) :=
begin
  funext a b,
  calc m₁ a b = m₁ (m₂ a e₁) (m₂ e₁ b) :
    by simp only [one h₁ h₂ distrib, h₁.one_mul, h₁.mul_one, h₂.one_mul, h₂.mul_one]
          ... = m₂ a b :
    by simp only [distrib, h₁.one_mul, h₁.mul_one, h₂.one_mul, h₂.mul_one]
end

lemma mul_comm : is_commutative _ m₂ :=
⟨λ a b, by simpa [mul h₁ h₂ distrib, h₂.one_mul, h₂.mul_one] using distrib e₂ a b e₂⟩

lemma mul_assoc : is_associative _ m₂ :=
⟨λ a b c, by simpa [mul h₁ h₂ distrib, h₂.one_mul, h₂.mul_one] using distrib a b e₂ c⟩

def comm_monoid : comm_monoid X :=
{ mul := m₂,
  one := e₂,
  mul_comm := (mul_comm h₁ h₂ distrib).comm,
  mul_assoc := (mul_assoc h₁ h₂ distrib).assoc,
  ..h₂ }

def comm_group [G : group X] (distrib : ∀ a b c d, ((a * b) <m₁> (c * d)) = ((a <m₁> c) * (b <m₁> d))) : comm_group X :=
{ mul_comm := (eckmann_hilton.comm_monoid h₁ group.is_unital distrib).mul_comm,
  ..G }

end eckmann_hilton


/-
Copyright (c) 2020 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/
import data.fintype.card
import data.zmod.basic
import group_theory.exponent
import data.int.parity

/-!
# Dihedral Groups

We define the dihedral groups `dihedral_group n`, with elements `r i` and `sr i` for `i : zmod n`.

For `n ≠ 0`, `dihedral_group n` represents the symmetry group of the regular `n`-gon. `r i`
represents the rotations of the `n`-gon by `2πi/n`, and `sr i` represents the reflections of the
`n`-gon. `dihedral_group 0` corresponds to the infinite dihedral group.
-/

/--
For `n ≠ 0`, `dihedral_group n` represents the symmetry group of the regular `n`-gon.
`r i` represents the rotations of the `n`-gon by `2πi/n`, and `sr i` represents the reflections of
the `n`-gon. `dihedral_group 0` corresponds to the infinite dihedral group.
-/
@[derive decidable_eq]
inductive dihedral_group (n : ℕ) : Type
| r : zmod n → dihedral_group
| sr : zmod n → dihedral_group

namespace dihedral_group

variables {n : ℕ}

/--
Multiplication of the dihedral group.
-/
private def mul : dihedral_group n → dihedral_group n → dihedral_group n
| (r i) (r j) := r (i + j)
| (r i) (sr j) := sr (j - i)
| (sr i) (r j) := sr (i + j)
| (sr i) (sr j) := r (j - i)

/--
The identity `1` is the rotation by `0`.
-/
private def one : dihedral_group n := r 0

instance : inhabited (dihedral_group n) := ⟨one⟩

/--
The inverse of a an element of the dihedral group.
-/
private def inv : dihedral_group n → dihedral_group n
| (r i) := r (-i)
| (sr i) := sr i

/--
The group structure on `dihedral_group n`.
-/
instance : group (dihedral_group n) :=
{ mul := mul,
  mul_assoc :=
  begin
    rintros (a | a) (b | b) (c | c);
    simp only [mul];
    ring,
  end,
  one := one,
  one_mul :=
  begin
    rintros (a | a),
    exact congr_arg r (zero_add a),
    exact congr_arg sr (sub_zero a),
  end,
  mul_one := begin
    rintros (a | a),
    exact congr_arg r (add_zero a),
    exact congr_arg sr (add_zero a),
  end,
  inv := inv,
  mul_left_inv := begin
    rintros (a | a),
    exact congr_arg r (neg_add_self a),
    exact congr_arg r (sub_self a),
  end }

@[simp] lemma r_mul_r (i j : zmod n) : r i * r j = r (i + j) := rfl
@[simp] lemma r_mul_sr (i j : zmod n) : r i * sr j = sr (j - i) := rfl
@[simp] lemma sr_mul_r (i j : zmod n) : sr i * r j = sr (i + j) := rfl
@[simp] lemma sr_mul_sr (i j : zmod n) : sr i * sr j = r (j - i) := rfl

lemma one_def : (1 : dihedral_group n) = r 0 := rfl

private def fintype_helper : (zmod n ⊕ zmod n) ≃ dihedral_group n :=
{ inv_fun := λ i, match i with
                 | (r j) := sum.inl j
                 | (sr j) := sum.inr j
                 end,
  to_fun := λ i, match i with
                 | (sum.inl j) := r j
                 | (sum.inr j) := sr j
                 end,
  left_inv := by rintro (x | x); refl,
  right_inv := by rintro (x | x); refl }

/--
If `0 < n`, then `dihedral_group n` is a finite group.
-/
instance [fact (0 < n)] : fintype (dihedral_group n) := fintype.of_equiv _ fintype_helper

instance : nontrivial (dihedral_group n) := ⟨⟨r 0, sr 0, dec_trivial⟩⟩

/--
If `0 < n`, then `dihedral_group n` has `2n` elements.
-/
lemma card [fact (0 < n)] : fintype.card (dihedral_group n) = 2 * n :=
by rw [← fintype.card_eq.mpr ⟨fintype_helper⟩, fintype.card_sum, zmod.card, two_mul]

@[simp] lemma r_one_pow (k : ℕ) : (r 1 : dihedral_group n) ^ k = r k :=
begin
  induction k with k IH,
  { refl },
  { rw [pow_succ, IH, r_mul_r],
    congr' 1,
    norm_cast,
    rw nat.one_add }
end

@[simp] lemma r_one_pow_n : (r (1 : zmod n))^n = 1 :=
begin
  cases n,
  { rw pow_zero },
  { rw [r_one_pow, one_def],
    congr' 1,
    exact zmod.nat_cast_self _, }
end

@[simp]

/--
If `0 < n`, then `sr i` has order 2.
-/
@[simp] lemma order_of_sr (i : zmod n) : order_of (sr i) = 2 :=
begin
  rw order_of_eq_prime _ _,
  { exact ⟨nat.prime_two⟩ },
  rw [sq, sr_mul_self],
  dec_trivial,
end

/--
If `0 < n`, then `r 1` has order `n`.
-/
@[simp] lemma order_of_r_one : order_of (r 1 : dihedral_group n) = n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { rw order_of_eq_zero_iff',
    intros n hn,
    rw [r_one_pow, one_def],
    apply mt r.inj,
    simpa using hn.ne' },
  { haveI := fact.mk hn,
    apply (nat.le_of_dvd hn $ order_of_dvd_of_pow_eq_one $ @r_one_pow_n n).lt_or_eq.resolve_left,
    intro h,
    have h1 : (r 1 : dihedral_group n)^(order_of (r 1)) = 1,
    { exact pow_order_of_eq_one _ },
    rw r_one_pow at h1,
    injection h1 with h2,
    rw [← zmod.val_eq_zero, zmod.val_nat_cast, nat.mod_eq_of_lt h] at h2,
    exact absurd h2.symm (order_of_pos _).ne },
end

/--
If `0 < n`, then `i : zmod n` has order `n / gcd n i`.
-/
lemma order_of_r [fact (0 < n)] (i : zmod n) : order_of (r i) = n / nat.gcd n i.val :=
begin
  conv_lhs { rw ←zmod.nat_cast_zmod_val i },
  rw [←r_one_pow, order_of_pow, order_of_r_one]
end

lemma exponent : monoid.exponent (dihedral_group n) = lcm n 2 :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { exact monoid.exponent_eq_zero_of_order_zero order_of_r_one },
  haveI := fact.mk hn,
  apply nat.dvd_antisymm,
  { apply monoid.exponent_dvd_of_forall_pow_eq_one,
    rintro (m | m),
    { rw [←order_of_dvd_iff_pow_eq_one, order_of_r],
      refine nat.dvd_trans ⟨gcd n m.val, _⟩ (dvd_lcm_left n 2),
      { exact (nat.div_mul_cancel (nat.gcd_dvd_left n m.val)).symm } },
    { rw [←order_of_dvd_iff_pow_eq_one, order_of_sr],
      exact dvd_lcm_right n 2 } },
  { apply lcm_dvd,
    { convert monoid.order_dvd_exponent (r 1),
      exact order_of_r_one.symm },
    { convert monoid.order_dvd_exponent (sr 0),
      exact (order_of_sr 0).symm } }
end

end dihedral_group


-- Not related to the CFR project.
-- The variance proof here was just a little thing I did in order to get familiar with Lean.

import data.rat

variable (α : Type)

theorem list.eq.identity : ∀ (l : list α), list.map id l = l
    | [] := rfl
    | (x :: l) := by simp [list.eq.identity l]

def mean (l : list rat) : rat := list.sum l / l.length
@[simp] def sqr (x : rat) := x ^ 2
theorem sqr.eq.a_minus_b (a b : rat) : sqr (a - b) = sqr a - 2 * a * b + sqr b := by {unfold sqr, ring}

def E (f : rat -> rat) (l : list rat) := mean $ list.map f l

def var (l : list rat) (m : rat) := E (fun x, (x - m) ^ 2) l
def var' (l : list rat) (m : rat) := mean (list.map sqr l) - sqr m

theorem list.eq.sum_add (f g : rat → rat) :
        ∀ (l : list rat), list.sum (list.map (λ x, f x + g x) l) = list.sum (list.map f l) + list.sum (list.map g l)
    | [] := rfl
    | (x :: l) := by simp [list.eq.sum_add]

theorem list.eq.sum_sub (f g : rat → rat) :
        ∀ (l : list rat), list.sum (list.map (λ x, f x - g x) l) = list.sum (list.map f l) - list.sum (list.map g l)
    | [] := rfl
    | (x :: l) := by {
        have := list.eq.sum_sub l,
        simp [list.eq.sum_add] at ⊢ this,
        assumption
        }

theorem list.eq.sum_mul (c : rat) (f : rat → rat) :
        ∀ (l : list rat), list.sum (list.map (λ x, c * f x) l) = c * list.sum (list.map f l)
    | [] := by simp
    | (x :: l) := by { simp, rw list.eq.sum_mul, ring }

theorem E.add {f g : rat -> rat} (l : list rat) : E (fun x, f x + g x) l = E f l + E g l :=
    by { unfold E mean, simp only [list.length_map, list.eq.sum_add], ring }

theorem E.sub {f g : rat -> rat} (l : list rat) : E (fun x, f x - g x) l = E f l - E g l :=
    by { unfold E mean, simp only [list.length_map, list.eq.sum_sub], ring }

theorem E.const_left {f : rat -> rat} (c : rat) (l : list rat) : E (fun x, c * f x) l = c * E f l :=
    by { simp [E, mean], rw [list.eq.sum_mul], ring }

theorem rat.eq.mult_elim (n : rat) :  n / n = 1 ∨ n = 0 :=
    if h : n = 0 then or.inr h
    else or.inl $ div_self h

theorem list.eq.repeat (c : rat) (l : list rat) : list.sum (list.map (fun _, c) l) = c * list.length l :=
    by { simp, rw add_monoid.smul_eq_mul _ c, ring }

theorem E.const_none (c : rat) : ∀ (x : rat) (l : list rat), E (fun x, c) (x :: l) = c
    | x l :=
        by {
            simp only [E, mean],
            rw list.eq.repeat,
            rw list.length_map,
            simp,
            from match rat.eq.mult_elim (1 + ↑(list.length l)) with
            | or.inl is_one := by {
                have := congr_arg (fun x, c * x) is_one,
                simp at this,
                ring at ⊢ this,
                assumption
                }
            | or.inr is_zero := by {
                ring at is_zero,
                norm_cast at is_zero
            }
            end
        }

theorem E.const_right (c : rat) (l : list rat) : E (fun x, x * c) l = E id l * c :=
    calc
        E (fun x, x * c) l = E (fun x, c * x) l : by simp [mul_comm]
        ... = c * E id l : by rw ← E.const_left; refl
        ... = E id l * c : by rw mul_comm

theorem E.const_both (c c' : rat) (l : list rat) : E (fun x, c * x * c') l = c * E id l * c' :=
    calc
        E (fun x, c * x * c') l = E (fun x, c * (x * c')) l : by simp [mul_assoc]
        ... = c * E (fun x, x * c') l : by rw E.const_left
        ... = c * (E id l * c') : by rw E.const_right
        ... = c * E id l * c' : by rw ← mul_assoc

theorem E.identity_is_mean (l : list rat) : E id l = mean l :=
    calc
        E id l = mean (list.map id l) : by unfold E
        ... = mean l : by rw list.eq.identity

theorem E.sqr_split (m : rat) (x : rat) (xs : list rat) : E (fun x, (x - m) ^ 2) (x :: xs) = E (fun x, x ^ 2) (x :: xs) - 2 * mean (x :: xs) * m + m ^ 2 :=
    let l := x :: xs in
    calc
        E (fun x, (x - m) ^ 2) l = E (fun x, x ^ 2 - 2 * x * m + m ^ 2) l : by ring
        ... = E (fun x, x ^ 2) l - E (fun x, 2 * x * m) l + E (fun _, m ^ 2) l : by rw [E.add, E.sub]
        ... = E (fun x, x ^ 2) l - 2 * E id l * m + m ^ 2 : by rw [E.const_both, E.const_none]
        ... = E (fun x, x ^ 2) l - 2 * mean l * m + m ^ 2 : by rw [E.identity_is_mean]

theorem var_equals_var' : ∀ (l : list rat), var l (mean l) = var' l (mean l)
    | [] := rfl
    | l@(x :: xs) :=
        let m := mean l in
        calc
            var l m = E (fun x, (x - m) ^ 2) l : by unfold var
            ... = E (fun x, x ^ 2) l - 2 * m * m + m ^ 2 : by rw E.sqr_split
            ... = E (fun x, x ^ 2) l - 2 * (m * m) + m ^ 2 : by rw [mul_assoc]
            ... = E (fun x, x ^ 2) l - 2 * m ^ 2 + m ^ 2 : by ring
            ... = E (fun x, x ^ 2) l - m ^ 2 : by ring
            ... = var' l m : by refl

-- Is also known as MSE = variance + bias ^ 2 proof
theorem mean_is_global_minima_of_variance (m' : rat) : ∀ (l : list rat), var l (mean l) <= var l m'
    | [] := by simp [var]
    | l@(x :: xs) :=
        let m := mean l in
        calc
            var l m = E (fun x, (x - m) ^ 2) l : rfl
            ... = E (fun x, x ^ 2) l - 2 * m * m + m ^ 2 : by rw E.sqr_split
            ... <= E (fun x, x ^ 2) l - 2 * m * m' + m' ^ 2 : by { repeat {rw [sub_eq_add_neg, add_assoc]}, apply add_le_add_left, apply @le_of_add_le_add_right _ _ _ (m ^ 2), convert (pow_two_nonneg (m - m')); ring }
            ... = E (fun x, (x - m') ^ 2) l : by rw ← E.sqr_split
            ... = var l m' : rfl


/- Proving question -/

def sum_to : Nat → Nat
| 0 => 0
| n + 1 => sum_to n + n + 1

theorem sum_to_eq (n : Nat) : 2 * sum_to n = n * (n + 1) := by
  induction n with
  | zero => rfl
  | succ n ih =>
    show 2 * (sum_to n + n + 1) = _
    simp [Nat.mul_add, ih]
    simp [Nat.succ_mul, Nat.add_succ, Nat.mul_succ, Nat.succ_add, Nat.add_assoc]

/- Programming question -/

structure Run where
  max : Nat
  len : Nat
  sum : Nat
  best_len : Nat
  best_sum : Nat

def Run.init : Run where
  max := 0
  len := 0
  sum := 0
  best_len := 0
  best_sum := 0

def Run.commit (r : Run) : Run :=
  if r.len ≥ 2 && r.len > r.best_len then
    { r with best_len := r.len, best_sum := r.sum }
  else
    r

def Run.push (r : Run) (n : Nat) : Run :=
  if r.max + 1 == n then
    { r with
      max := n,
      len := r.len + 1,
      sum := r.sum + n }
  else
    { r.commit with
      max := n
      len := 1
      sum := n }

def Run.extract (r : Run) : Nat := r.commit.best_sum

def longest_consec_sublist_sum (l : List Nat) : Nat := (l.foldl Run.push Run.init).extract

#eval longest_consec_sublist_sum [1, 2, 3, 100, 7, 8] -- 6
#eval longest_consec_sublist_sum [1, 2, 3, 4, 100, 7, 8, 9, 10, 2, 3, 4, 5, 6] -- 20


-- Las relaciones reflexivas y euclídeas son de equivalencia
-- =========================================================

-- ----------------------------------------------------
-- Una relación binaria (≈) es euclídea si
--    ∀ {a b c}, a ≈ b → c ≈ b → a ≈ c
--
-- El objetivo de esta teoría es demostrar que si una
-- relación es reflexiva y euclídea, entonces es de
-- equivalencia.
-- ----------------------------------------------------

import tactic

section

parameter {A : Type}
parameter (R : A → A → Prop)

local infix ≈ := R

parameter reflexivaR : reflexive (≈)
parameter euclideaR : ∀ {a b c}, a ≈ b → c ≈ b → a ≈ c

include reflexivaR euclideaR

-- ----------------------------------------------------
-- Ej. 1. Demostrar que las relaciones reflexivas y
-- y euclídeas son simétricas.
-- ----------------------------------------------------

-- 1ª demostración
example : symmetric (≈) :=
begin
  intros a b h,
  exact euclideaR (reflexivaR b) h,
end

-- 2ª demostración
example : symmetric (≈) :=
λ a b h, euclideaR (reflexivaR b) h

-- 3ª demostración
lemma simetricaR : symmetric (≈) :=
assume a b (h1 : a ≈ b),
have h2 : b ≈ b, from (reflexivaR b),
show b ≈ a, from euclideaR h2 h1

-- ----------------------------------------------------
-- Ej. 2. Demostrar que las relaciones reflexivas y
-- y euclídeas son transitivas.
-- ----------------------------------------------------

-- 1ª demostración
example : transitive (≈) :=
begin
  rintros a b c h1 h2,
  apply euclideaR h1,
  exact euclideaR (reflexivaR c) h2,
end

-- 2ª demostración
lemma transitivaR : transitive (≈) :=
λ a b c h1 h2, (euclideaR h1) (euclideaR (reflexivaR c) h2)

-- 3ª demostración
example : transitive (≈) :=
assume a b c (h1 : a ≈ b) (h2 : b ≈ c),
have h3 : c ≈ b, from euclideaR (reflexivaR c) h2,
show a ≈ c, from euclideaR h1 h3

-- ----------------------------------------------------
-- Ej. 3. Demostrar que las relaciones reflexivas y
-- y euclídeas son de equivalencia.
-- ----------------------------------------------------

-- 1ª demostración
example : equivalence (≈) :=
begin
  unfold equivalence,
  exact ⟨reflexivaR, simetricaR, transitivaR⟩,
end

-- 2ª demostración
example : equivalence (≈) :=
⟨reflexivaR, simetricaR, transitivaR⟩

end


import data.nat.prime
import data.rat.basic
import data.real.basic
import tactic

namespace uwyo -- hide

/-
# Chapter 1 : Basic facts

## Level 1

In this level you need to prove that `sqrt 2` is irrational.
This is adapted from a similar proof from chapter 2 of "logic and Proof"
by J. Avigad, R. Y. Lewis and F. van Doorn, freely available online.
-/

/- Lemma
For any two arbitrary natural numbers $a$ and $b$, it is not true that
$$ a^2 = 2 b^2.$$
-/
theorem sqrt_two_irrational {a b : ℕ} (co : nat.gcd a b = 1) : a^2 ≠ 2 * b^2 :=
begin
    intro h,
    have h1 : 2 ∣ a^2, simp [h],
    have h2 : 2 ∣ a, from nat.prime.dvd_of_dvd_pow nat.prime_two h1,
    cases h2 with c aeq,
    have h3 : 2 * ( 2 * c^2) = 2 * b^2,
        by simp [eq.symm h, aeq];
           simp [nat.pow_succ, mul_comm, mul_assoc, mul_left_comm],
    have h4 : 2 * c^2 = b^2,
        from nat.eq_of_mul_eq_mul_left dec_trivial h3,
    have h5 : 2 ∣ b^2, by simp [eq.symm h4],
    have hb : 2 ∣ b, from nat.prime.dvd_of_dvd_pow nat.prime_two h5,
    have ha : 2 ∣ a, from nat.prime.dvd_of_dvd_pow nat.prime_two h1,
    have h6 : 2 ∣ nat.gcd a b, from nat.dvd_gcd ha hb,
    have habs : 2 ∣ (1 : ℕ), by
        {rw co at h6, exact h6},
    have h7 : ¬ 2 ∣ 1, exact dec_trivial,
    exact h7 habs, done
end

end uwyo -- hide


-- propositions
-- proofs
-- predicates
    -- sets
    -- relations
    -- equality
-- connectives
    -- not
    -- and
    -- or

-- proposition
inductive nifty_was_a_cat : Prop
-- proofs
| there_are_pictures_of_nifty
| we_remember_nifty_fondly

inductive pet : Type
| nifty -- a cat
| fido -- a dog
| cheese -- a rat
| tom -- a cat

open pet

-- predicate
inductive was_a_cat : pet → Prop
| nifty_proof : was_a_cat nifty
| tom_proof : was_a_cat tom

open was_a_cat

theorem nwac : was_a_cat nifty :=
    nifty_proof

theorem cwac : was_a_cat cheese := _

/-
Property of a pet: that of having
been a cat. Some have it. Some don't

a predicate defines a property of its argument type
-/

/-
Set of pets: { nifty, tom }.
-/

/-
How might we assert that "nifty was
a cat AND cheese was a cat"? Each of
these claims is a proposition, in turn
an object of type Prop, and what we want
to build is a bigger proposition. Rather
than a one-off solution specific to the
given propositions, we'll create a way
to conjoin any two propositions into a
larger one, a conjunction. To build
one it is necessary and sufficient
to have proofs of each component
proposition.

We want a way to to build an AND
proposition based on any two smaller
component propositions. The type of
our proposition is Prop, and of the
smaller propositions, also Prop. So
we really need somthing of type
Prop → Prop → Prop. This is just a
Prop parameterized by two Props,
which we might call α and β. We
need a polymorphic type.
-/

#print and

namespace our_logic

/-
INTRODUCTION

Given proofs, α and β, we can build
a proof, (and.intro α β), of α ∧ β.
Here are three ways to write exactly
the same inductive definition.
-/

inductive and'' (α β : Prop) : Prop
| intro : α → β → and''

inductive and' (α β : Prop) : Prop
| intro (left : α) (right : β) : and'

structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)

-- if you have only one data type, you can use structure
-- building  data type with just one constructor

def x := and (was_a_cat nifty) (was_a_cat tom)

def pf4 : x := and.intro nifty_proof tom_proof

#reduce pf4.left
#reduce pf4.right

def nwac_and_cwac : Prop :=
    and'' (was_a_cat nifty) (was_a_cat cheese)

def pf : nwac_and_cwac :=
    and''.intro nifty_proof _

def nwac_and_twac : Prop :=
    and'' (was_a_cat nifty) (was_a_cat tom)

def pf2 : nwac_and_twac :=
    and''.intro nifty_proof tom_proof

def pf3 : and'' (was_a_cat nifty) (was_a_cat tom) :=
    and''.intro nifty_proof tom_proof

#reduce pf2

def and''_elim_left {α β : Prop} : (and'' α β) → α
| (and''.intro a b) := a

#reduce and''_elim_left pf2

def and''_elim_right{α β : Prop} : (and'' α β) → β
| (and''.intro a b) := b

#reduce and''_elim_right pf2

inductive and' (α β : Prop) : Prop
| intro (left : α) (right : β) : and'

end our_logic

namespace our_logic

notation P ^ Q := and P Q   -- we don't overload ∧

theorem were_cats_nifty_and_cheese :
    was_a_cat nifty ^ was_a_cat cheese :=
begin
    apply and.intro _ _, -- don't need the _ _, implied
    exact nifty_proof,
    sorry -- Stuck: no theorem obtained.
end

theorem were_cats_nifty_and_tom :
    was_a_cat nifty ^ was_a_cat tom :=
begin
    apply and.intro,
    exact nifty_proof,
    exact tom_proof,    -- Yay, it's a theorem!
end

/-
ELIMINATION

If we have a proof of P ^ Q, we can obtain
individual proofs of P and Q, respectively.
-/

def and.elim_left {α β : Prop} : and α β → α
| (and.intro a b) := a

def and.elim_right {α β : Prop} : and α β → β
| (and.intro a b) := b

end our_logic

/-Now we[re using lean libraries-/
-- PROPOSITIONS
def P1 : Prop := 0 = 0 -- propositions are types
def P2 : Prop := 1 = 1

#check and P1 P2

-- PROOFS
#check 0 = 0

-- eq is a 2 place predicate. (its .equals equivalent from java)
-- inductive eq {alpha : Tyoe}: α → α → Prop
-- refl: α → eq α α
def p1 : P1 := eq.refl 0
def p2 : P2 := eq.refl 1

example: 1 = 1 + 0 := eq.refl 1

/-
Prove 0 = 0.

Proof: equality is reflexive, this means that for any value a of any kind
or type α , a = a.

∀ {T:Type}, ∀ (t : T),  t = t.
We apply this axiom to 0 in particluar to derive a proof that 0 equals 0.

thia ia called universal generalization.
-/

def P1_and_P2' : Prop := and P1 P2
def P1_and_P2 : Prop := P1 ∧ P2

def p1_and_p2' : P1_and_P2 := and.intro p1 p2

def p1_and_p2 : P1_and_P2 :=
begin
    apply and.intro _ _,
    exact p1,
    exact p2,
end

#check p1_and_p2

#check and.elim_left p1_and_p2
#check p1_and_p2.left

#check and.elim_right p1_and_p2
#check p1_and_p2.right

#check @and.elim_left

theorem my_elim_left : ∀ (P1 P2 : Prop), P1 ∧ P2 → P1 :=
λ P1 P2 h,
    match h with
    | and.intro a b := a
    end

/-
English Language.

-/

/-
If we have a proof that nifty was a cat ∧
cheese was a cat, then we can deduce a proof
that cheese was a cat. Such a proof must be a
part of the assumed proof of the conjunction.
-/
theorem conj_impl_left :
    was_a_cat nifty ^
    was_a_cat cheese →
    was_a_cat cheese
| pf_n_and_c := and.elim_right pf_n_and_c

/-
There what we just did is kind of amazing.
We formalized a proof of a proposition,
"if nifty was a cat and cheese was a cat,
then cheese was a cat, as a function. That
there is such a function proves the truth
of the logical implication (proposition).
-/

/-
Note: We have not proved that cheese was a
cat. If fact cheese wasn't a cat; he was a
rat. All we have shown is that *if* we can
come up with a proof of the conjunction then
we can "extract" its right component proof.
It does not show that we could actually ever
build a proof of the conjunction in the
first place.
-/

/-
We see again that a proof of a conjunction
in our logic is really just a pair of proofs,
with fst and snd (left and right) projection
functions. The and.intro constructor takes a
pair of proofs and packages them up into pair
that is accepted as a proof of a conjunction.
-/

end our_logic

/-
Lean provides exactly such this polymorphic
logical and connective. It's called "and" has
∧ as a conventional infix notation. Here's an
example. We also take this moment to introduce
the "example" construct in Lean. It's just
like def or theorem, in that it calls for a
value of a particular type. The difference is
that it doesn't bind the value to a name. It
is a way to prove something without storing
the proof as a named object.
-/

example : was_a_cat tom ∧ 0 = 0 :=
    and.intro tom_proof (eq.refl 0)

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro tom_proof (eq.refl 0),
end

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro tom_proof, -- arg as subgoal
    exact (eq.refl 0)
end

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro,    -- two args as subgoals
    exact tom_proof,
    exact (eq.refl 0)
end

/-
Let's write some English language proofs.
-/

/-
IMPLIES
-/

/-
What we've seen now is that a proof that an
implication is true is a proof that *if* one
has a proof of its premise, then from that
one can obtain a proof of its conclusion.

Again, as an example, consider that from a
proof of a conjunction one can obtain (you
can also say "deduce") a proof of either of
its conjuncts. If one has a proof of P ∧ Q,
for example, then by applying one of the two
"and elimination" axioms (rules of natural
deduction) to the proof of P ∧ Q, one can
obtain either a proof of P, or a proof of Q.

To prove an implication we thus prove that
there is a way to transform any proof of
its premise into a proof of its conclusion.

In natural language, we'd say that we first
*assume* that the premise is true, and then
we'd show that in the context in which we've
made that assumption, we can show that the
conclusion must be true.

Theorem: For all propositions, P and Q,
(P ∧ Q) → P.

Proof. Suppose that P and Q are arbitrary
but specific propositions. What remains to
prove is that (P ∧ Q) → P. To prove this,
assume we have a proof of P ∧ Q. Applying
the natural deduction principle of and
elimination (left) yields of proof of P.
QED.

To formalize this idea, we prove such an
implication by showing that there is a
function that, *if* given a proof of the
premise as an argument is able to create
and return a proof of the conclusion. If
there is such a function in Lean (in which
case it is a total function, and so can
take *any* proof of the premise as an
argument), then from any proof of the
premise it is always possible to derive
a proof of the conclusion, so the truth
of the premise implies the truth of the
conclusion.
-/

def pf1 : ∀ (P Q : Prop), P ∧ Q → P :=
    λ P Q,
        λ h,
            and.elim_left h

def pf1' : ∀ (P Q : Prop), P ∧ Q → P :=
    λ X Y,
        λ h,
            and.elim_left h

-- Note that names bound by lambda do
-- not have to be P and Q. You can call
-- arguments whatever you want, as long
-- as their names are already in use.

/-
Let's take that bit by bit. We bind a name,
pf1, to a proof of ∀ (P Q : Prop), P ∧ Q → P.

We use ∀ (P Q : Prop) to give names to two
*parameters* -- any two propositions, P and
Q -- so that we can use these names in the
rest of the proposition: P ∧ Q → P.

We thus have the overall proposition: for
*any* propositions, P and Q, if P ∧ Q (is
true, has a proof) then P (is true, has a
proof), i.e., P ∧ Q → P. In curt English:
"If P ∧ Q then P."

The lambda expressions take argument values
that, in the rest of the function definition,
are *assumed* to be of the specified types.
So in the "body" of the function, P and Q are
*assumed* to be propositions (types, of type
Prop), and h is *assumed* to be a proof (value)
of (type) P ∧ Q.

What the expression, (and.elim_left h), then
shows is that, in the context of *the given
assumptions*, one can construct and return
a proof of *P*. From the assumption of the
premise follows the truth of the conclusion.
-/

/-
A proof of an implication in constructive
logic is a function: one that if given an
argument of the premise type returns a value
of the conclusion type. Recall: propositions
are types, proofs are values of such types.

We wrote the formal proof of ∀ (P Q : Prop),
P ∧ Q → P, to make explicit the overall
proposition being proved, but we could just
as well have written it in C style. In fact,
we could have written it in any of the ways
available to define functions.

Here are various forms in which exactly the
same proof can be expressed. In the first C
style proof, we see even more clearly that
we can think of argument to functions as
*assumptions* that we can then use in the
function body to construct a return result.
-/

def pf2 (P Q : Prop) (h : P ∧ Q) : P :=
    and.elim_left h -- from h deduce P

#check pf2      -- that's pretty cool

-- script, assume and name args in script
-- here X and Y refer to P, Q
-- better in general to keep names P, Q
def pf3 : ∀ (P Q : Prop), P ∧ Q → P :=
begin
    assume (X Y : Prop),
    assume (h : X ∧ Y),
    exact and.elim_left h,
end

-- proof script, args already assumed
def pf4 (P Q : Prop) (h : P ∧ Q) : P :=
begin -- look: arguments are assumptions
    exact and.elim_left h,
end

-- using cases notation
def pf5 : ∀ (P Q : Prop), P ∧ Q → P
| P Q h := and.elim_left h

/-
False Elimination: ∀ (P : Prop), false → P.
-/

/-
It doesn't matter whether or not one can
ever produce a proof of a premise, because
all that a proof of an implications says
is that *if* you can give a proof of the
premise as an argument to a function, then
it can return a proof of the conclusion.

A clear example involves the proof that
"false implies (the truth of) anything".
Formally: ∀ (P : Prop), false → P. Take
a moment to make sure you understand what
this proposition says!
-/

/-
The proposition (false : Prop) is one with
no proofs at all.
-/

inductive false' : Prop
-- no constructors!

/-
For example, it's true that (false → 0 = 1)
even though one can never produce a proof
of false. The truth of (false → 0 = 1) is
demonstrated by the existence of a function
that, *if* it could be given a proof of false,
would return a proof of 0 = 1 by applying the
false elimination inference rule to the
*assumed* proof of false to derive a proof
of 0 = 1.
-/

theorem false_elim_example : false → 0 = 1 :=
    λ h, false.elim h

theorem false_elim_example' (h : false) : 0 = 1 :=
    false.elim h

example : false → 0 = 1 := λ h, false.elim h


-- aplicaciones.lean
-- Aplicaciones inyectivas. suprayectivas y biyectivas.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 16-junio-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 1. Importar la librería de tácticas-
-- ---------------------------------------------------------------------

import tactic

-- ---------------------------------------------------------------------
-- Ejercicio 2. Abrir la lógica clásica.
-- ---------------------------------------------------------------------

open classical

-- ---------------------------------------------------------------------
-- Ejercicio 3. Declarar X, Y y Z variables de tipo-
-- ---------------------------------------------------------------------

variables {X Y Z : Type*}

-- ---------------------------------------------------------------------
-- Ejercicio 4. Definir la función es_inyectiva tal (es_inyectiva f)
-- expresa que f es inyectiva.
-- ---------------------------------------------------------------------

def es_inyectiva
  (f : X → Y) :=
  ∀ x x', f x = f x' → x = x'

-- ---------------------------------------------------------------------
-- Ejercicio 5. Definir la función es_suprayectiva tal (es_suprayectiva f)
-- expresa que f es suprayectiva.
-- ---------------------------------------------------------------------

def es_suprayectiva
  (f : X → Y) :=
  ∀ y, ∃ x, f x = y

-- ---------------------------------------------------------------------
-- Ejercicio 6. Definir la función es_biyectiva tal (es_biyectiva f)
-- expresa que f es biyectiva.
-- ---------------------------------------------------------------------

def es_biyectiva
  (f : X → Y) :=
  es_inyectiva f ∧ es_suprayectiva f

-- ---------------------------------------------------------------------
-- Ejercicio 7. Demostrar que las funciones biyectivas son inyectivas.
-- ---------------------------------------------------------------------

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

example
  {f : X → Y}
  (f_biyectiva : es_biyectiva f)
  : es_inyectiva f :=
and.elim_left f_biyectiva

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

lemma biy_iny
  {f : X → Y}
  (f_biyectiva: es_biyectiva f)
  : es_inyectiva f :=
f_biyectiva.1

-- ---------------------------------------------------------------------
-- Ejercicio 8. Demostrar que las funciones biyectivas son suprayectivas.
-- ---------------------------------------------------------------------

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

example
  {f : X → Y}
  (f_biyectiva : es_biyectiva f)
  : es_suprayectiva f :=
and.elim_right f_biyectiva

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

lemma biy_supr
  {f : X → Y}
  (f_biyectiva : es_biyectiva f)
  : es_suprayectiva f :=
f_biyectiva.2

-- ---------------------------------------------------------------------
-- Ejercicio 9. Demostrar que si f es suprayectiva e inyectiva, entonces
-- es biyectiva.
-- ---------------------------------------------------------------------

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

example
  {f : X → Y}
  (f_suprayectiva : es_suprayectiva f)
  (f_inyectiva : es_inyectiva f)
  : es_biyectiva f :=
and.intro f_inyectiva f_suprayectiva

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

lemma supr_iny_biy
  {f : X → Y}
  (f_suprayectiva : es_suprayectiva f)
  (f_inyectiva : es_inyectiva f)
  : es_biyectiva f :=
⟨f_inyectiva, f_suprayectiva⟩

-- ---------------------------------------------------------------------
-- Ejercicio 10. Demostrar que si (g ∘ f) es inyectiva, entonces f es
-- inyectiva.
-- ---------------------------------------------------------------------

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

example
  {f : X → Y}
  {g : Y → Z}
  (gf_inyectiva : es_inyectiva (g ∘ f))
  : es_inyectiva f :=
begin
  intros x x' f_xx',
  apply gf_inyectiva,
  simp [f_xx'],
end

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

lemma iny_comp_iny_primera
  {f : X → Y}
  {g : Y → Z}
  (gf_inyectiva : es_inyectiva (g ∘ f))
  : es_inyectiva f :=
begin
  assume x  : X,
  assume x' : X,
  assume f_xx' : f x = f x',
  have gf_xx' : (g ∘ f) x = (g ∘ f) x', from
    calc (g ∘ f) x = g (f x)    : by simp
               ... = g (f x')   : by simp [f_xx']
               ... = (g ∘ f) x' : by simp,
  show x = x',
    { apply gf_inyectiva,
      apply gf_xx'},
end

-- ---------------------------------------------------------------------
-- Ejercicio 11. Demostrar que si (g ∘ f) es suprayectiva, entonces f es
-- suprayectiva.
-- ---------------------------------------------------------------------

lemma supr_comp_supr_segunda
  {f : X → Y}
  {g : Y → Z}
  (gf_suprayectiva : es_suprayectiva (g ∘ f))
  : es_suprayectiva g  :=
begin
  assume z : Z,
  rcases gf_suprayectiva z with ⟨ x : X, gf_x_z : (g ∘ f) x = z⟩,
  let y : Y := f x,
  use y,
  show g y = z, from
    calc g y = g (f x)   : by simp
         ... = (g ∘ f) x : by simp
         ... = z         : by exact gf_x_z,
end

-- ---------------------------------------------------------------------
-- Ejercicio 12. Demostrar que si (f ∘ f) es biyectiva, entonces f es
-- biyectiva.
-- ---------------------------------------------------------------------

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

example
  (f : X → X)
  (ff_biyectiva : es_biyectiva (f ∘ f))
  : es_biyectiva f :=
begin
  apply supr_iny_biy,
  { apply supr_comp_supr_segunda,
    apply biy_supr,
    exact ff_biyectiva, },
  { apply iny_comp_iny_primera,
    apply biy_iny,
    exact ff_biyectiva, },
end

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

lemma cuadrado_biy_biy
  (f : X → X)
  (ff_biyectiva : es_biyectiva (f ∘ f))
  : es_biyectiva f :=
begin
  have f_inyectiva : es_inyectiva f, from
    begin
      have ff_inyectiva : es_inyectiva (f ∘ f),
        by exact biy_iny ff_biyectiva,
      show _,
        by exact iny_comp_iny_primera ff_inyectiva,
    end,
  have f_suprayectiva: es_suprayectiva f, from
    begin
      have ff_suprayectiva : es_suprayectiva (f ∘ f),
        by exact biy_supr ff_biyectiva,
      show _,
        by exact supr_comp_supr_segunda ff_suprayectiva,
    end,
  show es_biyectiva f,
    by exact supr_iny_biy f_suprayectiva f_inyectiva,
end

-- ---------------------------------------------------------------------
-- Ejercicio 13. Definir el tipo A con los constructores A1, A2 y A3.
-- ---------------------------------------------------------------------

inductive A : Type
  | A1
  | A2
  | A3

open A

-- ---------------------------------------------------------------------
-- Ejercicio 14. Definir la función
--   f ; A -> A
-- tal que
--   f A1 = A1,
--   f A2 = A1 y
--   f A3 = A2.
-- ---------------------------------------------------------------------

def f : A → A
  | A1 := A1
  | A2 := A1
  | A3 := A2

-- ---------------------------------------------------------------------
-- Ejercicio 15. Demostrar que f no es inyectiva.
-- ---------------------------------------------------------------------

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

example
  : ¬ es_inyectiva f :=
begin
  unfold es_inyectiva,
  simp,
  use [A1, A2],
  split,
  { dsimp [f],
    refl, },
  { simp, },
end

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

lemma f_no_iny
  : ¬ es_inyectiva f :=
begin
  let x  := A1,
  let x' := A2,
  have f_xx'_x_diferente_x' : f x = f x' ∧ x ≠ x', from
    begin
      have f_xx' : f x  = f x', by simp [f],
      have x_diferente_x' :  x ≠ x', by finish,
      show _, by exact and.intro f_xx' x_diferente_x',
    end,
  show ¬ es_inyectiva f, from
    begin
      simp only [es_inyectiva, not_forall],
      use x,
      use x',
      exact f_xx'_x_diferente_x',
    end
end

-- ---------------------------------------------------------------------
-- Ejercicio 16. Demostrar que f no es suprayectiva.
-- ---------------------------------------------------------------------

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

example
  : ¬ es_suprayectiva f:=
begin
  unfold es_suprayectiva,
  rw not_forall,
  use A3,
  rw not_exists,
  intro x,
  cases x,
  { simp [f], },
  { simp [f], },
  { simp [f], },
end

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

example
  : ¬ es_suprayectiva f:=
begin
  unfold es_suprayectiva,
  push_neg,
  use A3,
  intro x,
  cases x; finish,
end

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

lemma f_no_es_supr
  : ¬ es_suprayectiva f:=
begin
  simp only [es_suprayectiva, not_forall],
  show ∃ y : A, ¬(∃ x : A, f x = y), by
    begin
      use A3,
      have A3_no_es_imagen : ∀ x : A, ¬ f x = A3, from
        begin
          assume x : A,
          cases x,
            case A1 : {simp [f] },
            case A2 : {simp [f] },
            case A3 : {simp [f] },
        end,
      show _,
        by {simp only [not_exists], exact A3_no_es_imagen}
    end
end

-- ---------------------------------------------------------------------
-- Ejercicio 17. Definir el tipo B con los constructores B1 y B2.
-- ---------------------------------------------------------------------

inductive B
  | B1
  | B2

open B

-- ---------------------------------------------------------------------
-- Ejercicio 18. Definir la función
--    g : B → B
-- tal que
--    g B1 = B2
--    g B2 = B1
-- ---------------------------------------------------------------------

def g : B → B
  | B1 := B2
  | B2 := B1

-- ---------------------------------------------------------------------
-- Ejercicio 19. Demostrar que g es biyectiva.
-- ---------------------------------------------------------------------

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

example
  : es_biyectiva g :=
begin
  apply supr_iny_biy,
  { unfold es_suprayectiva,
    intro y,
    cases y,
    { use B2,
      simp [g], },
    { use B1,
      simp [g], }},
  { unfold es_inyectiva,
    intros x x' gxx',
    cases x,
    { cases x',
      { refl, },
      { dsimp [g] at gxx',
        rw gxx', }},
    { cases x',
      { dsimp [g] at gxx',
        rw gxx', },
      { refl, }}},
end

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

lemma g_es_biyectiva
  : es_biyectiva g :=
begin
  have g_es_inyectiva : es_inyectiva g, from
    begin
      assume x  : B,
      assume x' : B,
      assume g_xx' : g x = g x',
      cases x,
        case B1 : begin cases x', finish, finish end,
        case B2 : begin cases x', finish, finish end,
    end,
  have g_es_suprayectiva : es_suprayectiva g, from
    begin
      assume y : B,
      cases y,
        case B1 : begin use B2, finish end,
        case B2 : begin use B1, finish end,
    end,
  show _,
    by exact supr_iny_biy g_es_suprayectiva g_es_inyectiva
end

-- ---------------------------------------------------------------------
-- Ejercicio 20. Definir el conjunto conj_123 cuyos elementos son los
-- números naturales 1, 2 y 3.
-- ---------------------------------------------------------------------

def conj_123 : set ℕ :=
  {1,2,3}

-- ---------------------------------------------------------------------
-- Ejercicio 21. Demostrar que
--    1 ∈ conj_123
-- ---------------------------------------------------------------------

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

example : 1 ∈ conj_123  :=
begin
  fconstructor,
  refl,
end

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

lemma uno_en_123 : 1 ∈ conj_123 :=
by {fconstructor, refl}

-- ---------------------------------------------------------------------
-- Ejercicio 22. Demostrar que
--    2 ∈ conj_123
-- ---------------------------------------------------------------------

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

example : 2 ∈ conj_123  :=
begin
  apply or.inr,
  fconstructor,
  refl,
end

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

lemma dos_en_123 : 2 ∈ conj_123 :=
by {apply or.inr, simp}

-- ---------------------------------------------------------------------
-- Ejercicio 23. Demostrar que
--    3 ∈ conj_123
-- ---------------------------------------------------------------------

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

example : 3 ∈ conj_123  :=
begin
  apply or.inr,
  apply or.inr,
  fconstructor,
end

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

lemma tres_en_123 : 3 ∈ conj_123 :=
by {apply or.inr, simp}

-- ---------------------------------------------------------------------
-- Ejercicio 24. Definir la función
--    const1 : conj_123 → conj_123
-- que aplica todos los elementos en el 1.
-- ---------------------------------------------------------------------

def const1 : conj_123 → conj_123 :=
λ ⟨x, _⟩, ⟨1, uno_en_123⟩

-- ---------------------------------------------------------------------
-- Ejercicio 25. Definir la función
--    h : conj_123 → conj_123
-- que aplica el 3 en el 2 y los demás en el 1.
-- ---------------------------------------------------------------------

def h : conj_123 → conj_123 :=
λ ⟨x, x_in_123⟩,
  if x = 3 then ⟨ 2, dos_en_123 ⟩
           else ⟨ 1, uno_en_123 ⟩

-- ---------------------------------------------------------------------
-- Ejercicio 26. Demostrar que h no es inyectiva.
-- ---------------------------------------------------------------------

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

example
  : ¬ es_inyectiva h :=
begin
  unfold es_inyectiva,
  push_neg,
  let x1 : ↥conj_123 := ⟨ 1, uno_en_123 ⟩,
  let x2 : ↥conj_123 := ⟨ 2, dos_en_123 ⟩,
  use [x1, x2],
  split,
  { simp [h], },
  { simp, },
end

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

lemma h_no_es_inyectiva
  : ¬ es_inyectiva h :=
begin
  let x1 : ↥conj_123 := ⟨ 1, uno_en_123 ⟩,
  let x2 : ↥conj_123 := ⟨ 2, dos_en_123 ⟩,
  refine not_forall.mpr _,
  use x1,
  refine not_forall.mpr _,
  use x2,
  finish,
end

-- =====================================================================
-- § Ejercicios complementarios
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio 27. Definir la aplicación identidad
-- ---------------------------------------------------------------------

def apl_id
  (X : Type*)
  : X → X :=
λ x, x

-- ---------------------------------------------------------------------
-- Ejercicio 28. Demostrar que la aplicación identidad es biyectiva.
-- ---------------------------------------------------------------------

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

example
  (X : Type*)
  : es_biyectiva (apl_id X) :=
begin
  apply supr_iny_biy,
  { unfold es_suprayectiva,
    intro y,
    use y,
    simp [apl_id], },
  { unfold es_inyectiva,
    intros x x' f_xx',
    simp [apl_id] at f_xx',
    exact f_xx', },
end

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

lemma id_biyectiva
  (X : Type*)
  : es_biyectiva (apl_id X) :=
begin
  let f : X → X := apl_id X,
  have id_iny : es_inyectiva f, from
    begin
      assume x x' : X,
      assume f_xx' : f x = f x',
      show x = x', by
        calc x = f x  : by refl
           ... = f x' : by simp [f_xx']
           ... = x'   : by refl,
    end,
  have id_supr : es_suprayectiva f, from
    begin
      assume y : X,
      use y,
      show f y = y, by refl,
    end,
  show _,
    by exact supr_iny_biy id_supr id_iny,
end

-- ---------------------------------------------------------------------
-- Ejercicio 29. Demostrar que la composición de funciones inyectivas
-- es inyectiva.
-- ---------------------------------------------------------------------

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

example
  (f : X → Y)
  (g : Y → Z)
  (f_inyectiva : es_inyectiva f)
  (g_inyectiva : es_inyectiva g)
  : es_inyectiva (g ∘ f) :=
begin
  unfold es_inyectiva,
  intros x x' gf_xx',
  apply f_inyectiva,
  apply g_inyectiva,
  calc g (f x) = (g ∘ f) x  : rfl
           ... = (g ∘ f) x' : gf_xx'
           ... = g (f x')   : rfl
end

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

lemma comp_iny_es_iny
  (f : X → Y)
  (g : Y → Z)
  (f_inyectiva : es_inyectiva f)
  (g_inyectiva : es_inyectiva g)
  : es_inyectiva (g ∘ f) :=
begin
  assume x x' : X,
  assume gf_xx' : (g ∘ f) x = (g ∘ f) x',
  show x = x', by
    begin
      have f_xx' : f x = f x', from
        begin
          have g_fxfx' : g (f x) = g (f x'), from
            calc g (f x) = (g ∘ f) x  : by simp
                     ... = (g ∘ f) x' : by simp[gf_xx']
                     ... = g (f x')   : by simp,
          show _,
            by {apply g_inyectiva, apply g_fxfx'},
        end,
      show _,
        by {apply f_inyectiva, apply f_xx'},
    end
end

-- ---------------------------------------------------------------------
-- Ejercicio 30. Sea f : X → Y tal que existen x, x' ∈ X tales que
-- x ≠ x' y f x = f x'. Demostrar que f no es inyectiva.
-- ---------------------------------------------------------------------

lemma CS_inyectiva
  (f : X → Y)
  (x : X)
  (x' : X)
  (x_neq_x' : x ≠ x')
  (f_xx' : f x = f x')
  : ¬ es_inyectiva f :=
begin
  simp only [es_inyectiva, not_forall],
  use [x, x'],
  finish,
end

-- ---------------------------------------------------------------------
-- Ejercicio 31.  Usar el lema anterior para demostrar que f no es
-- inyectiva.
-- ---------------------------------------------------------------------

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

example
  : ¬ es_inyectiva f :=
begin
  apply CS_inyectiva f A1 A2,
  { trivial, },
  { simp [f] },
end

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

example
  : ¬ es_inyectiva f :=
begin
  let x  : A := A1,
  let x' : A := A2,
  have x_diferente_x' : x ≠ x', by finish,
  have f_xx' : f x = f x', by refl,
  show _,
    by exact (CS_inyectiva f x x' x_diferente_x' f_xx'),
end

-- ---------------------------------------------------------------------
-- Ejercicio 32. Demostrar que (g ∘ g = id).
-- ---------------------------------------------------------------------

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

example
  : g ∘ g = apl_id B :=
begin
  ext1,
  simp [apl_id],
  cases x,
  { calc g (g B1) = g B2 : by simp [g]
              ... = B1   : by simp [g] },
  { calc g (g B2) = g B1 : by simp [g]
              ... = B2   : by simp [g] },
end

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

lemma gg_id
  : g ∘ g = apl_id B :=
begin
  have g_id : ∀ x : B, (g ∘ g) x = apl_id B x, from
    begin
       assume x : B,
       cases x,
         {finish},
         {finish},
    end,
  show _, by {ext1, tauto},
end

-- ---------------------------------------------------------------------
-- Ejercicio 33. Demostrar que g es biyectiva.
-- ---------------------------------------------------------------------

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

example
  : es_biyectiva g :=
begin
  apply cuadrado_biy_biy g,
  convert id_biyectiva B,
  exact gg_id,
end

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

example
  : es_biyectiva g :=
begin
  have gg_biy : es_biyectiva (g ∘ g), from
    begin
      have gg_id : g ∘ g = apl_id B, by exact gg_id,
      show _, by {simp only [gg_id], apply id_biyectiva B},
    end,
  show _, by exact (cuadrado_biy_biy g gg_biy),
end

-- Referencia
-- ==========

-- Basado en "Injective, surjective, bijective maps" de Clara Löh que se
-- encuentra en https://bit.ly/3xzYqun