/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import ring_theory.polynomial.bernstein
import topology.continuous_function.compact
import topology.continuous_function.polynomial
import topology.unit_interval
import algebra.floor
import analysis.specific_limits

/-!
# Bernstein approximations and Weierstrass' theorem

We prove that the Bernstein approximations
```
∑ k : fin (n+1), f (k/n : ℝ) * n.choose k * x^k * (1-x)^(n-k)
```
for a continuous function `f : C([0,1], ℝ)` converge uniformly to `f` as `n` tends to infinity.

Our proof follows [Richard Beals' *Analysis, an introduction*][beals-analysis], §7D.
The original proof, due to [Bernstein](bernstein1912) in 1912, is probabilistic,
and relies on Bernoulli's theorem,
which gives bounds for how quickly the observed frequencies in a
Bernoulli trial approach the underlying probability.

The proof here does not directly rely on Bernoulli's theorem,
but can also be given a probabilistic account.
* Consider a weighted coin which with probability `x` produces heads,
  and with probability `1-x` produces tails.
* The value of `bernstein n k x` is the probability that
  such a coin gives exactly `k` heads in a sequence of `n` tosses.
* If such an appearance of `k` heads results in a payoff of `f(k / n)`,
  the `n`-th Bernstein approximation for `f` evaluated at `x` is the expected payoff.
* The main estimate in the proof bounds the probability that
  the observed frequency of heads differs from `x` by more than some `δ`,
  obtaining a bound of `(4 * n * δ^2)⁻¹`, irrespective of `x`.
* This ensures that for `n` large, the Bernstein approximation is (uniformly) close to the
  payoff function `f`.

(You don't need to think in these terms to follow the proof below: it's a giant `calc` block!)

This result proves Weierstrass' theorem that polynomials are dense in `C([0,1], ℝ)`,
although we defer an abstract statement of this until later.
-/

noncomputable theory

open_locale classical
open_locale big_operators
open_locale bounded_continuous_function
open_locale unit_interval

/--
The Bernstein polynomials, as continuous functions on `[0,1]`.
-/
def bernstein (n ν : ℕ) : C(I, ℝ) :=
(bernstein_polynomial ℝ n ν).to_continuous_map_on I

@[simp] lemma bernstein_apply (n ν : ℕ) (x : I) :
  bernstein n ν x = n.choose ν * x^ν * (1-x)^(n-ν) :=
begin
  dsimp [bernstein, polynomial.to_continuous_map_on, polynomial.to_continuous_map,
    bernstein_polynomial],
  simp,
end

lemma bernstein_nonneg {n ν : ℕ} {x : I} :
  0 ≤ bernstein n ν x :=
begin
  simp only [bernstein_apply],
  exact mul_nonneg
    (mul_nonneg (nat.cast_nonneg _) (pow_nonneg (by unit_interval) _))
    (pow_nonneg (by unit_interval) _),
end

/-!
We now give a slight reformulation of `bernstein_polynomial.variance`.
-/

namespace bernstein

/--
Send `k : fin (n+1)` to the equally spaced points `k/n` in the unit interval.
-/
def z {n : ℕ} (k : fin (n+1)) : I :=
⟨(k : ℝ) / n,
  begin
    cases n,
    { norm_num },
    { have h₁ : 0 < (n.succ : ℝ) := by exact_mod_cast (nat.succ_pos _),
      have h₂ : ↑k ≤ n.succ := by exact_mod_cast (fin.le_last k),
      rw [set.mem_Icc, le_div_iff h₁, div_le_iff h₁],
      norm_cast,
      simp [h₂], },
  end⟩

local postfix `/ₙ`:90 := z

lemma probability (n : ℕ) (x : I) :
  ∑ k : fin (n+1), bernstein n k x = 1 :=
begin
  have := bernstein_polynomial.sum ℝ n,
  apply_fun (λ p, polynomial.aeval (x : ℝ) p) at this,
  simp [alg_hom.map_sum, finset.sum_range] at this,
  exact this,
end

lemma variance {n : ℕ} (h : 0 < (n : ℝ)) (x : I) :
  ∑ k : fin (n+1), (x - k/ₙ : ℝ)^2 * bernstein n k x = x * (1-x) / n :=
begin
  have h' : (n : ℝ) ≠ 0 := ne_of_gt h,
  apply_fun (λ x : ℝ, x * n) using group_with_zero.mul_right_injective h',
  apply_fun (λ x : ℝ, x * n) using group_with_zero.mul_right_injective h',
  dsimp,
  conv_lhs { simp only [finset.sum_mul, z], },
  conv_rhs { rw div_mul_cancel _ h', },
  have := bernstein_polynomial.variance ℝ n,
  apply_fun (λ p, polynomial.aeval (x : ℝ) p) at this,
  simp [alg_hom.map_sum, finset.sum_range, ←polynomial.nat_cast_mul] at this,
  convert this using 1,
  { congr' 1, funext k,
    rw [mul_comm _ (n : ℝ), mul_comm _ (n : ℝ), ←mul_assoc, ←mul_assoc],
    congr' 1,
    field_simp [h],
    ring, },
  { ring, },
end

end bernstein

open bernstein

local postfix `/ₙ`:2000 := z
local notation `|`x`|` := abs x

/--
The `n`-th approximation of a continuous function on `[0,1]` by Bernstein polynomials,
given by `∑ k, f (k/n) * bernstein n k x`.
-/
def bernstein_approximation (n : ℕ) (f : C(I, ℝ)) : C(I, ℝ) :=
∑ k : fin (n+1), f k/ₙ • bernstein n k

/-!
We now set up some of the basic machinery of the proof that the Bernstein approximations
converge uniformly.

A key player is the set `S f ε h n x`,
for some function `f : C(I, ℝ)`, `h : 0 < ε`, `n : ℕ` and `x : I`.

This is the set of points `k` in `fin (n+1)` such that
`k/n` is within `δ` of `x`, where `δ` is the modulus of uniform continuity for `f`,
chosen so `|f x - f y| < ε/2` when `|x - y| < δ`.

We show that if `k ∉ S`, then `1 ≤ δ^-2 * (x - k/n)^2`.
-/

namespace bernstein_approximation

@[simp] lemma apply (n : ℕ) (f : C(I, ℝ)) (x : I) :
  bernstein_approximation n f x = ∑ k : fin (n+1), f k/ₙ * bernstein n k x :=
by simp [bernstein_approximation]

/--
The modulus of (uniform) continuity for `f`, chosen so `|f x - f y| < ε/2` when `|x - y| < δ`.
-/
def δ (f : C(I, ℝ)) (ε : ℝ) (h : 0 < ε) : ℝ := f.modulus (ε/2) (half_pos h)

/--
The set of points `k` so `k/n` is within `δ` of `x`.
-/
def S (f : C(I, ℝ)) (ε : ℝ) (h : 0 < ε) (n : ℕ) (x : I) : finset (fin (n+1)) :=
{ k : fin (n+1) | dist k/ₙ x < δ f ε h }.to_finset

/--
If `k ∈ S`, then `f(k/n)` is close to `f x`.
-/
lemma lt_of_mem_S
  {f : C(I, ℝ)} {ε : ℝ} {h : 0 < ε} {n : ℕ} {x : I} {k : fin (n+1)} (m : k ∈ S f ε h n x) :
  |f k/ₙ - f x| < ε/2 :=
begin
  apply f.dist_lt_of_dist_lt_modulus (ε/2) (half_pos h),
  simpa [S] using m,
end

/--
If `k ∉ S`, then as `δ ≤ |x - k/n|`, we have the inequality `1 ≤ δ^-2 * (x - k/n)^2`.
This particular formulation will be helpful later.
-/
lemma le_of_mem_S_compl
  {f : C(I, ℝ)} {ε : ℝ} {h : 0 < ε} {n : ℕ} {x : I} {k : fin (n+1)} (m : k ∈ (S f ε h n x)ᶜ) :
  (1 : ℝ) ≤ (δ f ε h)^(-2 : ℤ) * (x - k/ₙ) ^ 2 :=
begin
  simp only [finset.mem_compl, not_lt, set.mem_to_finset, set.mem_set_of_eq, S] at m,
  field_simp,
  erw [le_div_iff (pow_pos f.modulus_pos 2), one_mul],
  apply sq_le_sq,
  rw abs_eq_self.mpr (le_of_lt f.modulus_pos),
  rw [dist_comm] at m,
  exact m,
end

end bernstein_approximation

open bernstein_approximation
open bounded_continuous_function
open filter

open_locale topological_space

/--
The Bernstein approximations
```
∑ k : fin (n+1), f (k/n : ℝ) * n.choose k * x^k * (1-x)^(n-k)
```
for a continuous function `f : C([0,1], ℝ)` converge uniformly to `f` as `n` tends to infinity.

This is the proof given in [Richard Beals' *Analysis, an introduction*][beals-analysis], §7D,
and reproduced on wikipedia.
-/
theorem bernstein_approximation_uniform (f : C(I, ℝ)) :
  tendsto (λ n : ℕ, bernstein_approximation n f) at_top (𝓝 f) :=
begin
  simp only [metric.nhds_basis_ball.tendsto_right_iff, metric.mem_ball, dist_eq_norm],
  intros ε h,
  let δ := δ f ε h,
  have nhds_zero := tendsto_const_div_at_top_nhds_0_nat (2 * ∥f∥ * δ ^ (-2 : ℤ)),
  filter_upwards [nhds_zero.eventually (gt_mem_nhds (half_pos h)), eventually_gt_at_top 0],
  intros n nh npos',
  have npos : 0 < (n:ℝ) := by exact_mod_cast npos',
  -- Two easy inequalities we'll need later:
  have w₁ : 0 ≤ 2 * ∥f∥ := mul_nonneg (by norm_num) (norm_nonneg f),
  have w₂ : 0 ≤ 2 * ∥f∥ * δ^(-2 : ℤ) := mul_nonneg w₁ pow_minus_two_nonneg,
  -- As `[0,1]` is compact, it suffices to check the inequality pointwise.
  rw (continuous_map.norm_lt_iff _ h),
  intro x,
  -- The idea is to split up the sum over `k` into two sets,
  -- `S`, where `x - k/n < δ`, and its complement.
  let S := S f ε h n x,
  calc
    |(bernstein_approximation n f - f) x|
        = |bernstein_approximation n f x - f x|
                              : rfl
    ... = |bernstein_approximation n f x - f x * 1|
                              : by rw mul_one
    ... = |bernstein_approximation n f x - f x * (∑ k : fin (n+1), bernstein n k x)|
                              : by rw bernstein.probability
    ... = |∑ k : fin (n+1), (f k/ₙ - f x) * bernstein n k x|
                              : by simp [bernstein_approximation, finset.mul_sum, sub_mul]
    ... ≤ ∑ k : fin (n+1), |(f k/ₙ - f x) * bernstein n k x|
                              : finset.abs_sum_le_sum_abs _ _
    ... = ∑ k : fin (n+1), |f k/ₙ - f x| * bernstein n k x
                              : by simp_rw [abs_mul, abs_eq_self.mpr bernstein_nonneg]
    ... = ∑ k in S, |f k/ₙ - f x| * bernstein n k x +
          ∑ k in Sᶜ, |f k/ₙ - f x| * bernstein n k x
                              : (S.sum_add_sum_compl _).symm
    -- We'll now deal with the terms in `S` and the terms in `Sᶜ` in separate calc blocks.
    ... < ε/2 + ε/2 : add_lt_add_of_le_of_lt _ _
    ... = ε : add_halves ε,
    { -- We now work on the terms in `S`: uniform continuity and `bernstein.probability`
      -- quickly give us a bound.
      calc ∑ k in S, |f k/ₙ - f x| * bernstein n k x
          ≤ ∑ k in S, ε/2 * bernstein n k x
                                :  finset.sum_le_sum
                                    (λ k m, (mul_le_mul_of_nonneg_right (le_of_lt (lt_of_mem_S m))
                                      bernstein_nonneg))
      ... = ε/2 * ∑ k in S, bernstein n k x
                                : by rw finset.mul_sum
      -- In this step we increase the sum over `S` back to a sum over all of `fin (n+1)`,
      -- so that we can use `bernstein.probability`.
      ... ≤ ε/2 * ∑ k : fin (n+1), bernstein n k x
                                : mul_le_mul_of_nonneg_left
                                    (finset.sum_le_univ_sum_of_nonneg (λ k, bernstein_nonneg))
                                    (le_of_lt (half_pos h))
      ... = ε/2 : by rw [bernstein.probability, mul_one] },
      { -- We now turn to working on `Sᶜ`: we control the difference term just using `∥f∥`,
        -- and then insert a `δ^(-2) * (x - k/n)^2` factor
        -- (which is at least one because we are not in `S`).
        calc ∑ k in Sᶜ, |f k/ₙ - f x| * bernstein n k x
            ≤ ∑ k in Sᶜ, (2 * ∥f∥) * bernstein n k x
                                  : finset.sum_le_sum
                                      (λ k m, mul_le_mul_of_nonneg_right (f.dist_le_two_norm _ _)
                                        bernstein_nonneg)
        ... = (2 * ∥f∥) * ∑ k in Sᶜ, bernstein n k x
                                  : by rw finset.mul_sum
        ... ≤ (2 * ∥f∥) * ∑ k in Sᶜ, δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x
                                  : mul_le_mul_of_nonneg_left
                                      (finset.sum_le_sum (λ k m, begin
                                        conv_lhs { rw ←one_mul (bernstein _ _ _), },
                                        exact mul_le_mul_of_nonneg_right
                                          (le_of_mem_S_compl m) bernstein_nonneg,
                                      end)) w₁
        -- Again enlarging the sum from `Sᶜ` to all of `fin (n+1)`
        ... ≤ (2 * ∥f∥) * ∑ k : fin (n+1), δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x
                                  : mul_le_mul_of_nonneg_left
                                      (finset.sum_le_univ_sum_of_nonneg
                                        (λ k, mul_nonneg
                                          (mul_nonneg pow_minus_two_nonneg (sq_nonneg _))
                                          bernstein_nonneg)) w₁
        ... = (2 * ∥f∥) * δ^(-2 : ℤ) * ∑ k : fin (n+1), (x - k/ₙ)^2 * bernstein n k x
                                  : by conv_rhs {
                                      rw [mul_assoc, finset.mul_sum], simp only [←mul_assoc], }
        -- `bernstein.variance` and `x ∈ [0,1]` gives the uniform bound
        ... = (2 * ∥f∥) * δ^(-2 : ℤ) * x * (1-x) / n
                                  : by { rw variance npos, ring, }
        ... ≤ (2 * ∥f∥) * δ^(-2 : ℤ) / n
                                  : (div_le_div_right npos).mpr
                                    begin
                                      apply mul_nonneg_le_one_le w₂,
                                      apply mul_nonneg_le_one_le w₂ (le_refl _),
                                      all_goals { unit_interval, },
                                    end
        ... < ε/2 : nh, }
end


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

import topology.algebra.nonarchimedean.bases
import topology.algebra.uniform_filter_basis
import ring_theory.valuation.basic

/-!
# The topology on a valued ring

In this file, we define the non archimedean topology induced by a valuation on a ring.
The main definition is a `valued` type class which equips a ring with a valuation taking
values in a group with zero. Other instances are then deduced from this.
-/

open_locale classical topological_space uniformity
open set valuation
noncomputable theory

universes v u

variables {R : Type u} [ring R] {Γ₀ : Type v} [linear_ordered_comm_group_with_zero Γ₀]

namespace valuation

variables (v : valuation R Γ₀)

/-- The basis of open subgroups for the topology on a ring determined by a valuation. -/
lemma subgroups_basis :
  ring_subgroups_basis (λ γ : Γ₀ˣ, (v.lt_add_subgroup γ : add_subgroup R)) :=
{ inter := begin
    rintros γ₀ γ₁,
    use min γ₀ γ₁,
    simp [valuation.lt_add_subgroup] ; tauto
  end,
  mul := begin
    rintros γ,
    cases exists_square_le γ with γ₀ h,
    use γ₀,
    rintro - ⟨r, s, r_in, s_in, rfl⟩,
    calc (v (r*s) : Γ₀) = v r * v s : valuation.map_mul _ _ _
             ... < γ₀*γ₀ : mul_lt_mul₀ r_in s_in
             ... ≤ γ : by exact_mod_cast h
  end,
  left_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use (1 : Γ₀ˣ),
      rintros y (y_in : (v y : Γ₀) < 1),
      change v (x * y) < _,
      rw [valuation.map_mul, Hx, zero_mul],
      exact units.zero_lt γ },
    { simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
      use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change (v (x * y) : Γ₀) < γ,
      rw [valuation.map_mul, Hx, mul_comm],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end,
  right_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : (v y : Γ₀) < 1),
      change v (y * x) < _,
      rw [valuation.map_mul, Hx, mul_zero],
      exact units.zero_lt γ },
    { use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change (v (y * x) : Γ₀) < γ,
      rw [valuation.map_mul, Hx],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end }

end valuation

/-- A valued ring is a ring that comes equipped with a distinguished valuation. The class `valued`
is designed for the situation that there is a canonical valuation on the ring.

TODO: show that there always exists an equivalent valuation taking values in a type belonging to
the same universe as the ring.

See Note [forgetful inheritance] for why we extend `uniform_space`, `uniform_add_group`. -/
class valued (R : Type u) [ring R] (Γ₀ : out_param (Type v))
  [linear_ordered_comm_group_with_zero Γ₀] extends uniform_space R, uniform_add_group R :=
(v : valuation R Γ₀)
(is_topological_valuation : ∀ s, s ∈ 𝓝 (0 : R) ↔ ∃ (γ : Γ₀ˣ), { x : R | v x < γ } ⊆ s)

/-- The `dangerous_instance` linter does not check whether the metavariables only occur in
arguments marked with `out_param`, so in this instance it gives a false positive. -/
attribute [nolint dangerous_instance] valued.to_uniform_space

namespace valued

/-- Alternative `valued` constructor for use when there is no preferred `uniform_space`
structure. -/
def mk' (v : valuation R Γ₀) : valued R Γ₀ :=
{ v := v,
  to_uniform_space := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
  to_uniform_add_group := @topological_add_group_is_uniform _ _ v.subgroups_basis.topology _,
  is_topological_valuation :=
  begin
    letI := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
    intros s,
    rw filter.has_basis_iff.mp v.subgroups_basis.has_basis_nhds_zero s,
    exact exists_congr (λ γ, by simpa),
  end }

variables (R Γ₀) [_i : valued R Γ₀]
include _i

lemma has_basis_nhds_zero :
  (𝓝 (0 : R)).has_basis (λ _, true) (λ (γ : Γ₀ˣ), { x | v x < (γ : Γ₀) }) :=
by simp [filter.has_basis_iff, is_topological_valuation]

lemma has_basis_uniformity :
  (𝓤 R).has_basis (λ _, true) (λ (γ : Γ₀ˣ), { p : R × R | v (p.2 - p.1) < (γ : Γ₀) }) :=
begin
  rw uniformity_eq_comap_nhds_zero,
  exact (has_basis_nhds_zero R Γ₀).comap _,
end

lemma to_uniform_space_eq :
  to_uniform_space = @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _ :=
uniform_space_eq
  ((has_basis_uniformity R Γ₀).eq_of_same_basis $ v.subgroups_basis.has_basis_nhds_zero.comap _)

variables {R Γ₀}

lemma mem_nhds {s : set R} {x : R} :
  (s ∈ 𝓝 x) ↔ ∃ (γ : Γ₀ˣ), {y | (v (y - x) : Γ₀) < γ } ⊆ s :=
by simp only [← nhds_translation_add_neg x, ← sub_eq_add_neg, preimage_set_of_eq, exists_true_left,
  ((has_basis_nhds_zero R Γ₀).comap (λ y, y - x)).mem_iff]

lemma mem_nhds_zero {s : set R} :
  (s ∈ 𝓝 (0 : R)) ↔ ∃ γ : Γ₀ˣ, {x | v x < (γ : Γ₀) } ⊆ s :=
by simp only [mem_nhds, sub_zero]

lemma loc_const {x : R} (h : (v x : Γ₀) ≠ 0) : {y : R | v y = v x} ∈ 𝓝 x :=
begin
  rw mem_nhds,
  rcases units.exists_iff_ne_zero.mpr h with ⟨γ, hx⟩,
  use γ,
  rw hx,
  intros y y_in,
  exact valuation.map_eq_of_sub_lt _ y_in
end

@[priority 100]
instance : topological_ring R :=
(to_uniform_space_eq R Γ₀).symm ▸ v.subgroups_basis.to_ring_filter_basis.is_topological_ring

lemma cauchy_iff {F : filter R} :
  cauchy F ↔ F.ne_bot ∧ ∀ γ : Γ₀ˣ, ∃ M ∈ F, ∀ x y ∈ M, (v (y - x) : Γ₀) < γ :=
begin
  rw [to_uniform_space_eq, add_group_filter_basis.cauchy_iff],
  apply and_congr iff.rfl,
  simp_rw valued.v.subgroups_basis.mem_add_group_filter_basis_iff,
  split,
  { intros h γ,
    exact h _ (valued.v.subgroups_basis.mem_add_group_filter_basis _) },
  { rintros h - ⟨γ, rfl⟩,
    exact h γ }
end

end valued


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

import tactic
import ring_theory.principal_ideal_domain -- theory of PIDs
import data.polynomial.field_division -- polynomial rings over a field are PIDs
/-

# Principal Ideal Domains

First let's showcase what mathlib has.

Let `R` be a commutative ring.
-/

variables (R : Type) [comm_ring R]

-- We say `R` is a *principal ideal ring* if all ideals are principal.
-- We say `R` is a *domain* if it's an integral domain.
-- We say `R` is a *principal ideal domain* if it's both.

-- So here's how to say "Assume `R` is a PID":

variables [is_principal_ideal_ring R] [is_domain R]

-- Note that both of these are typeclasses, so various things should
-- be automatic.

example : ∀ a b : R, a * b = 0 → a = 0 ∨ b = 0 :=
begin
  intros a b,
  apply eq_zero_or_eq_zero_of_mul_eq_zero, -- typeclass inference
  -- magically extracts the assumption from `is_domain`
end

example : (0 : R) ≠ 1 :=
begin
  -- this is another consequence of being an integral domain
  apply zero_ne_one,
end

example (I : ideal R) : I.is_principal :=
begin
  -- typeclass inference system finds `is_principal_ideal_ring` and
  -- uses it automatically
  exact is_principal_ideal_ring.principal I,
end

example (I : ideal R) : ∃ j, I = ideal.span {j} :=
begin
  -- to make a term of type `is_principal I` you need to give one proof,
  -- but we still need to do `cases` or equivalent (I used `obtain` below)
  -- to get this proof out.
  obtain ⟨h⟩ := is_principal_ideal_ring.principal I,
  exact h,
end

-- Typeclass inference knows a bunch of theorems about PIDs and which things are PIDs.
-- Examples:

-- integers are a PID
example : is_principal_ideal_ring ℤ := begin
  exact euclidean_domain.to_principal_ideal_domain
end

-- just check the domain bit:
example : is_domain ℤ := begin
  apply_instance
end

-- a field is a PID
example (k : Type) [field k] : is_principal_ideal_ring k :=
begin
  apply_instance
end

example (k : Type) [field k] : is_domain k :=
begin
  apply_instance
end

open_locale polynomial -- to get `k[X]` notation instead of `polynomial k`

-- polys over a field are a PID
example (k : Type) [field k] : is_principal_ideal_ring k[X] :=
begin
  apply_instance
end

example (k : Type) [field k] : is_domain k[X] :=
begin
  apply_instance
end

-- if all ideals of a ring are principal then the ring is a principal ideal ring
example (A : Type) [comm_ring A] (h : ∀ I : ideal A, I.is_principal) : is_principal_ideal_ring A :=
{ principal := h }

-- see if you can prove that the ideal generated by 4 and 6 in any commutative ring is principal.
example (A : Type) [comm_ring A] : (ideal.span ({4, 6} : set A)).is_principal :=
begin
  sorry,
end

-- product of two PIDs isn't a PID, but only becuase it's not a domain
example (A B : Type) [comm_ring A] [comm_ring B]
  [is_principal_ideal_ring A] [is_principal_ideal_ring B] :
  is_principal_ideal_ring (A × B) :=
{ principal := begin
    sorry,
  end }


import incidence_world.level01 --hide
open IncidencePlane --hide

/- Axiom :
line_contains_two_points (ℓ : Line Ω) : ∃ P Q : Ω, P ≠ Q ∧ ℓ = line_through P Q
-/

/-
# Incidence World

## Level 2: proving useful lemmas (I).

If you look at the list of your theorem statements, you will note that the lemma of the previous level has been added. Despite not
being useful now, it will come handy for next levels. Analogously, the lemma of this level will be added to the list of theorem
statements, so that the computer can remember it in case you need to use it again.

To solve this level, another theorem statement has been added to the list as well. It is called `line_contains_two_points` and makes
reference to the second axiom of incidence. You will need to use it now. Here you have some hints that may help you to prove the lemma.

1) Add the hypothesis `A2 : ∃ (P Q : Ω), P ≠ Q ∧ ℓ = line_through P Q` by using the `have` tactic.

2) Prove the hypothesis A2 by using the `line_contains_two_points` theorem statement (remember to type the line that you are using).+

