/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.complex.basic
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Complex.Module
import Mathbin.Data.Complex.Exponential
import Mathbin.Data.IsROrC.Basic
import Mathbin.Topology.Algebra.InfiniteSum.Module
import Mathbin.Topology.Instances.RealVectorSpace

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `re_clm`
* `im_clm`
* `of_real_clm`
* `conj_cle`

They are bundled versions of the real part, the imaginary part, the embedding of `ℝ` in `ℂ`, and
the complex conjugate as continuous `ℝ`-linear maps. The last two are also bundled as linear
isometries in `of_real_li` and `conj_lie`.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/

assert_not_exists absorbs

noncomputable section

namespace Complex

open ComplexConjugate Topology

instance : Norm ℂ :=
  ⟨abs⟩

@[simp]
theorem norm_eq_abs (z : ℂ) : ‖z‖ = abs z :=
  rfl
#align complex.norm_eq_abs Complex.norm_eq_abs

theorem norm_exp_of_real_mul_i (t : ℝ) : ‖exp (t * I)‖ = 1 := by
  simp only [norm_eq_abs, abs_exp_of_real_mul_I]
#align complex.norm_exp_of_real_mul_I Complex.norm_exp_of_real_mul_i

instance : NormedAddCommGroup ℂ :=
  AddGroupNorm.toNormedAddCommGroup
    { abs with
      map_zero' := map_zero abs
      neg' := abs.map_neg
      eq_zero_of_map_eq_zero' := fun _ => abs.eq_zero.1 }

instance : NormedField ℂ :=
  { Complex.field,
    Complex.normedAddCommGroup with
    norm := abs
    dist_eq := fun _ _ => rfl
    norm_mul' := map_mul abs }

instance : DenselyNormedField ℂ
    where lt_norm_lt r₁ r₂ h₀ hr :=
    let ⟨x, h⟩ := NormedField.exists_lt_norm_lt ℝ h₀ hr
    have this : ‖(‖x‖ : ℂ)‖ = ‖‖x‖‖ := by simp only [norm_eq_abs, abs_of_real, Real.norm_eq_abs]
    ⟨‖x‖, by rwa [this, norm_norm]⟩

instance {R : Type _} [NormedField R] [NormedAlgebra R ℝ] : NormedAlgebra R ℂ
    where
  norm_smul_le r x :=
    by
    rw [norm_eq_abs, norm_eq_abs, ← algebraMap_smul ℝ r x, Algebra.smul_def, map_mul, ←
      norm_algebra_map' ℝ r, coe_algebra_map, abs_of_real]
    rfl
  toAlgebra := Complex.algebra

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℂ E]

-- see Note [lower instance priority]
/-- The module structure from `module.complex_to_real` is a normed space. -/
instance (priority := 900) NormedSpace.complexToReal : NormedSpace ℝ E :=
  NormedSpace.restrictScalars ℝ ℂ E
#align normed_space.complex_to_real NormedSpace.complexToReal

theorem dist_eq (z w : ℂ) : dist z w = abs (z - w) :=
  rfl
#align complex.dist_eq Complex.dist_eq

theorem dist_eq_re_im (z w : ℂ) : dist z w = Real.sqrt ((z.re - w.re) ^ 2 + (z.im - w.im) ^ 2) :=
  by
  rw [sq, sq]
  rfl
#align complex.dist_eq_re_im Complex.dist_eq_re_im

@[simp]
theorem dist_mk (x₁ y₁ x₂ y₂ : ℝ) :
    dist (mk x₁ y₁) (mk x₂ y₂) = Real.sqrt ((x₁ - x₂) ^ 2 + (y₁ - y₂) ^ 2) :=
  dist_eq_re_im _ _
#align complex.dist_mk Complex.dist_mk

theorem dist_of_re_eq {z w : ℂ} (h : z.re = w.re) : dist z w = dist z.im w.im := by
  rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, zero_add, Real.sqrt_sq_eq_abs, Real.dist_eq]
#align complex.dist_of_re_eq Complex.dist_of_re_eq

theorem nndist_of_re_eq {z w : ℂ} (h : z.re = w.re) : nndist z w = nndist z.im w.im :=
  NNReal.eq <| dist_of_re_eq h
#align complex.nndist_of_re_eq Complex.nndist_of_re_eq

theorem edist_of_re_eq {z w : ℂ} (h : z.re = w.re) : edist z w = edist z.im w.im := by
  rw [edist_nndist, edist_nndist, nndist_of_re_eq h]
#align complex.edist_of_re_eq Complex.edist_of_re_eq

theorem dist_of_im_eq {z w : ℂ} (h : z.im = w.im) : dist z w = dist z.re w.re := by
  rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, add_zero, Real.sqrt_sq_eq_abs, Real.dist_eq]
#align complex.dist_of_im_eq Complex.dist_of_im_eq

theorem nndist_of_im_eq {z w : ℂ} (h : z.im = w.im) : nndist z w = nndist z.re w.re :=
  NNReal.eq <| dist_of_im_eq h
#align complex.nndist_of_im_eq Complex.nndist_of_im_eq

theorem edist_of_im_eq {z w : ℂ} (h : z.im = w.im) : edist z w = edist z.re w.re := by
  rw [edist_nndist, edist_nndist, nndist_of_im_eq h]
#align complex.edist_of_im_eq Complex.edist_of_im_eq

theorem dist_conj_self (z : ℂ) : dist (conj z) z = 2 * |z.im| := by
  rw [dist_of_re_eq (conj_re z), conj_im, dist_comm, Real.dist_eq, sub_neg_eq_add, ← two_mul,
    _root_.abs_mul, abs_of_pos (zero_lt_two' ℝ)]
#align complex.dist_conj_self Complex.dist_conj_self

theorem nndist_conj_self (z : ℂ) : nndist (conj z) z = 2 * Real.nnabs z.im :=
  NNReal.eq <| by rw [← dist_nndist, NNReal.coe_mul, NNReal.coe_two, Real.coe_nnabs, dist_conj_self]
#align complex.nndist_conj_self Complex.nndist_conj_self

theorem dist_self_conj (z : ℂ) : dist z (conj z) = 2 * |z.im| := by rw [dist_comm, dist_conj_self]
#align complex.dist_self_conj Complex.dist_self_conj

theorem nndist_self_conj (z : ℂ) : nndist z (conj z) = 2 * Real.nnabs z.im := by
  rw [nndist_comm, nndist_conj_self]
#align complex.nndist_self_conj Complex.nndist_self_conj

@[simp]
theorem comap_abs_nhds_zero : Filter.comap abs (𝓝 0) = 𝓝 0 :=
  comap_norm_nhds_zero
#align complex.comap_abs_nhds_zero Complex.comap_abs_nhds_zero

theorem norm_real (r : ℝ) : ‖(r : ℂ)‖ = ‖r‖ :=
  abs_ofReal _
#align complex.norm_real Complex.norm_real

@[simp]
theorem norm_rat (r : ℚ) : ‖(r : ℂ)‖ = |(r : ℝ)| :=
  by
  rw [← of_real_rat_cast]
  exact norm_real _
#align complex.norm_rat Complex.norm_rat

@[simp]
theorem norm_nat (n : ℕ) : ‖(n : ℂ)‖ = n :=
  abs_of_nat _
#align complex.norm_nat Complex.norm_nat

@[simp]
theorem norm_int {n : ℤ} : ‖(n : ℂ)‖ = |n| := by
  simp (config := { singlePass := true }) [← Rat.cast_coe_int]
#align complex.norm_int Complex.norm_int

theorem norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ‖(n : ℂ)‖ = n := by simp [hn]
#align complex.norm_int_of_nonneg Complex.norm_int_of_nonneg

@[continuity]
theorem continuous_abs : Continuous abs :=
  continuous_norm
#align complex.continuous_abs Complex.continuous_abs

@[continuity]
theorem continuous_normSq : Continuous normSq := by
  simpa [← norm_sq_eq_abs] using continuous_abs.pow 2
#align complex.continuous_norm_sq Complex.continuous_normSq

@[simp, norm_cast]
theorem nnnorm_real (r : ℝ) : ‖(r : ℂ)‖₊ = ‖r‖₊ :=
  Subtype.ext <| norm_real r
#align complex.nnnorm_real Complex.nnnorm_real

@[simp, norm_cast]
theorem nnnorm_nat (n : ℕ) : ‖(n : ℂ)‖₊ = n :=
  Subtype.ext <| by simp
#align complex.nnnorm_nat Complex.nnnorm_nat

@[simp, norm_cast]
theorem nnnorm_int (n : ℤ) : ‖(n : ℂ)‖₊ = ‖n‖₊ :=
  Subtype.ext <| by simp only [coe_nnnorm, norm_int, Int.norm_eq_abs]
#align complex.nnnorm_int Complex.nnnorm_int

theorem nnnorm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) : ‖ζ‖₊ = 1 :=
  by
  refine' (@pow_left_inj NNReal _ _ _ _ zero_le' zero_le' hn.bot_lt).mp _
  rw [← nnnorm_pow, h, nnnorm_one, one_pow]
#align complex.nnnorm_eq_one_of_pow_eq_one Complex.nnnorm_eq_one_of_pow_eq_one

theorem norm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) : ‖ζ‖ = 1 :=
  congr_arg coe (nnnorm_eq_one_of_pow_eq_one h hn)
#align complex.norm_eq_one_of_pow_eq_one Complex.norm_eq_one_of_pow_eq_one

theorem equivRealProd_apply_le (z : ℂ) : ‖equivRealProd z‖ ≤ abs z := by
  simp [Prod.norm_def, abs_re_le_abs, abs_im_le_abs]
#align complex.equiv_real_prod_apply_le Complex.equivRealProd_apply_le

theorem equivRealProd_apply_le' (z : ℂ) : ‖equivRealProd z‖ ≤ 1 * abs z := by
  simpa using equiv_real_prod_apply_le z
#align complex.equiv_real_prod_apply_le' Complex.equivRealProd_apply_le'

theorem lipschitz_equivRealProd : LipschitzWith 1 equivRealProd := by
  simpa using AddMonoidHomClass.lipschitz_of_bound equiv_real_prod_lm 1 equiv_real_prod_apply_le'
#align complex.lipschitz_equiv_real_prod Complex.lipschitz_equivRealProd

theorem antilipschitz_equivRealProd : AntilipschitzWith (NNReal.sqrt 2) equivRealProd := by
  simpa using AddMonoidHomClass.antilipschitz_of_bound equiv_real_prod_lm abs_le_sqrt_two_mul_max
#align complex.antilipschitz_equiv_real_prod Complex.antilipschitz_equivRealProd

theorem uniformEmbedding_equivRealProd : UniformEmbedding equivRealProd :=
  antilipschitz_equivRealProd.UniformEmbedding lipschitz_equivRealProd.UniformContinuous
#align complex.uniform_embedding_equiv_real_prod Complex.uniformEmbedding_equivRealProd

instance : CompleteSpace ℂ :=
  (completeSpace_congr uniformEmbedding_equivRealProd).mpr inferInstance

/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps (config := { simpRhs := true }) apply symm_apply_re symm_apply_im]
def equivRealProdClm : ℂ ≃L[ℝ] ℝ × ℝ :=
  equivRealProdLm.toContinuousLinearEquivOfBounds 1 (Real.sqrt 2) equivRealProd_apply_le' fun p =>
    abs_le_sqrt_two_mul_max (equivRealProd.symm p)
#align complex.equiv_real_prod_clm Complex.equivRealProdClm

instance : ProperSpace ℂ :=
  (id lipschitz_equivRealProd : LipschitzWith 1 equivRealProdClm.toHomeomorph).ProperSpace

/-- The `abs` function on `ℂ` is proper. -/
theorem tendsto_abs_cocompact_atTop : Filter.Tendsto abs (Filter.cocompact ℂ) Filter.atTop :=
  tendsto_norm_cocompact_atTop
#align complex.tendsto_abs_cocompact_at_top Complex.tendsto_abs_cocompact_atTop

/-- The `norm_sq` function on `ℂ` is proper. -/
theorem tendsto_normSq_cocompact_atTop : Filter.Tendsto normSq (Filter.cocompact ℂ) Filter.atTop :=
  by
  simpa [mul_self_abs] using
    tendsto_abs_cocompact_at_top.at_top_mul_at_top tendsto_abs_cocompact_at_top
#align complex.tendsto_norm_sq_cocompact_at_top Complex.tendsto_normSq_cocompact_atTop

open ContinuousLinearMap

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def reClm : ℂ →L[ℝ] ℝ :=
  reLm.mkContinuous 1 fun x => by simp [abs_re_le_abs]
#align complex.re_clm Complex.reClm

@[continuity]
theorem continuous_re : Continuous re :=
  reClm.Continuous
#align complex.continuous_re Complex.continuous_re

@[simp]
theorem reClm_coe : (coe reClm : ℂ →ₗ[ℝ] ℝ) = reLm :=
  rfl
#align complex.re_clm_coe Complex.reClm_coe

@[simp]
theorem reClm_apply (z : ℂ) : (reClm : ℂ → ℝ) z = z.re :=
  rfl
#align complex.re_clm_apply Complex.reClm_apply

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def imClm : ℂ →L[ℝ] ℝ :=
  imLm.mkContinuous 1 fun x => by simp [abs_im_le_abs]
