/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/

import data.polynomial.eval
import algebra.algebra.tower

/-!
# Theory of univariate polynomials

We show that `polynomial A` is an R-algebra when `A` is an R-algebra.
We promote `eval₂` to an algebra hom in `aeval`.
-/

noncomputable theory
open finset
open_locale big_operators

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ}

section comm_semiring
variables [comm_semiring R] {p q r : polynomial R}

variables [semiring A] [algebra R A]

/-- Note that this instance also provides `algebra R (polynomial R)`. -/
instance algebra_of_algebra : algebra R (polynomial A) := add_monoid_algebra.algebra

lemma algebra_map_apply (r : R) :
  algebra_map R (polynomial A) r = C (algebra_map R A r) :=
rfl

/--
When we have `[comm_ring R]`, the function `C` is the same as `algebra_map R (polynomial R)`.

(But note that `C` is defined when `R` is not necessarily commutative, in which case
`algebra_map` is not available.)
-/
lemma C_eq_algebra_map {R : Type*} [comm_ring R] (r : R) :
  C r = algebra_map R (polynomial R) r :=
rfl

instance [nontrivial A] : nontrivial (subalgebra R (polynomial A)) :=
⟨⟨⊥, ⊤, begin
  rw [ne.def, set_like.ext_iff, not_forall],
  refine ⟨X, _⟩,
  simp only [algebra.mem_bot, not_exists, set.mem_range, iff_true, algebra.mem_top,
    algebra_map_apply, not_forall],
  intro x,
  rw [ext_iff, not_forall],
  refine ⟨1, _⟩,
  simp [coeff_C],
end⟩⟩

@[simp]
lemma alg_hom_eval₂_algebra_map
  {R A B : Type*} [comm_ring R] [ring A] [ring B] [algebra R A] [algebra R B]
  (p : polynomial R) (f : A →ₐ[R] B) (a : A) :
  f (eval₂ (algebra_map R A) a p) = eval₂ (algebra_map R B) (f a) p :=
begin
  dsimp [eval₂, finsupp.sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast,
    alg_hom.commutes],
end

@[simp]
lemma eval₂_algebra_map_X {R A : Type*} [comm_ring R] [ring A] [algebra R A]
  (p : polynomial R) (f : polynomial R →ₐ[R] A) :
  eval₂ (algebra_map R A) (f X) p = f p :=
begin
  conv_rhs { rw [←polynomial.sum_C_mul_X_eq p], },
  dsimp [eval₂, finsupp.sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast],
  simp [polynomial.C_eq_algebra_map],
end

@[simp]
lemma ring_hom_eval₂_algebra_map_int {R S : Type*} [ring R] [ring S]
  (p : polynomial ℤ) (f : R →+* S) (r : R) :
  f (eval₂ (algebra_map ℤ R) r p) = eval₂ (algebra_map ℤ S) (f r) p :=
alg_hom_eval₂_algebra_map p f.to_int_alg_hom r

@[simp]
lemma eval₂_algebra_map_int_X {R : Type*} [ring R] (p : polynomial ℤ) (f : polynomial ℤ →+* R) :
  eval₂ (algebra_map ℤ R) (f X) p = f p :=
-- Unfortunately `f.to_int_alg_hom` doesn't work here, as typeclasses don't match up correctly.
eval₂_algebra_map_X p { commutes' := λ n, by simp, .. f }

end comm_semiring

section aeval
variables [comm_semiring R] {p q : polynomial R}

variables [semiring A] [algebra R A]
variables {B : Type*} [semiring B] [algebra R B]
variables (x : A)

/-- Given a valuation `x` of the variable in an `R`-algebra `A`, `aeval R A x` is
the unique `R`-algebra homomorphism from `R[X]` to `A` sending `X` to `x`. -/
def aeval : polynomial R →ₐ[R] A :=
{ commutes' := λ r, eval₂_C _ _,
  ..eval₂_ring_hom' (algebra_map R A) x (λ a, algebra.commutes _ _) }

variables {R A}

@[ext] lemma alg_hom_ext {f g : polynomial R →ₐ[R] A} (h : f X = g X) : f = g :=
by { ext, exact h }

theorem aeval_def (p : polynomial R) : aeval x p = eval₂ (algebra_map R A) x p := rfl

@[simp] lemma aeval_zero : aeval x (0 : polynomial R) = 0 :=
alg_hom.map_zero (aeval x)

@[simp] lemma aeval_X : aeval x (X : polynomial R) = x := eval₂_X _ x

@[simp] lemma aeval_C (r : R) : aeval x (C r) = algebra_map R A r := eval₂_C _ x

@[simp] lemma aeval_monomial {n : ℕ} {r : R} : aeval x (monomial n r) = (algebra_map _ _ r) * x^n :=
eval₂_monomial _ _

@[simp] lemma aeval_X_pow {n : ℕ} : aeval x ((X : polynomial R)^n) = x^n :=
eval₂_X_pow _ _

@[simp] lemma aeval_add : aeval x (p + q) = aeval x p + aeval x q :=
alg_hom.map_add _ _ _

@[simp] lemma aeval_one : aeval x (1 : polynomial R) = 1 :=
alg_hom.map_one _

@[simp] lemma aeval_bit0 : aeval x (bit0 p) = bit0 (aeval x p) :=
alg_hom.map_bit0 _ _

@[simp] lemma aeval_bit1 : aeval x (bit1 p) = bit1 (aeval x p) :=
alg_hom.map_bit1 _ _

@[simp] lemma aeval_nat_cast (n : ℕ) : aeval x (n : polynomial R) = n :=
alg_hom.map_nat_cast _ _

lemma aeval_mul : aeval x (p * q) = aeval x p * aeval x q :=
alg_hom.map_mul _ _ _

lemma aeval_comp {A : Type*} [comm_semiring A] [algebra R A] (x : A) :
  aeval x (p.comp q) = (aeval (aeval x q) p) :=
eval₂_comp (algebra_map R A)

@[simp] lemma aeval_map {A : Type*} [comm_semiring A] [algebra R A] [algebra A B]
  [is_scalar_tower R A B] (b : B) (p : polynomial R) :
  aeval b (p.map (algebra_map R A)) = aeval b p :=
by rw [aeval_def, eval₂_map, ←is_scalar_tower.algebra_map_eq, ←aeval_def]

theorem eval_unique (φ : polynomial R →ₐ[R] A) (p) :
  φ p = eval₂ (algebra_map R A) (φ X) p :=
begin
  apply polynomial.induction_on p,
  { intro r, rw eval₂_C, exact φ.commutes r },
  { intros f g ih1 ih2,
    rw [φ.map_add, ih1, ih2, eval₂_add] },
  { intros n r ih,
    rw [pow_succ', ← mul_assoc, φ.map_mul,
        eval₂_mul_noncomm (algebra_map R A) _ (λ k, algebra.commutes _ _), eval₂_X, ih] }
end

theorem aeval_alg_hom (f : A →ₐ[R] B) (x : A) : aeval (f x) = f.comp (aeval x) :=
alg_hom.ext $ λ p, by rw [eval_unique (f.comp (aeval x)), alg_hom.comp_apply, aeval_X, aeval_def]

lemma aeval_algebra_map_apply (x : R) (p : polynomial R) :
  aeval (algebra_map R A x) p = algebra_map R A (p.eval x) :=
aeval_alg_hom_apply (algebra.of_id R A) x p

@[simp] lemma coe_aeval_eq_eval (r : R) :
  (aeval r : polynomial R → R) = eval r := rfl

@[simp] lemma aeval_fn_apply {X : Type*} (g : polynomial R) (f : X → R) (x : X) :
  ((aeval f) g) x = aeval (f x) g :=
(aeval_alg_hom_apply (pi.alg_hom.apply _ _ _ x) f g).symm

@[norm_cast] lemma aeval_subalgebra_coe
  (g : polynomial R) {A : Type*} [semiring A] [algebra R A] (s : subalgebra R A) (f : s) :
  (aeval f g : A) = aeval (f : A) g :=
(aeval_alg_hom_apply s.val f g).symm

lemma coeff_zero_eq_aeval_zero (p : polynomial R) : p.coeff 0 = aeval 0 p :=
by simp [coeff_zero_eq_eval_zero]

variables [comm_ring S] {f : R →+* S}

lemma is_root_of_eval₂_map_eq_zero
  (hf : function.injective f) {r : R} : eval₂ f (f r) p = 0 → p.is_root r :=
begin
  intro h,
  apply hf,
  rw [←eval₂_hom, h, f.map_zero],
end

lemma is_root_of_aeval_algebra_map_eq_zero [algebra R S] {p : polynomial R}
  (inj : function.injective (algebra_map R S))
  {r : R} (hr : aeval (algebra_map R S r) p = 0) : p.is_root r :=
is_root_of_eval₂_map_eq_zero inj hr

lemma dvd_term_of_dvd_eval_of_dvd_terms {z p : S} {f : polynomial S} (i : ℕ)
  (dvd_eval : p ∣ f.eval z) (dvd_terms : ∀ (j ≠ i), p ∣ f.coeff j * z ^ j) :
  p ∣ f.coeff i * z ^ i :=
begin
  by_cases hf : f = 0,
  { simp [hf] },
  by_cases hi : i ∈ f.support,
  { rw [eval, eval₂, sum_def] at dvd_eval,
    rw [←finset.insert_erase hi, finset.sum_insert (finset.not_mem_erase _ _)] at dvd_eval,
    refine (dvd_add_left _).mp dvd_eval,
    apply finset.dvd_sum,
    intros j hj,
    exact dvd_terms j (finset.ne_of_mem_erase hj) },
  { convert dvd_zero p,
    convert _root_.zero_mul _,
    exact finsupp.not_mem_support_iff.mp hi }
end

lemma dvd_term_of_is_root_of_dvd_terms {r p : S} {f : polynomial S} (i : ℕ)
  (hr : f.is_root r) (h : ∀ (j ≠ i), p ∣ f.coeff j * r ^ j) : p ∣ f.coeff i * r ^ i :=
dvd_term_of_dvd_eval_of_dvd_terms i (eq.symm hr ▸ dvd_zero p) h

lemma aeval_eq_sum_range [algebra R S] {p : polynomial R} (x : S) :
  aeval x p = ∑ i in finset.range (p.nat_degree + 1), p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range (algebra_map R S) x }

lemma aeval_eq_sum_range' [algebra R S] {p : polynomial R} {n : ℕ} (hn : p.nat_degree < n) (x : S) :
  aeval x p = ∑ i in finset.range n, p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range' (algebra_map R S) hn x }

end aeval

section ring
variables [ring R]

/--
The evaluation map is not generally multiplicative when the coefficient ring is noncommutative,
but nevertheless any polynomial of the form `p * (X - monomial 0 r)` is sent to zero
when evaluated at `r`.

This is the key step in our proof of the Cayley-Hamilton theorem.
-/
lemma eval_mul_X_sub_C {p : polynomial R} (r : R) :
  (p * (X - C r)).eval r = 0 :=
begin
  simp only [eval, eval₂, ring_hom.id_apply],
  have bound := calc
    (p * (X - C r)).nat_degree
         ≤ p.nat_degree + (X - C r).nat_degree : nat_degree_mul_le
     ... ≤ p.nat_degree + 1 : add_le_add_left nat_degree_X_sub_C_le _
     ... < p.nat_degree + 2 : lt_add_one _,
  rw sum_over_range' _ _ (p.nat_degree + 2) bound,
  swap,
  { simp, },
  rw sum_range_succ',
  conv_lhs {
    congr, apply_congr, skip,
    rw [coeff_mul_X_sub_C, sub_mul, mul_assoc, ←pow_succ],
  },
  simp [sum_range_sub', coeff_monomial],
end

theorem not_is_unit_X_sub_C [nontrivial R] {r : R} : ¬ is_unit (X - C r) :=
λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ by erw [← eval_mul_X_sub_C, hgf, eval_one]

end ring

lemma aeval_endomorphism {M : Type*}
  [comm_ring R] [add_comm_group M] [module R M]
  (f : M →ₗ[R] M) (v : M) (p : polynomial R) :
  aeval f p v = p.sum (λ n b, b • (f ^ n) v) :=
begin
  rw [aeval_def, eval₂],
  exact (finset.sum_hom p.support (λ h : M →ₗ[R] M, h v)).symm
end

end polynomial


import data.real.basic

lemma real.bcsupr_le {ι : Type*} {f : ι → ℝ} {s : set ι} {t : ℝ} (ht : 0 ≤ t)
  (h : ∀ i ∈ s, f i ≤ t) : (⨆ i ∈ s, f i) ≤ t :=
begin
  cases is_empty_or_nonempty ι with hι hι; resetI,
  { simp_rw [real.csupr_empty, ht] },
  refine csupr_le (λ i, _),
  cases is_empty_or_nonempty (i ∈ s) with hi hi; resetI,
  { simp_rw [real.csupr_empty, ht] },
  refine csupr_le (λ hi, h i hi),
end

lemma real.bcsupr_nonneg {ι : Type*} {f : ι → ℝ} {s : set ι} (h : ∀ i ∈ s, 0 ≤ f i) :
  0 ≤ (⨆ i ∈ s, f i) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hs,
  { simp [real.csupr_empty] },
  cases hs with i hi,
  by_cases h1s : bdd_above (set.range (λ i, ⨆ (H : i ∈ s), f i)),
  { refine le_trans _ (le_csupr h1s i),
    by_cases h2s : bdd_above (set.range (λ (hi : i ∈ s), f i)),
    refine (h i hi).trans (le_csupr h2s hi),
    exact (real.Sup_of_not_bdd_above h2s).symm.le },
  exact (real.Sup_of_not_bdd_above h1s).symm.le
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import analysis.convex.combination
import linear_algebra.affine_space.independent
import tactic.field_simp

/-!
# Carathéodory's convexity theorem

Convex hull can be regarded as a refinement of affine span. Both are closure operators but whereas
convex hull takes values in the lattice of convex subsets, affine span takes values in the much
coarser sublattice of affine subspaces.

The cost of this refinement is that one no longer has bases. However Carathéodory's convexity
theorem offers some compensation. Given a set `s` together with a point `x` in its convex hull,
Carathéodory says that one may find an affine-independent family of elements `s` whose convex hull
contains `x`. Thus the difference from the case of affine span is that the affine-independent family
depends on `x`.

In particular, in finite dimensions Carathéodory's theorem implies that the convex hull of a set `s`
in `𝕜ᵈ` is the union of the convex hulls of the `(d + 1)`-tuples in `s`.

## Main results

* `convex_hull_eq_union`: Carathéodory's convexity theorem

## Implementation details

This theorem was formalized as part of the Sphere Eversion project.

## Tags
convex hull, caratheodory

-/

open set finset
open_locale big_operators

universes u
variables {𝕜 : Type*} {E : Type u} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E]

namespace caratheodory

/-- If `x` is in the convex hull of some finset `t` whose elements are not affine-independent,
then it is in the convex hull of a strict subset of `t`. -/

variables {s : set E} {x : E} (hx : x ∈ convex_hull 𝕜 s)
include hx

/-- Given a point `x` in the convex hull of a set `s`, this is a finite subset of `s` of minimum
cardinality, whose convex hull contains `x`. -/
noncomputable def min_card_finset_of_mem_convex_hull : finset E :=
function.argmin_on finset.card nat.lt_wf { t | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) }
(by simpa only [convex_hull_eq_union_convex_hull_finite_subsets s, exists_prop, mem_Union] using hx)