3) Work on the hypothesis A2 with the `cases` tactic.

4) You may want to finish the proof with the `line_through_left` or the `line_through_right` theorem statement.

In case you get stuck, click right below for a hint.
-/

/- Hint : Click here for a hint, in case you get stuck.
You will have to use the `cases` tactic three times. Go back to the tutorial world if you don't remember how to use it. Then, "use" one of the points
that you generated and "rewrite" the line ℓ by using one of the hypotheses that you have in the local context. Still bewildered? Click on "View source"
(located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables  {P Q: Ω} {r : Line Ω}  -- hide

/- Lemma :
Given a line, there exists one point in that line.
-/
lemma exists_point_on_line (ℓ : Line Ω): ∃ A : Ω, A ∈ ℓ :=
begin
	have A2 : ∃ (P Q : Ω), P ≠ Q ∧ ℓ = line_through P Q,
  {
    exact line_contains_two_points ℓ,
  },
  cases A2 with A hA,
  cases hA with B hB,
  cases hB with HAB hl,
  use A,
  rw hl,
  exact line_through_left A B,
end


import data.real.basic

/-In this Lean tutorial, we aim to get to grips with using convergent
sequences in Lean. We start by defining convergence in a similar manner to
the analysis 1 course.-/

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

/-We will firstly look at the tactics which we will use in this section
to help us close our proofs and provide some examples.-/

/-We have already seen the rw, nth_rewrite and exact tactics being used, so we
now move onto using intros, specialize, apply, use and cases-/

/-The intro tactic can be used when, for propositions A and B, our goal is of the
form
⊢ A → B
or
⊢∀( a : A ),B.
This allows us to introduce the left hand side of the goal as a hypothesis for us
to use. For example, if you were to write
intro h,
for both the previous examples, the goal states would change to

h:A
⊢B

Some further examples of intro and shown below-/

example (A: Prop) : A → A:=
begin
intro h, --We introduce our hypothesis h: A
exact h, --Our goal is exactly the same as our hypothesis h
end

variables {a b c : ℝ}

#check (mul_pos : 0 < a → 0 < b → 0 < a * b)

example ( x : ℝ) (h₁: 0 < x) : ∀ ( a : ℝ), 0 < a →  0 < a*x:=
begin
intros a apos, --We introduce the hypotheses a : ℝ and apos: 0 < a
exact mul_pos apos h₁, --We use the theorem that multiplying two non-negative reals together gives a non-negative real
end

/-The use tactic can be deployed whenever our goal is of the form
⊢ ∃ (N : ℕ), statement
Then by writing
use x,
where x is a previous hypothesis, such as x : ℝ, meaning x is a real number, then our goal would progress to
⊢ statement
where the statement now depends on x. An example is given below-/

#check (zero_lt_one : (0 : ℝ) < (1 : ℝ) )

example: ∃ (x : ℝ), x < 1:=
begin
use 0,
exact zero_lt_one,
end

/-The specialize tactic can be used whenever we have a hypothesis of the form
hypothesis: ∀ ( a : A), statement
and another hypothesis say
h : A.
Then by writing
specialize @hypothesis h,
our hypothesis will become
hypothesis: statement depending on h

Furthermore if our we have the following hypotheses
h₁ : A → B
h₂ : A
then we could write
specialize @h₁ h₂
in order to simplify h₁ to
h₁: B
An example of using specialize is shown below with the question being from mathematics in Lean-/

variables {α : Type*} (P : α → Prop)

example (h : ∀ x, ¬ P x) : ¬ ∃ x, P x :=
begin
  intros h₁, --This changes our goal to false h₁ : ∃ (x : α), P x
  cases h₁ with x hx, --We unfold our hypothesis h₁ giving us x:α and hx : P x
  specialize @h x, --We act at h: ∀ (x : α), ¬P x giving h: ¬P x
  specialize @h hx, --We know P x so acting on h: ¬P x leaves us with h: false
  exact h,--Our goal is exactly the same as the hypothesis h
end

/-The apply tactic for cases similar to the following
h : A → B
⊢ B
where by writing
apply h,
our goal will turn to
⊢ A
Furthermore, you can use apply when you have a theorem of the form A→B
A few examples of using apply can be found below-/

example (h₁ : a < b) (h₂: b < c): a < c :=
begin
apply lt_trans h₁ h₂, --We use transitivity with our two hypotheses to show a < c
end

example (A B C : Prop) (h₁: A → B) (h₂: B → C) (h₃:A): C :=
begin
apply h₂, --This turns our goal from ⊢C to ⊢B
apply h₁, --This changes the goal from ⊢B to ⊢A
exact h₃, --Our goal is the same as our hypothesis h₃
end

/-We lastly look at the cases tactic which can be used to unfold hypotheses of the form
hypothesis: A ↔ B
in addition to
hypothesis: ∃(a:A), statement
By writing
cases hypothesis with h₁ h₂
We would introduce the new hypotheses
h₁ : A
h₂ : B
and
h₁ : A
h₂ : statement involving h₁
respectively
An example of using cases can be found above in the specialize section.-/

/-Now we've outlined our the tactics we will use, lets outline some proofs involving convergence-/

--Lets firstly look at a proof that if a function s converges absolutely to zero, then s converges to zero

variables {s t : ℕ → ℝ}

#check (sub_zero : ∀ a : ℝ , a - 0 = a)
#check (lt_of_abs_lt : | a |< b →  a < b)

theorem converges_to_ze
  (cs : converges_to (abs s) 0): converges_to (λ n, s n ) (0) :=
begin
intros ε εpos, --Introduce the hypotheses ε:ℝ and εpos:ε>0
dsimp,--This removes the λ in our goal and makes it easier to read
cases cs ε εpos with h₁ h₂, /-We unravel our hypothesis cs: converges_to |s| 0
using the fact ε: ℝ and εpos: ε > 0 giving our two new hypotheses h₁ and h₂-/
use h₁, --We progress our goal by using the natural number h₁
intros n h₃,--We progress our goal by introducing n: ℕ and h₃: n ≥ h₁
specialize @h₂ n h₃,--We simplify h₂ using n : ℕ and h₃: n ≥ h₁ leaving us with h₂: ||s| n - 0| < ε
rw sub_zero, --We use the theorem that a - 0 = a to simplify our goal to ⊢ |s n| < ε
rw sub_zero at h₂,--We use the same theorem to simplify h₂ to ||s| n| < ε
apply lt_of_abs_lt h₂,--We solve our goal by using the fact |a| < b → a < b on h₂ giving the goal ⊢ |s n| < ε
end

--Now we move onto a proof that convergent sequences are eventually bounded

#check (le_abs_self : ∀ (a :ℝ) , a ≤ |a|)
#check (sub_lt_iff_lt_add' : a - b < c ↔ a < b + c)
#check (lt_of_le_of_lt : a ≤ b → b < c → a < c)

theorem exists_le_of_converges_to (cs : converges_to s a) :
  ∃ N b, ∀ n, N ≤ n → s n < b :=
begin
cases cs 1 zero_lt_one with N h, /-Since s is convergent we let ε=1 and introduce N : ℕ and
h: ∀ (n : ℕ), n ≥ N → |s n - a| < 1 -/
use [N , a + 1], /-We will use n such that N ≤ n and prove all terms beyond this
are bounded by a+1 -/
intros n h₁, -- Introduce n : ℕ and h₁: N ≤ n
specialize @h n h₁, --We use n and h₁ to transform h from ∀ (n : ℕ), n ≥ N → |s n - a| < 1 to |s n - a| < 1
have h₂: s n - a ≤ abs(s n - a),-- We prove an auxiliary statement
apply le_abs_self, --This statement follows from the definition of the absolute value
suffices h₃: s n - a < 1, --We we show the goal ⊢ s n - a < 1 instead
exact sub_lt_iff_lt_add'.mp h₃, --(s n) - a < 1 implies (s n) < a + 1
apply lt_of_le_of_lt h₂ h, --We close our goal using transitivity with |s n - a| < 1 and s n - a ≤ |s n - a|
end

--Now lets tackle the proof of the squeezing theorem with the following new theorems.

#check (le_abs_self : ∀ (a :ℝ) , a ≤ |a|)
#check (lt_trans : a < b → b < c → a < c)
#check (lt_of_lt_of_le : a < b → b ≤ c → a < c )

theorem squeeze (cs :converges_to s 0)
(h₁: ∀ (e:ℕ), (abs t e) < s e ): converges_to (λ n, t n) (0):=
begin
intros ε εpos, --Introduce the hypotheses ε:ℝ and εpos:ε>0
dsimp,-- This removes the λ in our goal and makes it easier to read
cases cs ε εpos with h₂ h₃, /-We unravel our hypothesis cs: converges_to |s| 0
using the fact ε: ℝ and εpos: ε > 0 giving our two new hypotheses h₁ and h₂-/
use h₂, --We progress our goal by using the natural number h₂
intros n h₄, --We progress our goal by introducing n: ℕ and h₄: n ≥ h₁
specialize @h₃ n h₄, --We simplify h₃ using n : ℕ and h₄: n ≥ h₁ leaving us with h₃: |s n - 0| < ε
rw sub_zero,-- We remove the zero in our goal since t n - 0 = t n
rw sub_zero at h₃,--We remove the zero at h₃ leaving s n
specialize @h₁ n, --We simplify h₁ from ∀ (e : ℕ), |t| e < s e to |t| n < s n
have h₅: s n ≤  |s n|, --We use have in order to prove an auxiliary result, which will be helpful in our proof
exact le_abs_self (s n),--We prove s n ≤ |s n| using le_abs_self
apply lt_trans (lt_of_lt_of_le h₁ h₅) h₃, /-We close our goal using transitivity
with |t| n < s n, s n ≤ |s n| and |s n| < ε.-/
end

/-We now move on to proving that the sum of two convergent sequences is also convergent,
but we firstly mention the use of linarith and congr.
Linarith can be used when we have a goal that can be closed just using linear arithmetic and
Lean will figure out what theorems to use to close the goal.
Congr can be used to get rid of something that affects both sides of an equation allowing
us to show that each side of an equality takes the same values. In the following proof
it's used to get rid of the absolute sign when we prove an auxiliary hypothesis.-/

#check (le_of_max_le_left : max a b ≤ c → a ≤ c )
#check (le_of_max_le_right : max a b ≤ c → b ≤ c )
#check (abs_add : ∀ (a b : ℝ), |a+b| ≤ |a| + |b| )
#check (lt_of_le_of_lt : a ≤ b → b < c → a < c )

theorem converges_to_add
  (cs : converges_to s a) (ct : converges_to t b):
converges_to (λ n, s n + t n) (a + b) :=
begin
intros ε εpos, --Introduce ε: ℝ and εpos: ε > 0
dsimp, --dsimp gets rid of the λ in our goal and makes it easier to read
have ε2pos : 0 < ε / 2, --Let's prove an additional statement that 0 < ε/2
linarith , --Linarith uses linear arithmetic to show 0<ε/2
cases cs (ε / 2) ε2pos with Ns hs, --Convergence of s implies Ns: ℕ and hs: ∀ (n : ℕ), n ≥ Ns → abs (s n - a) < ε / 2
cases ct (ε / 2) ε2pos with Nt ht, --Convergence of t implies Nt: ℕ and ht: ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2
use max Ns Nt, -- We will show ⊢ ∀ (n : ℕ), n ≥ max Ns Nt → abs (s n + t n - (a + b)) < ε
intros c cN, -- Introduce c: ℕ and cN: c ≥ max Ns Nt
specialize @hs c,--hs becomes hs: c ≥ Ns → abs (s c - a) < ε / 2
specialize @ht c,--ht becomes ht: c ≥ Nt → abs (t c - b) < ε / 2
specialize @hs (le_of_max_le_left cN),-- hs becomes hs: abs (s c - a) < ε / 2
specialize @ht (le_of_max_le_right cN), --ht becomes ht: abs (t c - b) < ε / 2
have h₃: abs (s c + t c - (a + b)) = abs ((s c - a) + (t c - b)),
congr,-- We will show ⊢ s c + t c - (a + b) = s c - a + (t c - b)
linarith, --The above can be solved with linear arithmetic
rw h₃, --Change the goal to ⊢ abs (s c - a + (t c - b)) < ε
have h₅: abs (s c - a) + abs (t c - b) < ε,
linarith, --ε/2 + ε /2 = ε
have h₆: abs((s c - a) + ( t c - b)) ≤  abs (s c - a) + abs ( t c -b),
apply abs_add (s c - a) (t c - b), --We use the triangle inequality to prove h₆
apply lt_of_le_of_lt h₆ h₅, -- We complete our goal using transitivity
end

/-Mathematics in Lean by Jeremy Avigad has been used heavily in this tutorial with
the definition of convergence and first few lines of the proof showing the sum
of convergent sequences is also convergent as well as a few of the examples for
the tactics.-/


import .love01_definitions_and_statements_demo

/-! # LoVe Demo 2: Backward Proofs

A __tactic__ operates on a proof goal and either proves it or creates new
subgoals. Tactics are a __backward__ proof mechanism: They start from the goal
and work towards the available hypotheses and lemmas. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Tactic Mode

Syntax of tactical proofs:

    begin
      _tactic₁_,
      …,
      _tacticN_
    end -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
begin
  intros a b,
  intros ha hb,
  apply ha
end

/-! ## Basic Tactics

`intro`(`s`) moves `∀`-quantified variables, or the assumptions of
implications `→`, from the goal's conclusion (after `⊢`) into the goal's
hypotheses (before `⊢`).

`apply` matches the goal's conclusion with the conclusion of the specified lemma
and adds the lemma's hypotheses as new goals.

Food for thought: how do these compare to the typing derivation rules for
lambda and application expressions?

-/

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
begin
  apply ha
end

/-! Terminal tactic syntax:

    by _tactic_

abbreviates

    begin
      _tactic_
    end -/

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
by apply ha

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  apply hbc,
  apply hab,
  apply ha
end

/-! `exact` matches the goal's conclusion with the specified lemma, closing the
goal. We can often use `apply` in such situations, but `exact` communicates our
intentions better. -/

lemma fst_of_two_props₄ (a b : Prop) (ha : a) (hb : b) :
  a :=
by exact ha

/-! `assumption` finds a hypothesis from the local context that matches the
goal's conclusion and applies it to prove the goal. -/

lemma fst_of_two_props₅ (a b : Prop) (ha : a) (hb : b) :
  a :=
by assumption

/-! ## Reasoning about Logical Connectives and Quantifiers

Introduction rules:

The relevant symbol appears in the *conclusion* of the statement.
(On the right side of the ->)

We apply these rules when the symbol appears in our *goal*.
-/

#check true.intro
#check not.intro
#check and.intro
#check or.intro_left
#check or.intro_right
#check iff.intro
#check exists.intro

/-! Elimination rules:

The relevant symbol appears in a *hypothesis* of the statement.
(On the left side of the ->)

We apply these rules when the symbol appears in our *context*.
-/

#check false.elim
#check and.elim_left
#check and.elim_right
#check or.elim
#check iff.elim_left
#check iff.elim_right
#check exists.elim

/-! Definition of `¬` and related lemmas: -/

#print not
#check not_def
#check classical.em
#check classical.by_contradiction

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

/-! The `{ … }` combinator focuses on the first subgoal. The tactic inside must
fully prove it. -/

lemma and_swap₂ :
  ∀a b : Prop, a ∧ b → b ∧ a :=
begin
  intros a b hab,
  apply and.intro,
  { exact and.elim_right hab },
  { exact and.elim_left hab }
end

/-! Notice above how we pass the hypothesis `hab` directly to the lemmas
`and.elim_right` and `and.elim_left`, instead of waiting for the lemmas's
assumptions to appear as new subgoals. This is a small forward step in an
otherwise backward proof. -/

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
begin
  intros hab,
  apply or.elim hab,
  { intro ha,
    exact or.intro_right _ ha },
  { intro hb,
    exact or.intro_left _ hb }
end

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
begin
  intros hab ha,
  apply hab,
  exact ha
end

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
begin
  intro ha,
  apply not.intro,
  intro hna,
  apply hna,
  exact ha
end

lemma not_not_intro₂ (a : Prop) :
  a → ¬¬ a :=
begin
  intros ha hna,
  apply hna,
  exact ha
end

def double (n : ℕ) : ℕ :=
n + n

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
begin
  apply exists.intro 0,
  refl
end

/-! ## Reasoning about Equality

*Syntactic* equality:
  x = x
  [2, 1, 3] = [2, 1, 3]

*Definitional* equality (*intensional*, *up to computation*):
  2 + 2 = 4
  quicksort [2, 1, 3] = mergesort [2, 1, 3]
  all of the `by refl` examples below

*Propositional* equality (*provable*):
  x + y = y + x
  quicksort = mergesort
 -/

/-! `refl` proves `l = r`, where the two sides are equal up to
computation. Computation means unfolding of definitions, β-reduction
(application of λ to an argument), `let`, and more. -/

lemma α_example {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
begin
  refl
end

lemma α_example₂ {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
by refl

lemma β_example {α β : Type} (f : α → β) (a : α) :
  (λx, f x) a = f a :=
by refl

lemma δ_example :
  double 5 = 5 + 5 :=
by refl

lemma ζ_example :
  (let n : ℕ := 2 in n + n) = 2 + 2 :=
by refl

lemma η_example {α β : Type} (f : α → β) :
  (λx, f x) = f :=
by refl

inductive my_prod (α β : Type) : Type
| mk : α → β → my_prod

def my_prod.first {α β : Type} : my_prod α β → α
| (my_prod.mk a b) := a

lemma ι_example {α β : Type} (a : α) (b : β) :
  my_prod.first (my_prod.mk a b) = a :=
by refl

/-!

Which ones of these are *reduction rules*?

-/

#check eq.refl
#check eq.symm
#check eq.trans
#check eq.subst

/-! The above rules can be used directly: -/

lemma cong_fst_arg {α : Type} (a a' b : α)
    (f : α → α → α) (ha : a = a') :
  f a b = f a' b :=
begin
  apply eq.subst ha,
  apply eq.refl
end

lemma cong_two_args {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  apply eq.subst ha,
  apply eq.subst hb,
  apply eq.refl
end

/-! `rw` applies a single equation as a left-to-right rewrite rule, once. To
apply an equation right-to-left, prefix its name with `←`. -/

lemma cong_two_args₂ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  rw ha,
  rw hb
end

#check add_comm
#check add_assoc

lemma nat_comm_example (a b c : ℕ) :
  a + b + c = c + b + a :=
begin
  rw add_comm,
  rw add_comm a,
  rw add_assoc
end

lemma nat_comm_example₂ (a b c : ℕ) :
  a + b + c = c + b + a :=
begin
  rw [add_comm, add_comm a, add_assoc]
end

lemma double_example (n : ℕ) :
  double n = n + n + 0 :=
begin
  rw double,
  refl
end

lemma a_proof_of_negation₃ (a : Prop) :
  a → ¬¬ a :=
begin
  rw not_def,
  rw not_def,
  intro ha,
  intro hna,
  apply hna,
  exact ha
end

/-! `simp` applies a standard set of rewrite rules (the __simp set__)
exhaustively. The set can be extended using the `@[simp]` attribute. Lemmas can
be temporarily added to the simp set with the syntax
`simp [_lemma₁_, …, _lemmaN_]`. -/

lemma cong_two_args_etc {α : Type} (a a' b b' : α)
    (g : α → α → ℕ → α) (ha : a = a') (hb : b = b') :
  g a b (1 + 1) = g a' b' 2 :=
by simp [ha, hb]

/-! `cc` applies __congruence closure__ to derive new equalities. -/

lemma cong_two_args₃ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
by cc

/-! `cc` can also reason up to associativity and commutativity of `+`, `*`,
and other binary operators. -/

lemma cong_assoc_comm (a a' b c : ℝ) (f : ℝ → ℝ)
    (ha : a = a') :
  f (a + b + c) = f (c + b + a') :=
by cc

/-! ## Proofs by Mathematical Induction

`induction'` performs induction on the specified variable. It gives rise to one
subgoal per constructor. -/

lemma add_zero (n : ℕ) :
  add 0 n = n :=
begin
  induction' n,
  { refl },
  { simp [add, ih] }
end

/-! We use `induction'`, a variant of Lean's built-in `induction` tactic. The
two tactics are similar, but `induction'` is more user-friendly. -/

lemma add_succ (i j : ℕ) :
  add (nat.succ i) j = nat.succ (add i j) :=
begin
  induction' j,
  { refl },
  { simp [add, ih] }
end

lemma add_comm (i j : ℕ) :
  add i j = add j i :=
begin
  induction' j,
  { simp [add, add_zero] },
  { simp [add, add_succ, ih] }
end

lemma add_assoc (i j k : ℕ) :
  add (add i j) k = add i (add j k) :=
begin
  induction' k,
  { refl },
  { simp [add, ih] }
end

/-! `cc` is extensible. We can register `add` as a commutative and associative
operator using the type class instance mechanism (explained in lecture 4). This
is useful for the `cc` invocation below. -/

@[instance] def add.is_commutative : is_commutative ℕ add :=
{ comm := add_comm }

@[instance] def add.is_associative : is_associative ℕ add :=
{ assoc := add_assoc }

lemma mul_add (i j k : ℕ) :
  mul i (add j k) = add (mul i j) (mul i k) :=
begin
  induction' k,
  { refl },
  { simp [add, mul, ih],
    cc }
end

/-! ## Cleanup Tactics

`rename` changes the name of a variable or hypothesis.

`clear` removes unused variables or hypotheses. -/

lemma cleanup_example (a b c : Prop) (ha : a) (hb : b)
    (hab : a → b) (hbc : b → c) :
  c :=
begin
  clear ha hab a,
  apply hbc,
  clear hbc c,
  rename hb h,
  exact h
end

end backward_proofs

end LoVe


/- LoVe Homework 2: Tactical Proofs -/

import .love02_tactical_proofs_exercise

namespace LoVe

/- Question 1: Connectives and Quantifiers -/

/- 1.1. Complete the following proofs using basic tactics. -/

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

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

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

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

/- 1.2. Prove the following lemma. -/

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

/- Question 2 (**optional**): Logical Connectives -/

/- 2.1 (**optional**). Prove the following property about double negation.

Hint: You will need to apply the elimination rule for `false` at a key point in
the proof. -/

lemma herman (p : Prop) : ¬¬ (¬¬ p → p) :=
sorry

/- 2.2 (**optional**). Prove the missing link in our chain of classical axiom
implications.

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

#check excluded_middle
#check peirce
#check double_negation

lemma em_of_dn : double_negation → excluded_middle :=
sorry

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

#check peirce_of_em
#check dn_of_peirce
#check em_of_dn

-- enter your solution here

end LoVe


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen

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

/-!
# The finite-dimensional space of matrices

This file shows that `m` by `n` matrices form a finite-dimensional space,
and proves the `finrank` of that space is equal to `card m * card n`.

## Main definitions

 * `matrix.finite_dimensional`: matrices form a finite dimensional vector space over a field `K`
 * `matrix.finrank_matrix`: the `finrank` of `matrix m n R` is `card m * card n`

## Tags

matrix, finite dimensional, findim, finrank

-/

universe u v

namespace Matrix

section FiniteDimensional

variable {m n : Type _} {R : Type v} [Field R]

instance [Finite m] [Finite n] : FiniteDimensional R (Matrix m n R) :=
  LinearEquiv.finiteDimensional (LinearEquiv.curry R m n)

/-- The dimension of the space of finite dimensional matrices
is the product of the number of rows and columns.
-/
@[simp]
theorem finrank_matrix [Fintype m] [Fintype n] :
    FiniteDimensional.finrank R (Matrix m n R) = Fintype.card m * Fintype.card n := by
  rw [@LinearEquiv.finrank_eq R (Matrix m n R) _ _ _ _ _ _ (LinearEquiv.curry R m n).symm,
    FiniteDimensional.finrank_fintype_fun_eq_card, Fintype.card_prod]
#align matrix.finrank_matrix Matrix.finrank_matrix

end FiniteDimensional

end Matrix


import data.real.basic
import algebra.pi_instances
import tuto_lib

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

/-
In this file we manipulate the elementary definition of limits of
sequences of real numbers.
mathlib has a much more general definition of limits, but here
we want to practice using the logical operators and relations
covered in the previous files.

A sequence u is a function from ℕ to ℝ, hence Lean says
u : ℕ → ℝ
The definition we'll be using is:

-- Definition of « u tends to l »
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

Note the use of `∀ ε > 0, ...` which is an abbreviation of
`∀ ε, ε > 0 → ... `

In particular, a statement like `h : ∀ ε > 0, ...`
can be specialized to a given ε₀ by
  `specialize h ε₀ hε₀`
where hε₀ is a proof of ε₀ > 0.

Also recall that, wherever Lean expects some proof term, we can
start a tactic mode proof using the keyword `by` (followed by curly braces
if you need more than one tactic invocation).
For instance, if the local context contains:

δ : ℝ
δ_pos : δ > 0
h : ∀ ε > 0, ...

then we can specialize h to the real number δ/2 using:
  `specialize h (δ/2) (by linarith)`
where `by linarith` will provide the proof of `δ/2 > 0` expected by Lean.

We'll take this opportunity to use two new tactics:

`norm_num` will perform numerical normalization on the goal and `norm_num at h`
will do the same in assumption `h`. This will get rid of trivial calculations on numbers,
like replacing |l - l| by zero in the next exercise.

`congr'` will try to prove equalities between applications of functions by recursively
proving the arguments are the same.
For instance, if the goal is `f x + g y = f z + g t` then congr will replace it by
two goals: `x = z` and `y = t`.
You can limit the recursion depth by specifying a natural number after `congr'`.
For instance, in the above example, `congr' 1` will give new goals
`f x = f z` and `g y = g t`, which only inspect arguments of the addition and not deeper.
-/

variables (u v w : ℕ → ℝ) (l l' l₁ l₂ : ℝ)

-- If u is constant with value l then u tends to l
-- 0033
example : (∀ n, u n = l) → seq_limit u l :=
begin
  intros h x hx,
  use 0,
  intros n hn,
  rw h,
  norm_num,
  exact le_of_lt hx
end

/- When dealing with absolute values, we'll use lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

You should probably write them down on a sheet of paper that you keep at
hand since they are used in many exercises.
-/

-- Assume l > 0. Then u tends to l implies u n ≥ l/2 for large enough n
-- 0034
example (hl : l > 0) : seq_limit u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  intro h,
  cases h (l/2) (by linarith) with x hx,
  use x,
  intros y hy,
  specialize hx y hy,
  rw abs_le at hx,
  linarith
end

/-
When dealing with max, you can use

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

You should probably add them to the sheet of paper where you wrote
the `abs` lemmas since they are used in many exercises.

Let's see an example.
-/

example (hu : seq_limit u l₁) (hv : seq_limit v l₂) :
  seq_limit (u + v) (l₁ + l₂) :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with n₁ hn₁,
  cases hv (ε/2) (by linarith) with n₂ hn₂,
  use max n₁ n₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁' hn₂',
  have : |u n - l₁| ≤ ε/2, from hn₁ n hn₁',
  have : |v n - l₂| ≤ ε/2, from hn₂ n hn₂',
  calc
  |(u + v) n - (l₁ + l₂)| = |u n + v n - (l₁ + l₂)|   : rfl
  ...                     = |(u n - l₁) + (v n - l₂)| : by congr' 1; ring
  ...                     ≤ |u n - l₁| + |v n - l₂|   : by apply abs_add
  ...                     ≤ ε                         : by linarith
end

-- If u tends to l and v tends l' then u+v tends to l+l'
example (hu : seq_limit u l) (hv : seq_limit v l') :
  seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁ hn₂,
  have fact₁ : |u n - l| ≤ ε/2,
    from hN₁ n (by linarith),  -- note the use of `from`.
                               -- This is an alias for `exact`,
                               -- but reads nicer in this context
  have fact₂ : |v n - l'| ≤ ε/2,
    from hN₂ n (by linarith),
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith,
end

/-
In the above proof, we used `have` to prepare facts for `linarith` consumption in the last line.
Since we have direct proof terms for them, we can feed them directly to `linarith` as in the next proof
of the same statement.
Another variation we introduce is rewriting using `ge_max_iff` and letting `linarith` handle the
conjunction, instead of creating two new assumptions.
-/

example (hu : seq_limit u l) (hv : seq_limit v l') :
  seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith [hN₁ n (by linarith), hN₂ n (by linarith)],
end

/- Let's do something similar: the squeezing theorem. -/
-- 0035
example (hu : seq_limit u l) (hw : seq_limit w l)
  (h₁ : ∀ n, u n ≤ v n)
  (h₂ : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε (by linarith) with n₁ hn₁,
  cases hw ε (by linarith) with n₂ hn₂,
  use max n₁ n₂,
  intros k hk,
  rw ge_max_iff at hk,
  specialize hn₁ k hk.1,
  specialize hn₂ k hk.2,
  specialize h₁ k,
  specialize h₂ k,
  rw abs_le at *,
  split,
  show -ε ≤ v k - l, by calc
  -ε  ≤ u k - l : by linarith
  ... ≤ v k - l : by linarith,
  show v k - l ≤ ε, by calc
  v k - l ≤ w k - l : by linarith
  ...     ≤ ε       : by linarith,
end

/- What about < ε? -/
-- 0036
example (u l) : seq_limit u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  split,
  { intros h ε ε_pos,
    cases h (ε/2) (by linarith) with n hn,
    use n,
    intros m hm,
    specialize hn m hm,
    linarith },
  { intros h ε ε_pos,
    cases h ε ε_pos with n hn,
    use n,
    intros m hm,
    specialize hn m hm,
    linarith }
end

/- In the next exercise, we'll use

eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y
-/

-- A sequence admits at most one limit
-- 0037
example : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros h h',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  cases h (ε/2) (by linarith) with n h,
  cases h' (ε/2) (by linarith) with n' h',
  specialize h (max n n') (le_max_left _ _),
  specialize h' (max n n') (le_max_right _ _),
  rw abs_le at *,
  split; linarith
end

/-
Let's now practice deciphering definitions before proving.
-/

def non_decreasing (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- 0038
example (M : ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
  seq_limit u M :=
begin
  intros ε ε_pos,
  cases h with hM hu,
  cases hu ε ε_pos with N hN,
  use N,
  intros n hn,
  apply abs_le_of_le_of_neg_le,
  { apply sub_le_of_sub_le,
    rw sub_le_iff_le_add,
    specialize hM n,
    linarith },
  { specialize h' N n hn,
    linarith }
end


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.geom_sum
import algebra.group.unique_prods
import algebra.monoid_algebra.basic
import data.finsupp.lex
import data.zmod.basic

/-!
# Examples of zero-divisors in `add_monoid_algebra`s

This file contains an easy source of zero-divisors in an `add_monoid_algebra`.
If `k` is a field and `G` is an additive group containing a non-zero torsion element, then
`add_monoid_algebra k G` contains non-zero zero-divisors: this is lemma `zero_divisors_of_torsion`.

There is also a version for periodic elements of an additive monoid: `zero_divisors_of_periodic`.

The converse of this statement is
[Kaplansky's zero divisor conjecture](https://en.wikipedia.org/wiki/Kaplansky%27s_conjectures).

The formalized example generalizes in trivial ways the assumptions: the field `k` can be any
nontrivial ring `R` and the additive group `G` with a torsion element can be any additive monoid
`A` with a non-zero periodic element.

Besides this example, we also address a comment in `data.finsupp.lex` to the effect that the proof
that addition is monotone on `α →₀ N` uses that it is *strictly* monotone on `N`.

The specific statement is about `finsupp.lex.covariant_class_le_left` and its analogue
`finsupp.lex.covariant_class_le_right`.  We do not need two separate counterexamples, since the
operation is commutative.

The example is very simple.  Let `F = {0, 1}` with order determined by `0 < 1` and absorbing
addition (which is the same as `max` in this case).  We denote a function `f : F → F` (which is
automatically finitely supported!) by `[f 0, f 1]`, listing its values.  Recall that the order on
finitely supported function is lexicographic, matching the list notation.  The inequality
`[0, 1] ≤ [1, 0]` holds.  However, adding `[1, 0]` to both sides yields the *reversed* inequality
`[1, 1] > [1, 0]`.
-/
open finsupp add_monoid_algebra

/--  This is a simple example showing that if `R` is a non-trivial ring and `A` is an additive
monoid with an element `a` satisfying `n • a = a` and `(n - 1) • a ≠ a`, for some `2 ≤ n`,
then `add_monoid_algebra R A` contains non-zero zero-divisors.  The elements are easy to write down:
`[a]` and `[a] ^ (n - 1) - 1` are non-zero elements of `add_monoid_algebra R A` whose product
is zero.

Observe that such an element `a` *cannot* be invertible.  In particular, this lemma never applies
if `A` is a group. -/
lemma zero_divisors_of_periodic {R A} [nontrivial R] [ring R] [add_monoid A] {n : ℕ} (a : A)
  (n2 : 2 ≤ n) (na : n • a = a) (na1 : (n - 1) • a ≠ 0) :
  ∃ f g : add_monoid_algebra R A, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 :=
begin
  refine ⟨single a 1, single ((n - 1) • a) 1 - single 0 1, by simp, _, _⟩,
  { exact sub_ne_zero.mpr (by simpa [single_eq_single_iff]) },
  { rw [mul_sub, add_monoid_algebra.single_mul_single, add_monoid_algebra.single_mul_single,
      sub_eq_zero, add_zero, ← succ_nsmul, nat.sub_add_cancel (one_le_two.trans n2), na] },
end

lemma single_zero_one {R A} [semiring R] [has_zero A] :
  single (0 : A) (1 : R) = (1 : add_monoid_algebra R A) := rfl

/--  This is a simple example showing that if `R` is a non-trivial ring and `A` is an additive
monoid with a non-zero element `a` of finite order `oa`, then `add_monoid_algebra R A` contains
non-zero zero-divisors.  The elements are easy to write down:
`∑ i in finset.range oa, [a] ^ i` and `[a] - 1` are non-zero elements of `add_monoid_algebra R A`
whose product is zero.

In particular, this applies whenever the additive monoid `A` is an additive group with a non-zero
torsion element. -/
lemma zero_divisors_of_torsion {R A} [nontrivial R] [ring R] [add_monoid A] (a : A)
  (o2 : 2 ≤ add_order_of a) :
  ∃ f g : add_monoid_algebra R A, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 :=
begin
  refine ⟨(finset.range (add_order_of a)).sum (λ (i : ℕ), (single a 1) ^ i),
    single a 1 - single 0 1, _, _, _⟩,
  { apply_fun (λ x : add_monoid_algebra R A, x 0),
    refine ne_of_eq_of_ne (_ : (_ : R) = 1) one_ne_zero,
    simp_rw finset.sum_apply',
    refine (finset.sum_eq_single 0 _ _).trans _,
    { intros b hb b0,
      rw [single_pow, one_pow, single_eq_of_ne],
      exact nsmul_ne_zero_of_lt_add_order_of' b0 (finset.mem_range.mp hb) },
    { simp only [(zero_lt_two.trans_le o2).ne', finset.mem_range, not_lt, le_zero_iff,
        false_implies_iff] },
    { rw [single_pow, one_pow, zero_smul, single_eq_same] } },
  { apply_fun (λ x : add_monoid_algebra R A, x 0),
    refine sub_ne_zero.mpr (ne_of_eq_of_ne (_ : (_ : R) = 0) _),
    { have a0 : a ≠ 0 := ne_of_eq_of_ne (one_nsmul a).symm
        (nsmul_ne_zero_of_lt_add_order_of' one_ne_zero (nat.succ_le_iff.mp o2)),
      simp only [a0, single_eq_of_ne, ne.def, not_false_iff] },
    { simpa only [single_eq_same] using zero_ne_one, } },
  { convert commute.geom_sum₂_mul _ (add_order_of a),
    { ext, rw [single_zero_one, one_pow, mul_one] },
    { rw [single_pow, one_pow, add_order_of_nsmul_eq_zero, single_zero_one, one_pow, sub_self] },
    { simp only [single_zero_one, commute.one_right] } },
end

example {R} [ring R] [nontrivial R] (n : ℕ) (n0 : 2 ≤ n) :
  ∃ f g : add_monoid_algebra R (zmod n), f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 :=
zero_divisors_of_torsion (1 : zmod n) (n0.trans_eq (zmod.add_order_of_one _).symm)

/--  `F` is the type with two elements `zero` and `one`.  We define the "obvious" linear order and
absorbing addition on it to generate our counterexample. -/
@[derive [decidable_eq, inhabited]] inductive F | zero | one

/--  The same as `list.get_rest`, except that we take the "rest" from the first match, rather than
from the beginning, returning `[]` if there is no match.  For instance,
```lean
#eval [1,2].drop_until [3,1,2,4,1,2]  -- [4, 1, 2]
```
-/
def list.drop_until {α} [decidable_eq α] : list α → list α → list α
| l [] := []
| l (a::as) := ((a::as).get_rest l).get_or_else (l.drop_until as)

/-- `guard_decl_in_file na loc` makes sure that the declaration with name `na` is in the file with
relative path `"src/" ++ "/".intercalate loc ++ ".lean"`.
```lean
#eval guard_decl_in_file `nat.nontrivial ["data", "nat", "basic"]  -- does nothing

#eval guard_decl_in_file `nat.nontrivial ["not", "in", "here"]
-- fails giving the location 'data/nat/basic.lean'
```

This test makes sure that the comment referring to this example is in the file claimed in the
doc-module to this counterexample. -/
meta def guard_decl_in_file (na : name) (loc : list string) : tactic unit :=
do env ← tactic.get_env,
  some fil ← pure $ env.decl_olean na | fail!"the instance `{na}` is not imported!",
  let path : string := ⟨list.drop_until "/src/".to_list fil.to_list⟩,
  let locdot : string := ".".intercalate loc,
  guard (fil.ends_with ("src/" ++ "/".intercalate loc ++ ".lean")) <|>
    fail!("instance `{na}` is no longer in `{locdot}`.\n\n" ++
      "Please, update the doc-module and this check with the correct location:\n\n'{path}'\n")

#eval guard_decl_in_file `finsupp.lex.covariant_class_le_left ["data", "finsupp", "lex"]
#eval guard_decl_in_file `finsupp.lex.covariant_class_le_right ["data", "finsupp", "lex"]

namespace F

instance : has_zero F := ⟨F.zero⟩

/--  `1` is not really needed, but it is nice to use the notation. -/
instance : has_one F := ⟨F.one⟩

/--  A tactic to prove trivial goals by enumeration. -/
meta def boom : tactic unit :=
`[ repeat { rintro ⟨⟩ }; dec_trivial ]

/--  `val` maps `0 1 : F` to their counterparts in `ℕ`.
We use it to lift the linear order on `ℕ`. -/
def val : F → ℕ
| 0 := 0
| 1 := 1

instance : linear_order F := linear_order.lift' val (by boom)

@[simp] lemma z01  : (0 : F) < 1 := by boom

/--  `F` would be a `comm_semiring`, using `min` as multiplication.  Again, we do not need this. -/
instance : add_comm_monoid F :=
{ add       := max,
  add_assoc := by boom,
  zero      := 0,
  zero_add  := by boom,
  add_zero  := by boom,
  add_comm  := by boom }

/--  The `covariant_class`es asserting monotonicity of addition hold for `F`. -/
instance covariant_class_add_le : covariant_class F F (+) (≤) := ⟨by boom⟩
example : covariant_class F F (function.swap (+)) (≤) := by apply_instance

/--  The following examples show that `F` has all the typeclasses used by
`finsupp.lex.covariant_class_le_left`... -/
example : linear_order F := by apply_instance
example : add_monoid F   := by apply_instance

/-- ... except for the strict monotonicity of addition, the crux of the matter. -/
example : ¬ covariant_class F F (+) (<) := λ h, lt_irrefl 1 $ (h.elim : covariant F F (+) (<)) 1 z01

/--  A few `simp`-lemmas to take care of trivialities in the proof of the example below. -/
@[simp] lemma f1   : ∀ (a : F), 1 + a = 1 := by boom
@[simp] lemma f011 : of_lex (single (0 : F) (1 : F)) 1 = 0 := single_apply_eq_zero.mpr (λ h, h)
@[simp] lemma f010 : of_lex (single (0 : F) (1 : F)) 0 = 1 := single_eq_same
@[simp] lemma f111 : of_lex (single (1 : F) (1 : F)) 1 = 1 := single_eq_same
@[simp] lemma f110 : of_lex (single (1 : F) (1 : F)) 0 = 0 := single_apply_eq_zero.mpr (λ h, h.symm)

/--  Here we see that (not-necessarily strict) monotonicity of addition on `lex (F →₀ F)` is not
a consequence of monotonicity of addition on `F`.  Strict monotonicity of addition on `F` is
enough and is the content of `finsupp.lex.covariant_class_le_left`. -/
example : ¬ covariant_class (lex (F →₀ F)) (lex (F →₀ F)) (+) (≤) :=
begin
  rintro ⟨h⟩,
  refine not_lt.mpr (h (single (0 : F) (1 : F)) (_ : single 1 1 ≤ single 0 1)) ⟨1, _⟩,
  { exact or.inr ⟨0, by simp [(by boom : ∀ j : F, j < 0 ↔ false)]⟩ },
  { simp only [(by boom : ∀ j : F, j < 1 ↔ j = 0), of_lex_add, coe_add, pi.to_lex_apply,
      pi.add_apply, forall_eq, f010, f1, eq_self_iff_true, f011, f111, zero_add, and_self] },
end

example {α} [ring α] [nontrivial α] :
  ∃ f g : add_monoid_algebra α F, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 :=
zero_divisors_of_periodic (1 : F) le_rfl (by simp [two_smul]) (z01.ne')

example {α} [has_zero α] : 2 • (single 0 1 : α →₀ F) = single 0 1 ∧ (single 0 1 : α →₀ F) ≠ 0 :=
⟨smul_single _ _ _, by simpa only [ne.def, single_eq_zero] using z01.ne⟩

end F

/-- A Type that does not have `unique_prods`. -/
example : ¬ unique_prods ℕ :=
begin
  rintros ⟨h⟩,
  refine not_not.mpr (h (finset.singleton_nonempty 0) (finset.insert_nonempty 0 {1})) _,
  suffices : (∃ (x : ℕ), (x = 0 ∨ x = 1) ∧ ¬x = 0) ∧ ∃ (x : ℕ), (x = 0 ∨ x = 1) ∧ ¬x = 1,
  { simpa [unique_mul] },
  exact ⟨⟨1, by simp⟩, ⟨0, by simp⟩⟩,
end

/-- Some Types that do not have `unique_sums`. -/
example (n : ℕ) (n2 : 2 ≤ n): ¬ unique_sums (zmod n) :=
begin
  haveI : fintype (zmod n) := @zmod.fintype n ⟨(zero_lt_two.trans_le n2).ne'⟩,
  haveI : nontrivial (zmod n) := char_p.nontrivial_of_char_ne_one (one_lt_two.trans_le n2).ne',
  rintros ⟨h⟩,
  refine not_not.mpr (h finset.univ_nonempty finset.univ_nonempty) _,
  suffices : ∀ (x y : zmod n), ∃ (x' y' : zmod n), x' + y' = x + y ∧ (x' = x → ¬y' = y),
  { simpa [unique_add] },
  exact λ x y, ⟨x - 1, y + 1, sub_add_add_cancel _ _ _, by simp⟩,
end


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

import data.W.basic

/-!
# W types

The file `data/W.lean` shows that if `α` is an an encodable fintype and for every `a : α`,
`β a` is encodable, then `W β` is encodable.

As an example of how this can be used, we show that the type of propositional formulas with
variables labeled from an encodable type is encodable.

The strategy is to define a type of labels corresponding to the constructors.
From the definition (using `sum`, `unit`, and an encodable type), Lean can infer
that it is encodable. We then define a map from propositional formulas to the
corresponding `Wfin` type, and show that map has a left inverse.

We mark the auxiliary constructions `private`, since their only purpose is to
show encodability.
-/

/-- Propositional formulas with labels from `α`. -/
inductive prop_form (α : Type*)
| var : α → prop_form
| not : prop_form → prop_form
| and : prop_form → prop_form → prop_form
| or  : prop_form → prop_form → prop_form

/-!
The next three functions make it easier to construct functions from a small
`fin`.
-/

section
variable {α : Type*}

/-- the trivial function out of `fin 0`. -/
def mk_fn0 : fin 0 → α
| ⟨_, h⟩ := absurd h dec_trivial

/-- defines a function out of `fin 1` -/
def mk_fn1 (t : α) : fin 1 → α
| ⟨0, _⟩   := t
| ⟨n+1, h⟩ := absurd h dec_trivial

/-- defines a function out of `fin 2` -/
def mk_fn2 (s t : α) : fin 2 → α
| ⟨0, _⟩   := s
| ⟨1, _⟩   := t
| ⟨n+2, h⟩ := absurd h dec_trivial

attribute [simp] mk_fn0 mk_fn1 mk_fn2
end

namespace prop_form

private def constructors (α : Type*) := α ⊕ unit ⊕ unit ⊕ unit

local notation `cvar ` a := sum.inl a
local notation `cnot`   := sum.inr (sum.inl unit.star)
local notation `cand`   := sum.inr (sum.inr (sum.inr unit.star))
local notation `cor`    := sum.inr (sum.inr (sum.inl unit.star))

@[simp]
private def arity (α : Type*) : constructors α → nat
| (cvar a) := 0
| cnot     := 1
| cand     := 2
| cor      := 2

variable {α : Type*}

private def f : prop_form α → W_type (λ i, fin (arity α i))
| (var a)   := ⟨cvar a, mk_fn0⟩
| (not p)   := ⟨cnot, mk_fn1 (f p)⟩
| (and p q) := ⟨cand, mk_fn2 (f p) (f q)⟩
| (or  p q) := ⟨cor, mk_fn2 (f p) (f q)⟩

private def finv : W_type (λ i, fin (arity α i)) → prop_form α
| ⟨cvar a, fn⟩ := var a
| ⟨cnot, fn⟩   := not (finv (fn ⟨0, dec_trivial⟩))
| ⟨cand, fn⟩   := and (finv (fn ⟨0, dec_trivial⟩)) (finv (fn ⟨1, dec_trivial⟩))
| ⟨cor, fn⟩    := or  (finv (fn ⟨0, dec_trivial⟩)) (finv (fn ⟨1, dec_trivial⟩))

instance [encodable α] : encodable (prop_form α) :=
begin
  haveI : encodable (constructors α),
  { unfold constructors, apply_instance },
  exact encodable.of_left_inverse f finv
    (by { intro p, induction p; simp [f, finv, *] })
end

end prop_form


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

import tactic -- imports all the Lean tactics
import measure_theory.integral.bochner
--import probability.martingale.basic -- note to self: surely too much

/-

# Measures

Recall that Lean calls a space equipped with
a sigma algebra a "measurable_space". We will go with this language
and call sets in the sigma algebra "measurable sets".

Given a measurable space, a *measure* on the measurable space is a function from
the measurable sets to `[0,∞]` which is countably additive (i.e.,
the measure of a countable disjoint union of measurable sets is the sum of the measures).
This is not the *definition* of a measure in Lean, but it is mathematically equivalent to the
definition.

For what it's worth, the actual definition of a measure in Lean is this: an `outer_measure`
on a type `α` is this:

```
structure outer_measure (α : Type*) :=
(measure_of : set α → ℝ≥0∞)
(empty : measure_of ∅ = 0)
(mono : ∀{s₁ s₂}, s₁ ⊆ s₂ → measure_of s₁ ≤ measure_of s₂)
(Union_nat : ∀(s:ℕ → set α), measure_of (⋃i, s i) ≤ ∑'i, measure_of (s i))
```

So it attaches an element of `[0,∞]` to *every* subset of α, satisfying some natural axioms;
note in particular it is countably *sub*additive, meaning that the measure of a countable
union of open sets, even if they're pairwise disjoint, is only assumed to be at most the sum of the measures.

And if `α` has a measurable space structure then a measure on `α` is an outer measure satisfying
some axioms, which boil down to "the restriction of the outer measure is a measure on the measurable
sets, and the extension of this measure to an outer measure agrees with the outer measure we started with".
The advantage of doing it this way is that given a measure, we can evaluate it on *any* subset
(getting the outer measure of the subset) rather than having to supply a proof that the subset
is measurable. This coincides with Lean's "make functions total" philosophy (the same reason that 1/0=0).

-/

open filter
open_locale nnreal ennreal measure_theory big_operators topological_space
-- note to self: removed `probability_theory`

namespace measure_theory

-- Let Ω be a set equipped with a sigma algebra.
variables {Ω : Type} [measurable_space Ω]

-- Now let's add a measure `μ` on `Ω`
variables {μ : measure Ω}

/-
Try proving the following:
-/

example (S T : set Ω) (hS : μ S ≠ ∞) (hT : measurable_set T) :
  μ (S ∪ T) = μ S + μ T - μ (S ∩ T) :=
begin
  rw ← measure_union_add_inter S hT,
  rw ennreal.add_sub_cancel_right,
  apply ne_top_of_le_ne_top hS,
  apply outer_measure.mono,
  exact set.inter_subset_left S T,
end

/-
*Remark*: while proving the above, you might have noticed I've added the
condition `hS` (think about what is a + ∞ - ∞). In particular, subtraction in
extended non-negative reals (`ℝ≥0∞`) might not be what you expect,
e.g. 1 - 2 = 0 in `ℝ≥0∞`. For this reason, the above lemma is better phrased as
`μ (S ∪ T) + μ (S ∩ T) = μ S + μ T` for which we can omit the condition `hS`.
-/

/-!
## Measurable functions

So far we've worked in the space `Ω` though with all mathematical objects, we
want to map between them. In measure theory, the correct notion of maps is
measurable functions. If you have seen continuity in topology, they are quite
similar, namely, a function `f` between two measurable spaces is said to be
measurable if the preimages of all measurable sets along `f` is measurable.
-/

/-
If you go to the definition of measurable you will find what you expect.
However, of course, measure theory in Lean is a bit more complicated. As we
shall see, in contrast to maths, there are 3 additional notions of measurability
in mathlib. These are:
- `ae_measurable`
- `strongly_measurable`
- `ae_strongly_measurable`
The reasons for their existence is technical but TLDR: `ae_foo f` is the predicate
that `f` is almost everywhere equal to some function satisfying `foo` (see the
a.e. filter section) while `strongly_measurable f` is saying `f` is the limit
of a sequence of simple functions.

Alongside `measurable`, we also see them quite often in the mathlib, although
all you have to know is in most cases (range is metrizable and second-countable),
`measurable` and `strongly_measurable` are equivalent.
-/

example : measurable (id : Ω → Ω) :=
begin
  intros U hU,
  exact hU,
end

example {X Y Z : Type} [measurable_space X] [measurable_space Y] [measurable_space Z]
  (f : X → Y) (g : Y → Z) (hg : measurable g) (hf : measurable f) :
  measurable (g ∘ f) :=
begin
  intros U hU,
  replace hg := hg hU,
  exact hf hg,
end

/-!
## Integration

One of the primary motivations of measure theory is to introduce a more
satisfactory theory of integration. If you recall the definition of the
Darboux-Riemann integral, we cannot integrate the indicator function of
`ℚ ∩ [0, 1]` despite, intuitively, the set of rationals in the unit interval
is much "smaller" (rationals is countable while the irrationals are not.
In contrast, measure theory allows us to construct the Lebesgue integral
which can deal with integrals such as this one.

Lean uses a even more general notion of integration known as Bochner integration
which allows us to integrate Banach-space valued functions. Its construction
is similar to the Lebesgue integral.

Read page 5-6 of https://arxiv.org/pdf/2102.07636.pdf
if you want to know the details.
-/

-- Suppose now `X` is another measurable space
variables {X : Type} [measurable_space X]

-- and suppose it's also a Banach space (i.e. a vector space and a complete metric space)
variables [normed_add_comm_group X] [normed_space ℝ X] [complete_space X]

-- If `f : Ω → X` is a function, then the integral of `f` is written as
-- `∫ x, f x ∂μ`. If you want to integrate over the set `s : set Ω` then write
-- `∫ x in s, f x ∂μ`.

-- Try looking in mathlib
example {f g : Ω → X} (hf : integrable f μ) (hg : integrable g μ) :
  ∫ x, f x + g x ∂μ = ∫ x, f x ∂μ + ∫ x, g x ∂μ :=
begin
  apply integral_add hf hg,
end

example (a : X) (s : set Ω) : ∫ x in s, a ∂μ = (μ s).to_real • a :=
begin
  rw integral_const,
  congr' 2,
  rw measure.restrict_apply,
  { simp },
  { simp },
end

-- Harder
example {f : Ω → ℝ} (hf : measurable f) (hint : integrable f μ)
  (hμ : 0 < μ {ω | 0 < f ω}) :
  (0 : ℝ) < ∫ ω in {ω | 0 < f ω}, f ω ∂μ :=
begin
  sorry
end

/-
*Remark* It's a common myth that Lebesgue integration is strictly better than
the Darboux-Riemann integral. This is true for integration on bounded intervals
though it is not true when considering improper integrals. A common example
for this is, while `∫ x in [0, ∞), sin x / x dx` is Darboux-Riemann integrable
(in fact it equals `π / 2`) it is not Lebesgue integrable as
`∫ x in [0, ∞), |sin x / x| dx = ∞`.
-/

/-!
## ae filter

Now we have come to a very important section of working with measure theory
in Lean.

In measure theory we have a notion known as almost everywhere (a.e.). In
probability this is known as almost surely however we will stick with
almost everywhere in this project. Namely, a predicate `P` on `Ω` is said to
be true almost everywhere if the set for which `P` holds is co-null, i.e.
`μ {ω : Ω | P ω}ᶜ = 0`.

As examples, we say:
- given functions `f, g`, `f` equals `g` a.e. if `μ {ω : Ω | f ω ≠ g ω} = 0`;
- `f` is less equal to `g` a.e. if `μ {ω : Ω | ¬ f ω ≤ g ω} = 0` etc.

Often, showing that a property holds a.e. is the best we can do in
measure/probability theory.

In Lean, the notion of a.e. is handled by the `measure.ae` filter.
Let's construct that filter ourselves.
-/

example (X : Type) [measurable_space X] (μ : measure X) : filter X :=
{ sets := {U | μ Uᶜ = 0},
  univ_sets := begin
    simp only [set.mem_set_of_eq, set.compl_univ, measure_empty],
  end,
  sets_of_superset := begin
    rintro S T (hS : μ Sᶜ = 0) hST,
    change μ Tᶜ = 0,
    apply measure_mono_null _ hS,
    exact set.compl_subset_compl.mpr hST,
  end,
  inter_sets := begin
    intros S T hS hT,
    rw set.mem_set_of at hS hT ⊢,
    rw set.compl_inter,
    rw ← le_zero_iff,
    apply le_trans (measure_union_le _ _),
    rw [hS, hT],
    norm_num,
  end }

-- say `f` and `g` are measurable functions `Ω → X`
variables (f g : Ω → X)
-- The following is a proposition that `f` and `g` are almost everywhere equal
-- it's **not** a proof that `f` and `g` are a.e. equal but simply a statement
example : Prop := ∀ᵐ ω ∂μ, f ω = g ω

-- Here's another example on how to state `f` is almost everywhere less equal
-- than `g`
-- To be able to formulate this we need a notion of inequality on `X` so we
-- will add the `has_le` instance on `X`, i.e. equip `X` with a inequality
example [has_le X] : Prop := ∀ᵐ ω ∂μ, f ω ≤ g ω

-- Since the above two cases come up quite often, there are special notations
-- for them. See if you can guess what they mean
example : Prop := f =ᵐ[μ] g
example [has_le X] : Prop := f ≤ᵐ[μ] g

-- In general, if `P : Ω → Prop` is a predicate on `Ω`, we write `∀ᵐ ω ∂μ, P ω`
-- for the statement that `P` holds a.e.
example (P : Ω → Prop) : Prop := ∀ᵐ ω ∂μ, P ω

-- Sanity check: the above notation actually means what we think
example (P : Ω → Prop) : (∀ᵐ ω ∂μ, P ω) ↔ μ {ω | P ω}ᶜ = 0 :=
begin
  refl,
end

-- Heres a more convoluted example. See if you can figure what it means
example (f : ℕ → Ω → ℝ) (s : set Ω) :=
  ∀ᵐ ω ∂μ.restrict s, ∃ l : ℝ, tendsto (λ n, f n ω) at_top (𝓝 l)

-- Now to do some exercises: you will need to dig into the source code to see
-- what the definitions are and search for helpful lemmas
-- *Hint*: try out the `measurability` tactic. It should be able to solve simple
-- goals of the form `measurable_set s` and `measurable f`
example (s : set Ω) (f g : Ω → ℝ)
  (hf : measurable f) (hg : measurable g) (hfg : ∀ ω ∈ s, f ω = g ω) :
  f =ᵐ[μ.restrict s] g :=
begin
  unfold eventually_eq filter.eventually,
  rw mem_ae_iff,
  rw measure.restrict_apply,
  { convert measure_empty,
    rw set.eq_empty_iff_forall_not_mem,
    rintro x ⟨hx1, hx2⟩,
    apply hx1,
    apply hfg _ hx2, },
  { measurability, },
end

example (f g h : Ω → ℝ) (h₁ : f ≤ᵐ[μ] g) (h₂ : f ≤ᵐ[μ] h) :
  2 * f ≤ᵐ[μ] g + h :=
begin
  convert eventually_le.add_le_add h₁ h₂,
  rw two_mul,
end

example (f g : Ω → ℝ) (h : f =ᵐ[μ] g) (hg : ∀ᵐ ω ∂μ, 2 * g ω + 1 ≤ 0) :
  ∀ᵐ ω ∂μ, f ω ≤ -1/2 :=
begin
  filter_upwards [h, hg],
  rintro a ha hg,
  rw ha,
  linarith,
end

example (f g : ℕ → Ω → ℝ) (a b : ℝ)
  (hf : ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 a))
  (hg : ∀ᵐ ω ∂μ, tendsto (λ n, g n ω) at_top (𝓝 b)) :
  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω + g n ω) at_top (𝓝 (a + b)) :=
begin
  filter_upwards [hf, hg],
  intros ω h1 h2,
  convert tendsto.comp tendsto_add _, swap, exact (λ n, (f n ω, g n ω)), refl,
  { apply_instance, },
  rw nhds_prod_eq,
  rw tendsto_prod_iff',
  exact ⟨h1, h2⟩,
end

/-
I hope that you found the above examples slightly annoying, especially the
third example: why can't we just `rw h`?! Of course, while we often do do so on
paper, rigourously, such a rewrite require some logic. Luckily, what we normally
do on paper is most often ok and we would like to do so in Lean as well. While
we can't directly rewrite almost everywhere equalities, we have the next best
thing: the `filter_upwards` tactic. See the tactic documentation here:
https://leanprover-community.github.io/mathlib_docs/tactics.html#filter_upwards

The `filter_upwards` tactic is much more powerful than simply rewritting a.e.
equalities and is helpful in many situtations, e.g. the above second, third
and fourth examples are all easily solvable with this tactic. Let us see how
it works in action.
-/

-- Hover over each line and see how the goal changes
example (f₁ f₂ g₁ g₂ : Ω → ℝ) (h₁ : f₁ ≤ᵐ[μ] g₁) (h₂ : f₂ ≤ᵐ[μ] g₂) :
  f₁ + f₂ ≤ᵐ[μ] g₁ + g₂ :=
begin
  filter_upwards [h₁, h₂],
  intros ω hω₁ hω₂,
  exact add_le_add hω₁ hω₂,
end

-- Heres an even shorter proof using additional parameters of `filter_upwards`
example (f₁ f₂ g₁ g₂ : Ω → ℝ) (h₁ : f₁ ≤ᵐ[μ] g₁) (h₂ : f₂ ≤ᵐ[μ] g₂) :
  f₁ + f₂ ≤ᵐ[μ] g₁ + g₂ :=
begin
  filter_upwards[h₁, h₂] with ω hω₁ hω₂ using add_le_add hω₁ hω₂,
end

/-
Intuitively, what `filter_upwards` is doing is simply exploiting the fact that
the intersection of two full measure sets (i.e. complements are null) is also
a set of full measure. Thus, it suffices to work in their intersection instead.

Now, try the above examples again using the `filter_upwards` tactic.
-/

end measure_theory


-- Prove ¬(p ∨ q) ↔ ¬p ∧ ¬q
example (p q : Prop) : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
⟨λ h, ⟨λ hp, h (or.inl hp), λ hq, h (or.inr hq)⟩,
λ hn h, or.elim h hn.1 hn.2⟩

-- Page 83
-- Prove (A ∧ B) → (B ∧ A)
example (A B : Prop) : (A ∧ B) → (B ∧ A) :=
λ ⟨A, B⟩, ⟨B, A⟩

example (A B : Prop) : (A ∧ B) → (B ∧ A) :=
λ p : A ∧ B, ⟨and.right p, and.left p⟩

example (A B : Prop) : (A ∧ B) → (B ∧ A) :=
λ p, and.intro (and.right p) (and.left p)

-- Prove (((A ∨ B) → C) ∧ A) → C
example (A B C : Prop) : (((A ∨ B) → C) ∧ A) → C :=
λ qr, (and.left qr) (or.inl (and.right qr))

-- Prove (((A ∨ B) → C) ∧ A) → C, second example, closer to Thompson book
example (A B C : Prop) : (((A ∨ B) → C) ∧ A) → C :=
λ ⟨q, r⟩, q (or.inl r)

-- Page 90
-- 4.1. Show that conjunction is associative by deriving a proof of the formula
-- (A ∧ B) ∧ C → A ∧ (B ∧ C)
example (A B C : Prop) : (A ∧ B) ∧ C → A ∧ (B ∧ C) :=
λ p, ⟨and.left (and.left p), ⟨and.right (and.left p), and.right p⟩⟩

example (A B C : Prop) : (A ∧ B) ∧ C → A ∧ (B ∧ C) :=
λ p, ⟨and.left (and.left p), and.right (and.left p), and.right p⟩

example (A B C : Prop) : (A ∧ B) ∧ C → A ∧ (B ∧ C) :=
λ p, and.intro (and.left (and.left p)) (and.intro (and.right (and.left p)) (and.right p))

-- 4.2. A) Show that the formula (¬A ∨ B) → (A → B) is valid by exhibiting a proof object for it.
example (A B : Prop) : (¬A ∨ B) → (A → B) :=
λ p, or.elim p
(λ na, λ a, absurd a na)
(λ b, λ a, b)

example (A B : Prop) : (¬A ∨ B) → (A → B) :=
assume hnab : ¬A ∨ B,
or.elim hnab
(assume hna : ¬A,
assume ha : A,
show B, from absurd ha hna)
(assume hb : B,
assume ha : A,
show B, from hb)

example (A B : Prop) : (¬A ∨ B) → (A → B) :=
assume hnab : ¬A ∨ B,
or.elim hnab
(assume hna : ¬A,
assume ha : A,
show B, from false.elim (hna ha))
(assume hb : B,
assume ha : A,
show B, from hb)

-- 4.2 B) Do you expect the converse, (A → B) → (¬A ∨ B), to be provable?

-- 4.3. A) Show that from the assumption x : (A ∨ ¬A) that you can derive a
-- proof object for the formula (¬¬A → A).
example (A : Prop) : (A ∨ ¬A) → (¬¬A → A) :=
λ hana, or.elim hana
(λ ha, λ hna, ha)
(λ hna, λ hnna, absurd hna hnna)

example (A : Prop) : (A ∨ ¬A) → (¬¬A → A) :=
assume hana : (A ∨ ¬A),
or.elim hana
(assume ha : A,
assume hna : ¬¬A, show A, from ha)
(assume hna : ¬A,
assume hnna : ¬¬A, show A, from false.elim (hnna hna))

-- 4.3 B) Show that you can find a proof
-- object for the converse, (A → ¬¬A) without this assumption.
example (A : Prop): (A → ¬¬A) :=
assume ha : A,
assume hna : ¬A, show false, from hna ha

example (A : Prop): (A → ¬¬A) :=
assume ha : A,
assume hna : ¬A, absurd ha hna

-- 4.4. Show that from the assumptions x : ((A ∧ B) → C) and y : A you
-- can derive a proof of B → C.
example (A B C : Prop) : ((A ∧ B) → C) ∧ A → (B → C) :=
λ x, λ y, x.left (and.intro x.right y)

example (A B C : Prop) : ((A ∧ B) → C) ∧ A → (B → C) :=
assume habc,
assume hb, show  C, from habc.left (and.intro habc.right hb)

-- 4.5. Given a function of type A → (B → C) how would you define a
-- function of type (A ∧ B) → C from it? How would you do the reverse?
-- A)
example (A B C : Prop) : (A → (B → C)) → ((A ∧ B) → C) :=
assume habc,
assume hab, show C, from  (habc (and.left hab)) (and.right hab)

example (A B C : Prop) : (A → (B → C)) → ((A ∧ B) → C) :=
λ abc, λ ab, show C, from (abc ab.left) ab.right

-- B) How would you do the reverse?
example (A B C : Prop) : ((A ∧ B) → C) → (A → (B → C)) :=
assume habc,
assume ha,
assume hb, show C, from habc (and.intro ha hb)

example (A B C : Prop) : ((A ∧ B) → C) → (A → (B → C)) :=
λ habc, λ ha, λ hb, habc (and.intro ha hb)

-- 4.6. Show that from objects x : A and y : (B ∨ C) you can derive an object
-- of type (A ∧ B) ∨ (A ∧ C).
example (A B C : Prop) : (A ∧ (B ∨ C)) → ((A ∧ B) ∨ (A ∧ C)) :=
assume habc,
show (A ∧ B) ∨ (A ∧ C), from
(or.elim (and.right habc)
(assume hb, or.inl (and.intro (and.left habc) hb))
(assume hc, or.inr (and.intro (and.left habc) hc)))

example (A B C : Prop) : (A ∧ (B ∨ C)) → ((A ∧ B) ∨ (A ∧ C)) :=
λ habc,
(or.elim (and.right habc)
  (λ  hb, or.inl (and.intro (and.left habc) hb))
  (λ  hc, or.inr (and.intro (and.left habc) hc)))

-- 4.7. Show how to define a function of type
-- (A ∧ B) → (C ∧ D)
-- from functions f : A → C and g : B → D.
example (A B C D : Prop): (A ∧ B) → (C ∧ D) :=
λ x: (A ∧ B), and.intro (sorry) (sorry)

example (A B C D : Prop): (A ∧ B) → (A → C) → (B → D) → (C ∧ D) :=
λ x: (A ∧ B), λ f : (A → C), λ g: (B → D), and.intro (f x.left)(g x.right)

-- 4.8. Show that the following formulas are valid, by giving a proof object
-- for each of them.
-- A) A → ¬¬A
example (A : Prop): A → ¬¬A :=
assume ha,
show ¬¬A, from (assume hna, show false, from false.elim (hna ha))

example (A : Prop): A → ¬¬A :=
λ ha, λ hna, false.elim (hna ha)

-- B) (B ∨ C) → ¬(¬B ∧ ¬C)
example (B C : Prop): (B ∨ C) → ¬(¬B ∧ ¬C) :=
assume hbc : B ∨ C,
assume hnbnc : ¬B ∧ ¬C,
or.elim hbc
(assume hb : B, show false, from false.elim ((and.left hnbnc) hb))
(assume hc : C, show false, from false.elim ((and.right hnbnc) hc))

example (B C : Prop): (B ∨ C) → ¬(¬B ∧ ¬C) :=
λ hbc : B ∨ C,
λ hnbnc : ¬B ∧ ¬C,
or.elim hbc
(λ hb : B, false.elim ((and.left hnbnc) hb))
(λ hc : C, false.elim ((and.right hnbnc) hc))

-- C) (A → B) → ((A → C) → (A → (B ∧ C)))
example (A B C : Prop): (A → B) → ((A → C) → (A → (B ∧ C))) :=
assume hab : A → B,
assume hac : A → C,
assume ha : A, show B ∧ C, from and.intro (hab ha) (hac ha)

example (A B C : Prop): (A → B) → ((A → C) → (A → (B ∧ C))) :=
λ hab : A → B,
λ hac : A → C,
λ ha : A, and.intro (hab ha) (hac ha)

-- 4.9. Show that the following formulas are equivalent
-- (A ∧ B) → C    A → (B → C)
example (A B C : Prop): (A ∧ B) → C ↔ A → (B → C) :=
iff.intro
(assume habc, show A → B → C, from
  assume ha,
  assume hb,
show C, from habc (and.intro ha hb))
(assume habc, show A ∧ B → C, from
  assume hab,
  have ha : A, from and.left hab,
  have hb : B, from and.right hab,
  show C, from (habc ha) hb)

example (A B C : Prop): (A ∧ B) → C ↔ A → (B → C) :=
⟨ λ habc, λ ha, λ hb, habc (and.intro ha hb)
  ,
  λ habc, λ hab, habc (and.left hab) (and.right hab)
⟩

-- 4.10. Show that the de Morgan formula
-- (¬A ∨ ¬B) → ¬(A ∧ B)
-- is valid by giving an object of type
-- ((A → C) ∨ (B → C)) → ((A ∧ B) → C)
example (A B C : Prop): ((A → C) ∨ (B → C)) → ((A ∧ B) → C) :=
assume hacbc, show (A ∧ B) → C, from
  assume hab, show C, from
  or.elim hacbc
  (assume hac, show C, from hac (and.left hab))
  (assume hbc, show C, from hbc (and.right hab))

example (A B C : Prop): ((A → C) ∨ (B → C)) → ((A ∧ B) → C) :=
λ hacbc, λ hab, or.elim hacbc
  (λ hac, hac (and.left hab))
  (λ hbc, hbc (and.right hab))

-- 4.12. Give a derivation of a proof object of the formula
-- (∃x : X).¬P → ¬(∀x : X).P
variables (α : Type) (p q : α → Prop)

example (h : ∃ x, ¬p x) : ¬∀ x, p x :=
  (assume h1 : ∀ x, p x,
    have h2 : ∀ x, ¬ p x, from
      assume x,
      assume h3 : p x,
      have h4 : ∃ x, p x, from  ⟨x, h3⟩,
      show false, from h1 h4,
    show false, from h h2)

example (h : ∃ x, ¬p x) : ¬∀ x, p x :=
  (assume h1 : ∀ x, p x,
      assume y : α,
      have  h2 : p y, from  h1 y,
      show false, from sorry)

example (h : ∃ x, ¬p x) : ¬p α :=
      assume y : α,
      show false, from (sorry)


import .lovelib

/- # LoVe Demo 4: Functional Programming

We take a closer look at the basics of typed functional programming: inductive
types, proofs by induction, recursive functions, pattern matching, structures
(records), and type classes. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Inductive Types

Recall the definition of type `nat` (= `ℕ`): -/

#print nat

/- Mottos:

* **No junk**: The type contains no values beyond those expressible using the
  constructors.

* **No confusion**: Values built in a different ways are different.

For `nat` (= `ℕ`):

* "No junk" means that there are no special values, say, `–1` or `ε`, that
  cannot be expressed using a finite combination of `zero` and `succ`.

* "No confusion" is what ensures that `zero` ≠ `succ x`.

In addition, inductive types are always finite. `succ (succ (succ …))` is not a
value.

## Structural Induction

__Structural induction__ is a generalization of mathematical induction to
inductive types. To prove a property `P[n]` for all natural numbers `n`, it
suffices to prove the base case

    `P[0]`

and the induction step

    `∀k, P[k] → P[k + 1]`

For lists, the base case is

    `P[[]]`

and the induction step is

    `∀y ys, P[ys] → P[y :: ys]`

In general, there is one subgoal per constructor, and induction hypotheses are
available for all constructor arguments of the type we are doing the induction
on. -/

lemma nat.succ_neq_self (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  { simp },
  { simp [ih] }
end

/- The `case` tactic can be used to supply custom names, and potentially
reorder the cases. -/

lemma nat.succ_neq_self₂ (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  case succ : m IH {
    simp [IH] },
  case zero {
    simp }
end

/- ## Structural Recursion

__Structural recursion__ is a form of recursion that allows us to peel off
one or more constructors from the value on which we recurse. Such functions are
guaranteed to call themselves only finitely many times before the recursion
stops. This is a prerequisite for establishing that the function terminates. -/

def fact : ℕ → ℕ
| 0       := 1
| (n + 1) := (n + 1) * fact n

def fact₂ : ℕ → ℕ
| 0       := 1
| 1       := 1
| (n + 1) := (n + 1) * fact₂ n

/- For structurally recursive functions, Lean can automatically prove
termination. For more general recursive schemes, the termination check may fail.
Sometimes it does so for a good reason, as in the following example: -/

-- fails
def illegal : ℕ → ℕ
| n := illegal n + 1

constant immoral : ℕ → ℕ

axiom immoral_eq (n : ℕ) :
  immoral n = immoral n + 1

lemma proof_of_false :
  false :=
have immoral 0 = immoral 0 + 1 :=
  immoral_eq 0,
have immoral 0 - immoral 0 = immoral 0 + 1 - immoral 0 :=
  by cc,
have 0 = 1 :=
  by simp [*] at *,
show false, from
  by cc

/- ## Pattern Matching Expressions

    `match` _term₁_, …, _termM_ `with`
    | _pattern₁₁_, …, _pattern₁M_ := _result₁_
        ⋮
    | _patternN₁_, …, _patternNM_ := _resultN_
    `end`

`match` allows nonrecursive pattern matching within terms.

In contrast to pattern matching after `lemma` or `def`, the patterns are
separated by commas, so parentheses are optional. -/

def bcount {α : Type} (p : α → bool) : list α → ℕ
| []        := 0
| (x :: xs) :=
  match p x with
  | tt := bcount xs + 1
  | ff := bcount xs
  end

def min (a b : ℕ) : ℕ :=
if a ≤ b then a else b

/- ## Structures

Lean provides a convenient syntax for defining records, or structures. These are
essentially nonrecursive, single-constructor inductive types. -/

structure rgb :=
(red green blue : ℕ)

#check rgb.mk
#check rgb.red
#check rgb.green
#check rgb.blue

namespace rgb_as_inductive

inductive rgb : Type
| mk : ℕ → ℕ → ℕ → rgb

def rgb.red : rgb → ℕ
| (rgb.mk r _ _) := r

def rgb.green : rgb → ℕ
| (rgb.mk _ g _) := g

def rgb.blue : rgb → ℕ
| (rgb.mk _ _ b) := b

end rgb_as_inductive

structure rgba extends rgb :=
(alpha : ℕ)

#print rgba

def pure_red : rgb :=
{ red   := 0xff,
  green := 0x00,
  blue  := 0x00 }

def semitransparent_red : rgba :=
{ alpha := 0x7f,
  ..pure_red }

#print pure_red
#print semitransparent_red

def shuffle (c : rgb) : rgb :=
{ red   := rgb.green c,
  green := rgb.blue c,
  blue  := rgb.red c }

/- `cases'` performs a case distinction on the specified term. This gives rise
to as many subgoals as there are constructors in the definition of the term's
type. The tactic behaves the same as `induction'` except that it does not
produce induction hypotheses. -/

lemma shuffle_shuffle_shuffle (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
begin
  cases' c,
  refl
end

lemma shuffle_shuffle_shuffle₂ (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
match c with
| rgb.mk r g b := eq.refl _
end

/- ## Type Classes

A __type class__ is a structure type combining abstract constants and their
properties. A type can be declared an instance of a type class by providing
concrete definitions for the constants and proving that the properties hold.
Based on the type, Lean retrieves the relevant instance. -/

#print inhabited

@[instance] def nat.inhabited : inhabited ℕ :=
{ default := 0 }

@[instance] def list.inhabited {α : Type} :
  inhabited (list α) :=
{ default := [] }

#eval inhabited.default ℕ          -- result: 0
#eval inhabited.default (list ℤ)   -- result: []

def head {α : Type} [inhabited α] : list α → α
| []       := inhabited.default α
| (x :: _) := x

lemma head_head {α : Type} [inhabited α] (xs : list α) :
  head [head xs] = head xs :=
begin
  cases' xs,
  { refl },
  { refl }
end

#eval head ([] : list ℕ)   -- result: 0

#check list.head

@[instance] def fun.inhabited {α β : Type} [inhabited β] :
  inhabited (α → β) :=
{ default := λa : α, inhabited.default β }

inductive empty : Type

@[instance] def fun_empty.inhabited {β : Type} :
  inhabited (empty → β) :=
{ default := λa : empty, match a with end }

@[instance] def prod.inhabited {α β : Type}
    [inhabited α] [inhabited β] :
  inhabited (α × β) :=
{ default := (inhabited.default α, inhabited.default β) }

/- Here are other type classes without properties: -/

#check has_zero
#check has_neg
#check has_add
#check has_one
#check has_inv
#check has_mul

#check (1 : ℕ)
#check (1 : ℤ)
#check (1 : ℝ)

/- We encountered these type classes in lecture 2: -/

#print is_commutative
#print is_associative

/- ## Lists

`list` is an inductive polymorphic type constructed from `nil` and `cons`: -/

#print list

/- `cases'` can also be used on a hypothesis of the form `l = r`. It matches `r`
against `l` and replaces all occurrences of the variables occurring in `r` with
the corresponding terms in `l` everywhere in the goal. -/

lemma injection_example {α : Type} (x y : α) (xs ys : list α)
    (h : list.cons x xs = list.cons y ys) :
  x = y ∧ xs = ys :=
begin
  cases' h,
  cc
end

/- If `r` fails to match `l`, no subgoals emerge; the proof is complete. -/

lemma distinctness_example {α : Type} (y : α) (ys : list α)
    (h : [] = y :: ys) :
  false :=
by cases' h

def map {α β : Type} (f : α → β) : list α → list β
| []        := []
| (x :: xs) := f x :: map xs

def map₂ {α β : Type} : (α → β) → list α → list β
| _ []        := []
| f (x :: xs) := f x :: map₂ f xs

#check list.map

lemma map_ident {α : Type} (xs : list α) :
  map (λx, x) xs = xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ)
    (xs : list α) :
  map g (map f xs) = map (λx, g (f x)) xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_append {α β : Type} (f : α → β) (xs ys : list α) :
  map f (xs ++ ys) = map f xs ++ map f ys :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

def tail {α : Type} : list α → list α
| []        := []
| (_ :: xs) := xs

#check list.tail

def head_opt {α : Type} : list α → option α
| []       := option.none
| (x :: _) := option.some x

def head_le {α : Type} : ∀xs : list α, xs ≠ [] → α
| []       hxs := by cc
| (x :: _) _   := x

#eval head_opt [3, 1, 4]
#eval head_le [3, 1, 4] (by simp)
-- fails
#eval head_le ([] : list ℕ) sorry

def zip {α β : Type} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| []        _         := []
| (_ :: _)  []        := []

#check list.zip

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := length xs + 1

#check list.length

/- `cases'` can also be used to perform a case distinction on a proposition, in
conjunction with `classical.em`. Two cases emerge: one in which the proposition
is true and one in which it is false. -/

#check classical.em

lemma min_add_add (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
begin
  cases' classical.em (m ≤ n),
  case inl {
    simp [min, h] },
  case inr {
    simp [min, h] }
end

lemma min_add_add₂ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
match classical.em (m ≤ n) with
| or.inl h := by simp [min, h]
| or.inr h := by simp [min, h]
end

lemma min_add_add₃ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
if h : m ≤ n then
  by simp [min, h]
else
  by simp [min, h]

lemma length_zip {α β : Type} (xs : list α) (ys : list β) :
  length (zip xs ys) = min (length xs) (length ys) :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : x xs' {
    cases' ys,
    case nil {
      refl },
    case cons : y ys' {
      simp [zip, length, ih ys', min_add_add] } }
end

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys,
    map (λab : α × β, (f (prod.fst ab), g (prod.snd ab)))
      (zip xs ys) =
    zip (map f xs) (map g ys)
| (x :: xs) (y :: ys) := by simp [zip, map, map_zip xs ys]
| []        _         := by refl
| (_ :: _)  []        := by refl

/- ## Binary Trees

Inductive types with constructors taking several recursive arguments define
tree-like objects. __Binary trees__ have nodes with at most two children. -/

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

/- The type `aexp` of arithmetic expressions was also an example of a tree data
structure.

The nodes of a tree, whether inner nodes or leaf nodes, often carry labels or
other annotations.

Inductive trees contain no infinite branches, not even cycles. This is less
expressive than pointer- or reference-based data structures (in imperative
languages) but easier to reason about.

Recursive definitions (and proofs by induction) work roughly as for lists, but
we may need to recurse (or invoke the induction hypothesis) on several child
nodes. -/

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

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

lemma mirror_mirror₂ {α : Type} :
  ∀t : btree α, mirror (mirror t) = t
| btree.empty        := by refl
| (btree.node a l r) :=
  calc  mirror (mirror (btree.node a l r))
      = mirror (btree.node a (mirror r) (mirror l)) :
    by refl
  ... = btree.node a (mirror (mirror l)) (mirror (mirror r)) :
    by refl
  ... = btree.node a l (mirror (mirror r)) :
    by rw mirror_mirror₂ l
  ... = btree.node a l r :
    by rw mirror_mirror₂ r

lemma mirror_eq_empty_iff {α : Type} :
  ∀t : btree α, mirror t = btree.empty ↔ t = btree.empty
| btree.empty        := by refl
| (btree.node _ _ _) := by simp [mirror]

/- ## Dependent Inductive Types (**optional**) -/

#check vector

inductive vec (α : Type) : ℕ → Type
| nil {}                           : vec 0
| cons (a : α) {n : ℕ} (v : vec n) : vec (n + 1)

#check vec.nil
#check vec.cons

def list_of_vec {α : Type} : ∀{n : ℕ}, vec α n → list α
| _ vec.nil        := []
| _ (vec.cons a v) := a :: list_of_vec v

def vec_of_list {α : Type} :
  ∀xs : list α, vec α (list.length xs)
| []        := vec.nil
| (x :: xs) := vec.cons x (vec_of_list xs)

lemma length_list_of_vec {α : Type} :
  ∀{n : ℕ} (v : vec α n), list.length (list_of_vec v) = n
| _ vec.nil        := by refl
| _ (vec.cons a v) :=
  by simp [list_of_vec, length_list_of_vec v]

end LoVe