#align complex.im_clm Complex.imClm

@[continuity]
theorem continuous_im : Continuous im :=
  imClm.Continuous
#align complex.continuous_im Complex.continuous_im

@[simp]
theorem imClm_coe : (coe imClm : ℂ →ₗ[ℝ] ℝ) = imLm :=
  rfl
#align complex.im_clm_coe Complex.imClm_coe

@[simp]
theorem imClm_apply (z : ℂ) : (imClm : ℂ → ℝ) z = z.im :=
  rfl
#align complex.im_clm_apply Complex.imClm_apply

theorem restrictScalars_one_smul_right' (x : E) :
    ContinuousLinearMap.restrictScalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) =
      reClm.smul_right x + I • imClm.smul_right x :=
  by
  ext ⟨a, b⟩
  simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I]
#align complex.restrict_scalars_one_smul_right' Complex.restrictScalars_one_smul_right'

theorem restrictScalars_one_smulRight (x : ℂ) :
    ContinuousLinearMap.restrictScalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] ℂ) = x • 1 :=
  by
  ext1 z
  dsimp
  apply mul_comm
#align complex.restrict_scalars_one_smul_right Complex.restrictScalars_one_smulRight

/-- The complex-conjugation function from `ℂ` to itself is an isometric linear equivalence. -/
def conjLie : ℂ ≃ₗᵢ[ℝ] ℂ :=
  ⟨conjAe.toLinearEquiv, abs_conj⟩
#align complex.conj_lie Complex.conjLie

@[simp]
theorem conjLie_apply (z : ℂ) : conjLie z = conj z :=
  rfl
#align complex.conj_lie_apply Complex.conjLie_apply

@[simp]
theorem conjLie_symm : conjLie.symm = conjLie :=
  rfl
#align complex.conj_lie_symm Complex.conjLie_symm

theorem isometry_conj : Isometry (conj : ℂ → ℂ) :=
  conjLie.Isometry
#align complex.isometry_conj Complex.isometry_conj

@[simp]
theorem dist_conj_conj (z w : ℂ) : dist (conj z) (conj w) = dist z w :=
  isometry_conj.dist_eq z w
#align complex.dist_conj_conj Complex.dist_conj_conj

@[simp]
theorem nndist_conj_conj (z w : ℂ) : nndist (conj z) (conj w) = nndist z w :=
  isometry_conj.nndist_eq z w
#align complex.nndist_conj_conj Complex.nndist_conj_conj

theorem dist_conj_comm (z w : ℂ) : dist (conj z) w = dist z (conj w) := by
  rw [← dist_conj_conj, conj_conj]
#align complex.dist_conj_comm Complex.dist_conj_comm

theorem nndist_conj_comm (z w : ℂ) : nndist (conj z) w = nndist z (conj w) :=
  Subtype.ext <| dist_conj_comm _ _
#align complex.nndist_conj_comm Complex.nndist_conj_comm

instance : ContinuousStar ℂ :=
  ⟨conjLie.Continuous⟩

@[continuity]
theorem continuous_conj : Continuous (conj : ℂ → ℂ) :=
  continuous_star
#align complex.continuous_conj Complex.continuous_conj