lemma min_card_finset_of_mem_convex_hull_subseteq : ↑(min_card_finset_of_mem_convex_hull hx) ⊆ s :=
(function.argmin_on_mem _ _ { t : finset E | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) } _).1

lemma mem_min_card_finset_of_mem_convex_hull :
  x ∈ convex_hull 𝕜 (min_card_finset_of_mem_convex_hull hx : set E) :=
(function.argmin_on_mem _ _ { t : finset E | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) } _).2

lemma min_card_finset_of_mem_convex_hull_nonempty :
  (min_card_finset_of_mem_convex_hull hx).nonempty :=
begin
  rw [← finset.coe_nonempty, ← @convex_hull_nonempty_iff 𝕜],
  exact ⟨x, mem_min_card_finset_of_mem_convex_hull hx⟩,
end

lemma min_card_finset_of_mem_convex_hull_card_le_card
  {t : finset E} (ht₁ : ↑t ⊆ s) (ht₂ : x ∈ convex_hull 𝕜 (t : set E)) :
  (min_card_finset_of_mem_convex_hull hx).card ≤ t.card :=
function.argmin_on_le _ _ _ ⟨ht₁, ht₂⟩

lemma affine_independent_min_card_finset_of_mem_convex_hull :
  affine_independent 𝕜 (coe : min_card_finset_of_mem_convex_hull hx → E) :=
begin
  let k := (min_card_finset_of_mem_convex_hull hx).card - 1,
  have hk : (min_card_finset_of_mem_convex_hull hx).card = k + 1,
  { exact (nat.succ_pred_eq_of_pos
      (finset.card_pos.mpr (min_card_finset_of_mem_convex_hull_nonempty hx))).symm },
  classical,
  by_contra,
  obtain ⟨p, hp⟩ := mem_convex_hull_erase h (mem_min_card_finset_of_mem_convex_hull hx),
  have contra := min_card_finset_of_mem_convex_hull_card_le_card hx (set.subset.trans
    (finset.erase_subset ↑p (min_card_finset_of_mem_convex_hull hx))
    (min_card_finset_of_mem_convex_hull_subseteq hx)) hp,
  rw [← not_lt] at contra,
  apply contra,
  erw [card_erase_of_mem p.2, hk],
  exact lt_add_one _,
end

end caratheodory

variables {s : set E}

/-- **Carathéodory's convexity theorem** -/
lemma convex_hull_eq_union :
  convex_hull 𝕜 s =
  ⋃ (t : finset E) (hss : ↑t ⊆ s) (hai : affine_independent 𝕜 (coe : t → E)), convex_hull 𝕜 ↑t :=
begin
  apply set.subset.antisymm,
  { intros x hx,
    simp only [exists_prop, set.mem_Union],
    exact ⟨caratheodory.min_card_finset_of_mem_convex_hull hx,
           caratheodory.min_card_finset_of_mem_convex_hull_subseteq hx,
           caratheodory.affine_independent_min_card_finset_of_mem_convex_hull hx,
           caratheodory.mem_min_card_finset_of_mem_convex_hull hx⟩ },
  { iterate 3 { convert set.Union_subset _, intro },
    exact convex_hull_mono ‹_› }
end

/-- A more explicit version of `convex_hull_eq_union`. -/
theorem eq_pos_convex_span_of_mem_convex_hull {x : E} (hx : x ∈ convex_hull 𝕜 s) :
  ∃ (ι : Sort (u+1)) (_ : fintype ι), by exactI ∃ (z : ι → E) (w : ι → 𝕜)
    (hss : set.range z ⊆ s) (hai : affine_independent 𝕜 z)
    (hw : ∀ i, 0 < w i), ∑ i, w i = 1 ∧ ∑ i, w i • z i = x :=
begin
  rw convex_hull_eq_union at hx,
  simp only [exists_prop, set.mem_Union] at hx,
  obtain ⟨t, ht₁, ht₂, ht₃⟩ := hx,
  simp only [t.convex_hull_eq, exists_prop, set.mem_set_of_eq] at ht₃,
  obtain ⟨w, hw₁, hw₂, hw₃⟩ := ht₃,
  let t' := t.filter (λ i, w i ≠ 0),
  refine ⟨t', t'.fintype_coe_sort, (coe : t' → E), w ∘ (coe : t' → E), _, _, _, _, _⟩,
  { rw subtype.range_coe_subtype, exact subset.trans (finset.filter_subset _ t) ht₁ },
  { exact ht₂.comp_embedding
      ⟨_, inclusion_injective (finset.filter_subset (λ i, w i ≠ 0) t)⟩ },
  { exact λ i, (hw₁ _ (finset.mem_filter.mp i.2).1).lt_of_ne
      (finset.mem_filter.mp i.property).2.symm },
  { erw [finset.sum_attach, finset.sum_filter_ne_zero, hw₂] },
  { change ∑ (i : t') in t'.attach, (λ e, w e • e) ↑i = x,
    erw [finset.sum_attach, finset.sum_filter_of_ne],
    { rw t.center_mass_eq_of_sum_1 id hw₂ at hw₃, exact hw₃ },
    { intros e he hwe contra, apply hwe, rw [contra, zero_smul] } }
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.calculus.inverse
import analysis.complex.real_deriv
import analysis.special_functions.exp

/-!
# Complex and real exponential

In this file we prove that `complex.exp` and `real.exp` are infinitely smooth functions.

## Tags

exp, derivative
-/

noncomputable theory

open filter asymptotics set function
open_locale classical topology

namespace complex
variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ]

/-- The complex exponential is everywhere differentiable, with the derivative `exp x`. -/
lemma has_deriv_at_exp (x : ℂ) : has_deriv_at exp (exp x) x :=
begin
  rw has_deriv_at_iff_is_o_nhds_zero,
  have : (1 : ℕ) < 2 := by norm_num,
  refine (is_O.of_bound (‖exp x‖) _).trans_is_o (is_o_pow_id this),
  filter_upwards [metric.ball_mem_nhds (0 : ℂ) zero_lt_one],
  simp only [metric.mem_ball, dist_zero_right, norm_pow],
  exact λ z hz, exp_bound_sq x z hz.le,
end

lemma differentiable_exp : differentiable 𝕜 exp :=
λ x, (has_deriv_at_exp x).differentiable_at.restrict_scalars 𝕜

lemma differentiable_at_exp {x : ℂ} : differentiable_at 𝕜 exp x :=
differentiable_exp x

@[simp] lemma deriv_exp : deriv exp = exp :=
funext $ λ x, (has_deriv_at_exp x).deriv

@[simp] lemma iter_deriv_exp : ∀ n : ℕ, (deriv^[n] exp) = exp
| 0 := rfl
| (n+1) := by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]

lemma cont_diff_exp : ∀ {n}, cont_diff 𝕜 n exp :=
begin
  refine cont_diff_all_iff_nat.2 (λ n, _),
  have : cont_diff ℂ ↑n exp,
  { induction n with n ihn,
    { exact cont_diff_zero.2 continuous_exp },
    { rw cont_diff_succ_iff_deriv,
      use differentiable_exp,
      rwa deriv_exp }, },
  exact this.restrict_scalars 𝕜
end

lemma has_strict_deriv_at_exp (x : ℂ) : has_strict_deriv_at exp (exp x) x :=
cont_diff_exp.cont_diff_at.has_strict_deriv_at' (has_deriv_at_exp x) le_rfl

lemma has_strict_fderiv_at_exp_real (x : ℂ) :
  has_strict_fderiv_at exp (exp x • (1 : ℂ →L[ℝ] ℂ)) x :=
(has_strict_deriv_at_exp x).complex_to_real_fderiv

lemma is_open_map_exp : is_open_map exp :=
open_map_of_strict_deriv has_strict_deriv_at_exp exp_ne_zero

end complex

section
variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ]
  {f : 𝕜 → ℂ} {f' : ℂ} {x : 𝕜} {s : set 𝕜}

lemma has_strict_deriv_at.cexp (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') x :=
(complex.has_strict_deriv_at_exp (f x)).comp x hf

lemma has_deriv_at.cexp (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') x :=
(complex.has_deriv_at_exp (f x)).comp x hf

lemma has_deriv_within_at.cexp (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') s x :=
(complex.has_deriv_at_exp (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cexp (hf : differentiable_within_at 𝕜 f s x)
  (hxs : unique_diff_within_at 𝕜 s x) :
  deriv_within (λ x, complex.exp (f x)) s x = complex.exp (f x) * deriv_within f s x :=
hf.has_deriv_within_at.cexp.deriv_within hxs

@[simp] lemma deriv_cexp (hc : differentiable_at 𝕜 f x) :
  deriv (λ x, complex.exp (f x)) x = complex.exp (f x) * deriv f x :=
hc.has_deriv_at.cexp.deriv

end

section
variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {f : E → ℂ} {f' : E →L[𝕜] ℂ}
  {x : E} {s : set E}

lemma has_strict_fderiv_at.cexp (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') x :=
(complex.has_strict_deriv_at_exp (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_within_at.cexp (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') s x :=
(complex.has_deriv_at_exp (f x)).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.cexp (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') x :=
has_fderiv_within_at_univ.1 $ hf.has_fderiv_within_at.cexp

lemma differentiable_within_at.cexp (hf : differentiable_within_at 𝕜 f s x) :
  differentiable_within_at 𝕜 (λ x, complex.exp (f x)) s x :=
hf.has_fderiv_within_at.cexp.differentiable_within_at

@[simp] lemma differentiable_at.cexp (hc : differentiable_at 𝕜 f x) :
  differentiable_at 𝕜 (λ x, complex.exp (f x)) x :=
hc.has_fderiv_at.cexp.differentiable_at

lemma differentiable_on.cexp (hc : differentiable_on 𝕜 f s) :
  differentiable_on 𝕜 (λ x, complex.exp (f x)) s :=
λ x h, (hc x h).cexp

@[simp] lemma differentiable.cexp (hc : differentiable 𝕜 f) :
  differentiable 𝕜 (λ x, complex.exp (f x)) :=
λ x, (hc x).cexp

lemma cont_diff.cexp {n} (h : cont_diff 𝕜 n f) :
  cont_diff 𝕜 n (λ x, complex.exp (f x)) :=
complex.cont_diff_exp.comp h

lemma cont_diff_at.cexp {n} (hf : cont_diff_at 𝕜 n f x) :
  cont_diff_at 𝕜 n (λ x, complex.exp (f x)) x :=
complex.cont_diff_exp.cont_diff_at.comp x hf

lemma cont_diff_on.cexp {n} (hf : cont_diff_on 𝕜 n f s) :
  cont_diff_on 𝕜 n (λ x, complex.exp (f x)) s :=
complex.cont_diff_exp.comp_cont_diff_on hf

lemma cont_diff_within_at.cexp {n} (hf : cont_diff_within_at 𝕜 n f s x) :
  cont_diff_within_at 𝕜 n (λ x, complex.exp (f x)) s x :=
complex.cont_diff_exp.cont_diff_at.comp_cont_diff_within_at x hf

end

namespace real

variables {x y z : ℝ}

lemma has_strict_deriv_at_exp (x : ℝ) : has_strict_deriv_at exp (exp x) x :=
(complex.has_strict_deriv_at_exp x).real_of_complex

lemma has_deriv_at_exp (x : ℝ) : has_deriv_at exp (exp x) x :=
(complex.has_deriv_at_exp x).real_of_complex

lemma cont_diff_exp {n} : cont_diff ℝ n exp :=
complex.cont_diff_exp.real_of_complex

lemma differentiable_exp : differentiable ℝ exp :=
λx, (has_deriv_at_exp x).differentiable_at

lemma differentiable_at_exp : differentiable_at ℝ exp x :=
differentiable_exp x

@[simp] lemma deriv_exp : deriv exp = exp :=
funext $ λ x, (has_deriv_at_exp x).deriv

@[simp] lemma iter_deriv_exp : ∀ n : ℕ, (deriv^[n] exp) = exp
| 0 := rfl
| (n+1) := by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]

end real

section
/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variables {f : ℝ → ℝ} {f' x : ℝ} {s : set ℝ}

lemma has_strict_deriv_at.exp (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.exp (f x)) (real.exp (f x) * f') x :=
(real.has_strict_deriv_at_exp (f x)).comp x hf

lemma has_deriv_at.exp (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.exp (f x)) (real.exp (f x) * f') x :=
(real.has_deriv_at_exp (f x)).comp x hf

lemma has_deriv_within_at.exp (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.exp (f x)) (real.exp (f x) * f') s x :=
(real.has_deriv_at_exp (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_exp (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.exp (f x)) s x = real.exp (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.exp.deriv_within hxs

@[simp] lemma deriv_exp (hc : differentiable_at ℝ f x) :
  deriv (λx, real.exp (f x)) x = real.exp (f x) * (deriv f x) :=
hc.has_deriv_at.exp.deriv

end

section
/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ}
  {x : E} {s : set E}

lemma cont_diff.exp {n} (hf : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, real.exp (f x)) :=
real.cont_diff_exp.comp hf

lemma cont_diff_at.exp {n} (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ x, real.exp (f x)) x :=
real.cont_diff_exp.cont_diff_at.comp x hf

lemma cont_diff_on.exp {n} (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ x, real.exp (f x)) s :=
real.cont_diff_exp.comp_cont_diff_on  hf

lemma cont_diff_within_at.exp {n} (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ x, real.exp (f x)) s x :=
real.cont_diff_exp.cont_diff_at.comp_cont_diff_within_at x hf

lemma has_fderiv_within_at.exp (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.exp (f x)) (real.exp (f x) • f') s x :=
(real.has_deriv_at_exp (f x)).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.exp (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.exp (f x)) (real.exp (f x) • f') x :=
(real.has_deriv_at_exp (f x)).comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.exp (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.exp (f x)) (real.exp (f x) • f') x :=
(real.has_strict_deriv_at_exp (f x)).comp_has_strict_fderiv_at x hf

lemma differentiable_within_at.exp (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.exp (f x)) s x :=
hf.has_fderiv_within_at.exp.differentiable_within_at

@[simp] lemma differentiable_at.exp (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.exp (f x)) x :=
hc.has_fderiv_at.exp.differentiable_at

lemma differentiable_on.exp (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.exp (f x)) s :=
λ x h, (hc x h).exp

@[simp] lemma differentiable.exp (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.exp (f x)) :=
λ x, (hc x).exp

lemma fderiv_within_exp (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.exp (f x)) s x = real.exp (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.exp.fderiv_within hxs

@[simp] lemma fderiv_exp (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.exp (f x)) x = real.exp (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.exp.fderiv

end


-- for simplicity, you can imagine that `T : Type` means `T` is a set
-- and that `S : set T` means `S ⊆ T`

-- we define when a function ` f : X → Y ` is surjective
def surjectiv {X : Type} {Y : Type} (f : X → Y) := ∀ y : Y, ∃ x : X, f x = y

-- we state the Cantor's theorem as a non-existence of a surjective function from a set to its powerset
theorem Cantor_diag {T : Type} : ¬ ∃ g : T → (set T), surjectiv g :=
-- here comes the proof
begin
  intro ass,                              -- gives ` ass : ∃ (g : T → set T), surjectiv g `
                                          -- and tranforms the goal into ` false `
                                          -- because `intro` first unwraps `¬Q` into `Q → false`
                                          -- (definition of negation in Lean), then it saves `Q` into `ass`

  cases ass with g surj,                  -- gives ` g : T → set T ` and ` surj : surjectiv g `
  specialize surj (λ t : T, ¬ (g t t)),   -- gives ` surj: ∃ (x : T), g x = λ (t : T), ¬g t t `
  cases surj with x surje,                -- gives ` x : T ` (fixes the element provided by the existential quantifier)
                                          -- and ` surje: g x = λ (t : T), ¬g t t ` as open formula

  -- since `set T` is defined as `T → Prop`,
  -- we can treat `surje` as a claim about equality between two sets
  -- (you can imagine `Prop` as if it was `Bool`)
  -- the first set is defined by the now-fixed term ` g x `
  -- the second set is defined by the lambda expression ` λ (t : T), ¬g t t `
  -- i.e., the set of values (of the type `T`) that are not contained in their `g`-image

  have paradox: g x x = ¬ (g x x),        -- now we claim equality of these two concrete terms
    exact congr_fun surje x,              -- which is obtained by plugging `x` into `surje`
                                          -- i.e., by asking whether `x ∈ (g x)` and dtto for the second set (assumed to be equal)
                                          -- in set theory, we would say { A=B implies z∈A ↔ z∈B }
                                          -- here, in type theory, sets are modelled by functions, and so,
                                          -- we call `congr_fun` which implements the rule { A=B implies (A z) ↔ (B z) }
                                          -- for `A,B : T → Prop` in our pseudo-code formula above
  exact false_of_a_eq_not_a paradox,      -- we finish by calling a technical lemma that concludes `false` from `p = ¬p`

  -- finally, the interactive windows now displays "goals accomplished"; we are done
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import ring_theory.algebra_tower
import linear_algebra.matrix.finite_dimensional
import linear_algebra.matrix.to_lin

/-!
# Tower of field extensions

In this file we prove the tower law for arbitrary extensions and finite extensions.
Suppose `L` is a field extension of `K` and `K` is a field extension of `F`.
Then `[L:F] = [L:K] [K:F]` where `[E₁:E₂]` means the `E₂`-dimension of `E₁`.

In fact we generalize it to vector spaces, where `L` is not necessarily a field,
but just a vector space over `K`.

## Implementation notes

We prove two versions, since there are two notions of dimensions: `module.rank` which gives
the dimension of an arbitrary vector space as a cardinal, and `finite_dimensional.finrank` which
gives the dimension of a finitely-dimensional vector space as a natural number.

## Tags

tower law

-/

universes u v w u₁ v₁ w₁
open_locale classical big_operators

section field

open cardinal

variables (F : Type u) (K : Type v) (A : Type w)
variables [field F] [field K] [add_comm_group A]
variables [algebra F K] [module K A] [module F A] [is_scalar_tower F K A]

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim' :
  (cardinal.lift.{w} (module.rank F K) * cardinal.lift.{v} (module.rank K A)) =
  cardinal.lift.{v} (module.rank F A) :=
let b := basis.of_vector_space F K, c := basis.of_vector_space K A in
by rw [← (module.rank F K).lift_id, ← b.mk_eq_dim,
    ← (module.rank K A).lift_id, ← c.mk_eq_dim,
    ← lift_umax.{w v}, ← (b.smul c).mk_eq_dim, mk_prod, lift_mul,
    lift_lift, lift_lift, lift_lift, lift_lift, lift_umax]

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim (F : Type u) (K A : Type v) [field F] [field K] [add_comm_group A]
  [algebra F K] [module K A] [module F A] [is_scalar_tower F K A] :
  module.rank F K * module.rank K A = module.rank F A :=
by convert dim_mul_dim' F K A; rw lift_id

namespace finite_dimensional

open is_noetherian

theorem trans [finite_dimensional F K] [finite_dimensional K A] : finite_dimensional F A :=
let b := basis.of_vector_space F K, c := basis.of_vector_space K A in
of_fintype_basis $ b.smul c

lemma right [hf : finite_dimensional F A] : finite_dimensional K A :=
let ⟨⟨b, hb⟩⟩ := hf in ⟨⟨b, submodule.restrict_scalars_injective F _ _ $
by { rw [submodule.restrict_scalars_top, eq_top_iff, ← hb, submodule.span_le],
  exact submodule.subset_span }⟩⟩

/-- Tower law: if `A` is a `K`-algebra and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem finrank_mul_finrank [finite_dimensional F K] :
  finrank F K * finrank K A = finrank F A :=
begin
  by_cases hA : finite_dimensional K A,
  { resetI,
    let b := basis.of_vector_space F K,
    let c := basis.of_vector_space K A,
    rw [finrank_eq_card_basis b, finrank_eq_card_basis c,
      finrank_eq_card_basis (b.smul c), fintype.card_prod] },
  { rw [finrank_of_infinite_dimensional hA, mul_zero, finrank_of_infinite_dimensional],
    exact mt (@right F K A _ _ _ _ _ _ _) hA }
end

instance linear_map (F : Type u) (V : Type v) (W : Type w)
  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
  [finite_dimensional F V] [finite_dimensional F W] :
  finite_dimensional F (V →ₗ[F] W) :=
let b := basis.of_vector_space F V, c := basis.of_vector_space F W in
(matrix.to_lin b c).finite_dimensional

lemma finrank_linear_map (F : Type u) (V : Type v) (W : Type w)
  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
  [finite_dimensional F V] [finite_dimensional F W] :
  finrank F (V →ₗ[F] W) = finrank F V * finrank F W :=
  let b := basis.of_vector_space F V, c := basis.of_vector_space F W in
by rw [linear_equiv.finrank_eq (linear_map.to_matrix b c), matrix.finrank_matrix,
      finrank_eq_card_basis b, finrank_eq_card_basis c, mul_comm]

-- TODO: generalize by removing [finite_dimensional F K]
-- V = ⊕F,
-- (V →ₗ[F] K) = ((⊕F) →ₗ[F] K) = (⊕ (F →ₗ[F] K)) = ⊕K
instance linear_map' (F : Type u) (K : Type v) (V : Type w)
  [field F] [field K] [algebra F K] [finite_dimensional F K]
  [add_comm_group V] [module F V] [finite_dimensional F V] :
  finite_dimensional K (V →ₗ[F] K) :=
right F _ _

lemma finrank_linear_map' (F : Type u) (K : Type v) (V : Type w)
  [field F] [field K] [algebra F K] [finite_dimensional F K]
  [add_comm_group V] [module F V] [finite_dimensional F V] :
  finrank K (V →ₗ[F] K) = finrank F V :=
(nat.mul_right_inj $ show 0 < finrank F K, from finrank_pos).1 $
calc  finrank F K * finrank K (V →ₗ[F] K)
    = finrank F (V →ₗ[F] K) : finrank_mul_finrank _ _ _
... = finrank F V * finrank F K : finrank_linear_map F V K
... = finrank F K * finrank F V : mul_comm _ _

end finite_dimensional

end field


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

! This file was ported from Lean 3 source module set_theory.cardinal.finite
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.ZMod.Defs
import Mathlib.SetTheory.Cardinal.Basic

/-!
# Finite Cardinality Functions

## Main Definitions

* `Nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `Nat.card α = 0`.
* `PartENat.card α` is the cardinality of `α` as an extended natural number
  (Part ℕ` implementation). If `α` is infinite, `PartENat.card α = ⊤`.
-/

open Cardinal

noncomputable section

open BigOperators

variable {α β : Type _}

namespace Nat

/-- `Nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `Nat.card α = 0`. -/
protected def card (α : Type _) : ℕ :=
  toNat (mk α)
#align nat.card Nat.card

@[simp]
theorem card_eq_fintype_card [Fintype α] : Nat.card α = Fintype.card α :=
  mk_toNat_eq_card
#align nat.card_eq_fintype_card Nat.card_eq_fintype_card

@[simp]
theorem card_eq_zero_of_infinite [Infinite α] : Nat.card α = 0 :=
  mk_toNat_of_infinite
#align nat.card_eq_zero_of_infinite Nat.card_eq_zero_of_infinite

theorem finite_of_card_ne_zero (h : Nat.card α ≠ 0) : Finite α :=
  not_infinite_iff_finite.mp <| h ∘ @Nat.card_eq_zero_of_infinite α
#align nat.finite_of_card_ne_zero Nat.finite_of_card_ne_zero

theorem card_congr (f : α ≃ β) : Nat.card α = Nat.card β :=
  Cardinal.toNat_congr f
#align nat.card_congr Nat.card_congr

theorem card_eq_of_bijective (f : α → β) (hf : Function.Bijective f) : Nat.card α = Nat.card β :=
  card_congr (Equiv.ofBijective f hf)
#align nat.card_eq_of_bijective Nat.card_eq_of_bijective

theorem card_eq_of_equiv_fin {α : Type _} {n : ℕ} (f : α ≃ Fin n) : Nat.card α = n := by
  simpa only [card_eq_fintype_card, Fintype.card_fin] using card_congr f
#align nat.card_eq_of_equiv_fin Nat.card_eq_of_equiv_fin

/-- If the cardinality is positive, that means it is a finite type, so there is
an equivalence between `α` and `Fin (Nat.card α)`. See also `Finite.equivFin`. -/
def equivFinOfCardPos {α : Type _} (h : Nat.card α ≠ 0) : α ≃ Fin (Nat.card α) := by
  cases fintypeOrInfinite α
  · simpa only [card_eq_fintype_card] using Fintype.equivFin α
  · simp only [card_eq_zero_of_infinite, ne_eq] at h
#align nat.equiv_fin_of_card_pos Nat.equivFinOfCardPos

theorem card_of_subsingleton (a : α) [Subsingleton α] : Nat.card α = 1 := by
  letI := Fintype.ofSubsingleton a
  rw [card_eq_fintype_card, Fintype.card_ofSubsingleton a]
#align nat.card_of_subsingleton Nat.card_of_subsingleton

-- @[simp] -- Porting note: simp can prove this
theorem card_unique [Unique α] : Nat.card α = 1 :=
  card_of_subsingleton default
#align nat.card_unique Nat.card_unique

theorem card_eq_one_iff_unique : Nat.card α = 1 ↔ Subsingleton α ∧ Nonempty α :=
  Cardinal.toNat_eq_one_iff_unique
#align nat.card_eq_one_iff_unique Nat.card_eq_one_iff_unique

theorem card_eq_two_iff : Nat.card α = 2 ↔ ∃ x y : α, x ≠ y ∧ {x, y} = @Set.univ α :=
  (toNat_eq_iff two_ne_zero).trans <| Iff.trans (by rw [Nat.cast_two]) mk_eq_two_iff
#align nat.card_eq_two_iff Nat.card_eq_two_iff

theorem card_eq_two_iff' (x : α) : Nat.card α = 2 ↔ ∃! y, y ≠ x :=
  (toNat_eq_iff two_ne_zero).trans <| Iff.trans (by rw [Nat.cast_two]) (mk_eq_two_iff' x)
#align nat.card_eq_two_iff' Nat.card_eq_two_iff'

theorem card_of_isEmpty [IsEmpty α] : Nat.card α = 0 := by simp
#align nat.card_of_is_empty Nat.card_of_isEmpty

@[simp]
theorem card_prod (α β : Type _) : Nat.card (α × β) = Nat.card α * Nat.card β := by
  simp only [Nat.card, mk_prod, toNat_mul, toNat_lift]
#align nat.card_prod Nat.card_prod

@[simp]
theorem card_uLift (α : Type _) : Nat.card (ULift α) = Nat.card α :=
  card_congr Equiv.ulift
#align nat.card_ulift Nat.card_uLift

@[simp]
theorem card_pLift (α : Type _) : Nat.card (PLift α) = Nat.card α :=
  card_congr Equiv.plift
#align nat.card_plift Nat.card_pLift

theorem card_pi {β : α → Type _} [Fintype α] : Nat.card (∀ a, β a) = ∏ a, Nat.card (β a) := by
  simp_rw [Nat.card, mk_pi, prod_eq_of_fintype, toNat_lift, toNat_finset_prod]
#align nat.card_pi Nat.card_pi

theorem card_fun [Finite α] : Nat.card (α → β) = Nat.card β ^ Nat.card α := by
  haveI := Fintype.ofFinite α
  rw [Nat.card_pi, Finset.prod_const, Finset.card_univ, ← Nat.card_eq_fintype_card]
#align nat.card_fun Nat.card_fun

@[simp]
theorem card_zMod (n : ℕ) : Nat.card (ZMod n) = n := by
  cases n
  · exact @Nat.card_eq_zero_of_infinite _ Int.infinite
  · rw [Nat.card_eq_fintype_card, ZMod.card]
#align nat.card_zmod Nat.card_zMod

end Nat

namespace PartENat

/-- `PartENat.card α` is the cardinality of `α` as an extended natural number.
  If `α` is infinite, `PartENat.card α = ⊤`. -/
def card (α : Type _) : PartENat :=
  toPartENat (mk α)
#align part_enat.card PartENat.card

@[simp]
theorem card_eq_coe_fintype_card [Fintype α] : card α = Fintype.card α :=
  mk_toPartENat_eq_coe_card
#align part_enat.card_eq_coe_fintype_card PartENat.card_eq_coe_fintype_card

@[simp]
theorem card_eq_top_of_infinite [Infinite α] : card α = ⊤ :=
  mk_toPartENat_of_infinite
#align part_enat.card_eq_top_of_infinite PartENat.card_eq_top_of_infinite

end PartENat


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Bhavik Mehta, Stuart Presnell
-/
import data.nat.factorial.basic

/-!
# Binomial coefficients

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

This file defines binomial coefficients and proves simple lemmas (i.e. those not
requiring more imports).

## Main definition and results

* `nat.choose`: binomial coefficients, defined inductively
* `nat.choose_eq_factorial_div_factorial`: a proof that `choose n k = n! / (k! * (n - k)!)`
* `nat.choose_symm`: symmetry of binomial coefficients
* `nat.choose_le_succ_of_lt_half_left`: `choose n k` is increasing for small values of `k`
* `nat.choose_le_middle`: `choose n r` is maximised when `r` is `n/2`
* `nat.desc_factorial_eq_factorial_mul_choose`: Relates binomial coefficients to the descending
  factorial. This is used to prove `nat.choose_le_pow` and variants. We provide similar statements
  for the ascending factorial.
* `nat.multichoose`: whereas `choose` counts combinations, `multichoose` counts multicombinations.
The fact that this is indeed the correct counting function for multisets is proved in
`sym.card_sym_eq_multichoose` in `data/sym/card`.
* `nat.multichoose_eq` : a proof that `multichoose n k = (n + k - 1).choose k`.
This is central to the "stars and bars" technique in informal mathematics, where we switch between
counting multisets of size `k` over an alphabet of size `n` to counting strings of `k` elements
("stars") separated by `n-1` dividers ("bars").  See `data/sym/card` for more detail.

## Tags

binomial coefficient, combination, multicombination, stars and bars
-/

open_locale nat

namespace nat

/-- `choose n k` is the number of `k`-element subsets in an `n`-element set. Also known as binomial
coefficients. -/
def choose : ℕ → ℕ → ℕ
| _             0 := 1
| 0       (k + 1) := 0
| (n + 1) (k + 1) := choose n k + choose n (k + 1)

@[simp] lemma choose_zero_right (n : ℕ) : choose n 0 = 1 := by cases n; refl

@[simp] lemma choose_zero_succ (k : ℕ) : choose 0 (succ k) = 0 := rfl

lemma choose_succ_succ (n k : ℕ) : choose (succ n) (succ k) = choose n k + choose n (succ k) := rfl

lemma choose_eq_zero_of_lt : ∀ {n k}, n < k → choose n k = 0
| _             0 hk := absurd hk dec_trivial
| 0       (k + 1) hk := choose_zero_succ _
| (n + 1) (k + 1) hk :=
  have hnk : n < k, from lt_of_succ_lt_succ hk,
  have hnk1 : n < k + 1, from lt_of_succ_lt hk,
  by rw [choose_succ_succ, choose_eq_zero_of_lt hnk, choose_eq_zero_of_lt hnk1]

@[simp] lemma choose_self (n : ℕ) : choose n n = 1 :=
by induction n; simp [*, choose, choose_eq_zero_of_lt (lt_succ_self _)]

@[simp] lemma choose_succ_self (n : ℕ) : choose n (succ n) = 0 :=
choose_eq_zero_of_lt (lt_succ_self _)

@[simp] lemma choose_one_right (n : ℕ) : choose n 1 = n :=
by induction n; simp [*, choose, add_comm]

/- The `n+1`-st triangle number is `n` more than the `n`-th triangle number -/
lemma triangle_succ (n : ℕ) : (n + 1) * ((n + 1) - 1) / 2 = n * (n - 1) / 2 + n :=
begin
  rw [← add_mul_div_left, mul_comm 2 n, ← mul_add, add_tsub_cancel_right, mul_comm],
  cases n; refl, apply zero_lt_succ
end

/-- `choose n 2` is the `n`-th triangle number. -/
lemma choose_two_right (n : ℕ) : choose n 2 = n * (n - 1) / 2 :=
begin
  induction n with n ih,
  simp,
  {rw triangle_succ n, simp [choose, ih], rw add_comm},
end

lemma choose_pos : ∀ {n k}, k ≤ n → 0 < choose n k
| 0             _ hk := by rw [nat.eq_zero_of_le_zero hk]; exact dec_trivial
| (n + 1)       0 hk := by simp; exact dec_trivial
| (n + 1) (k + 1) hk := by rw choose_succ_succ;
    exact add_pos_of_pos_of_nonneg (choose_pos (le_of_succ_le_succ hk)) (nat.zero_le _)

lemma choose_eq_zero_iff {n k : ℕ} : n.choose k = 0 ↔ n < k :=
⟨λ h, lt_of_not_ge (mt nat.choose_pos h.symm.not_lt), nat.choose_eq_zero_of_lt⟩

lemma succ_mul_choose_eq : ∀ n k, succ n * choose n k = choose (succ n) (succ k) * succ k
| 0             0 := dec_trivial
| 0       (k + 1) := by simp [choose]
| (n + 1)       0 := by simp
| (n + 1) (k + 1) :=
  by rw [choose_succ_succ (succ n) (succ k), add_mul, ←succ_mul_choose_eq, mul_succ,
  ←succ_mul_choose_eq, add_right_comm, ←mul_add, ←choose_succ_succ, ←succ_mul]

lemma choose_mul_factorial_mul_factorial : ∀ {n k}, k ≤ n → choose n k * k! * (n - k)! = n!
| 0              _ hk := by simp [nat.eq_zero_of_le_zero hk]
| (n + 1)        0 hk := by simp
| (n + 1) (succ k) hk :=
begin
  cases lt_or_eq_of_le hk with hk₁ hk₁,
  { have h : choose n k * k.succ! * (n-k)! = (k + 1) * n! :=
      by rw ← choose_mul_factorial_mul_factorial (le_of_succ_le_succ hk);
      simp [factorial_succ, mul_comm, mul_left_comm],
    have h₁ : (n - k)! = (n - k) * (n - k.succ)! :=
      by rw [← succ_sub_succ, succ_sub (le_of_lt_succ hk₁), factorial_succ],
    have h₂ : choose n (succ k) * k.succ! * ((n - k) * (n - k.succ)!) = (n - k) * n! :=
      by rw ← choose_mul_factorial_mul_factorial (le_of_lt_succ hk₁);
      simp [factorial_succ, mul_comm, mul_left_comm, mul_assoc],
    have h₃ : k * n! ≤ n * n! := nat.mul_le_mul_right _ (le_of_succ_le_succ hk),
    rw [choose_succ_succ, add_mul, add_mul, succ_sub_succ, h, h₁, h₂, add_mul,
      tsub_mul, factorial_succ, ← add_tsub_assoc_of_le h₃, add_assoc, ← add_mul,
      add_tsub_cancel_left, add_comm] },
  { simp [hk₁, mul_comm, choose, tsub_self] }
end

lemma choose_mul {n k s : ℕ} (hkn : k ≤ n) (hsk : s ≤ k) :
  n.choose k * k.choose s = n.choose s * (n - s).choose (k - s) :=
begin
  have h : (n - k)! * (k - s)! * s! ≠ 0, by apply_rules [mul_ne_zero, factorial_ne_zero],
  refine mul_right_cancel₀ h _,
  calc
    n.choose k * k.choose s * ((n - k)! * (k - s)! * s!)
        = n.choose k * (k.choose s * s! * (k - s)!) * (n - k)!
        : by rw [mul_assoc, mul_assoc, mul_assoc, mul_assoc _ s!, mul_assoc, mul_comm (n - k)!,
              mul_comm s!]
    ... = n!
        : by rw [choose_mul_factorial_mul_factorial hsk, choose_mul_factorial_mul_factorial hkn]
    ... = n.choose s * s! * ((n - s).choose (k - s) * (k - s)! * (n - s - (k - s))!)
        : by rw [choose_mul_factorial_mul_factorial (tsub_le_tsub_right hkn _),
              choose_mul_factorial_mul_factorial (hsk.trans hkn)]
    ... = n.choose s * (n - s).choose (k - s) * ((n - k)! * (k - s)! * s!)
        : by rw [tsub_tsub_tsub_cancel_right hsk, mul_assoc, mul_left_comm s!, mul_assoc,
              mul_comm (k - s)!, mul_comm s!, mul_right_comm, ←mul_assoc]
end

theorem choose_eq_factorial_div_factorial {n k : ℕ} (hk : k ≤ n) :
  choose n k = n! / (k! * (n - k)!) :=
begin
  rw [← choose_mul_factorial_mul_factorial hk, mul_assoc],
  exact (mul_div_left _ (mul_pos (factorial_pos _) (factorial_pos _))).symm
end

lemma add_choose (i j : ℕ) : (i + j).choose j = (i + j)! / (i! * j!) :=
by rw [choose_eq_factorial_div_factorial (nat.le_add_left j i), add_tsub_cancel_right, mul_comm]

theorem factorial_mul_factorial_dvd_factorial {n k : ℕ} (hk : k ≤ n) : k! * (n - k)! ∣ n! :=
by rw [←choose_mul_factorial_mul_factorial hk, mul_assoc]; exact dvd_mul_left _ _

lemma factorial_mul_factorial_dvd_factorial_add (i j : ℕ) :
  i! * j! ∣ (i + j)! :=
begin
  convert factorial_mul_factorial_dvd_factorial (le.intro rfl),
  rw add_tsub_cancel_left
end

@[simp] lemma choose_symm {n k : ℕ} (hk : k ≤ n) : choose n (n-k) = choose n k :=
by rw [choose_eq_factorial_div_factorial hk, choose_eq_factorial_div_factorial (nat.sub_le _ _),
  tsub_tsub_cancel_of_le hk, mul_comm]

lemma choose_symm_of_eq_add {n a b : ℕ} (h : n = a + b) : nat.choose n a = nat.choose n b :=
by { convert nat.choose_symm (nat.le_add_left _ _), rw add_tsub_cancel_right}

lemma choose_symm_add {a b : ℕ} : choose (a+b) a = choose (a+b) b :=
choose_symm_of_eq_add rfl

lemma choose_symm_half (m : ℕ) : choose (2 * m + 1) (m + 1) = choose (2 * m + 1) m :=
by { apply choose_symm_of_eq_add,
  rw [add_comm m 1, add_assoc 1 m m, add_comm (2 * m) 1, two_mul m] }

lemma choose_succ_right_eq (n k : ℕ) : choose n (k + 1) * (k + 1) = choose n k * (n - k) :=
begin
  have e : (n+1) * choose n k = choose n k * (k+1) + choose n (k+1) * (k+1),
    rw [← right_distrib, ← choose_succ_succ, succ_mul_choose_eq],
  rw [← tsub_eq_of_eq_add_rev e, mul_comm, ← mul_tsub, add_tsub_add_eq_tsub_right]
end

@[simp] lemma choose_succ_self_right : ∀ (n:ℕ), (n+1).choose n = n+1
| 0     := rfl
| (n+1) := by rw [choose_succ_succ, choose_succ_self_right, choose_self]

lemma choose_mul_succ_eq (n k : ℕ) :
  (n.choose k) * (n + 1) = ((n+1).choose k) * (n + 1 - k) :=
begin
  induction k with k ih, { simp },
  obtain hk | hk := le_or_lt (k + 1) (n + 1),
  { rw [choose_succ_succ, add_mul, succ_sub_succ, ←choose_succ_right_eq, ←succ_sub_succ,
      mul_tsub, add_tsub_cancel_of_le (nat.mul_le_mul_left _ hk)] },
  rw [choose_eq_zero_of_lt hk, choose_eq_zero_of_lt (n.lt_succ_self.trans hk), zero_mul, zero_mul],
end

lemma asc_factorial_eq_factorial_mul_choose (n k : ℕ) :
  n.asc_factorial k = k! * (n + k).choose k :=
begin
  rw mul_comm,
  apply mul_right_cancel₀ (factorial_ne_zero (n + k - k)),
  rw [choose_mul_factorial_mul_factorial, add_tsub_cancel_right, ←factorial_mul_asc_factorial,
    mul_comm],
  exact nat.le_add_left k n,
end

lemma factorial_dvd_asc_factorial (n k : ℕ) : k! ∣ n.asc_factorial k :=
⟨(n+k).choose k, asc_factorial_eq_factorial_mul_choose _ _⟩

lemma choose_eq_asc_factorial_div_factorial (n k : ℕ) :
  (n + k).choose k = n.asc_factorial k / k! :=
begin
  apply mul_left_cancel₀ (factorial_ne_zero k),
  rw ←asc_factorial_eq_factorial_mul_choose,
  exact (nat.mul_div_cancel' $ factorial_dvd_asc_factorial _ _).symm,
end

lemma desc_factorial_eq_factorial_mul_choose (n k : ℕ) : n.desc_factorial k = k! * n.choose k :=
begin
  obtain h | h := nat.lt_or_ge n k,
  { rw [desc_factorial_eq_zero_iff_lt.2 h, choose_eq_zero_of_lt h, mul_zero] },
  rw mul_comm,
  apply mul_right_cancel₀ (factorial_ne_zero (n - k)),
  rw [choose_mul_factorial_mul_factorial h, ←factorial_mul_desc_factorial h, mul_comm],
end

lemma factorial_dvd_desc_factorial (n k : ℕ) : k! ∣ n.desc_factorial k :=
⟨n.choose k, desc_factorial_eq_factorial_mul_choose _ _⟩

lemma choose_eq_desc_factorial_div_factorial (n k : ℕ) : n.choose k = n.desc_factorial k / k! :=
begin
  apply mul_left_cancel₀ (factorial_ne_zero k),
  rw ←desc_factorial_eq_factorial_mul_choose,
  exact (nat.mul_div_cancel' $ factorial_dvd_desc_factorial _ _).symm,
end

/-! ### Inequalities -/

/-- Show that `nat.choose` is increasing for small values of the right argument. -/
lemma choose_le_succ_of_lt_half_left {r n : ℕ} (h : r < n/2) :
  choose n r ≤ choose n (r+1) :=
begin
  refine le_of_mul_le_mul_right _ (lt_tsub_iff_left.mpr (lt_of_lt_of_le h (n.div_le_self 2))),
  rw ← choose_succ_right_eq,
  apply nat.mul_le_mul_left,
  rw [← nat.lt_iff_add_one_le, lt_tsub_iff_left, ← mul_two],
  exact lt_of_lt_of_le (mul_lt_mul_of_pos_right h zero_lt_two) (n.div_mul_le_self 2),
end

/-- Show that for small values of the right argument, the middle value is largest. -/
private lemma choose_le_middle_of_le_half_left {n r : ℕ} (hr : r ≤ n/2) :
  choose n r ≤ choose n (n/2) :=
decreasing_induction
  (λ _ k a,
      (eq_or_lt_of_le a).elim
        (λ t, t.symm ▸ le_rfl)
        (λ h, (choose_le_succ_of_lt_half_left h).trans (k h)))
  hr (λ _, le_rfl) hr

/-- `choose n r` is maximised when `r` is `n/2`. -/
lemma choose_le_middle (r n : ℕ) : choose n r ≤ choose n (n/2) :=
begin
  cases le_or_gt r n with b b,
  { cases le_or_lt r (n/2) with a h,
    { apply choose_le_middle_of_le_half_left a },
    { rw ← choose_symm b,
      apply choose_le_middle_of_le_half_left,
      rw [div_lt_iff_lt_mul' zero_lt_two] at h,
      rw [le_div_iff_mul_le' zero_lt_two, tsub_mul, tsub_le_iff_tsub_le,
          mul_two, add_tsub_cancel_right],
      exact le_of_lt h } },
  { rw choose_eq_zero_of_lt b,
    apply zero_le }
end

/-! #### Inequalities about increasing the first argument -/

lemma choose_le_succ (a c : ℕ) : choose a c ≤ choose a.succ c :=
by cases c; simp [nat.choose_succ_succ]

lemma choose_le_add (a b c : ℕ) : choose a c ≤ choose (a + b) c :=
begin
  induction b with b_n b_ih,
  { simp, },
  exact le_trans b_ih (choose_le_succ (a + b_n) c),
end

lemma choose_le_choose {a b : ℕ} (c : ℕ) (h : a ≤ b) : choose a c ≤ choose b c :=
(add_tsub_cancel_of_le h) ▸ choose_le_add a (b - a) c

lemma choose_mono (b : ℕ) : monotone (λ a, choose a b) := λ _ _, choose_le_choose b

/-! #### Multichoose

Whereas `choose n k` is the number of subsets of cardinality `k` from a type of cardinality `n`,
`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`.

Alternatively, whereas `choose n k` counts the number of combinations,
i.e. ways to select `k` items (up to permutation) from `n` items without replacement,
`multichoose n k` counts the number of multicombinations,
i.e. ways to select `k` items (up to permutation) from `n` items with replacement.

Note that `multichoose` is *not* the multinomial coefficient, although it can be computed
in terms of multinomial coefficients. For details see https://mathworld.wolfram.com/Multichoose.html

TODO: Prove that `choose (-n) k = (-1)^k * multichoose n k`,
where `choose` is the generalized binomial coefficient.
<https://github.com/leanprover-community/mathlib/pull/15072#issuecomment-1171415738>

-/

/--
`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`. -/
def multichoose : ℕ → ℕ → ℕ
| _             0 := 1
| 0       (k + 1) := 0
| (n + 1) (k + 1) := multichoose n (k + 1) + multichoose (n + 1) k

@[simp] lemma multichoose_zero_right (n : ℕ) : multichoose n 0 = 1 :=
by { cases n; simp [multichoose] }

@[simp] lemma multichoose_zero_succ (k : ℕ) : multichoose 0 (k + 1) = 0 := by simp [multichoose]

lemma multichoose_succ_succ (n k : ℕ) :
  multichoose (n + 1) (k + 1) = multichoose n (k + 1) + multichoose (n + 1) k :=
by simp [multichoose]

@[simp] lemma multichoose_one (k : ℕ) : multichoose 1 k = 1 :=
begin
  induction k with k IH, { simp },
  simp [multichoose_succ_succ 0 k, IH],
end

@[simp] lemma multichoose_two (k : ℕ) : multichoose 2 k = k + 1 :=
begin
  induction k with k IH, { simp },
  simp [multichoose_succ_succ 1 k, IH],
  rw add_comm,
end

@[simp] lemma multichoose_one_right (n : ℕ) : multichoose n 1 = n :=
begin
  induction n with n IH, { simp },
  simp [multichoose_succ_succ n 0, IH],
end

lemma multichoose_eq : ∀ (n k : ℕ), multichoose n k = (n + k - 1).choose k
| _      0    := by simp
| 0     (k+1) := by simp
| (n+1) (k+1) := by
  { rw [multichoose_succ_succ, add_comm, nat.succ_add_sub_one, ←add_assoc, nat.choose_succ_succ],
    simp [multichoose_eq] }

end nat


import tactic.basic
import .ch07_indprop

open nat (succ)

open poly (prod)
open indprop (even even_four even_four' even_add_four)
open indprop.even

variables {α : Type}
variables {x y : α}
variables {P Q R : Prop}

namespace proofobjects

/-
Print even.
(* ==>
  Inductive even : nat -> Prop :=
    | ev_0 : even 0
    | ev_SS : forall n, even n -> even (S (S n)).
*)
-/

#print even

/-
Check ev_SS.
(* ===> ev_SS : forall n,
                  even n ->
                  even (S (S n)) *)
-/

#check ev_ss

/-
Theorem ev_4 : even 4.
Proof.
  apply ev_SS. apply ev_SS. apply ev_0. Qed.
-/

/-
Print ev_4.
(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0)
     : even 4  *)
-/

#print even_four

/-
Check (ev_SS 2 (ev_SS 0 ev_0)).
(* ===> even 4 *)
-/

#check ev_ss (ev_ss ev_0)

/-
Theorem ev_4': even 4.
Proof.
  apply (ev_SS 2 (ev_SS 0 ev_0)).
Qed.
-/

#print even_four'

/-
Theorem ev_4'' : even 4.
Proof.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_0.
  Show Proof.
Qed.
-/

theorem even_four'' : even 4 :=
begin
  trace_state,
  apply ev_ss,
  trace_state,
  apply ev_ss,
  trace_state,
  apply ev_0,
  trace_state,
end

/-
Definition ev_4''' : even 4 :=
  ev_SS 2 (ev_SS 0 ev_0).
-/

def even_four''' : even 4 := ev_ss (ev_ss ev_0)

/-
Print ev_4.
(* ===> ev_4    =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'.
(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4''.
(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'''.
(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
-/

#print even_four
#print even_four'
#print even_four''
#print even_four'''

/-
Theorem ev_8 : even 8.
Proof.
  (* FILL IN HERE *) Admitted.

Definition ev_8' : even 8
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
-/

theorem even_eight : even 8 :=
begin
  apply ev_ss,
  apply ev_ss,
  exact even_four,
end

def ev_8' : even 8 := ev_ss (ev_ss even_four)

/-
Theorem ev_plus4 : ∀n, even n → even (4 + n).
Proof.
  intros n H. simpl.
  apply ev_SS.
  apply ev_SS.
  apply H.
Qed.
-/

#print even_add_four

/-
Definition ev_plus4' : ∀n, even n → even (4 + n) :=
  fun (n : nat) ⇒ fun (H : even n) ⇒
    ev_SS (S (S n)) (ev_SS n H).
-/

def even_add_four' : ∀n, even n → even (n + 4) := λn h, ev_ss (ev_ss h)

/-
Definition ev_plus4'' (n : nat) (H : even n)
                    : even (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).
Check ev_plus4''.
-/

def even_add_four'' (n) (h : even n) : even (n + 4) := ev_ss (ev_ss h)

/-
Definition ev_plus2 : Prop :=
  ∀n, ∀(E : even n), even (n + 2).
-/

def even_add_two : Prop := ∀n, ∀e : even n, even (n + 2)

/-
Definition ev_plus2' : Prop :=
  ∀n, ∀(_ : even n), even (n + 2).
-/

def even_add_two' : Prop := ∀n, ∀_ : even n, even (n + 2)

/-
Definition ev_plus2'' : Prop :=
  ∀n, even n → even (n + 2).
-/

def even_add_two'' : Prop := ∀n, even n → even (n + 2)

/-
Definition add1 : nat → nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.

Print add1.
(* ==>
    add1 = fun n : nat => S n
         : nat -> nat
*)

Compute add1 2.
(* ==> 3 : nat *)
-/

def add_one : nat → nat :=
begin
  intro n,
  apply succ,
  exact n,
end

#print add_one

#reduce add_one 2

/-
Inductive and (P Q : Prop) : Prop :=
| conj : P → Q → and P Q.
End And.
-/

structure and (P Q : Prop) : Prop := intro :: (left : P) (right : Q)

/-
Print prod.
(* ===>
   Inductive prod (X Y : Type) : Type :=
   | pair : X -> Y -> X * Y. *)
-/

#print and
#print prod

/-
Lemma and_comm : ∀P Q : Prop, P ∧ Q ↔ Q ∧ P.
Proof.
  intros P Q. split.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
Qed.
-/

lemma and_comm (P Q : Prop) : P ∧ Q ↔ Q ∧ P :=
begin
  split,
    rintro ⟨p, q⟩,
    exact ⟨q, p⟩,
  rintro ⟨q, p⟩,
  exact ⟨p, q⟩,
end

/-
Definition and_comm'_aux P Q (H : P ∧ Q) : Q ∧ P :=
  match H with
  | conj HP HQ ⇒ conj HQ HP
  end.

Definition and_comm' P Q : P ∧ Q ↔ Q ∧ P :=
  conj (and_comm'_aux P Q) (and_comm'_aux Q P).
-/

def and_comm'_aux : P ∧ Q → Q ∧ P
| ⟨p, q⟩ := ⟨q, p⟩

def and_comm' : P ∧ Q ↔ Q ∧ P := ⟨and_comm'_aux, and_comm'_aux⟩

/-
Definition conj_fact : ∀P Q R, P ∧ Q → Q ∧ R → P ∧ R
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
-/

def conj_fact (hpq : P ∧ Q) (hqr : Q ∧ R) : P ∧ R := ⟨hpq.left, hqr.right⟩

/-
Module Or.

Inductive or (P Q : Prop) : Prop :=
| or_introl : P → or P Q
| or_intror : Q → or P Q.

End Or.
-/

namespace or

inductive or (P Q : Prop) : Prop
| inl : P → or
| inr : Q → or

end or

/-
Definition or_comm : ∀P Q, P ∨ Q → Q ∨ P
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
-/

def or_comm : P ∨ Q → Q ∨ P
| (or.inl p) := or.inr p
| (or.inr q) := or.inl q

/-
Module Ex.

Inductive ex {A : Type} (P : A → Prop) : Prop :=
| ex_intro : ∀x : A, P x → ex P.

End Ex.
-/

namespace Exists

inductive Exists (P : α → Prop) : Prop
| intro : ∀x, P x → Exists

/-
Check ex (fun n ⇒ even n).
(* ===> exists n : nat, even n
        : Prop *)
-/

#check Exists (λn, even n)

end Exists

/-
Definition some_nat_is_even : ∃n, even n :=
  ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)).
-/

def some_nat_is_even : ∃n, even n := Exists.intro 4 (ev_ss (ev_ss ev_0))

/-
Definition ex_ev_Sn : ex (fun n ⇒ even (S n))
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
-/

def ex_even_succ : ∃n, even (succ n) := Exists.intro 1 (ev_ss ev_0)

/-
Inductive True : Prop :=
  | I : True.
-/

inductive true : Prop
| intro : true

/-
Inductive False : Prop := .
-/

inductive false : Prop

/-
Module MyEquality.

Inductive eq {X:Type} : X → X → Prop :=
| eq_refl : ∀x, eq x x.

Notation "x == y" := (eq x y)
                    (at level 70, no associativity)
                    : type_scope.
-/

#check eq

inductive eq (a : α) : α → Prop
| refl : eq a

local infix == := eq

/-
Lemma four: 2 + 2 == 1 + 3.
Proof.
  apply eq_refl.
Qed.
-/

lemma four : 2 + 2 == 1 + 3 := by apply eq.refl

/-
Definition four' : 2 + 2 == 1 + 3 :=
  eq_refl 4.

Definition singleton : ∀(X:Type) (x:X), []++[x] == x::[] :=
  fun (X:Type) (x:X) ⇒ eq_refl [x].
-/

def four' : 2 + 2 == 1 + 3 := eq.refl

def singleton (a : α) : [] ++ [a] == a::[] := eq.refl

/-
Lemma equality__leibniz_equality : ∀(X : Type) (x y: X),
  x == y → ∀P:X→Prop, P x → P y.
Proof.
(* FILL IN HERE *) Admitted.
-/

lemma equality__leibniz_equality
  (heq : x == y) (P : α → Prop) (h : P x) : P y :=
begin
  cases heq,
  exact h,
end

/-
Lemma leibniz_equality__equality : ∀(X : Type) (x y: X),
  (∀P:X→Prop, P x → P y) → x == y.
Proof.
(* FILL IN HERE *) Admitted.
-/

lemma leibniz_equality__equality (h : ∀P : α → Prop, P x → P y) : x == y :=
begin
  apply h,
  exact eq.refl,
end

#print leibniz_equality__equality

end proofobjects


variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by
  apply Iff.intro
  . intro h
    apply And.intro
    . exact h.right
    . exact h.left
  . intro h
    apply And.intro
    . exact h.right
    . exact h.left

example : p ∨ q ↔ q ∨ p := by
  apply Iff.intro
  . intro h
    apply h.elim
    . intro hp
      exact Or.inr hp
    . intro hq
      exact Or.inl hq
  . intro h
    apply h.elim
    . intro hq
      exact Or.inr hq
    . intro hp
      exact Or.inl hp

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  apply Iff.intro
  . intro h
    apply And.intro
    . exact h.left.left
    apply And.intro
    . exact h.left.right
    . exact h.right
  . intro h
    apply And.intro
    apply And.intro
    . exact h.left
    . exact h.right.left
    exact h.right.right

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by
  apply Iff.intro
  . intro h
    apply h.elim
    . intro hpq
      apply hpq.elim
      . intro hp
        exact Or.inl hp
      . intro hq
        apply Or.inr
        exact Or.inl hq
    . intro hr
      apply Or.inr (Or.inr hr)
  . intro h
    apply h.elim
    . intro hp
      apply Or.inl (Or.inl hp)
    . intro hqr
      apply hqr.elim
      . intro hq
        apply Or.inl (Or.inr hq)
      . intro hr
        exact Or.inr hr

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  . intro h
    apply Or.elim (h.right)
    . intro hq
      apply Or.inl ⟨h.left, hq⟩
    . intro hr
      apply Or.inr ⟨h.left, hr⟩
  . intro h
    apply h.elim
    . intro hpq
      apply And.intro
      exact hpq.left
      exact Or.inl hpq.right
    . intro hpr
      apply And.intro
      exact hpr.left
      exact Or.inr hpr.right

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by
  apply Iff.intro
  . intro h
    apply h.elim
    . intro hp
      exact ⟨Or.inl hp, Or.inl hp⟩
    . intro hqr
      apply And.intro
      exact Or.inr hqr.left
      exact Or.inr hqr.right
  . intro h
    apply Or.elim h.left
    . intro hp
      exact Or.inl hp
    . intro hq
      apply Or.elim h.right
      . intro hp
        exact Or.inl hp
      . intro hr
        exact Or.inr ⟨hq,hr⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by
  apply Iff.intro
  . intro h
    intros
    simp [*]
  . intro h
    intro h1 h2
    simp [h, h1, h2]

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by
  apply Iff.intro
  . intro h
    apply And.intro
    . intro hp
      simp [h, hp]
    . intro hq
      simp [h, hq]
  . intro h
    intro h1
    apply h1.elim
    . intro hp
      simp [*]
    . intro hq
      simp [*]

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by
  apply Iff.intro
  . intro h
    apply And.intro
    . intro hp
      exact h (Or.inl hp)
    . intro hq
      exact h (Or.inr hq)
  . intro h
    intro h1
    apply h1.elim
    . intro hp
      exact h.left hp
    . intro hq
      exact h.right hq

example : ¬p ∨ ¬q → ¬(p ∧ q) := by
  intro h h1
  apply h.elim
  . intro hnp
    exact hnp h1.left
  . intro hnq
    exact hnq h1.right

example : ¬(p ∧ ¬p) := by
  intro h
  exact h.right h.left

example : p ∧ ¬q → ¬(p → q) := by
  intro h h1
  have h2 := h1 h.left
  exact h.right h2

example : ¬p → (p → q) := by
  intro h h1
  apply False.elim (h h1)

example : (¬p ∨ q) → (p → q) := by
  intro h hp
  apply h.elim
  . intro hnp
    apply False.elim (hnp hp)
  . intro hq
    exact hq

example : p ∨ False ↔ p := by
  simp

example : p ∧ False ↔ False := by
  simp

example : (p → q) → (¬q → ¬p) := by
  intro h hnq hp
  exact hnq (h hp)

open Classical

example : (p → q ∨ r) → ((p → q) ∨ (p → r)) := by
  intro h
  apply Or.elim (em p)
  . intro hp
    have hqr := (h hp)
    apply hqr.elim
    . intro hq
      simp [*]
    . intro hr
      simp [*]
  . intro hnp
    simp [h, hnp]

example : ¬(p ∧ q) → ¬p ∨ ¬q := by
  intro h
  apply Or.elim (em p)
  . intro hp
    apply Or.inr
    . intro hq
      simp [h ⟨hp,hq⟩]
  . intro hnp
    apply Or.inl <;> assumption

example : ¬(p → q) → p ∧ ¬q := by
  intro h
  apply Or.elim (em p)
  . intro hp
    apply And.intro
    exact hp
    intro hq
    simp [hp, hq] at h
  . intro hnp
    apply And.intro
    apply False.elim
    apply h
    . intro hp
      exact absurd hp hnp
    . intro hq
      apply absurd
      exact h
      simp [*]

example : (p → q) → (¬p ∨ q) := by
  intro h
  apply Or.elim (em q)
  . intro hq
    exact Or.inr hq
  . intro hnq
    apply Or.inl
    . intro hp
      apply absurd
      exact (h hp)
      exact hnq

example : (¬q → ¬p) → (p → q) := by
  intro h hp
  apply Or.elim (em q)
  . intro hq
    exact hq
  . intro hnq
    exact absurd hp (h hnq)

example : p ∨ ¬p := by
  exact (em p)

example : ((p → q) → p) → p := by
  intro h
  apply Or.elim
  apply em p
  . intro hp
    exact hp
  . intro hnp
    apply absurd
    exact h (fun hp => byContradiction (fun _ => hnp hp))
    exact hnp

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

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := by
  apply Iff.intro
  . intro h
    apply And.intro
    intro α
    exact (h α).left
    intro α
    exact (h α).right
  . intro h
    simp [*]

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := by
  intro h h1
  simp [h, h1]

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := by
  intro h α
  apply h.elim
  . intro hp
    exact Or.inl (hp α)
  . intro hq
    exact Or.inr (hq α)

example : α → ((∀ x : α, r) ↔ r) := by
  intro α
  apply Iff.intro
  . intro h
    exact h α
  . intro h
    simp [*]

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := by
  apply Iff.intro
  . intro h
    apply Or.elim (em r)
    . intro hr
      exact Or.inr hr
    . intro hnr
      apply Or.inl
      intro α
      apply (h α).elim
      . intro hp
        exact hp
      . intro hr
        apply False.elim
        exact absurd hr hnr
  . intro h α
    apply h.elim
    . intro hp
      simp [*]
    . intro hr
      simp [*]

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := by
  apply Iff.intro
  . intro h
    intro hr α
    simp [*]
  . intro h α
    intro hr
    simp [*]

-- open Classical

example : (∃ x : α, r) → r := by
  intro h
  cases h with
  | intro α hr => simp [*]

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

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by
  apply Iff.intro
  . intro h
    cases h with
    | intro x px => constructor; exists x; exact px.left; exact px.right
  . intro h
    cases h.left with
    | intro x px => exists x; constructor; exact px; exact h.right

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  apply Iff.intro
  . intro h
    cases h with
    | intro x px =>
      apply px.elim
      . intro hpx
        apply Or.inl
        apply Exists.intro x hpx
      . intro hqx
        apply Or.inr
        apply Exists.intro x hqx
  . intro h
    apply h.elim
    . intro hpx
      cases hpx with
      | intro x px => exists x; apply Or.inl; exact px
    . intro hqx
      cases hqx with
      | intro x qx => exists x; apply Or.inr; exact qx

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := by
  apply Iff.intro
  . intro h h1
    cases h1 with
    | intro x px => apply absurd (h x) px
  . intro h α
    apply byContradiction
    intro hnp
    apply absurd (Exists.intro α hnp) h

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := by
  apply Iff.intro
  . intro h h1
    cases h with
    | intro x px => apply absurd px (h1 x)
  . intro h
    apply byContradiction
    . intro h1
      apply absurd
      exact (fun α => byCases
      (fun h2 : p α => False.elim (absurd ⟨α,h2⟩ h1))
      (fun h2 => h2))
      exact h

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := by
  apply Iff.intro
  . intro h α hpa
    apply absurd (Exists.intro α hpa) h
  . intro h h1
    cases h1 with
    | intro x px => apply absurd px (h x)

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := by
  apply Iff.intro
  . intro h
    apply byContradiction
    exact (fun h1 => absurd
      (fun α => byCases
      (fun hpa : p α => hpa)
      (fun hnp => False.elim (absurd (Exists.intro α hnp) h1))) h)
  . intro h h1
    cases h with
    | intro x px => apply absurd (h1 x) px

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by
  apply Iff.intro
  . intro h h1
    cases h1 with
    | intro x px => apply (h x) px
  . intro h α hpa
    apply h (Exists.intro α hpa)

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := by
  apply Iff.intro
  . intro h h1
    cases h with
    | intro x px => simp [*]
  . intro h
    apply byCases
    . intro hap
      apply Exists.intro a (fun _ => h hap)
    . intro hnap
      apply byContradiction
      . intro hnex
        apply hnap
        . intro x
          apply byContradiction
          . intro hnp
            apply hnex (Exists.intro x (fun hp => absurd hp hnp))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := by
  apply Iff.intro
  . intro h
    cases h with
    | intro x px => intro hr; exists x; simp [px hr]
  . intro h
    apply Or.elim (em r)
    . intro hr
      cases (h hr) with
      | intro x px =>
      apply Exists.intro x
      intro _
      exact px
    . intro hnr
      apply Exists.intro a
      . intro hr
        apply False.elim (hnr hr)

-- 2
example (p q r : Prop) (hp : p)
        : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  simp [*]


/-
Copyright (c) 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/
import topology.homeomorph

/-!
# Topological space structure on the opposite monoid and on the units group

In this file we define `topological_space` structure on `Mᵐᵒᵖ`, `Mᵃᵒᵖ`, `Mˣ`, and `add_units M`.
This file does not import definitions of a topological monoid and/or a continuous multiplicative
action, so we postpone the proofs of `has_continuous_mul Mᵐᵒᵖ` etc till we have these definitions.

## Tags

topological space, opposite monoid, units
-/

variables {M X : Type*}

open filter
open_locale topological_space

namespace mul_opposite

/-- Put the same topological space structure on the opposite monoid as on the original space. -/
@[to_additive] instance [topological_space M] : topological_space Mᵐᵒᵖ :=
topological_space.induced (unop : Mᵐᵒᵖ → M) ‹_›

variables [topological_space M]

@[continuity, to_additive] lemma continuous_unop : continuous (unop : Mᵐᵒᵖ → M) :=
continuous_induced_dom

@[continuity, to_additive] lemma continuous_op : continuous (op : M → Mᵐᵒᵖ) :=
continuous_induced_rng continuous_id

@[to_additive] instance [t2_space M] : t2_space Mᵐᵒᵖ :=
⟨λ x y h, separated_by_continuous mul_opposite.continuous_unop $ unop_injective.ne h⟩

/-- `mul_opposite.op` as a homeomorphism. -/
@[to_additive "`add_opposite.op` as a homeomorphism."]
def op_homeomorph : M ≃ₜ Mᵐᵒᵖ :=
{ to_equiv := op_equiv,
  continuous_to_fun := continuous_op,
  continuous_inv_fun := continuous_unop }

@[simp, to_additive] lemma map_op_nhds (x : M) : map (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (op x) :=
op_homeomorph.map_nhds_eq x

@[simp, to_additive] lemma map_unop_nhds (x : Mᵐᵒᵖ) : map (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.symm.map_nhds_eq x

@[simp, to_additive] lemma comap_op_nhds (x : Mᵐᵒᵖ) : comap (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.comap_nhds_eq x

@[simp, to_additive]

end mul_opposite

namespace units

open mul_opposite

variables [topological_space M] [monoid M]

/-- The units of a monoid are equipped with a topology, via the embedding into `M × M`. -/
@[to_additive] instance : topological_space Mˣ :=
topological_space.induced (embed_product M) prod.topological_space

@[to_additive] lemma continuous_embed_product : continuous (embed_product M) :=
continuous_induced_dom

@[to_additive] lemma continuous_coe : continuous (coe : Mˣ → M) :=
(@continuous_embed_product M _ _).fst

end units


-- https://www.codewars.com/kata/5e9981da9dd96e001f3b7c0c/train/lean

import data.real.basic
open classical
attribute [instance] prop_decidable

/-
  Rigorous definition of a limit
  For a sequence x_n, we say that \lim_{n \to \infty} x_n = l if
    ∀ ε > 0, ∃ N, n ≥ N → |x_n - l| < ε
-/

def lim_to_inf (x : ℕ → ℝ) (l : ℝ) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (x n - l) < ε

/-
-- Suppose |x_n - l| \leq y_n and \lim_{n\to\infty} y_n = 0.
-- Then \lim_{n\to\infty} x_n = l.
def SUBMISSION := ∀ (x y : ℕ → ℝ) l,
  (∀ n, abs (x n - l) ≤ y n) →
  lim_to_inf y 0 →
  lim_to_inf x l
notation `SUBMISSION` := SUBMISSION
-/

example (x : ℝ) : x ≤ abs x
:=
by exact le_abs_self x

theorem exercise_1p3 (x y : ℕ → ℝ) (l : ℝ)
  (h₁ : ∀ n, abs (x n - l) ≤ y n) (h₂ : lim_to_inf y 0) :
  lim_to_inf x l :=
begin
  -- unfold lim_to_inf,
  show ∀ (ε : ℝ), ε > 0 → (∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (x n - l) < ε),
  intros ε pos_ε, -- let ε be a real number such that ε > 0
  -- unfold lim_to_inf at h₂,
  specialize h₂ ε pos_ε, -- using h₂, ε, and pos_ε we get that ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (y n - 0) < ε
  cases h₂ with n hn,
  use n,
  intros n_1 hn_1,
  specialize hn n_1 hn_1,
  specialize h₁ n_1,
  clear hn_1 n pos_ε,
  simp at hn,
  have : y n_1 ≤ abs (y n_1),
  exact le_abs_self (y n_1),
  linarith,
end

github-repos/lean/apurvanakade-lean-playground/lean-playground-2fe58797031ff8a6c29e1a442cbcc7a0ebc9c768/src/codewars/Mathematical Analysis - Limits of Sequences #2.lean


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.special_functions.pow
import analysis.asymptotics.asymptotic_equivalent
import analysis.asymptotics.specific_asymptotics

/-!
# Growth estimates on `x ^ y` for complex `x`, `y`

Let `l` be a filter on `ℂ` such that `complex.re` tends to infinity along `l` and `complex.im z`
grows at a subexponential rate compared to `complex.re z`. Then

- `complex.is_o_log_abs_re_of_subexponential_im_re`: `real.log ∘ complex.abs` is `o`-small of
  `complex.re` along `l`;

- `complex.is_o_cpow_mul_exp`: $z^{a_1}e^{b_1 * z} = o\left(z^{a_1}e^{b_1 * z}\right)$ along `l`
  for any complex `a₁`, `a₂` and real `b₁ < b₂`.

We use these assumptions on `l` for two reasons. First, these are the assumptions that naturally
appear in the proof. Second, in some applications (e.g., in Ilyashenko's proof of the individual
finiteness theorem for limit cycles of polynomial ODEs with hyperbolic singularities only) natural
stronger assumptions (e.g., `im z` is bounded from below and from above) are not available.

-/

open asymptotics filter function
open_locale topology

namespace complex

/-- We say that `l : filter ℂ` is an *exponential comparison filter* if the real part tends to
infinity along `l` and the imaginary part grows subexponentially compared to the real part. These
properties guarantee that `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))` for any
complex `a₁`, `a₂` and real `b₁ < b₂`.

In particular, the second property is automatically satisfied if the imaginary part is bounded along
`l`. -/
structure is_exp_cmp_filter (l : filter ℂ) : Prop :=
(tendsto_re : tendsto re l at_top)
(is_O_im_pow_re : ∀ n : ℕ, (λ z : ℂ, z.im ^ n) =O[l] (λ z, real.exp z.re))

namespace is_exp_cmp_filter

variables {l : filter ℂ}

/-!
### Alternative constructors
-/

lemma of_is_O_im_re_rpow (hre : tendsto re l at_top) (r : ℝ) (hr : im =O[l] (λ z, z.re ^ r)) :
  is_exp_cmp_filter l :=
⟨hre, λ n, is_o.is_O $
  calc (λ z : ℂ, z.im ^ n) =O[l] (λ z, (z.re ^ r) ^ n) : hr.pow n
  ... =ᶠ[l] (λ z, z.re ^ (r * n)) : (hre.eventually_ge_at_top 0).mono $
    λ z hz, by simp only [real.rpow_mul hz r n, real.rpow_nat_cast]
  ... =o[l] (λ z, real.exp z.re) : (is_o_rpow_exp_at_top _).comp_tendsto hre⟩

lemma of_is_O_im_re_pow (hre : tendsto re l at_top) (n : ℕ) (hr : im =O[l] (λ z, z.re ^ n)) :
  is_exp_cmp_filter l :=
of_is_O_im_re_rpow hre n $ by simpa only [real.rpow_nat_cast]

lemma of_bounded_under_abs_im (hre : tendsto re l at_top)
  (him : is_bounded_under (≤) l (λ z, |z.im|)) :
  is_exp_cmp_filter l :=
of_is_O_im_re_pow hre 0 $
  by simpa only [pow_zero] using @is_bounded_under.is_O_const ℂ ℝ ℝ _ _ _ l him 1 one_ne_zero

lemma of_bounded_under_im (hre : tendsto re l at_top) (him_le : is_bounded_under (≤) l im)
  (him_ge : is_bounded_under (≥) l im) :
  is_exp_cmp_filter l :=
of_bounded_under_abs_im hre $ is_bounded_under_le_abs.2 ⟨him_le, him_ge⟩

/-!
### Preliminary lemmas
-/

lemma eventually_ne (hl : is_exp_cmp_filter l) : ∀ᶠ w : ℂ in l, w ≠ 0 :=
hl.tendsto_re.eventually_ne_at_top' _

lemma tendsto_abs_re (hl : is_exp_cmp_filter l) : tendsto (λ z : ℂ, |z.re|) l at_top :=
tendsto_abs_at_top_at_top.comp hl.tendsto_re

lemma tendsto_abs (hl : is_exp_cmp_filter l) : tendsto abs l at_top :=
tendsto_at_top_mono abs_re_le_abs hl.tendsto_abs_re

lemma is_o_log_re_re (hl : is_exp_cmp_filter l) : (λ z, real.log z.re) =o[l] re :=
real.is_o_log_id_at_top.comp_tendsto hl.tendsto_re

lemma abs_im_pow_eventually_le_exp_re (hl : is_exp_cmp_filter l) (n : ℕ) :
  (λ z : ℂ, |z.im| ^ n) ≤ᶠ[l] (λ z, real.exp z.re) :=
by simpa using (hl.is_o_im_pow_exp_re n).bound zero_lt_one

/-- If `l : filter ℂ` is an "exponential comparison filter", then $\log |z| =o(ℜ z)$ along `l`.
This is the main lemma in the proof of `complex.is_exp_cmp_filter.is_o_cpow_exp` below.
-/
lemma is_o_log_abs_re (hl : is_exp_cmp_filter l) : (λ z, real.log (abs z)) =o[l] re :=
calc (λ z, real.log (abs z)) =O[l] (λ z, real.log (real.sqrt 2) + real.log (max z.re (|z.im|))) :
  is_O.of_bound 1 $ (hl.tendsto_re.eventually_ge_at_top 1).mono $ λ z hz,
    begin
      have h2 : 0 < real.sqrt 2, by simp,
      have hz' : 1 ≤ abs z, from hz.trans (re_le_abs z),
      have hz₀ : 0 < abs z, from one_pos.trans_le hz',
      have hm₀ : 0 < max z.re (|z.im|), from lt_max_iff.2 (or.inl $ one_pos.trans_le hz),
      rw [one_mul, real.norm_eq_abs, _root_.abs_of_nonneg (real.log_nonneg hz')],
      refine le_trans _ (le_abs_self _),
      rw [← real.log_mul, real.log_le_log, ← _root_.abs_of_nonneg (le_trans zero_le_one hz)],
      exacts [abs_le_sqrt_two_mul_max z, one_pos.trans_le hz', (mul_pos h2 hm₀), h2.ne', hm₀.ne']
    end
... =o[l] re : is_o.add (is_o_const_left.2 $ or.inr $ hl.tendsto_abs_re) $ is_o_iff_nat_mul_le.2 $
  λ n, begin
    filter_upwards [is_o_iff_nat_mul_le.1 hl.is_o_log_re_re n, hl.abs_im_pow_eventually_le_exp_re n,
      hl.tendsto_re.eventually_gt_at_top 1] with z hre him h₁,
    cases le_total (|z.im|) z.re with hle hle,
    { rwa [max_eq_left hle] },
    { have H : 1 < |z.im|, from h₁.trans_le hle,
      rwa [max_eq_right hle, real.norm_eq_abs, real.norm_eq_abs, abs_of_pos (real.log_pos H),
        ← real.log_pow, real.log_le_iff_le_exp (pow_pos (one_pos.trans H) _),
        abs_of_pos (one_pos.trans h₁)] }
  end

/-!
### Main results
-/

/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a` and any
positive real `b`, we have `(λ z, z ^ a) =o[l] (λ z, exp (b * z))`. -/
lemma is_o_cpow_exp (hl : is_exp_cmp_filter l) (a : ℂ) {b : ℝ} (hb : 0 < b) :
  (λ z, z ^ a) =o[l] (λ z, exp (b * z)) :=
calc (λ z, z ^ a) =Θ[l] λ z, abs z ^ re a : is_Theta_cpow_const_rpow $ λ _ _, hl.eventually_ne
... =ᶠ[l] λ z, real.exp (re a * real.log (abs z)) : hl.eventually_ne.mono $
  λ z hz, by simp only [real.rpow_def_of_pos, abs.pos hz, mul_comm]
... =o[l] λ z, exp (b * z) : is_o.of_norm_right $
  begin
    simp only [norm_eq_abs, abs_exp, of_real_mul_re, real.is_o_exp_comp_exp_comp],
    refine (is_equivalent.refl.sub_is_o _).symm.tendsto_at_top (hl.tendsto_re.const_mul_at_top hb),
    exact (hl.is_o_log_abs_re.const_mul_left _).const_mul_right hb.ne'
  end

/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any
real `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/
lemma is_o_cpow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (a₁ a₂ : ℂ) :
  (λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z)) :=
calc (λ z, z ^ a₁ * exp (b₁ * z)) =ᶠ[l] (λ z, z ^ a₂ * exp (b₁ * z) * z ^ (a₁ - a₂)) :
  hl.eventually_ne.mono $ λ z hz,
    by { simp only, rw [mul_right_comm, ← cpow_add _ _ hz, add_sub_cancel'_right] }
... =o[l] λ z, z ^ a₂ * exp (b₁ * z) * exp (↑(b₂ - b₁) * z) :
  (is_O_refl (λ z, z ^ a₂ * exp (b₁ * z)) l).mul_is_o $ hl.is_o_cpow_exp _ (sub_pos.2 hb)
... =ᶠ[l] λ z, z ^ a₂ * exp (b₂ * z) :
  by simp only [of_real_sub, sub_mul, mul_assoc, ← exp_add, add_sub_cancel'_right]

/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a` and any
negative real `b`, we have `(λ z, exp (b * z)) =o[l] (λ z, z ^ a)`. -/
lemma is_o_exp_cpow (hl : is_exp_cmp_filter l) (a : ℂ) {b : ℝ} (hb : b < 0) :
  (λ z, exp (b * z)) =o[l] (λ z, z ^ a) :=
by simpa using hl.is_o_cpow_mul_exp hb 0 a

/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any
natural `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/
lemma is_o_pow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (m n : ℕ) :
  (λ z, z ^ m * exp (b₁ * z)) =o[l] (λ z, z ^ n * exp (b₂ * z)) :=
by simpa only [cpow_nat_cast] using hl.is_o_cpow_mul_exp hb m n

/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any
integer `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/
lemma is_o_zpow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (m n : ℤ) :
  (λ z, z ^ m * exp (b₁ * z)) =o[l] (λ z, z ^ n * exp (b₂ * z)) :=
by simpa only [cpow_int_cast] using hl.is_o_cpow_mul_exp hb m n

end is_exp_cmp_filter

end complex


import tactic --hide

lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by {cc} --hide
lemma P_not_P_false (P : Prop) : P ∧ ¬ P → false := by {cc} --hide

-- Level name : De Morgan's laws, Final Boss

/-
For this final battle with De Morgan, you are on your own!
-/

/-Lemma
If $P,Q$ are logical statements then $¬(P ∧ Q)$ is equivalent to $¬ P ∨ ¬Q$.
-/

lemma DeMorgan_two (P Q : Prop) :  ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
begin
  split,
  { intro h,
    by_cases hP : P,
    { right,
      intro hQ,
      apply h,
      exact ⟨hP, hQ⟩ },
    { left,
      exact hP } },
  { rintro (hnP | hnQ) ⟨hP, hQ⟩,
    { apply contra P false,
      split,
      exact hP,
      exact hnP, },
    { apply hnQ, exact hQ } }
end


import ring_theory.ideal.basic

import exercise2 -- For ideal generated by subset of a ring/radical of ideal

-- ###################################
-- Aufgabe 6

def ideal_sum {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
  ideal R := ⟨ I.carrier ∪ J.carrier ⟩

notation I `+` J := ideal_sum I J

lemma ideal_sum_mem_iff {R : Type} [comm_semiring R] {I : ideal R} {J : ideal R} {x : R}:
  x ∈ I + J ↔ ∃ a ∈ I, ∃ b ∈ J, x = a + b :=
begin
  split,
  {
    sorry,
  },
  {
    intro h,
    cases h with a h,
    cases h with ha h,
    cases h with b h,
    cases h with hb h,
    suffices h' : a ∈ I+J ∧ b ∈ I+J,
    {
      rw h,
      apply (I+J).add_mem,
      exact h'.left,
      exact h'.right,
    },
    split,
    {
      apply ideal_of_extensive,
      left,
      exact ha,
    },
    {
      apply ideal_of_extensive,
      right,
      exact hb,
    },
  },
end

def ideal_product {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
  ideal R := ⟨ {ab | ∃ a ∈ I, ∃ b ∈ J, ab = a*b} ⟩

notation I `⬝` J := ideal_product I J

-- Aufgabe 6a)
def ideal_intersection {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
  ideal R := {
    carrier := I.carrier ∩ J.carrier,
    zero_mem' := begin
        rw set.inter_def,
        split,
        exact I.zero_mem',
        exact J.zero_mem',
      end,
    add_mem' := begin
        rw set.inter_def,
        intros a b aInInter bInInter,
        split,
        apply I.add_mem',
        exact aInInter.left,
        exact bInInter.left,
        apply J.add_mem',
        exact aInInter.right,
        exact bInInter.right,
      end,
    smul_mem' := begin
        rw set.inter_def,
        intros c x xInInter,
        split,
        apply I.smul_mem',
        exact xInInter.left,
        apply J.smul_mem',
        exact xInInter.right,
      end
  }

notation I `∩` J := ideal_intersection I J

-- Aufgabe b)
def ideal_quotient {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
  ideal R := {
    carrier := {r : R | {r' | ∃ j : J, r' = r*j} ⊆ I},
    zero_mem' := begin
        intros r' hr',
        have h: r' = 0 := begin
          cases hr' with j hj,
          rw hj,
          ring,
        end,
        rw h,
        exact I.zero_mem',
      end,
    add_mem' := begin
        sorry,
      end,
    smul_mem' := begin
        sorry,
      end
  }

notation I `:` J := ideal_quotient I J

  -- Aufgabe c)
  lemma ideal_prod_sub_cap {R : Type} [comm_semiring R] {I : ideal R} {J : ideal R} :
    (I ⬝ J).carrier ⊆ (I ∩ J).carrier := begin
      rw ← ideal_of_ideal (I ∩ J),
      apply ideal_of_mono,
      intros ab hab,
      cases hab with a hab,
      cases hab with ha hab,
      cases hab with b hab,
      cases hab with hb h,
      rw h,
      split,
      {
        show a*b ∈ I,
        rw mul_comm,
        exact I.smul_mem b ha,
      },
      {
        show a*b ∈ J,
        exact J.smul_mem a hb,
      },
  end

  lemma ideal_cap_sub_sum {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
    (I ∩ J).carrier ⊆ (I + J).carrier := begin
      sorry,
  end

  -- Aufgabe d)
  lemma radical_prod_eq_cap {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
    (√(I ⬝ J)) = √(I ∩ J) := begin
      sorry,
  end

  lemma radical_cap_eq_cap_radical {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
    (√(I ∩ J)) = (√I) ∩ (√J) := begin
      sorry,
  end

  -- Aufgabe e)
  lemma radical_sum {R : Type} [comm_semiring R] (I : ideal R) (J : ideal R) :
    (√(I + J)) = √((√I) + (√J)) := begin
      sorry,
  end


import analysis.topology.topological_space
import analysis.topology.continuity
import data.set.basic
import logic.basic
import Topology.Material.connected_spaces
import Topology.Material.WIP_Path_Homotopy
import analysis.real

open set filter lattice classical
local attribute [instance] prop_decidable

universe u
variables {α : Type u} {β : Type u}

def closed_interval (a b : ℝ) : set ℝ := {x : ℝ | a ≤ x ∧ x ≤ b}
def open_interval (a b : ℝ) : set ℝ := {x : ℝ | a < x ∧ x < b}

--def is_connected_in_reals (s : set ℝ) [topological_space ℝ] : Prop :=
--is_open s ↔ ∃ a b, s = open_interval a b

def is_path_connected [topological_space α] (U : set α) : Prop :=
∀ x y, x ∈ U → y ∈ U → ∃ f : I01 → α, is_path x y f ∧ ∀ r : I01, f r ∈ U

def is_path_connected_space [topological_space α] : Prop :=
∀ x y : α, ∃ f : I01 → α, is_path x y f

class path_connected_space α extends topological_space α :=
(path_connectedness : ∀ x y : α, ∃ f : I01 → α, is_path x y f)

theorem is_pcon_univ_iff_pcon (t : topological_space α) :
@is_path_connected_space α t ↔ @is_path_connected α t univ :=
begin
  apply iff.intro,
    intros H x y hx hy, cases (H x y) with f hf,
    by exact exists.intro f ⟨hf, assume r : I01, by simp⟩,
  intros H x y, cases (H x y (by simp) (by simp)) with f hf,
  by exact exists.intro f hf.1,
end

theorem exists_id_path [topological_space α] : ∀ x : α, ∃ f : I01 → α, is_path x x f :=
  assume x, exists.intro (λ y : I01, x) ⟨by simp, by simp, continuous_const⟩

lemma I01_connected : connected_space I01 := sorry

lemma I01_no_sep (C : connected_space I01) : ∀ U V : set I01,
is_open U ∧ is_open V → ¬(U ∪ V = univ ∧ U ∩ V = ∅ ∧ U ≠ ∅ ∧ V ≠ ∅)
:= sorry

theorem path_connected_imp_connected [path_connected_space α] : connected_space α :=
begin
  suffices H : ∀ U V : set α, is_open U ∧ is_open V → ¬(U ∪ V = univ ∧ U ∩ V = ∅ ∧ U ≠ ∅ ∧ V ≠ ∅),
    by exact no_open_separation_to_connected H,
  intros U V Huv Hc,
  have hx : ∃ x, x ∈ U := ne_empty_iff_exists_mem.mp Hc.2.2.1,
  have hy : ∃ y, y ∈ V := ne_empty_iff_exists_mem.mp Hc.2.2.2,
  cases hx with x hx, cases hy with y hy,
  have hf : ∃ f : I01 → α, is_path x y f := path_connected_space.path_connectedness x y,
  cases hf with f hp, unfold is_path at hp,
  have g1 : (f ⁻¹' U) ∪ (f ⁻¹' V) = univ, {rw [←preimage_union,Hc.1],simp},
  have g2 : (f ⁻¹' U) ∩ (f ⁻¹' V) = ∅, {rw [←preimage_inter,Hc.2.1],simp},
  have g3 : (f ⁻¹' U) ≠ ∅,
    {have a1 := hp.1,
      have a2 : f 0 ∈ U, rwa a1, rw [←mem_preimage_eq] at a2,
      have a3 : ∃ a, a ∈ f ⁻¹' U, exact exists.intro 0 a2,
      show (f ⁻¹' U) ≠ ∅, from ne_empty_iff_exists_mem.mpr a3},
  have g4 : (f ⁻¹' V) ≠ ∅,
    {have a1 := hp.2.1,
      have a2 : f 1 ∈ V, rwa a1, rw [←mem_preimage_eq] at a2,
      have a3 : ∃ a, a ∈ f ⁻¹' V, exact exists.intro 1 a2,
      show (f ⁻¹' V) ≠ ∅, from ne_empty_iff_exists_mem.mpr a3},
  have g5 : is_open (f ⁻¹' U) := hp.2.2 U Huv.1,
  have g6 : is_open (f ⁻¹' V) := hp.2.2 V Huv.2,
  have ha : (f ⁻¹' U) ∪ (f ⁻¹' V) = univ ∧ (f ⁻¹' U) ∩ (f ⁻¹' V) = ∅ ∧ (f ⁻¹' U) ≠ ∅ ∧ (f ⁻¹' V) ≠ ∅
    := ⟨g1,g2,g3,g4⟩,
  have C : connected_space I01 := I01_connected,
  have b1 : ¬((f ⁻¹' U) ∪ (f ⁻¹' V) = univ ∧ (f ⁻¹' U) ∩ (f ⁻¹' V) = ∅ ∧ (f ⁻¹' U) ≠ ∅ ∧ (f ⁻¹' V) ≠ ∅)
    := I01_no_sep C (f ⁻¹' U) (f ⁻¹' V) ⟨g5,g6⟩,
  by exact absurd ha b1,
end


import tactic.ring
import tactic.ring_exp
import algebra.category.CommRing.basic

open CommRing

universes v u
local notation ` Ring `     :=    CommRing.{u}
local notation ` Set  `     :=    Type u

---          Study of co-maximal familly ! I do the job why two elements for the moment  !
---          This is good file !
namespace co_maxi
variables (R : Type u) [comm_ring.{u} R ]

def co_max  (a b : R)    :=
             ∃ u v :  R,    a * u + b * v = 1

local infix     ⊥  :=  co_max R   --- notation
lemma one_perp (a : R)    :  1 ⊥ a :=   --- with 1 * 1 + a * 0 = 1
begin
    have h: 1 * 1 + a * 0 = 1,
        rw [one_mul,mul_zero,add_zero],
    use ⟨1,0,h⟩
end
lemma symm (a b : R) : (a ⊥ b) →  (b ⊥ a)  :=   --- a u + b v = 1 → b v + a u = 1
    λ ⟨u,v,k⟩,
        begin
            have  t :  b * v + a * u = 1,
                rw add_comm,  assumption,
            use ⟨v,u,t⟩,
        end

lemma abab_trick (a b c : R) : (a ⊥ c) → (b ⊥ c) → (a * b) ⊥ c :=    ---  Trick to simplify proof !  if a ⊥ c and b ⊥ c then ab ⊥ c  from calculus !
    λ ⟨ua,va,ka⟩  ⟨ub,vb,kb⟩,
        begin
            have J : (a * b) * ( ua * ub) + c * ( a * ua * vb + va * b * ub + va * c * vb) = 1,
                 by calc
                    (a * b) * ( ua * ub) + c * ( a * ua * vb + va * b * ub + va * c * vb)  =  (a * ua + c * va) * (b * ub + c * vb) : by ring_exp
                    ...                                                                    =   1                                    : by rw [ka,kb, one_mul],
        use ⟨ ua * ub,  a * ua * vb + va * b * ub + va * c * vb , J⟩,
        end
---- We do the big calculus, now is trivial induction !
---- for exemple a ⊥ c →  a^2 ⊥ c  using abab_trick a a c !  induction ...
open nat
lemma star (a  b : R) (n : nat):   (a ⊥ b) → ((a^n) ⊥ b)  :=
    λ u,
        nat.rec_on n
                (show  (a^0) ⊥ b, {rw pow_zero a, apply one_perp, })
                (assume n, assume re : ((a^n) ⊥ b), show (a^(n+1)) ⊥ b,
                       {rw pow_succ a n,apply abab_trick, assumption,assumption})

theorem My_favorite_localisation_lemma (a b : R) (n m : nat) : (a ⊥ b) → (a^n) ⊥ (b^m) :=                 --- the goals
    λ u, begin
        apply star,
        apply symm,    -- is there a repeat method ? How to programme such method ?
        apply star,
        apply symm,
        assumption,
    end
----
---     We want to proof 𝔸 is a local functor : a scheaf for global Zariski for Affᵒᵖ.
----   ( Note 𝔸 is structural for Ring so if you do the job for 𝔸 you do the job for all ring i.e Spec R := Hom(R,•) is a scheme (in sense of functorial geometry)
---    (ref Jantzen : 'algebraic group and representation' the first chapter) for all ring R : i can explain) !
---                 for the moment only with 2-covering famillies
---     There is two axioms :
---             1/ Separation : (for two elements ONLY)
---                      let R : comm_ring
---                      Let f,g ∈ R :  f ⊥ g.
---                      Let a ∈ R :
---                             ∃ m n : ℕ,  f^m a = 0 ∧  g^n a = 0   --- i.e a = 0 in localisation  {f^k k ∈ N⋆} and   {g^k k ∈ N⋆}
---                      Since f ⊥ g , we have f^m ⊥ b^n
---                      Have (u,v) s.t   f^m u + g^n v = 1
---                      multipliying by a give f^m au  + g^n a v = a  so 0 = a !
---    Note : i don't use Localisation library for the moment (i have to study) !
theorem Separation_axiom (a : R) (f g : R) : f ⊥ g → ( ∃ m n : ℕ, f^m * a = 0 ∧ g^n * a = 0 )   →   a = 0  :=  λ certif  ⟨m,n,proof⟩,
begin
    have H : (f^m) ⊥ (g^n),
        apply My_favorite_localisation_lemma,
        assumption,
    rcases H with ⟨ua,va,ka⟩,
        apply eq.symm,
        have H :  0  = (f ^ m * a* ua  +  g ^ n *a * va),
            rw [proof.1,proof.2],
            apply eq.symm,
            rw [zero_mul,zero_mul,add_zero],
        have G : (f ^ m * a* ua  +  g ^ n *a * va) = (f ^ m * ua  +  g ^ n  * va) * a,
        ring,
        rewrite [H,G,ka,one_mul a],
end
---   Gluing_axiome :
---
set_option class.instance_max_depth 20
theorem gluing_data (f g : R)(s_f s_g : R) (n : ℕ) :
         f ⊥ g → (∃ m : ℕ, f^m * g^(n+m) * s_f = g^m * f^(n+m) * s_g) →  (∃ s : R, ∃ N_f N_g : ℕ, f^(N_f+n) * s = f^N_f * s_f ∧  g^(N_g+n) * s = g^N_g * s_g) :=
         λ certif ⟨m,proof_m⟩, begin
            have H: (f^(n+m)) ⊥ (g^(n+m)),
                apply My_favorite_localisation_lemma,
                assumption,
            rcases H with ⟨vf,vg,proof_n_plus_m_f_g⟩,
            existsi [vf *s_f * f^m+ vg*s_g*g^m,m,m],
                split,
                    have H : f ^ (m + n) * (vf * s_f * f ^ m + vg * s_g * g ^ m) =   ( f ^ (n + m)* vf * s_f * f ^ m +  g ^ m *f ^ (n + m) *s_g * vg),
                        ring_exp,
                        rw [H,eq.symm proof_m],
                            have B : f ^ (n + m) * vf * s_f * f ^ m + f ^ m * g ^ (n + m) * s_f * vg = f^m *s_f *(f ^ (n + m) * vf + g ^ (n + m) * vg),
                            ring,
                            rw [B,proof_n_plus_m_f_g,mul_one],
                    have H : g ^ (m + n) * (vf * s_f * f ^ m + vg * s_g * g ^ m) =      f ^ m *g ^ (n+m) *s_f *vf + g ^ m* g ^ (n + m) * vg * s_g,
                        ring_exp,
                    rw [H,proof_m],
                        have B : g ^ m * f ^ (n + m) * s_g * vf + g ^ m * g ^ (n + m) * vg * s_g = g^m * s_g *(f ^ (n + m) * vf + g ^ (n + m) * vg ),
                        ring,
                        rw [B,proof_n_plus_m_f_g,mul_one],
end

#explode gluing_data

end co_maxi


import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

theorem fn_ub_add {f g : ℝ → ℝ} {a b : ℝ}
    (hfa : fn_ub f a) (hgb : fn_ub g b) :
  fn_ub (λ x, f x + g x) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

variables {f g : ℝ → ℝ}

-- BEGIN

example : fn_has_ub f → fn_has_ub g →
  fn_has_ub (λ x, f x + g x) :=
begin
  intros ubf ubg,
  sorry,
end

-- END


/- LoVe Homework 9: Hoare Logic -/

import .love08_operational_semantics_exercise_sheet
import .love09_hoare_logic_demo

namespace LoVe

/- Question 1: Hoare Logic for Dijkstra's Guarded Command Language -/

/- Recall the definition of GCL from exercise 8: -/

#check gcl

namespace gcl

#check big_step

/- The definition of Hoare triples for partial correctness is unsurprising: -/

def partial_hoare (P : state → Prop) (S : gcl state) (Q : state → Prop) :
  Prop :=
∀s t, P s → (S, s) ~~> t → Q t

local notation `{* ` P : 1 ` *} ` S : 1 ` {* ` Q : 1 ` *}` :=
partial_hoare P S Q

namespace partial_hoare

variables {P P' P₁ P₂ P₃ Q Q' : state → Prop} {x : string} {a : state → ℕ}
variables {S S₀ S₁ S₂ : gcl state} {Ss : list (gcl state)}

/- 1.1. Prove the consequence rule. -/

lemma consequence (h : {* P *} S {* Q *}) (hp : ∀s, P' s → P s)
    (hq : ∀s, Q s → Q' s) :
  {* P' *} S {* Q' *} :=
sorry

/- 1.2. Prove the rule for `assign`. -/

lemma assign_intro (P : state → Prop) :
  {* λs : state, P (s{x ↦ a s}) *} assign x a {* P *} :=
sorry

/- 1.3. Prove the rule for `assert`. -/

lemma assert_intro :
  {* λs, Q s → P s *} assert Q {* P *} :=
sorry

/- 1.4. Prove the rule for `seq`. -/

lemma seq_intro (h₁ : {* P₁ *} S₁ {* P₂ *}) (h₂ : {* P₂ *} S₂ {* P₃ *}) :
  {* P₁ *} seq S₁ S₂ {* P₃ *} :=
sorry

/- 1.5. Prove the rule for `choice`. -/

lemma choice_intro
    (h : ∀i (hi : i < list.length Ss),
       {* λs, P s *} list.nth_le Ss i hi {* Q *}) :
  {* P *} choice Ss {* Q *} :=
sorry

/- 1.6. State the rule for `loop`.

    lemma loop_intro … :
      {* … *} loop p {* … *} :=
    … -/

/- 1.7 **optional**. Prove the rule you stated for `loop`.

Hint: This one is difficult and requires some generalization, as explained in
Section 5.8 ("Induction Pitfalls") of the lecture notes. -/

-- enter your answer to question 1.6 here
-- enter your answer to question 1.7 here

end partial_hoare

end gcl

/- Question 2: Factorial -/

section FACT

/- The following WHILE program is intended to compute the factorial of `n`,
leaving the result in `r`. -/

def FACT : program :=
assign "r" (λs, 1) ;;
while (λs, s "n" ≠ 0)
  (assign "r" (λs, s "r" * s "n") ;;
   assign "n" (λs, s "n" - 1))

/- 2.1. Define the factorial function. -/

def fact : ℕ → ℕ
:= sorry

/- 2.2. Prove the correctness of `FACT` using `vcg`. -/

lemma FACT_correct (n : ℕ) :
  {* λs, s "n" = n *} FACT {* λs, s "r" = fact n *} :=
sorry

end FACT

end LoVe