/-- The only continuous ring homomorphisms from `ℂ` to `ℂ` are the identity and the complex
conjugation. -/
theorem ringHom_eq_id_or_conj_of_continuous {f : ℂ →+* ℂ} (hf : Continuous f) :
    f = RingHom.id ℂ ∨ f = conj :=
  by
  refine'
    (real_alg_hom_eq_id_or_conj <| AlgHom.mk' f <| map_real_smul f hf).imp (fun h => _) fun h => _
  all_goals convert congr_arg AlgHom.toRingHom h; ext1; rfl
#align complex.ring_hom_eq_id_or_conj_of_continuous Complex.ringHom_eq_id_or_conj_of_continuous

/-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/
def conjCle : ℂ ≃L[ℝ] ℂ :=
  conjLie
#align complex.conj_cle Complex.conjCle

@[simp]
theorem conjCle_coe : conjCle.toLinearEquiv = conjAe.toLinearEquiv :=
  rfl
#align complex.conj_cle_coe Complex.conjCle_coe

@[simp]
theorem conjCle_apply (z : ℂ) : conjCle z = conj z :=
  rfl
#align complex.conj_cle_apply Complex.conjCle_apply

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def ofRealLi : ℝ →ₗᵢ[ℝ] ℂ :=
  ⟨ofRealAm.toLinearMap, norm_real⟩
#align complex.of_real_li Complex.ofRealLi

theorem isometry_of_real : Isometry (coe : ℝ → ℂ) :=
  ofRealLi.Isometry
#align complex.isometry_of_real Complex.isometry_of_real

@[continuity]
theorem continuous_of_real : Continuous (coe : ℝ → ℂ) :=
  ofRealLi.Continuous
#align complex.continuous_of_real Complex.continuous_of_real

/-- The only continuous ring homomorphism from `ℝ` to `ℂ` is the identity. -/
theorem ringHom_eq_ofReal_of_continuous {f : ℝ →+* ℂ} (h : Continuous f) : f = Complex.ofReal :=
  by
  convert congr_arg AlgHom.toRingHom
      (Subsingleton.elim (AlgHom.mk' f <| map_real_smul f h) <| Algebra.ofId ℝ ℂ)
  ext1; rfl
#align complex.ring_hom_eq_of_real_of_continuous Complex.ringHom_eq_ofReal_of_continuous

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def ofRealClm : ℝ →L[ℝ] ℂ :=
  ofRealLi.toContinuousLinearMap
#align complex.of_real_clm Complex.ofRealClm

@[simp]
theorem ofRealClm_coe : (ofRealClm : ℝ →ₗ[ℝ] ℂ) = ofRealAm.toLinearMap :=
  rfl
#align complex.of_real_clm_coe Complex.ofRealClm_coe

@[simp]
theorem ofRealClm_apply (x : ℝ) : ofRealClm x = x :=
  rfl
#align complex.of_real_clm_apply Complex.ofRealClm_apply

noncomputable instance : IsROrC ℂ
    where
  re := ⟨Complex.re, Complex.zero_re, Complex.add_re⟩
  im := ⟨Complex.im, Complex.zero_im, Complex.add_im⟩
  I := Complex.I
  i_re_ax := by simp only [AddMonoidHom.coe_mk, Complex.I_re]
  i_mul_i_ax := by simp only [Complex.I_mul_I, eq_self_iff_true, or_true_iff]
  re_add_im_ax z := by
    simp only [AddMonoidHom.coe_mk, Complex.re_add_im, Complex.coe_algebraMap,
      Complex.ofReal_eq_coe]
  of_real_re_ax r := by
    simp only [AddMonoidHom.coe_mk, Complex.ofReal_re, Complex.coe_algebraMap,
      Complex.ofReal_eq_coe]
  of_real_im_ax r := by
    simp only [AddMonoidHom.coe_mk, Complex.ofReal_im, Complex.coe_algebraMap,
      Complex.ofReal_eq_coe]
  mul_re_ax z w := by simp only [Complex.mul_re, AddMonoidHom.coe_mk]
  mul_im_ax z w := by simp only [AddMonoidHom.coe_mk, Complex.mul_im]
  conj_re_ax z := rfl
  conj_im_ax z := rfl
  conj_i_ax := by simp only [Complex.conj_I, RingHom.coe_mk]
  norm_sq_eq_def_ax z := by
    simp only [← Complex.normSq_eq_abs, ← Complex.normSq_apply, AddMonoidHom.coe_mk,
      Complex.norm_eq_abs]
  mul_im_i_ax z := by simp only [mul_one, AddMonoidHom.coe_mk, Complex.I_im]
  inv_def_ax z := by
    simp only [Complex.inv_def, Complex.normSq_eq_abs, Complex.coe_algebraMap,
      Complex.ofReal_eq_coe, Complex.norm_eq_abs]
  div_i_ax := Complex.div_I

theorem IsROrC.re_eq_complex_re : ⇑(IsROrC.re : ℂ →+ ℝ) = Complex.re :=
  rfl
#align is_R_or_C.re_eq_complex_re IsROrC.re_eq_complex_re

theorem IsROrC.im_eq_complex_im : ⇑(IsROrC.im : ℂ →+ ℝ) = Complex.im :=
  rfl
#align is_R_or_C.im_eq_complex_im IsROrC.im_eq_complex_im

section ComplexOrder

open ComplexOrder

theorem eq_coe_norm_of_nonneg {z : ℂ} (hz : 0 ≤ z) : z = ↑‖z‖ := by
  rw [eq_re_of_real_le hz, IsROrC.norm_of_real, Real.norm_of_nonneg (Complex.le_def.2 hz).1]
#align complex.eq_coe_norm_of_nonneg Complex.eq_coe_norm_of_nonneg

end ComplexOrder

end Complex

namespace IsROrC

open ComplexConjugate

-- mathport name: exprreC
local notation "reC" => @IsROrC.re ℂ _

-- mathport name: exprimC
local notation "imC" => @IsROrC.im ℂ _

-- mathport name: exprIC
local notation "IC" => @IsROrC.i ℂ _

-- mathport name: exprabsC
local notation "absC" => @IsROrC.abs ℂ _

-- mathport name: exprnorm_sqC
local notation "norm_sqC" => @IsROrC.normSq ℂ _

@[simp]
theorem re_to_complex {x : ℂ} : reC x = x.re :=
  rfl
#align is_R_or_C.re_to_complex IsROrC.re_to_complex

@[simp]
theorem im_to_complex {x : ℂ} : imC x = x.im :=
  rfl
#align is_R_or_C.im_to_complex IsROrC.im_to_complex

@[simp]
theorem i_to_complex : IC = Complex.I :=
  rfl
#align is_R_or_C.I_to_complex IsROrC.i_to_complex

@[simp]
theorem normSq_to_complex {x : ℂ} : norm_sqC x = Complex.normSq x := by
  simp [IsROrC.normSq, Complex.normSq]
#align is_R_or_C.norm_sq_to_complex IsROrC.normSq_to_complex

@[simp]
theorem abs_to_complex {x : ℂ} : absC x = Complex.abs x := by simp [IsROrC.abs, Complex.abs]
#align is_R_or_C.abs_to_complex IsROrC.abs_to_complex

section tsum

variable {α : Type _} (𝕜 : Type _) [IsROrC 𝕜]

@[simp]
theorem hasSum_conj {f : α → 𝕜} {x : 𝕜} : HasSum (fun x => conj (f x)) x ↔ HasSum f (conj x) :=
  conjCle.HasSum
#align is_R_or_C.has_sum_conj IsROrC.hasSum_conj

theorem hasSum_conj' {f : α → 𝕜} {x : 𝕜} : HasSum (fun x => conj (f x)) (conj x) ↔ HasSum f x :=
  conjCle.has_sum'
#align is_R_or_C.has_sum_conj' IsROrC.hasSum_conj'

@[simp]
theorem summable_conj {f : α → 𝕜} : (Summable fun x => conj (f x)) ↔ Summable f :=
  summable_star_iff
#align is_R_or_C.summable_conj IsROrC.summable_conj

variable {𝕜}

theorem conj_tsum (f : α → 𝕜) : conj (∑' a, f a) = ∑' a, conj (f a) :=
  tsum_star
#align is_R_or_C.conj_tsum IsROrC.conj_tsum

variable (𝕜)

@[simp, norm_cast]
theorem hasSum_of_real {f : α → ℝ} {x : ℝ} : HasSum (fun x => (f x : 𝕜)) x ↔ HasSum f x :=
  ⟨fun h => by simpa only [IsROrC.reClm_apply, IsROrC.of_real_re] using re_clm.has_sum h,
    ofRealClm.HasSum⟩
#align is_R_or_C.has_sum_of_real IsROrC.hasSum_of_real

@[simp, norm_cast]
theorem summable_of_real {f : α → ℝ} : (Summable fun x => (f x : 𝕜)) ↔ Summable f :=
  ⟨fun h => by simpa only [IsROrC.reClm_apply, IsROrC.of_real_re] using re_clm.summable h,
    ofRealClm.Summable⟩
#align is_R_or_C.summable_of_real IsROrC.summable_of_real

@[norm_cast]
theorem of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : 𝕜) = ∑' a, f a :=
  by
  by_cases h : Summable f
  · exact ContinuousLinearMap.map_tsum of_real_clm h
  ·
    rw [tsum_eq_zero_of_not_summable h,
      tsum_eq_zero_of_not_summable ((summable_of_real _).Not.mpr h), of_real_zero]
#align is_R_or_C.of_real_tsum IsROrC.of_real_tsum

theorem hasSum_re {f : α → 𝕜} {x : 𝕜} (h : HasSum f x) : HasSum (fun x => re (f x)) (re x) :=
  reClm.HasSum h
#align is_R_or_C.has_sum_re IsROrC.hasSum_re

theorem hasSum_im {f : α → 𝕜} {x : 𝕜} (h : HasSum f x) : HasSum (fun x => im (f x)) (im x) :=
  imClm.HasSum h
#align is_R_or_C.has_sum_im IsROrC.hasSum_im

theorem re_tsum {f : α → 𝕜} (h : Summable f) : re (∑' a, f a) = ∑' a, re (f a) :=
  reClm.map_tsum h
#align is_R_or_C.re_tsum IsROrC.re_tsum

theorem im_tsum {f : α → 𝕜} (h : Summable f) : im (∑' a, f a) = ∑' a, im (f a) :=
  imClm.map_tsum h
#align is_R_or_C.im_tsum IsROrC.im_tsum

variable {𝕜}

theorem hasSum_iff (f : α → 𝕜) (c : 𝕜) :
    HasSum f c ↔ HasSum (fun x => re (f x)) (re c) ∧ HasSum (fun x => im (f x)) (im c) :=
  by
  refine' ⟨fun h => ⟨has_sum_re _ h, has_sum_im _ h⟩, _⟩
  rintro ⟨h₁, h₂⟩
  rw [← IsROrC.re_add_im c]
  convert((has_sum_of_real 𝕜).mpr h₁).add (((has_sum_of_real 𝕜).mpr h₂).mul_right I)
  simp_rw [IsROrC.re_add_im]
#align is_R_or_C.has_sum_iff IsROrC.hasSum_iff

end tsum

end IsROrC

namespace Complex

/-!
We have to repeat the lemmas about `is_R_or_C.re` and `is_R_or_C.im` as they are not syntactic
matches for `complex.re` and `complex.im`.

We do not have this problem with `of_real` and `conj`, although we repeat them anyway for
discoverability and to avoid the need to unify `𝕜`.
-/

section tsum

variable {α : Type _}

open ComplexConjugate

@[simp]
theorem hasSum_conj {f : α → ℂ} {x : ℂ} : HasSum (fun x => conj (f x)) x ↔ HasSum f (conj x) :=
  IsROrC.hasSum_conj _
#align complex.has_sum_conj Complex.hasSum_conj

theorem hasSum_conj' {f : α → ℂ} {x : ℂ} : HasSum (fun x => conj (f x)) (conj x) ↔ HasSum f x :=
  IsROrC.hasSum_conj' _
#align complex.has_sum_conj' Complex.hasSum_conj'

@[simp]
theorem summable_conj {f : α → ℂ} : (Summable fun x => conj (f x)) ↔ Summable f :=
  IsROrC.summable_conj _
#align complex.summable_conj Complex.summable_conj

theorem conj_tsum (f : α → ℂ) : conj (∑' a, f a) = ∑' a, conj (f a) :=
  IsROrC.conj_tsum _
#align complex.conj_tsum Complex.conj_tsum

@[simp, norm_cast]
theorem hasSum_of_real {f : α → ℝ} {x : ℝ} : HasSum (fun x => (f x : ℂ)) x ↔ HasSum f x :=
  IsROrC.hasSum_of_real _
#align complex.has_sum_of_real Complex.hasSum_of_real

@[simp, norm_cast]
theorem summable_of_real {f : α → ℝ} : (Summable fun x => (f x : ℂ)) ↔ Summable f :=
  IsROrC.summable_of_real _
#align complex.summable_of_real Complex.summable_of_real

@[norm_cast]
theorem of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : ℂ) = ∑' a, f a :=
  IsROrC.of_real_tsum _ _
#align complex.of_real_tsum Complex.of_real_tsum

theorem hasSum_re {f : α → ℂ} {x : ℂ} (h : HasSum f x) : HasSum (fun x => (f x).re) x.re :=
  IsROrC.hasSum_re _ h
#align complex.has_sum_re Complex.hasSum_re

theorem hasSum_im {f : α → ℂ} {x : ℂ} (h : HasSum f x) : HasSum (fun x => (f x).im) x.im :=
  IsROrC.hasSum_im _ h
#align complex.has_sum_im Complex.hasSum_im

theorem re_tsum {f : α → ℂ} (h : Summable f) : (∑' a, f a).re = ∑' a, (f a).re :=
  IsROrC.re_tsum _ h
#align complex.re_tsum Complex.re_tsum

theorem im_tsum {f : α → ℂ} (h : Summable f) : (∑' a, f a).im = ∑' a, (f a).im :=
  IsROrC.im_tsum _ h
#align complex.im_tsum Complex.im_tsum

theorem hasSum_iff (f : α → ℂ) (c : ℂ) :
    HasSum f c ↔ HasSum (fun x => (f x).re) c.re ∧ HasSum (fun x => (f x).im) c.im :=
  IsROrC.hasSum_iff _ _
#align complex.has_sum_iff Complex.hasSum_iff

end tsum

end Complex


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import data.opposite
import algebra.field
import algebra.group.commute
import group_theory.group_action.defs
import data.equiv.mul_add

/-!
# Algebraic operations on `αᵒᵖ`

This file records several basic facts about the opposite of an algebraic structure, e.g. the
opposite of a ring is a ring (with multiplication `x * y = yx`). Use is made of the identity
functions `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`.
-/

namespace opposite
universes u

variables (α : Type u)

instance [has_add α] : has_add (opposite α) :=
{ add := λ x y, op (unop x + unop y) }

instance [has_sub α] : has_sub (opposite α) :=
{ sub := λ x y, op (unop x - unop y) }

instance [add_semigroup α] : add_semigroup (opposite α) :=
{ add_assoc := λ x y z, unop_injective $ add_assoc (unop x) (unop y) (unop z),
  .. opposite.has_add α }

instance [add_left_cancel_semigroup α] : add_left_cancel_semigroup (opposite α) :=
{ add_left_cancel := λ x y z H, unop_injective $ add_left_cancel $ op_injective H,
  .. opposite.add_semigroup α }

instance [add_right_cancel_semigroup α] : add_right_cancel_semigroup (opposite α) :=
{ add_right_cancel := λ x y z H, unop_injective $ add_right_cancel $ op_injective H,
  .. opposite.add_semigroup α }

instance [add_comm_semigroup α] : add_comm_semigroup (opposite α) :=
{ add_comm := λ x y, unop_injective $ add_comm (unop x) (unop y),
  .. opposite.add_semigroup α }

instance [has_zero α] : has_zero (opposite α) :=
{ zero := op 0 }

instance [nontrivial α] : nontrivial (opposite α) :=
let ⟨x, y, h⟩ := exists_pair_ne α in nontrivial_of_ne (op x) (op y) (op_injective.ne h)

section
local attribute [reducible] opposite
@[simp] lemma unop_eq_zero_iff [has_zero α] (a : αᵒᵖ) : a.unop = (0 : α) ↔ a = (0 : αᵒᵖ) :=
iff.refl _

@[simp] lemma op_eq_zero_iff [has_zero α] (a : α) : op a = (0 : αᵒᵖ) ↔ a = (0 : α) :=
iff.refl _
end

instance [add_zero_class α] : add_zero_class (opposite α) :=
{ zero_add := λ x, unop_injective $ zero_add $ unop x,
  add_zero := λ x, unop_injective $ add_zero $ unop x,
  .. opposite.has_add α, .. opposite.has_zero α }

instance [add_monoid α] : add_monoid (opposite α) :=
{ .. opposite.add_semigroup α, .. opposite.add_zero_class α }

instance [add_comm_monoid α] : add_comm_monoid (opposite α) :=
{ .. opposite.add_monoid α, .. opposite.add_comm_semigroup α }

instance [has_neg α] : has_neg (opposite α) :=
{ neg := λ x, op $ -(unop x) }

instance [add_group α] : add_group (opposite α) :=
{ add_left_neg := λ x, unop_injective $ add_left_neg $ unop x,
  sub_eq_add_neg := λ x y, unop_injective $ sub_eq_add_neg (unop x) (unop y),
  .. opposite.add_monoid α, .. opposite.has_neg α, .. opposite.has_sub α }

instance [add_comm_group α] : add_comm_group (opposite α) :=
{ .. opposite.add_group α, .. opposite.add_comm_monoid α }

instance [has_mul α] : has_mul (opposite α) :=
{ mul := λ x y, op (unop y * unop x) }

instance [semigroup α] : semigroup (opposite α) :=
{ mul_assoc := λ x y z, unop_injective $ eq.symm $ mul_assoc (unop z) (unop y) (unop x),
  .. opposite.has_mul α }

instance [right_cancel_semigroup α] : left_cancel_semigroup (opposite α) :=
{ mul_left_cancel := λ x y z H, unop_injective $ mul_right_cancel $ op_injective H,
  .. opposite.semigroup α }

instance [left_cancel_semigroup α] : right_cancel_semigroup (opposite α) :=
{ mul_right_cancel := λ x y z H, unop_injective $ mul_left_cancel $ op_injective H,
  .. opposite.semigroup α }

instance [comm_semigroup α] : comm_semigroup (opposite α) :=
{ mul_comm := λ x y, unop_injective $ mul_comm (unop y) (unop x),
  .. opposite.semigroup α }

instance [has_one α] : has_one (opposite α) :=
{ one := op 1 }

section
local attribute [reducible] opposite
@[simp] lemma unop_eq_one_iff [has_one α] (a : αᵒᵖ) : a.unop = 1 ↔ a = 1 :=
iff.refl _

@[simp] lemma op_eq_one_iff [has_one α] (a : α) : op a = 1 ↔ a = 1 :=
iff.refl _
end

instance [mul_one_class α] : mul_one_class (opposite α) :=
{ one_mul := λ x, unop_injective $ mul_one $ unop x,
  mul_one := λ x, unop_injective $ one_mul $ unop x,
  .. opposite.has_mul α, .. opposite.has_one α }

instance [monoid α] : monoid (opposite α) :=
{ .. opposite.semigroup α, .. opposite.mul_one_class α }

instance [comm_monoid α] : comm_monoid (opposite α) :=
{ .. opposite.monoid α, .. opposite.comm_semigroup α }

instance [has_inv α] : has_inv (opposite α) :=
{ inv := λ x, op $ (unop x)⁻¹ }

instance [group α] : group (opposite α) :=
{ mul_left_inv := λ x, unop_injective $ mul_inv_self $ unop x,
  .. opposite.monoid α, .. opposite.has_inv α }

instance [comm_group α] : comm_group (opposite α) :=
{ .. opposite.group α, .. opposite.comm_monoid α }

instance [distrib α] : distrib (opposite α) :=
{ left_distrib := λ x y z, unop_injective $ add_mul (unop y) (unop z) (unop x),
  right_distrib := λ x y z, unop_injective $ mul_add (unop z) (unop x) (unop y),
  .. opposite.has_add α, .. opposite.has_mul α }

instance [mul_zero_class α] : mul_zero_class (opposite α) :=
{ zero := 0,
  mul := (*),
  zero_mul := λ x, unop_injective $ mul_zero $ unop x,
  mul_zero := λ x, unop_injective $ zero_mul $ unop x }

instance [mul_zero_one_class α] : mul_zero_one_class (opposite α) :=
{ .. opposite.mul_zero_class α, .. opposite.mul_one_class α }

instance [monoid_with_zero α] : monoid_with_zero (opposite α) :=
{ .. opposite.monoid α, .. opposite.mul_zero_one_class α }

instance [semiring α] : semiring (opposite α) :=
{ .. opposite.add_comm_monoid α, .. opposite.monoid_with_zero α, .. opposite.distrib α }

instance [ring α] : ring (opposite α) :=
{ .. opposite.add_comm_group α, .. opposite.monoid α, .. opposite.semiring α }

instance [comm_ring α] : comm_ring (opposite α) :=
{ .. opposite.ring α, .. opposite.comm_semigroup α }

instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors (opposite α) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y (H : op (_ * _) = op (0:α)),
    or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero $ op_injective H)
      (λ hy, or.inr $ unop_injective $ hy) (λ hx, or.inl $ unop_injective $ hx), }

instance [integral_domain α] : integral_domain (opposite α) :=
{ .. opposite.no_zero_divisors α, .. opposite.comm_ring α, .. opposite.nontrivial α }

instance [field α] : field (opposite α) :=
{ mul_inv_cancel := λ x hx, unop_injective $ inv_mul_cancel $ λ hx', hx $ unop_injective hx',
  inv_zero := unop_injective inv_zero,
  .. opposite.comm_ring α, .. opposite.has_inv α, .. opposite.nontrivial α }

instance (R : Type*) [has_scalar R α] : has_scalar R (opposite α) :=
{ smul := λ c x, op (c • unop x) }

instance (R : Type*) [monoid R] [mul_action R α] : mul_action R (opposite α) :=
{ one_smul := λ x, unop_injective $ one_smul R (unop x),
  mul_smul := λ r₁ r₂ x, unop_injective $ mul_smul r₁ r₂ (unop x),
  ..opposite.has_scalar α R  }

instance (R : Type*) [monoid R] [add_monoid α] [distrib_mul_action R α] :
  distrib_mul_action R (opposite α) :=
{ smul_add := λ r x₁ x₂, unop_injective $ smul_add r (unop x₁) (unop x₂),
  smul_zero := λ r, unop_injective $ smul_zero r,
  ..opposite.mul_action α R }

@[simp] lemma op_zero [has_zero α] : op (0 : α) = 0 := rfl
@[simp]

@[simp] lemma op_one [has_one α] : op (1 : α) = 1 := rfl
@[simp] lemma unop_one [has_one α] : unop (1 : αᵒᵖ) = 1 := rfl

variable {α}

@[simp] lemma op_add [has_add α] (x y : α) : op (x + y) = op x + op y := rfl
@[simp] lemma unop_add [has_add α] (x y : αᵒᵖ) : unop (x + y) = unop x + unop y := rfl

@[simp] lemma op_neg [has_neg α] (x : α) : op (-x) = -op x := rfl
@[simp] lemma unop_neg [has_neg α] (x : αᵒᵖ) : unop (-x) = -unop x := rfl

@[simp] lemma op_mul [has_mul α] (x y : α) : op (x * y) = op y * op x := rfl
@[simp] lemma unop_mul [has_mul α] (x y : αᵒᵖ) : unop (x * y) = unop y * unop x := rfl

@[simp] lemma op_inv [has_inv α] (x : α) : op (x⁻¹) = (op x)⁻¹ := rfl
@[simp] lemma unop_inv [has_inv α] (x : αᵒᵖ) : unop (x⁻¹) = (unop x)⁻¹ := rfl

@[simp] lemma op_sub [add_group α] (x y : α) : op (x - y) = op x - op y := rfl
@[simp] lemma unop_sub [add_group α] (x y : αᵒᵖ) : unop (x - y) = unop x - unop y := rfl

@[simp] lemma op_smul {R : Type*} [has_scalar R α] (c : R) (a : α) : op (c • a) = c • op a := rfl
@[simp] lemma unop_smul {R : Type*} [has_scalar R α] (c : R) (a : αᵒᵖ) :
  unop (c • a) = c • unop a := rfl

lemma semiconj_by.op [has_mul α] {a x y : α} (h : semiconj_by a x y) :
  semiconj_by (op a) (op y) (op x) :=
begin
  dunfold semiconj_by,
  rw [← op_mul, ← op_mul, h.eq]
end

lemma semiconj_by.unop [has_mul α] {a x y : αᵒᵖ} (h : semiconj_by a x y) :
  semiconj_by (unop a) (unop y) (unop x) :=
begin
  dunfold semiconj_by,
  rw [← unop_mul, ← unop_mul, h.eq]
end

@[simp] lemma semiconj_by_op [has_mul α] {a x y : α} :
  semiconj_by (op a) (op y) (op x) ↔ semiconj_by a x y :=
begin
  split,
  { intro h,
    rw [← unop_op a, ← unop_op x, ← unop_op y],
    exact semiconj_by.unop h },
  { intro h,
    exact semiconj_by.op h }
end

@[simp] lemma semiconj_by_unop [has_mul α] {a x y : αᵒᵖ} :
  semiconj_by (unop a) (unop y) (unop x) ↔ semiconj_by a x y :=
by conv_rhs { rw [← op_unop a, ← op_unop x, ← op_unop y, semiconj_by_op] }

lemma commute.op [has_mul α] {x y : α} (h : commute x y) : commute (op x) (op y) :=
begin
  dunfold commute at h ⊢,
  exact semiconj_by.op h
end

lemma commute.unop [has_mul α] {x y : αᵒᵖ} (h : commute x y) : commute (unop x) (unop y) :=
begin
  dunfold commute at h ⊢,
  exact semiconj_by.unop h
end

@[simp] lemma commute_op [has_mul α] {x y : α} :
  commute (op x) (op y) ↔ commute x y :=
begin
  dunfold commute,
  rw semiconj_by_op
end

@[simp] lemma commute_unop [has_mul α] {x y : αᵒᵖ} :
  commute (unop x) (unop y) ↔ commute x y :=
begin
  dunfold commute,
  rw semiconj_by_unop
end

/-- The function `op` is an additive equivalence. -/
def op_add_equiv [has_add α] : α ≃+ αᵒᵖ :=
{ map_add' := λ a b, rfl, .. equiv_to_opposite }

@[simp] lemma coe_op_add_equiv [has_add α] : (op_add_equiv : α → αᵒᵖ) = op := rfl
@[simp] lemma coe_op_add_equiv_symm [has_add α] :
  (op_add_equiv.symm : αᵒᵖ → α) = unop := rfl

@[simp] lemma op_add_equiv_to_equiv [has_add α] :
  (op_add_equiv : α ≃+ αᵒᵖ).to_equiv = equiv_to_opposite :=
rfl

end opposite

open opposite

/-- Inversion on a group is a `mul_equiv` to the opposite group. When `G` is commutative, there is
`mul_equiv.inv`. -/
@[simps {fully_applied := ff}]
def mul_equiv.inv' (G : Type*) [group G] : G ≃* Gᵒᵖ :=
{ to_fun := opposite.op ∘ has_inv.inv,
  inv_fun := has_inv.inv ∘ opposite.unop,
  map_mul' := λ x y, unop_injective $ mul_inv_rev x y,
  ..(equiv.inv G).trans equiv_to_opposite}

/-- A monoid homomorphism `f : R →* S` such that `f x` commutes with `f y` for all `x, y` defines
a monoid homomorphism to `Sᵒᵖ`. -/
@[simps {fully_applied := ff}]
def monoid_hom.to_opposite {R S : Type*} [mul_one_class R] [mul_one_class S] (f : R →* S)
  (hf : ∀ x y, commute (f x) (f y)) : R →* Sᵒᵖ :=
{ to_fun := opposite.op ∘ f,
  map_one' := congr_arg op f.map_one,
  map_mul' := λ x y, by simp [(hf x y).eq] }

/-- A ring homomorphism `f : R →+* S` such that `f x` commutes with `f y` for all `x, y` defines
a ring homomorphism to `Sᵒᵖ`. -/
@[simps {fully_applied := ff}]
def ring_hom.to_opposite {R S : Type*} [semiring R] [semiring S] (f : R →+* S)
  (hf : ∀ x y, commute (f x) (f y)) : R →+* Sᵒᵖ :=
{ to_fun := opposite.op ∘ f,
  .. ((opposite.op_add_equiv : S ≃+ Sᵒᵖ).to_add_monoid_hom.comp ↑f : R →+ Sᵒᵖ),
  .. f.to_monoid_hom.to_opposite hf }


import tuto_lib

set_option pp.beta true
set_option pp.coercions false

/-
This is the final file in the series. Here we use everything covered
in previous files to prove a couple of famous theorems from
elementary real analysis. Of course they all have more general versions
in mathlib.

As usual, keep in mind the following:

  abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

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

  le_max_left p q : p ≤ max p q

  le_max_right p q : q ≤ max p q

as well as a lemma from the previous file:

  le_of_le_add_all : (∀ ε > 0, y ≤ x + ε) →  y ≤ x

Let's start with a variation on a known exercise.
-/

-- 0071
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∃ N, ∀ n ≥ N, y ≤ u n) : y ≤ x :=
begin
  sorry
end

/-
Let's now return to the result proved in the `00_` file of this series,
and prove again the sequential characterization of upper bounds (with a slighly
different proof).

For this, and other exercises below, we'll need many things that we proved in previous files,
and a couple of extras.

From the 5th file:

  limit_const (x : ℝ) : seq_limit (λ n, x) x

  squeeze (lim_u : seq_limit u l) (lim_w : seq_limit w l)
    (hu : ∀ n, u n ≤ v n) (hw : ∀ n, v n ≤ w n)  : seq_limit v l

From the 8th:

  def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

  def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

  lt_sup (hx : is_sup A x) : ∀ y, y < x → ∃ a ∈ A, y < a :=

You can also use:

  nat.one_div_pos_of_nat {n : ℕ} : 0 < 1 / (n + 1 : ℝ)

  inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε

and their easy consequences:

  limit_of_sub_le_inv_succ (h : ∀ n, |u n - x| ≤ 1/(n+1)) : seq_limit u x

  limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x

  limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x

The structure of the proof is offered. It features a new tactic:
`choose` which invokes the axiom of choice (observing the tactic state before and
after using it should be enough to understand everything).
-/

-- 0072
lemma is_sup_iff (A : set ℝ) (x : ℝ) :
(is_sup A x) ↔ (upper_bound A x ∧ ∃ u : ℕ → ℝ, seq_limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    {
      sorry
    },
    { have : ∀ n : ℕ, ∃ a ∈ A, x - 1/(n+1) < a,
      { intros n,
        have : 1/(n+1 : ℝ) > 0,
          exact nat.one_div_pos_of_nat,
        sorry
      },
      choose u hu using this,
      sorry
  } },
  { rintro ⟨maj, u, limu, u_in⟩,
    sorry
  },
end

/-- Continuity of a function at a point  -/
def continuous_at_pt (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

variables {f : ℝ → ℝ} {x₀ : ℝ} {u : ℕ → ℝ}

-- 0073
lemma seq_continuous_of_continuous (hf : continuous_at_pt f x₀)
  (hu : seq_limit u x₀) : seq_limit (f ∘ u) (f x₀) :=
begin
  sorry
end

-- 0074
example :
  (∀ u : ℕ → ℝ, seq_limit u x₀ → seq_limit (f ∘ u) (f x₀)) →
  continuous_at_pt f x₀ :=
begin
  sorry
end

/-
Recall from the 6th file:

  def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

  def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
    ∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

  id_le_extraction : extraction φ → ∀ n, n ≤ φ n

and from the 8th file:

  def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

  not_seq_limit_of_tendstoinfinity : tendsto_infinity u → ∀ l, ¬ seq_limit u l
-/

variables {φ : ℕ → ℕ}

-- 0075
lemma subseq_tendstoinfinity
  (h : tendsto_infinity u) (hφ : extraction φ) :
tendsto_infinity (u ∘ φ) :=
begin
  sorry
end

-- 0076
lemma squeeze_infinity {u v : ℕ → ℝ} (hu : tendsto_infinity u)
(huv : ∀ n, u n ≤ v n) : tendsto_infinity v :=
begin
  sorry
end

/-
We will use segments: Icc a b := { x | a ≤ x ∧ x ≤ b }
The notation stands for Interval-closed-closed. Variations exist with
o or i instead of c, where o stands for open and i for infinity.

We will use the following version of Bolzano-Weierstrass

  bolzano_weierstrass (h : ∀ n, u n ∈ [a, b]) :
    ∃ c ∈ [a, b], cluster_point u c

as well as the obvious

  seq_limit_id : tendsto_infinity (λ n, n)
-/
open set

-- 0077
lemma bdd_above_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ M, ∀ x ∈ Icc a b, f x ≤ M :=
begin
  sorry
end

/-
In the next exercise, we can use:

  abs_neg x : |-x| = |x|
-/

-- 0078
lemma continuous_opposite {f : ℝ → ℝ} {x₀ : ℝ} (h : continuous_at_pt f x₀) :
  continuous_at_pt (λ x, -f x) x₀ :=
begin
  sorry
end

/-
Now let's combine the two exercises above
-/

-- 0079
lemma bdd_below_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ m, ∀ x ∈ Icc a b, m ≤ f x :=
begin
  sorry
end

/-
Remember from the 5th file:

 unique_limit : seq_limit u l → seq_limit u l' → l = l'

and from the 6th one:

  subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
    seq_limit (u ∘ φ) l

We now admit the following version of the least upper bound theorem
(that cannot be proved without discussing the construction of real numbers
or admitting another strong theorem).

sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x

In the next exercise, it can be useful to prove inclusions of sets of real number.
By definition, A ⊆ B means : ∀ x, x ∈ A → x ∈ B.
Hence one can start a proof of A ⊆ B by `intros x x_in`,
which brings `x : ℝ` and `x_in : x ∈ A` in the local context,
and then prove `x ∈ B`.

Note also the use of
  {x | P x}
which denotes the set of x satisfying predicate P.

Hence `x' ∈ { x | P x} ↔ P x'`, by definition.
-/

-- 0080
example {a b : ℝ} (hab : a ≤ b) (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ x₀ ∈ Icc a b, ∀ x ∈ Icc a b, f x ≤ f x₀ :=
begin
  sorry
end

lemma stupid {a b x : ℝ} (h : x ∈ Icc a b) (h' : x ≠ b) : x < b :=
lt_of_le_of_ne h.right h'

/-
And now the final boss...
-/

def I := (Icc 0 1 : set ℝ) -- the type ascription makes sure 0 and 1 are real numbers here

-- 0081
example (f : ℝ → ℝ) (hf : ∀ x, continuous_at_pt f x) (h₀ : f 0 < 0) (h₁ : f 1 > 0) :
∃ x₀ ∈ I, f x₀ = 0 :=
begin
  let A := { x | x ∈ I ∧ f x < 0},
  have ex_x₀ : ∃ x₀ ∈ I, is_sup A x₀,
  {
    sorry
  },
  rcases ex_x₀ with ⟨x₀, x₀_in, x₀_sup⟩,
  use [x₀, x₀_in],
  have : f x₀ ≤ 0,
  {
    sorry
  },
  have x₀_1: x₀ < 1,
  {
    sorry
  },
  have : f x₀ ≥ 0,
  { have in_I : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ I,
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ 1-x₀,
      {
        sorry
      },
      sorry
    },
    have not_in : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    -- By definition, x ∉ A means ¬ (x ∈ A).
    {
      sorry
    },
    dsimp [A] at not_in,
    sorry
  },
  linarith,
end


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

/-!
# Squarefree elements of monoids
An element of a monoid is squarefree when it is not divisible by any squares
except the squares of units.

Results about squarefree natural numbers are proved in `data/nat/squarefree`.

## Main Definitions
 - `squarefree r` indicates that `r` is only divisible by `x * x` if `x` is a unit.

## Main Results
 - `multiplicity.squarefree_iff_multiplicity_le_one`: `x` is `squarefree` iff for every `y`, either
  `multiplicity y x ≤ 1` or `is_unit y`.
 - `unique_factorization_monoid.squarefree_iff_nodup_factors`: A nonzero element `x` of a unique
 factorization monoid is squarefree iff `factors x` has no duplicate factors.

## Tags
squarefree, multiplicity

-/

variables {R : Type*}

/-- An element of a monoid is squarefree if the only squares that
  divide it are the squares of units. -/
def squarefree [monoid R] (r : R) : Prop := ∀ x : R, x * x ∣ r → is_unit x

@[simp]
lemma is_unit.squarefree [comm_monoid R] {x : R} (h : is_unit x) :
  squarefree x :=
λ y hdvd, is_unit_of_mul_is_unit_left (is_unit_of_dvd_unit hdvd h)

@[simp]
lemma squarefree_one [comm_monoid R] : squarefree (1 : R) :=
is_unit_one.squarefree

@[simp]
lemma not_squarefree_zero [monoid_with_zero R] [nontrivial R] : ¬ squarefree (0 : R) :=
begin
  erw [not_forall],
  exact ⟨0, by simp⟩,
end

lemma squarefree.ne_zero [monoid_with_zero R] [nontrivial R] {m : R}
  (hm : squarefree (m : R)) : m ≠ 0 :=
begin
  rintro rfl,
  exact not_squarefree_zero hm,
end

@[simp]
lemma irreducible.squarefree [comm_monoid R] {x : R} (h : irreducible x) :
  squarefree x :=
begin
  rintros y ⟨z, hz⟩,
  rw mul_assoc at hz,
  rcases h.is_unit_or_is_unit hz with hu | hu,
  { exact hu },
  { apply is_unit_of_mul_is_unit_left hu },
end

@[simp]
lemma prime.squarefree [cancel_comm_monoid_with_zero R] {x : R} (h : prime x) :
  squarefree x :=
h.irreducible.squarefree

lemma squarefree.of_mul_left [comm_monoid R] {m n : R} (hmn : squarefree (m * n)) : squarefree m :=
(λ p hp, hmn p (dvd_mul_of_dvd_left hp n))

lemma squarefree.of_mul_right [comm_monoid R] {m n : R} (hmn : squarefree (m * n)) : squarefree n :=
(λ p hp, hmn p (dvd_mul_of_dvd_right hp m))

lemma squarefree_of_dvd_of_squarefree [comm_monoid R]
  {x y : R} (hdvd : x ∣ y) (hsq : squarefree y) :
  squarefree x :=
λ a h, hsq _ (h.trans hdvd)

namespace multiplicity

section comm_monoid

variables [comm_monoid R] [decidable_rel (has_dvd.dvd : R → R → Prop)]

lemma squarefree_iff_multiplicity_le_one (r : R) :
  squarefree r ↔ ∀ x : R, multiplicity x r ≤ 1 ∨ is_unit x :=
begin
  refine forall_congr (λ a, _),
  rw [← sq, pow_dvd_iff_le_multiplicity, or_iff_not_imp_left, not_le, imp_congr _ iff.rfl],
  simpa using enat.add_one_le_iff_lt (enat.coe_ne_top 1)
end

end comm_monoid

section cancel_comm_monoid_with_zero

variables [cancel_comm_monoid_with_zero R] [wf_dvd_monoid R]

lemma finite_prime_left {a b : R} (ha : prime a) (hb : b ≠ 0) :
  multiplicity.finite a b :=
begin
  classical,
  revert hb,
  refine wf_dvd_monoid.induction_on_irreducible b (by contradiction) (λ u hu hu', _)
    (λ b p hb hp ih hpb, _),
  { rw [multiplicity.finite_iff_dom, multiplicity.is_unit_right ha.not_unit hu],
    exact enat.dom_coe 0, },
  { refine multiplicity.finite_mul ha
      (multiplicity.finite_iff_dom.mpr (enat.dom_of_le_coe (show multiplicity a p ≤ ↑1, from _)))
      (ih hb),
    norm_cast,
    exact (((multiplicity.squarefree_iff_multiplicity_le_one p).mp hp.squarefree a)
      .resolve_right ha.not_unit) }
end

end cancel_comm_monoid_with_zero

end multiplicity

section irreducible
variables [comm_monoid_with_zero R] [wf_dvd_monoid R]

lemma irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree (r : R) :
  (∀ x : R, irreducible x → ¬ x * x ∣ r) ↔ ((r = 0 ∧ ∀ x : R, ¬irreducible x) ∨ squarefree r) :=
begin
  symmetry,
  split,
  { rintro (⟨rfl, h⟩ | h),
    { simpa using h },
    intros x hx t,
    exact hx.not_unit (h x t) },
  intro h,
  rcases eq_or_ne r 0 with rfl | hr,
  { exact or.inl (by simpa using h) },
  right,
  intros x hx,
  by_contra i,
  have : x ≠ 0,
  { rintro rfl,
    apply hr,
    simpa only [zero_dvd_iff, mul_zero] using hx},
  obtain ⟨j, hj₁, hj₂⟩ := wf_dvd_monoid.exists_irreducible_factor i this,
  exact h _ hj₁ ((mul_dvd_mul hj₂ hj₂).trans hx),
end

lemma squarefree_iff_irreducible_sq_not_dvd_of_ne_zero {r : R} (hr : r ≠ 0) :
  squarefree r ↔ ∀ x : R, irreducible x → ¬ x * x ∣ r :=
by simpa [hr] using (irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree r).symm

lemma squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible
  {r : R} (hr : ∃ (x : R), irreducible x) :
  squarefree r ↔ ∀ x : R, irreducible x → ¬ x * x ∣ r :=
begin
  rw [irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree, ←not_exists],
  simp only [hr, not_true, false_or, and_false],
end

end irreducible

namespace unique_factorization_monoid
variables [cancel_comm_monoid_with_zero R] [nontrivial R] [unique_factorization_monoid R]
variables [normalization_monoid R]

lemma squarefree_iff_nodup_normalized_factors [decidable_eq R] {x : R} (x0 : x ≠ 0) :
  squarefree x ↔ multiset.nodup (normalized_factors x) :=
begin
  have drel : decidable_rel (has_dvd.dvd : R → R → Prop),
  { classical,
    apply_instance, },
  haveI := drel,
  rw [multiplicity.squarefree_iff_multiplicity_le_one, multiset.nodup_iff_count_le_one],
  split; intros h a,
  { by_cases hmem : a ∈ normalized_factors x,
    { have ha := irreducible_of_normalized_factor _ hmem,
      rcases h a with h | h,
      { rw ← normalize_normalized_factor _ hmem,
        rw [multiplicity_eq_count_normalized_factors ha x0] at h,
        assumption_mod_cast },
      { have := ha.1, contradiction, } },
    { simp [multiset.count_eq_zero_of_not_mem hmem] } },
  { rw or_iff_not_imp_right, intro hu,
    by_cases h0 : a = 0,
    { simp [h0, x0] },
    rcases wf_dvd_monoid.exists_irreducible_factor hu h0 with ⟨b, hib, hdvd⟩,
    apply le_trans (multiplicity.multiplicity_le_multiplicity_of_dvd_left hdvd),
    rw [multiplicity_eq_count_normalized_factors hib x0],
    specialize h (normalize b),
    assumption_mod_cast }
end

lemma dvd_pow_iff_dvd_of_squarefree {x y : R} {n : ℕ} (hsq : squarefree x) (h0 : n ≠ 0) :
  x ∣ y ^ n ↔ x ∣ y :=
begin
  classical,
  by_cases hx : x = 0,
  { simp [hx, pow_eq_zero_iff (nat.pos_of_ne_zero h0)] },
  by_cases hy : y = 0,
  { simp [hy, zero_pow (nat.pos_of_ne_zero h0)] },
  refine ⟨λ h, _, λ h, h.pow h0⟩,
  rw [dvd_iff_normalized_factors_le_normalized_factors hx (pow_ne_zero n hy),
    normalized_factors_pow,
    ((squarefree_iff_nodup_normalized_factors hx).1 hsq).le_nsmul_iff_le h0] at h,
  rwa dvd_iff_normalized_factors_le_normalized_factors hx hy,
end

end unique_factorization_monoid


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import ring_theory.power_series.basic
import data.nat.parity
import algebra.big_operators.nat_antidiagonal

/-!
# Definition of well-known power series

In this file we define the following power series:

* `power_series.inv_units_sub`: given `u : units R`, this is the series for `1 / (u - x)`.
  It is given by `∑ n, x ^ n /ₚ u ^ (n + 1)`.

* `power_series.sin`, `power_series.cos`, `power_series.exp` : power series for sin, cosine, and
  exponential functions.
-/

namespace power_series

section ring

variables {R S : Type*} [ring R] [ring S]

/-- The power series for `1 / (u - x)`. -/
def inv_units_sub (u : units R) : power_series R := mk $ λ n, 1 /ₚ u ^ (n + 1)

@[simp] lemma coeff_inv_units_sub (u : units R) (n : ℕ) :
  coeff R n (inv_units_sub u) = 1 /ₚ u ^ (n + 1) :=
coeff_mk _ _

@[simp] lemma constant_coeff_inv_units_sub (u : units R) :
  constant_coeff R (inv_units_sub u) = 1 /ₚ u :=
by rw [← coeff_zero_eq_constant_coeff_apply, coeff_inv_units_sub, zero_add, pow_one]

@[simp] lemma inv_units_sub_mul_X (u : units R) :
  inv_units_sub u * X = inv_units_sub u * C R u - 1 :=
begin
  ext (_|n),
  { simp },
  { simp [n.succ_ne_zero, pow_succ] }
end

@[simp] lemma inv_units_sub_mul_sub (u : units R) : inv_units_sub u * (C R u - X) = 1 :=
by simp [mul_sub, sub_sub_cancel]

lemma map_inv_units_sub (f : R →+* S) (u : units R) :
  map f (inv_units_sub u) = inv_units_sub (units.map (f : R →* S) u) :=
by { ext, simp [← monoid_hom.map_pow] }

end ring

section field

variables (A A' : Type*) [ring A] [ring A'] [algebra ℚ A] [algebra ℚ A']

open_locale nat

/-- Power series for the exponential function at zero. -/
def exp : power_series A := mk $ λ n, algebra_map ℚ A (1 / n!)

/-- Power series for the sine function at zero. -/
def sin : power_series A :=
mk $ λ n, if even n then 0 else algebra_map ℚ A ((-1) ^ (n / 2) / n!)

/-- Power series for the cosine function at zero. -/
def cos : power_series A :=
mk $ λ n, if even n then algebra_map ℚ A ((-1) ^ (n / 2) / n!) else 0

variables {A A'} (n : ℕ) (f : A →+* A')

@[simp] lemma coeff_exp : coeff A n (exp A) = algebra_map ℚ A (1 / n!) := coeff_mk _ _

@[simp] lemma constant_coeff_exp : constant_coeff A (exp A) = 1 :=
by { rw [← coeff_zero_eq_constant_coeff_apply, coeff_exp], simp }

@[simp] lemma map_exp : map (f : A →+* A') (exp A) = exp A' := by { ext, simp }

@[simp] lemma map_sin : map f (sin A) = sin A' := by { ext, simp [sin, apply_ite f] }

@[simp] lemma map_cos : map f (cos A) = cos A' := by { ext, simp [cos, apply_ite f] }

end field

open ring_hom
open finset nat

variables {A : Type*} [comm_ring A]

/-- Shows that $e^{aX} * e^{bX} = e^{(a + b)X}$ -/
theorem exp_mul_exp_eq_exp_add [algebra ℚ A] (a b : A) :
  rescale a (exp A) * rescale b (exp A) = rescale (a + b) (exp A) :=
begin
  ext,
  simp only [coeff_mul, exp, rescale, coeff_mk, coe_mk, factorial,
    nat.sum_antidiagonal_eq_sum_range_succ_mk, add_pow, sum_mul],
  apply sum_congr rfl,
  rintros x hx,
  suffices : a^x * b^(n - x) * (algebra_map ℚ A (1 / ↑(x.factorial)) * algebra_map ℚ A
    (1 / ↑((n - x).factorial))) =
    a^x * b^(n - x) * ((↑(n.choose x) * (algebra_map ℚ A) (1 / ↑(n.factorial)))),
  { convert this using 1; ring },
  congr' 1,
  rw [←map_nat_cast (algebra_map ℚ A) (n.choose x), ←map_mul, ←map_mul],
  refine ring_hom.congr_arg _ _,
  rw [mul_one_div ↑(n.choose x) _, one_div_mul_one_div],
  symmetry,
  rw [div_eq_iff, div_mul_eq_mul_div, one_mul, choose_eq_factorial_div_factorial],
  norm_cast,
  rw cast_dvd_char_zero,
  { apply factorial_mul_factorial_dvd_factorial (mem_range_succ_iff.1 hx), },
  { apply mem_range_succ_iff.1 hx, },
  { rintros h, apply factorial_ne_zero n, rw cast_eq_zero.1 h, },
end

/-- Shows that $e^{x} * e^{-x} = 1$ -/
theorem exp_mul_exp_neg_eq_one [algebra ℚ A] : exp A * eval_neg_hom (exp A) = 1 :=
by convert exp_mul_exp_eq_exp_add (1 : A) (-1); simp

/-- Shows that $(e^{X})^k = e^{kX}$. -/
theorem exp_pow_eq_rescale_exp [algebra ℚ A] (k : ℕ) : (exp A)^k = rescale (k : A) (exp A) :=
begin
  induction k with k h,
  { simp only [rescale_zero, constant_coeff_exp, function.comp_app, map_one, cast_zero,
      pow_zero, coe_comp], },
  simpa only [succ_eq_add_one, cast_add, ←exp_mul_exp_eq_exp_add (k : A), ←h, cast_one,
    id_apply, rescale_one] using pow_succ' (exp A) k,
end

/-- Shows that
$\sum_{k = 0}^{n - 1} (e^{X})^k = \sum_{p = 0}^{\infty} \sum_{k = 0}^{n - 1} \frac{k^p}{p!}X^p$. -/
theorem exp_pow_sum [algebra ℚ A] (n : ℕ) : (finset.range n).sum (λ k, (exp A)^k) =
  power_series.mk (λ p, (finset.range n).sum (λ k, k^p * algebra_map ℚ A p.factorial⁻¹)) :=
begin
  simp only [exp_pow_eq_rescale_exp, rescale],
  ext,
  simp only [one_div, coeff_mk, coe_mk, coeff_exp, factorial, linear_map.map_sum],
end

end power_series


import .logic_extra
import .definitions

namespace nat

lemma eq_eq {m n : ℕ} (h : eq m n = tt) : m = n :=
begin
  by_cases m = n with h1,
  { assumption },
  { simp [eq, h1] at h, contradiction }
end

lemma eq_of_eq {m n : ℕ} (h : m = n) : eq m n = tt :=
by simp [eq,h]

/-
Useful stuff that should possibly be in the standard library.
(Maybe some of this is already there and I overlooked it?)
-/

lemma lt_one_zero (n : ℕ) : n < 1 → n = 0 :=
assume h : n < 1,
have h1 : n+1 ≤ 0+1, from h,
nat.eq_zero_of_le_zero (le_of_add_le_add_right h1)

lemma lt_succ {n : ℕ} : n < nat.succ n :=
begin
induction n,
{ exact zero_lt_one },
{ simp [nat.succ_lt_succ,*] }
end

lemma le_ne_succ {m n : ℕ}
  (hle : m ≤ nat.succ n)
  (hne : m ≠ nat.succ n) :
  m ≤ n :=
have m = nat.succ n ∨ m < nat.succ n, from nat.eq_or_lt_of_le hle,
have m < nat.succ n, from or.resolve_left this hne,
nat.le_of_lt_succ this

lemma lt_imp_ne {m n : ℕ} (h : m < n) : m ≠ n :=
assume h' : m = n,
have hn : n < n, by simp [h'] at h; assumption,
have hlen : n ≤ n, by refl,
nat.lt_le_antisymm hn hlen

lemma m_dvd_mn {m n : ℕ} : m ∣ m*n :=
begin
  simp [has_dvd.dvd],
  existsi n, reflexivity
end

lemma foil (m n : ℕ) : (nat.succ m)*(nat.succ n) = 1 + m + n + m*n :=
calc (nat.succ m)*(nat.succ n) = (1+m)*(1+n) : by rw [←nat.one_add m, ←nat.one_add n]
           ... = 1 * 1 + m * 1 + (1 + m) * n : by rw [left_distrib, right_distrib]
           ... = 1 + m + n + m*n             : by rw [one_mul, mul_one, right_distrib]; simp

lemma no_zero_divisors {m n : ℕ} : m*n ≠ 0 → m ≠ 0 ∧ n ≠ 0 :=
assume hmn : m*n ≠ 0,
have (m = 0 ∨ n = 0) → m*n = 0, from
  assume h : m = 0 ∨ n = 0, or.elim h
    (assume hm : m = 0, (eq.symm hm) ▸ zero_mul n)
    (assume hn : n = 0, (eq.symm hn) ▸ mul_zero m),
have ¬(m = 0 ∨ n = 0), from (mt this) hmn,
(iff.elim_left (demorgan (m=0) (n=0))) this

lemma unique_unit {m n : ℕ} (H : m*n = 1) : m = 1 ∧ n = 1 :=
begin revert m, induction n with n ih,
{ intros; contradiction },
{ intro m, intro H; cases m with m,
  { have h01 : 0 = 1, by rw [←H]; simp, contradiction },
  { have h : 1 + 0 = 1 + (m + n + m*n), from
    calc 1 + 0 = 1                            : rfl
           ... = (nat.succ m) * (nat.succ n)  : by rw [←H]
           ... = 1 + (m + n + m*n)            : by rw [nat.foil]; simp,
    have hz : m + (n + m*n) = 0, by simp [nat.add_left_cancel h],
    from and.intro
      (have hmz: m = 0, from nat.eq_zero_of_add_eq_zero_right hz,
       show nat.succ m = 1, by rw [hmz])
      (have hmnz: n + m * n = 0, from nat.eq_zero_of_add_eq_zero_left hz,
       have hnz: n = 0, from nat.eq_zero_of_add_eq_zero_right hmnz,
       show nat.succ n = 1, by rw [hnz])
  }
}
end

end nat


import ..lectures.love08_operational_semantics_demo

/-! # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Guarded Command Language

In 1976, E. W. Dijkstra introduced the guarded command language (GCL), a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

infixr (name := seq_exercise) ` ;; ` : 90 := stmt.seq

/-! The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug. Below we will take `σ := state`.

1.1. Complete the following big-step semantics, based on the informal
specification of GCL above. -/

inductive big_step : (stmt state × state) → state → Prop
-- enter the missing `assign` rule here
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
-- enter the missing `seq` rule here
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
-- enter the missing `loop` rules here

infix (name := big_step_exercise) ` ⟹ ` : 110 := big_step

/-! 1.2. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
sorry

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
sorry

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
sorry

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
sorry

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
sorry

end gcl

/-! 1.3. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  sorry
| (S ;; T)          :=
  sorry
| (stmt.ite b S T)  :=
  sorry
| (stmt.while b S)  :=
  sorry

/-! 1.4. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

-- enter your answer here

/-! ## Question 2: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix (name := equiv_exercise) ` ≈ ` := big_step_equiv

/-! Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/-! 2.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
sorry

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
sorry

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
sorry

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
sorry

/-! 2.2 (**optional**). Program equivalence can be used to replace subprograms
by other subprograms with the same semantics. Prove the following so-called
congruence rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
sorry

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
sorry

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
sorry

end LoVe


import tactic
import data.real.basic
import set_theory.cardinal

-- Local imports
import func lang struc

/-!
# model.lean

In this file, we define
- Terms
  - we define a function for term substitution and prove a theorem.
  - we give an interpretation of terms in structures.
- Formulas
- Models and Theories
-

## Tags

model theory, o-minimality
-/

/-! ## Terms -/

/-- We define terms in a language to be constants, variables, functions or
   functions applied to level-0 terms. Here a (term L n) represents all
   terms of level n. Level 0 terms must be constants, variables, or terms
   of type L.F 0.

TODO: Wait for PR#4406: https://github.com/leanprover-community/mathlib/pull/4406
so we can switch to using finvec.
-/
inductive term (L : lang) : ℕ → Type
| con : L.C → term 0
| var : ℕ → term 0
| func {n : ℕ+} : L.F n → term n
| app {n : ℕ} : term (n+1) → term 0 → term n

namespace term
variables {L : lang} {M : struc L}

/-- This function computes the depth of a term as seen by a parser. For
    example, the depth of `f(v₁, v₂, v₃)` is 4 (one for `f` and one for
    each variable). The depth of `f(v₁, g(v₂), v₃)` is similarly 5.
-/
def depth : Π {n : ℕ}, term L n → ℕ
| 0 (con c)    := 1
| 0 (var v)    := 1
| _ (func f)   := 1
| _ (app t t₀) := t.depth + t₀.depth

/-- Every language L is guaranteed to have a 0-level term because
variable terms can be formed without reference to L. In fact, every
language has countably infinite terms of level 0.
-/
instance inhabited : inhabited (term L 0) :=
  {default := var 0}

/- Note about Prod and Sum:
  1. Π denotes Prod of types. Represents ∀ at type level.
     Cartesian product of types
  2. Σ denotes Sum of types. Represents ∃ at type level.
     Disjoint union of types (co-product in category of Set/Types).-/

/-- Variables in a of term returned as a finite set. -/
@[reducible] def vars_in_term : Π {n : ℕ}, term L n → finset ℕ
| 0 (con c)    := ∅
| 0 (var v)    := {v}
| _ (func f)   := ∅
| _ (app t t₀) := vars_in_term t ∪ vars_in_term t₀

/-- The number of variables in a term is computed as the size of
the finset given by vars_in_term. -/
@[reducible] def number_of_vars : Π {n : ℕ}, term L n → ℕ
| 0 (con c)    := 0
| 0 (var v)    := 1
| _ (func f)   := 0
| _ (app t t₀) := number_of_vars t + number_of_vars t₀

/-- Given a variable assignment map, we can define an interpretation of an
`L`-term of level `n` as a function on `M.univ` of arity `n`.-/
@[reducible] def term_interpretation (var_assign : ℕ → M.univ) :
  Π {n : ℕ}, term L n → Func M.univ n
| 0 (con c)    := M.C c
| 0 (var v)    := var_assign v
| _ (func f)   := M.F f
| _ (app t t₀) := (term_interpretation t) (term_interpretation t₀)

/- The interpretation of an `L`-term `t` in an `L`-structure `M`, under a
variable assignment map `va : ℕ → M.univ` is denoted `va^^t`.-/
notation t`^^`va : 80 := term_interpretation va t

/-! ## 4.2 Terms Substitution
    -----------------------/

/-- Simple example of a map where we substitute every variable
with exactly one term. A lemma will show if the term is variable
free, then the image of the function is variable free. Can be
generalized to subsitute each variable with its own term. -/
def term_sub (t' : term L 0) : Π n, term L n → term L n
| 0 (con c)    := con c
| 0 (var n)    := t'
| n (func f)   := func f
| n (app t t₀) := app (term_sub (n+1) t) (term_sub 0 t₀)

/--Alternative definition where we only allow the substitution to
occur over only one variable.-/

def term_sub_for_var (t' : term L 0) (k : ℕ) :
  Π n, term L n → term L n
| 0 (con c)    := con c
| 0 (var n)    := if k = n then t' else var n
| n (func f)   := func f
| n (app t t₀) := app (term_sub_for_var (n+1) t) (term_sub_for_var 0 t₀)

end term

/-! ##  Formulas and Sentences -/

inductive formula (L : lang)
| tt : formula
| ff : formula
| eq  : term L 0 → term L 0 → formula
| rel : Π {n : ℕ+}, L.R n → vector (term L 0) n → formula
| neg : formula → formula
| and : formula → formula → formula
| or  : formula → formula → formula
| exi : ℕ → formula → formula    -- ℕ gives us a variable
| all : ℕ → formula → formula    -- ℕ gives us a variable

namespace formula
variables {L : lang} {M : struc L}

infix    ` =' ` :  80 := eq
prefix   ` ¬' ` :  60 := neg
infix    ` ∧' ` :  70 := and
infix    ` ∨' ` :  70 := or
notation ` ∃' ` : 110 := exi
notation ` ∀' ` : 110 := all
notation ` ⊤' ` : 110 := tt
notation ` ⊥' ` : 110 := ff

def impl (φ₁ : formula L) (φ₂ : formula L) := ¬'φ₁ ∨' φ₂
infix ` →' ` : 80 := impl

def bicond (φ₁ : formula L) (φ₂ : formula L) := (φ₁ →' φ₂)∧'(φ₂ →' φ₁)
infix ` ↔' ` : 80 := bicond

/-- Helper function for variables from list of terms-/
@[reducible] def vars_in_list : list (term L 0) → finset ℕ
| [] := ∅
| (t :: ts) := t.vars_in_term ∪ vars_in_list ts

/-- Extracts set of variables from the formula-/
@[reducible] def vars_in_formula : formula L → finset ℕ
| ⊤'                 := ∅
| ⊥'                 := ∅
| (t₁='t₂)           := t₁.vars_in_term ∪ t₂.vars_in_term
| (formula.rel _ ts) := vars_in_list (ts.to_list)
| (¬' ϕ)             := vars_in_formula ϕ
| (ϕ₁ ∧' ϕ₂)         := vars_in_formula ϕ₁ ∪ vars_in_formula ϕ₂
| (ϕ₁ ∨' ϕ₂)         := vars_in_formula ϕ₁ ∪ vars_in_formula ϕ₂
| (∃' v ϕ)           := vars_in_formula ϕ ∪ {v}
| (∀' v ϕ)           := vars_in_formula ϕ ∪ {v}

/- The set of L-formulas for any language L must have ⊤ as a formula -/
instance inhabited {L : lang} : inhabited (formula L) :=
  {default := formula.tt}

/-- A variable occurs freely in a formula
    1. if it occurs in the formula, AND
    2. if at least one of its occurrences is outside of a quantification.

    For example, this function returns `false` on input `(var, ϕ)` in any of
    the following scenarios --
    - `var` does not occur in `ϕ` at all.
    - `var` occurs in `ϕ` but only after a quantifier.-/
@[reducible] def var_occurs_freely (var : ℕ) : formula L → Prop
| ⊤'                 := false  -- doesn't occur
| ⊥'                 := false  -- doesn't occur
| (t₁='t₂)           := var ∈ t₁.vars_in_term ∪ t₂.vars_in_term -- check occur
| (formula.rel _ ts) := var ∈ vars_in_list (ts.to_list)         -- check occur
| (¬' ϕ)             := var_occurs_freely ϕ
| (ϕ₁ ∧' ϕ₂)         := var_occurs_freely ϕ₁ ∨ var_occurs_freely ϕ₂
| (ϕ₁ ∨' ϕ₂)         := var_occurs_freely ϕ₁ ∨ var_occurs_freely ϕ₂
| (∃' v ϕ)           := (var ≠ v) ∧ var_occurs_freely ϕ -- check not quantified
| (∀' v ϕ)           := (var ≠ v) ∧ var_occurs_freely ϕ -- check not quantified

end formula

/-- A formula in which no variable occurs freely is a sentence.  We create a
    subtype of `L`-formulas that we call `L`-sentences.-/
def sentence (L : lang) : Type :=
  {ϕ : formula L // ∀ var, ¬ ϕ.var_occurs_freely var}

namespace sentence
variables {L : lang} {M : struc L} (ϕ : formula L) (σ: sentence L)

@[simp] lemma iff_not_var_occurs_freely_of_vars_in_formula :
  (∀ var, ¬ ϕ.var_occurs_freely var) ↔ (∀ var ∈ ϕ.vars_in_formula, ¬ formula.var_occurs_freely var ϕ) :=
begin
  split,
    {tauto},

   intros hϕ var,
   by_cases var_occurs : var ∈ ϕ.vars_in_formula,
     { tauto },

   clear' hϕ,
   { induction ϕ;
     finish [formula.var_occurs_freely]},
end

/-- Since sentences are a subtype of formula, we define a coercion map for
    conveniently casting any sentence `σ` to a formula by writing `↑σ`.-/
instance coe_formula : has_coe (sentence L) (formula L) :=
  ⟨λ σ, σ.val⟩

/- The formula ⊤ previously used to prove that formulas are inhabited is also
   vacuously a sentence -/
instance inhabited {L : lang} : inhabited (sentence L) :=
  {default := ⟨⊤', by tauto⟩}
end sentence

/-! ## Satisfiability and Models -/

variables {L : lang} {M : struc L} {ϕ : formula L} {σ : sentence L}

/-- We define what it means for a formula to be true in an `L`-structure
`M`, or consequently, what it means for a structure `M` to model/satisfy a
formula.-/
@[reducible] def models_formula : (ℕ → M.univ) → formula L →  Prop
| _ ⊤'           := true
| _ ⊥'           := false
| va (t₁ =' t₂)   := (t₁^^va) = (t₂^^va)
| va (formula.rel r ts) := vector.map (^^va) ts ∈ M.R r
| va (¬' ϕ)       :=  ¬ models_formula va ϕ
| va (ϕ₁ ∧' ϕ₂)   := models_formula va ϕ₁ ∧ models_formula va ϕ₂
| va (ϕ₁ ∨' ϕ₂)   := models_formula va ϕ₁ ∨ models_formula va ϕ₂
| va (∃' v ϕ)     := ∃ (x : M.univ), let va_updated := function.update va v x in
                                      models_formula va_updated ϕ
| va (∀' v ϕ)     := ∀ (x : M.univ), let va_updated := function.update va v x in
                                      models_formula va_updated ϕ

infix ` ⊨ ` : 100 := models_formula  -- Type this as a variant of \entails.

def models_sentence (M : struc L) (σ : sentence L) : Prop :=
  ∃ va : ℕ → M.univ, va ⊨ σ
notation M` ⊨ `σ : 100 := models_sentence M σ -- Type this as a variant of \entails.

lemma models_formula_or_negation (va : ℕ → M.univ) :
  models_formula va ϕ ∨ models_formula va (¬' ϕ) :=
begin
  by_cases (va ⊨ ϕ),
  repeat {tauto},
end

namespace sentence

lemma neg_of_sentence (σ : sentence L) (var : ℕ) :
  ¬ formula.var_occurs_freely var (¬' (↑σ : formula L)) :=
  σ.property var

def neg (σ : sentence L) : sentence L := ⟨¬' ↑σ, neg_of_sentence σ⟩
prefix ` ¬' ` :  60 := neg
end sentence

lemma models_sentence_or_negation (M : struc L) (σ : sentence L) :
  models_sentence M σ ∨ models_sentence M (¬' σ) :=
begin
  by_cases (M ⊨ σ),
    {tauto},
  right,
  unfold models_sentence at h,
  push_neg at h,
  split,
    {tauto},
  exact function.const ℕ (@default M.univ M.univ_inhabited),
end

/-- We say that two `L`-structures `M` and `N` are elementarily equivalent
and write `M ≡ N` if : `M ⊨ φ` if and only if `N ⊨ φ` for all `L`-sentences
`φ`.-/
def elementarily_equivalent (M₁ M₂: struc L) : Prop :=
  ∀ (σ : sentence L), (M₁ ⊨ σ) ↔ M₂ ⊨ σ
infix ` ≡ ` := elementarily_equivalent

/-- The full theory of `M` is the set of `L`-sentences `φ` such that `M ⊨ φ`.-/
@[reducible] def full_theory (M : struc L) : set (sentence L) := {ϕ : sentence L | M ⊨ ϕ}

/-- `M ≡ N` iff their full theories match.-/
lemma eq_full_theory_iff_elementary_equivalent {M N : struc L} :
      full_theory M = full_theory N ↔ M ≡ N :=
begin
  simp only [elementarily_equivalent, set_of, full_theory],
  split,
  { intros h σ,
    rwa h},
  { intro h,
    ext σ,
    finish}
end

-- TODO: Theorem: If two structures are isomorphic then they must satisfy
-- the same theory. Proof by induction on formulas. Idea: Perhaps we need
-- an induction principle that works only on level=0 terms which have no
-- variables.
theorem isomorphic_struc_satisfy_same_theory {M₁ M₂ : struc L}
  (η : isomorphism M₁ M₂) {σ : sentence L} : M₁ ⊨ σ → M₂ ⊨ σ :=
begin
  cases σ with ϕ hϕ,
  rintros ⟨va, va_models_ϕ⟩,
  have η_map := η.η,
  use η_map ∘ va,
  unfold_coes at *,
  cases ϕ,
    case formula.tt
    { tauto},      -- every variable assignment satisfies T'
    case formula.ff
    { tauto},  -- no variable assignment can satisfy ⊥'thus the hypothesis
              -- is impossible
    case formula.eq : t₁ t₂
    { unfold models_formula at *,
      -- Question/TODO: term-interpret of t₁ under (η_map∘va) is same as
      -- term-interpret of t₂ under (η_map∘va). Why? How can we show this?
      revert hϕ va_models_ϕ,

      sorry},
    case formula.rel : n r vec
    { admit },
    case formula.neg : ϕ
    { admit },
    case formula.and : ϕ₁ ϕ₂
    { admit },
    case formula.or : ϕ₁ ϕ₂
    { admit },
    case formula.exi : x ϕ
    { admit },
    case formula.all : x ϕ
    { admit }
end

-- TODO: But put this on hold till we figure out how to prove that the
-- inverse of bijective function is bijective.
noncomputable def isomorphism_inverse (M N : struc L)
  (η : isomorphism M N) : isomorphism N M :=
begin
  haveI M_univ_inhabited := M.univ_inhabited,
  let ηi := function.inv_fun η.η,
  fconstructor,
  { fconstructor,
    { exact ηi,
    },
    { apply function.bijective.injective,
      rw function.bijective_iff_has_inverse,
      use η.η,
      split,
      have z := function.left_inverse.comp_eq_id,
      unfold function.left_inverse,
      intro x,

      apply @function.inv_fun_eq,
      use ηi x,
      --refine function.right_inverse.left_inverse _,
    repeat{sorry}},
  repeat {sorry},
  },

{sorry},
end

/-- The full theory is an isomorphism invariant.-/
theorem full_theory_is_isomorphism_invariant {M N : struc L}
 (η : isomorphism M N) : M ≡ N :=
begin
 unfold elementarily_equivalent,
 intro σ,
 split,
   {exact isomorphic_struc_satisfy_same_theory η},
   { sorry},
end

/-- Suppose that s₁ and s₂ are variable assignment functions into a structure M
such that s₁(v) = s₂(v) for every free variable v in the term t.
Then t is interpreted to the same element under both s₁ and s₂. -/
lemma eq_interpretation_of_identical_var_assign {s₁ s₂ : ℕ → M.univ}
  {t : term L 0} (h : ∀ v ∈ t.vars_in_term, s₁ v = s₂ v) :
  (t^^s₁) = (t^^s₂) :=
begin
  -- We will proceed with induction on the term t.
  -- First we revert the hypothesis h which has `t` in it.
  -- Without reverting, we will not be able to apply induction on t.
  revert h,
  -- We induct on t and then immediately re-introduce hypothesis h in all cases.
  induction t with c v' n f₀ n t t₀ t_ih t₀_ih; intros h,

  { -- In the case when t is a constant, the result holds definitionally.
    refl},

  { -- In the case when t is a variable v', the result is straightforward once
    -- we use the hypothesis h.
    apply h,
    simp only [term.vars_in_term, finset.mem_singleton]},

  { -- In the case when t is a function of arity n, the result is definitionally
    -- true for n zero and nonzero.
    cases n; refl},

  { -- In the case when t is an application, we break it into cases when n is
    -- zero and nonzero.
    cases n;
      -- rewrite definitions and use the induction hypotheses.
      rw [term.term_interpretation, t_ih, t₀_ih];
      -- The rest follows from hypothesis h.
      intros v hv;
      apply h;
      simp only [finset.mem_union];
      -- Note the use of the tactic combinator below to dismiss all goals
      -- simultaneously.
      {right, assumption} <|> {left, assumption}},
end

/-- Consider the formula `ϕ := (r t₁ ... tₙ)`.
    Suppose that `va₁` and `va₂` are variable assignment functions into a
    structure `M` such that `va₁(var)=va₂(var)` for every variable `var` that
    occurs freely in `ϕ`. Then, the formula is satisfied in `M` under `va₁`
    iff it is also satisfied under `va₂`.
-/
lemma iff_models_formula_relation_of_identical_var_assign
  {n : ℕ+} {r : L.R n} {vec : vector (term L 0) n}
  {va₁ va₂ : ℕ → M.univ}
  (h : ∀ var ∈ formula.vars_in_formula (formula.rel r vec), va₁ var = va₂ var) :
  (va₁ ⊨ (formula.rel r vec)) ↔ (va₂ ⊨ (formula.rel r vec)) :=
begin
  set ϕ : formula L := formula.rel r vec,

  suffices eq_interpretations : vector.map (^^va₁) vec = vector.map (^^va₂) vec,
  simp only [models_formula, eq_interpretations],

  ext1,
  rw [vector.nth_map, vector.nth_map, eq_interpretation_of_identical_var_assign],

  intros var h₁,
  suffices x : var ∈ term.vars_in_term (vec.nth m) → var ∈ formula.vars_in_list vec.to_list,
    { apply h,
      apply x,
      exact h₁},
  --suffices y : vars_in_term (vec.nth m) ⊆ vars_in_list vec.to_list, apply y,
  --cases (vec.nth m) with c var',
  --{unfold vars_in_term, tauto},

  --simp,intro h₂, rw h₂,
  sorry,
end

/-- Suppose that va₁ and va₂ are variable assignment functions into a structure M
such that va₁(v) = va₂(v) for every free variable v in the formula ϕ.
Then M ⊨ ϕ[va₁] iff M ⊨ ϕ[va₂]. -/
lemma iff_models_formula_of_identical_var_assign (va₁ va₂ : ℕ → M.univ)
  (ϕ : formula L) (h : ∀ v ∈ ϕ.vars_in_formula, va₁ v = va₂ v) :
  (va₁ ⊨ ϕ ↔ va₂ ⊨ ϕ) :=
begin
  induction ϕ with t₁ t₂ n r v ϕ ϕ_ih ϕ₁ ϕ₂ ϕ₁_ih ϕ₂_ih ϕ₁ ϕ₂ ϕ₁_ih ϕ₂_ih n ϕ ϕ_ih n ϕ ϕ_ih,
  case formula.tt
  { refl },
  case formula.ff
  { refl },
  case formula.eq : t₁ t₂
  { simp only [finset.mem_union] at h,

    have h₁ : ∀ v ∈ t₁.vars_in_term, va₁ v = va₂ v,
      from λ v H, h v (or.inl H),
    have h₂ : ∀ v ∈ t₂.vars_in_term, va₁ v = va₂ v,
      from λ v H, h v (or.inr H),

    replace h₁ := eq_interpretation_of_identical_var_assign h₁,
    replace h₂ := eq_interpretation_of_identical_var_assign h₂,

    split,
      exact λ H, (h₁.symm.trans H).trans h₂,
      exact λ H, (h₁.trans H).trans h₂.symm},

  case formula.rel
  { exact iff_models_formula_relation_of_identical_var_assign h},

  case formula.neg : ϕ ϕ_ih
  { exact not_congr (ϕ_ih h)},

  case formula.and : ϕ₁ ϕ₂ ϕ₁_ih ϕ₂_ih
  { apply and_congr,
    { exact ϕ₁_ih (λ var H, h var (finset.mem_union.mpr (or.inl H)))},
    { exact ϕ₂_ih (λ var H, h var (finset.mem_union.mpr (or.inr H)))}},

  case formula.or : ϕ₁ ϕ₂ ϕ₁_ih ϕ₂_ih
  { apply or_congr,
    { exact ϕ₁_ih (λ var H, h var (finset.mem_union.mpr (or.inl H)))},
    { exact ϕ₂_ih (λ var H, h var (finset.mem_union.mpr (or.inr H)))}},

  case formula.exi : n ϕ ϕ_ih
  { apply exists_congr,
    intros x,
    simp,
    split,
    intros h',
    have y := function.update_apply va₂ n x,
    simp at *,
    sorry,
    sorry},
  case formula.all : n ϕ ϕ_ih
  { apply forall_congr,
    intros x,
    fconstructor,
    repeat {sorry}},
end

/-- If `σ` is a sentence in the language `L` and `M` is an `L`-structure,
either `M ⊨ σ[s]` for all variable assignments or `M ⊨ σ[s]` for no
variable assignment.-/
lemma models_formula_all_or_none_sentences {L: lang} (M : struc L)
  (σ : sentence L) :
  xor (∀ va : ℕ → M.univ, va ⊨ σ.val) (∀ va' : ℕ → M.univ, ¬ va' ⊨ σ.val) :=
begin
  unfold xor,
  cases σ with ϕ hϕ,
  simp,
  haveI Muniv_in := M.univ_inhabited,
  have va := function.const ℕ (default M.univ),
  cases ϕ,
    case formula.tt
    { simp [models_formula]},         -- every var-assignment satisfies ⊤'
    case formula.ff
    { simp [models_formula]},         -- every var-assign falsifies ⊥'
    case formula.eq : t₁ t₂
    { simp [models_formula],          -- Question/TODO: Not sure how to proceed.
      sorry },
    case formula.rel : n r vec
    { admit },
    case formula.neg : ϕ₁
    { admit },
    case formula.and : ϕ₁ ϕ₂
    { admit },
    case formula.or : ϕ₁ ϕ₂
    { admit },
    case formula.exi : x ϕ₁
    { admit },
    case formula.all : x ϕ₁
    { admit },
end

/-- An `L`-theory `T` is simply a set of `L`-sentences. We say that `M` is
a model of `T` and write `M ⊨ T` if `M ⊨ φ` for all sentences `φ ∈ T`.-/
def theory (L : lang) : Type := set (sentence L)

namespace theory
  /-- Add standard instances for theories. Each instance is derived from the
  parent type `set (sentence L).-/
  instance has_mem : has_mem (sentence L) (theory L) := set.has_mem
  instance has_singleton : has_singleton (sentence L) (theory L) :=
    set.has_singleton
  instance has_union : has_union (theory L) := set.has_union
  instance has_subset : has_subset (theory L) := set.has_subset
  /- There always exists an L-theory, having a single sentence given by {⊤'},
     since ⊤' is always guaranteed to be a sentence -/
  instance inhabited {L : lang} : inhabited (theory L) := set.inhabited
end theory
variable T : theory L

/-- We now define a model to be a structure that models a set of sentences
and show `(ℚ, <)` models the axioms for DLO.-/
structure Model :=
(M : struc L)
(satis {σ : sentence L} : σ ∈ T → M ⊨ σ)

def Model.card {T : theory L} (μ : Model T) : cardinal := μ.M.card

/-- We say that a theory is satisfiable if it has a model.-/
def satisfiable_theory : Prop := nonempty (Model T)

/-! ## Completeness of Language-/

/-- A set of sentences models something if every model of that theory also
 models it.-/
def logical_consequence : Prop := ∀ μ : Model T, μ.M ⊨ σ

structure proof (T : theory L) (ϕ : formula L) : Type :=
(steps : list (formula L))
(steps_nonempty : steps ≠ [] := by tauto)
(conclusion : list.last steps steps_nonempty = ϕ)

def proves : Prop := nonempty (proof T ϕ)

-- Every inconsistent theory is complete
def is_consistent_theory (t : theory L) : Prop :=
  ∃ (M : struc L), ∀ (σ ∈ t), M ⊨ σ

/-- A theory is complete if any pair of models satisfies exactly the same
sentences.-/
def is_complete_theory (t : theory L) : Prop :=
  ∀ (A₁ A₂ : Model t), A₁.M ≡ A₂.M

lemma is_consistent_theory_full_theory (M : struc L) :
  is_consistent_theory (full_theory M) := by {use M, tauto}

lemma is_complete_theory_full_theory (M : struc L) :
  is_complete_theory (full_theory M) :=
begin
  intros A₁ A₂ σ,
  by_cases (σ ∈ full_theory M),
  have H₁ : A₁.M ⊨ σ := A₁.satis h,
  have H₂ : A₂.M ⊨ σ := A₂.satis h,
  tauto,

  have va : ℕ → A₁.M.univ := sorry,
  --have H₁ : models_formula va A₁.M (¬' ↑σ) := suggest,
  sorry,
end

class has_infinite_model (T : theory L) : Type 1 :=
(μ : Model T)
(big : cardinal.omega ≤ μ.card)

/-- Lowenheim-Skolem asserts that for a theory over a language L, if that theory
    has an infinite model, then it has a model for any infinite cardinality
    greater than or equal to |L|-/
axiom LS_Lou [has_infinite_model T] {k : cardinal}
  (kbig : cardinal.omega ≤ k) (h : L.card ≤ k) :
  ∃ μ : Model T, μ.card = k

/- A theory is k-categorical if all models of cardinality k are isomorphic as
   structures.-/
def theory_kcategorical (k : cardinal) (T : theory L) :=
  ∀ (M₁ M₂ : Model T), M₁.card = k ∧ M₂.card = k
  → nonempty (isomorphism M₁.M M₂.M)

/-- A theory can always be extended by sentences modeled by its struc. Here, we
define the singleton-version of this result.
-/
def model_of_extended {T : theory L} {μ : Model T} {σ : sentence L}
  (sat_σ: μ.M ⊨ σ) : Model (T ∪ {σ}) :=
  ⟨μ.M, λ σ' H, by {cases H, exact μ.satis H, rwa [← H.symm]}⟩

def model_of_subset {t s : theory L} (M : Model t) (H : s ⊆ t) : Model s :=
  {M := M.M,
   satis := λ σ h,  M.satis (set.mem_of_subset_of_mem H h)}

instance infinite_model_of_theory_extended {T : theory L} {μ₁ : Model T} {σ : sentence L}
  (models_infinite : ∀ (μ : Model T), cardinal.omega ≤ μ.card)
  (h₁ : μ₁.M ⊨  σ) :
  has_infinite_model (T ∪ {σ}) :=
⟨model_of_extended h₁, models_infinite μ₁⟩

/-- If a theory is k-categorical and has an infinite model,
    it is complete.-/
theorem Vaught (k : cardinal) (h : L.card ≤ k) (kbig : cardinal.omega ≤ k)
  (models_infinite : ∀ (μ : Model T), cardinal.omega ≤ μ.card)
  (hkc : theory_kcategorical k T)
  : is_complete_theory T :=
begin
  intros A₁ A₂ σ,
  split,
  { intro A₁_sat_σ,
    -- We extend the theory T with sentence σ. T has an infinite model. We
    -- prove that T∪{σ} also has an infinite model.
    haveI has_infinite_model_T_σ
      := infinite_model_of_theory_extended models_infinite A₁_sat_σ,

    -- We proceed to write a proof by contradiction.
    by_contradiction A₂_unsat_σ,
    have A₂_sat_neg_σ : A₂.M ⊨ ¬' σ,
      { have A₂_sat_or_unsat_σ, from models_sentence_or_negation A₂.M σ,
        tauto},

    -- Show that an infinite model exists if we extend the theory T with
    -- sentence ¬'σ.
    haveI has_infinite_model_T_neg_σ
      := infinite_model_of_theory_extended models_infinite A₂_sat_neg_σ,

    -- Invoke the Lowenheim-Skolem axiom to obtain models A₃ and A₄ of T
    -- with σ and ¬'σ respectively. More importantly, both models have the
    -- same cardinality.
    obtain ⟨A₃, A₃card⟩ := LS_Lou (T ∪ {σ}) kbig h,
    obtain ⟨A₄, A₄card⟩ := LS_Lou (T ∪ {¬'σ}) kbig h,
    -- Construct models of T from A₃ and A₄ (restricting the theory to a
    -- subset).
    let A₅ : Model T := model_of_subset A₃ (by norm_num),
    let A₆ : Model T := model_of_subset A₄ (by norm_num),

    -- Since A₄ does not satisfy σ, every variable assignment must evaluate
    -- σ to false.
    rcases models_formula_all_or_none_sentences A₄.M σ with ⟨h₁,__⟩ | ⟨h₂,__⟩,
      { -- If all variable assignments satisfiy σ, then we get
        -- contradiction via A₄_satis.
        obtain ⟨va, hva⟩ : A₄.M ⊨ ¬'σ, from A₄.satis (by norm_num),
        tauto},

      { -- If all variable assignments falsify σ, then we get contradiction
        -- via the fact the A₅ and A₆ are isomorphic, but they satisfy σ
        -- and ¬'σ respectively.
        have iso : isomorphism A₅.M A₆.M,
          from nonempty.some (hkc A₅ A₆ ⟨A₃card, A₄card⟩),
        have h₃ : A₃.M ⊨ σ, from A₃.satis (by norm_num),
        obtain ⟨va', hva'⟩ : A₆.M ⊨ σ,
          from isomorphic_struc_satisfy_same_theory iso h₃,
        tauto},
    },
  sorry, -- Symmetric. The same proof as above should work. TODO: turn it
         -- into two lemmas.
end

#exit

def extend_struc_by_element : sorry := sorry

def extension_of_isomorphism (t : theory L) (M₁ M₂ : Model t) :
  ∀ (S₁ : substruc M₁.M) (S₂ : substruc M₂.M) [fin_substruc S₁] [fin_substruc S₂]
  (η : isomorphism S₁ S₂),
  ∀ (m : M₁.M.univ), ∃ (m': M₂.M.univ),
  ∃ (η' : extend_struc_by_element S₁ m → extend_struc_by_element S₂ m'),
  η' is_isomorphism ∧ (η' m = m') ∧ (η = η' on S₁)
-- TODO: Show that this is true for DLOs.

/-Completeness and Compactness theorems-/

lemma consequence_if_proves {L : lang} (t : theory L) : ∀ (ϕ : sentence L),
      proves t ϕ → logical_consequence t ϕ :=
  begin
    sorry,
  end

theorem completeness {L : lang} (t : theory L) : ∀ (ϕ : sentence L),
        proves t ϕ ↔ logical_consequence t ϕ :=
  begin
    sorry,
  end

theorem compactness {L : lang} (t : theory L) : ∀ (ϕ : sentence L),
        logical_consequence t ϕ → ∃ (t' ⊂ t), logical_consequence t' ϕ :=
  begin
    sorry,
  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 algebra.algebra.tower
import data.polynomial.algebra_map

/-!
# Algebra towers for polynomial

This file proves some basic results about the algebra tower structure for the type `polynomial R`.

This structure itself is provided elsewhere as `polynomial.is_scalar_tower`
-/

universes u v w u₁
open_locale polynomial

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A) {B}
theorem aeval_apply (x : A) (p : R[X]) : polynomial.aeval x p =
  polynomial.aeval x (polynomial.map (algebra_map R S) p) :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.eval₂_map, algebra_map_eq R S A]

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

lemma algebra_map_aeval (x : A) (p : R[X]) :
  algebra_map A B (polynomial.aeval x p) = polynomial.aeval (algebra_map A B x) p :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.hom_eval₂,
  ←is_scalar_tower.algebra_map_eq]

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero {x : A} {p : R[X]}
  (h : function.injective (algebra_map A B)) (hp : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
begin
  rw [← algebra_map_aeval, ← (algebra_map A B).map_zero] at hp,
  exact h hp,
end

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero_field {R A B : Type*} [comm_semiring R] [field A]
  [comm_semiring B] [nontrivial B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B]
  {x : A} {p : R[X]} (h : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B (algebra_map A B).injective h

end comm_semiring

end is_scalar_tower

namespace subalgebra

open is_scalar_tower

section comm_semiring

variables (R) {S A} [comm_semiring R] [comm_semiring S] [comm_semiring A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

@[simp]

end comm_semiring

end subalgebra