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

! This file was ported from Lean 3 source module geometry.manifold.instances.sphere
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.Circle
import Mathbin.Analysis.NormedSpace.BallAction
import Mathbin.Analysis.InnerProductSpace.Calculus
import Mathbin.Analysis.InnerProductSpace.PiL2
import Mathbin.Geometry.Manifold.Algebra.LieGroup
import Mathbin.Geometry.Manifold.Instances.Real

/-!
# Manifold structure on the sphere

This file defines stereographic projection from the sphere in an inner product space `E`, and uses
it to put a smooth manifold structure on the sphere.

## Main results

For a unit vector `v` in `E`, the definition `stereographic` gives the stereographic projection
centred at `v`, a local homeomorphism from the sphere to `(ℝ ∙ v)ᗮ` (the orthogonal complement of
`v`).

For finite-dimensional `E`, we then construct a smooth manifold instance on the sphere; the charts
here are obtained by composing the local homeomorphisms `stereographic` with arbitrary isometries
from `(ℝ ∙ v)ᗮ` to Euclidean space.

We prove two lemmas about smooth maps:
* `cont_mdiff_coe_sphere` states that the coercion map from the sphere into `E` is smooth;
  this is a useful tool for constructing smooth maps *from* the sphere.
* `cont_mdiff.cod_restrict_sphere` states that a map from a manifold into the sphere is
  smooth if its lift to a map to `E` is smooth; this is a useful tool for constructing smooth maps
  *to* the sphere.

As an application we prove `cont_mdiff_neg_sphere`, that the antipodal map is smooth.

Finally, we equip the `circle` (defined in `analysis.complex.circle` to be the sphere in `ℂ`
centred at `0` of radius `1`) with the following structure:
* a charted space with model space `euclidean_space ℝ (fin 1)` (inherited from `metric.sphere`)
* a Lie group with model with corners `𝓡 1`

We furthermore show that `exp_map_circle` (defined in `analysis.complex.circle` to be the natural
map `λ t, exp (t * I)` from `ℝ` to `circle`) is smooth.

## Implementation notes

The model space for the charted space instance is `euclidean_space ℝ (fin n)`, where `n` is a
natural number satisfying the typeclass assumption `[fact (finrank ℝ E = n + 1)]`.  This may seem a
little awkward, but it is designed to circumvent the problem that the literal expression for the
dimension of the model space (up to definitional equality) determines the type.  If one used the
naive expression `euclidean_space ℝ (fin (finrank ℝ E - 1))` for the model space, then the sphere in
`ℂ` would be a manifold with model space `euclidean_space ℝ (fin (2 - 1))` but not with model space
`euclidean_space ℝ (fin 1)`.
-/

variable {E : Type _} [NormedAddCommGroup E] [InnerProductSpace ℝ E]

noncomputable section

open Metric FiniteDimensional Function

open Manifold

attribute [local instance] fact_finite_dimensional_of_finrank_eq_succ

section StereographicProjection

variable (v : E)

/-! ### Construction of the stereographic projection -/

/-- Stereographic projection, forward direction. This is a map from an inner product space `E` to
the orthogonal complement of an element `v` of `E`. It is smooth away from the affine hyperplane
through `v` parallel to the orthogonal complement.  It restricts on the sphere to the stereographic
projection. -/
def stereoToFun [CompleteSpace E] (x : E) : (ℝ ∙ v)ᗮ :=
  (2 / ((1 : ℝ) - innerSL _ v x)) • orthogonalProjection (ℝ ∙ v)ᗮ x
#align stereo_to_fun stereoToFun

variable {v}

@[simp]
theorem stereoToFun_apply [CompleteSpace E] (x : E) :
    stereoToFun v x = (2 / ((1 : ℝ) - innerSL _ v x)) • orthogonalProjection (ℝ ∙ v)ᗮ x :=
  rfl
#align stereo_to_fun_apply stereoToFun_apply

theorem contDiffOn_stereoToFun [CompleteSpace E] :
    ContDiffOn ℝ ⊤ (stereoToFun v) { x : E | innerSL _ v x ≠ (1 : ℝ) } :=
  by
  refine' ContDiffOn.smul _ (orthogonalProjection (ℝ ∙ v)ᗮ).ContDiff.ContDiffOn
  refine' cont_diff_const.cont_diff_on.div _ _
  · exact (cont_diff_const.sub (innerSL ℝ v).ContDiff).ContDiffOn
  · intro x h h'
    exact h (sub_eq_zero.mp h').symm
#align cont_diff_on_stereo_to_fun contDiffOn_stereoToFun

theorem continuousOn_stereoToFun [CompleteSpace E] :
    ContinuousOn (stereoToFun v) { x : E | innerSL _ v x ≠ (1 : ℝ) } :=
  (@contDiffOn_stereoToFun E _ _ v _).ContinuousOn
#align continuous_on_stereo_to_fun continuousOn_stereoToFun

variable (v)

/-- Auxiliary function for the construction of the reverse direction of the stereographic
projection.  This is a map from the orthogonal complement of a unit vector `v` in an inner product
space `E` to `E`; we will later prove that it takes values in the unit sphere.

For most purposes, use `stereo_inv_fun`, not `stereo_inv_fun_aux`. -/
def stereoInvFunAux (w : E) : E :=
  (‖w‖ ^ 2 + 4)⁻¹ • ((4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v)
#align stereo_inv_fun_aux stereoInvFunAux

variable {v}

@[simp]
theorem stereoInvFunAux_apply (w : E) :
    stereoInvFunAux v w = (‖w‖ ^ 2 + 4)⁻¹ • ((4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v) :=
  rfl
#align stereo_inv_fun_aux_apply stereoInvFunAux_apply

theorem stereoInvFunAux_mem (hv : ‖v‖ = 1) {w : E} (hw : w ∈ (ℝ ∙ v)ᗮ) :
    stereoInvFunAux v w ∈ sphere (0 : E) 1 :=
  by
  have h₁ : 0 ≤ ‖w‖ ^ 2 + 4 := by nlinarith
  suffices ‖(4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v‖ = ‖w‖ ^ 2 + 4
    by
    have h₂ : ‖w‖ ^ 2 + 4 ≠ 0 := by nlinarith
    simp only [mem_sphere_zero_iff_norm, norm_smul, Real.norm_eq_abs, abs_inv, this,
      abs_of_nonneg h₁, stereoInvFunAux_apply]
    field_simp
  suffices ‖(4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v‖ ^ 2 = (‖w‖ ^ 2 + 4) ^ 2
    by
    have h₃ : 0 ≤ ‖stereoInvFunAux v w‖ := norm_nonneg _
    simpa [h₁, h₃, -one_pow] using this
  rw [Submodule.mem_orthogonal_singleton_iff_inner_left] at hw
  simp [norm_add_sq_real, norm_smul, inner_smul_left, inner_smul_right, hw, mul_pow,
    Real.norm_eq_abs, hv]
  ring
#align stereo_inv_fun_aux_mem stereoInvFunAux_mem

theorem hasFderivAt_stereoInvFunAux (v : E) :
    HasFderivAt (stereoInvFunAux v) (ContinuousLinearMap.id ℝ E) 0 :=
  by
  have h₀ : HasFderivAt (fun w : E => ‖w‖ ^ 2) (0 : E →L[ℝ] ℝ) 0 :=
    by
    convert(hasStrictFderivAt_norm_sq _).HasFderivAt
    simp
  have h₁ : HasFderivAt (fun w : E => (‖w‖ ^ 2 + 4)⁻¹) (0 : E →L[ℝ] ℝ) 0 := by
    convert(hasFderivAt_inv _).comp _ (h₀.add (hasFderivAt_const 4 0)) <;> simp
  have h₂ :
    HasFderivAt (fun w => (4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v) ((4 : ℝ) • ContinuousLinearMap.id ℝ E)
      0 :=
    by
    convert((hasFderivAt_const (4 : ℝ) 0).smul (hasFderivAt_id 0)).add
        ((h₀.sub (hasFderivAt_const (4 : ℝ) 0)).smul (hasFderivAt_const v 0))
    ext w
    simp
  convert h₁.smul h₂
  ext w
  simp
#align has_fderiv_at_stereo_inv_fun_aux hasFderivAt_stereoInvFunAux

theorem hasFderivAt_stereoInvFunAux_comp_coe (v : E) :
    HasFderivAt (stereoInvFunAux v ∘ (coe : (ℝ ∙ v)ᗮ → E)) (ℝ ∙ v)ᗮ.subtypeL 0 :=
  by
  have : HasFderivAt (stereoInvFunAux v) (ContinuousLinearMap.id ℝ E) ((ℝ ∙ v)ᗮ.subtypeL 0) :=
    hasFderivAt_stereoInvFunAux v
  convert this.comp (0 : (ℝ ∙ v)ᗮ) (by apply ContinuousLinearMap.hasFderivAt)
#align has_fderiv_at_stereo_inv_fun_aux_comp_coe hasFderivAt_stereoInvFunAux_comp_coe

theorem contDiff_stereoInvFunAux : ContDiff ℝ ⊤ (stereoInvFunAux v) :=
  by
  have h₀ : ContDiff ℝ ⊤ fun w : E => ‖w‖ ^ 2 := contDiff_norm_sq ℝ
  have h₁ : ContDiff ℝ ⊤ fun w : E => (‖w‖ ^ 2 + 4)⁻¹ :=
    by
    refine' (h₀.add contDiff_const).inv _
    intro x
    nlinarith
  have h₂ : ContDiff ℝ ⊤ fun w => (4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v :=
    by
    refine' (cont_diff_const.smul contDiff_id).add _
    refine' (h₀.sub contDiff_const).smul contDiff_const
  exact h₁.smul h₂
#align cont_diff_stereo_inv_fun_aux contDiff_stereoInvFunAux

/-- Stereographic projection, reverse direction.  This is a map from the orthogonal complement of a
unit vector `v` in an inner product space `E` to the unit sphere in `E`. -/
def stereoInvFun (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) : sphere (0 : E) 1 :=
  ⟨stereoInvFunAux v (w : E), stereoInvFunAux_mem hv w.2⟩
#align stereo_inv_fun stereoInvFun

@[simp]
theorem stereoInvFun_apply (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
    (stereoInvFun hv w : E) = (‖w‖ ^ 2 + 4)⁻¹ • ((4 : ℝ) • w + (‖w‖ ^ 2 - 4) • v) :=
  rfl
#align stereo_inv_fun_apply stereoInvFun_apply

theorem stereoInvFun_ne_north_pole (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
    stereoInvFun hv w ≠ (⟨v, by simp [hv]⟩ : sphere (0 : E) 1) :=
  by
  refine' Subtype.ne_of_val_ne _
  rw [← inner_lt_one_iff_real_of_norm_one _ hv]
  · have hw : ⟪v, w⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2
    have hw' : (‖(w : E)‖ ^ 2 + 4)⁻¹ * (‖(w : E)‖ ^ 2 - 4) < 1 :=
      by
      refine' (inv_mul_lt_iff' _).mpr _
      · nlinarith
      linarith
    simpa [real_inner_comm, inner_add_right, inner_smul_right, real_inner_self_eq_norm_mul_norm, hw,
      hv] using hw'
  · simpa using stereoInvFunAux_mem hv w.2
#align stereo_inv_fun_ne_north_pole stereoInvFun_ne_north_pole

theorem continuous_stereoInvFun (hv : ‖v‖ = 1) : Continuous (stereoInvFun hv) :=
  continuous_induced_rng.2 (contDiff_stereoInvFunAux.Continuous.comp continuous_subtype_val)
#align continuous_stereo_inv_fun continuous_stereoInvFun

variable [CompleteSpace E]

theorem stereo_left_inv (hv : ‖v‖ = 1) {x : sphere (0 : E) 1} (hx : (x : E) ≠ v) :
    stereoInvFun hv (stereoToFun v x) = x := by
  ext
  simp only [stereoToFun_apply, stereoInvFun_apply, smul_add]
  -- name two frequently-occuring quantities and write down their basic properties
  set a : ℝ := innerSL _ v x
  set y := orthogonalProjection (ℝ ∙ v)ᗮ x
  have split : ↑x = a • v + ↑y :=
    by
    convert eq_sum_orthogonalProjection_self_orthogonal_complement (ℝ ∙ v) x
    exact (orthogonalProjection_unit_singleton ℝ hv x).symm
  have hvy : ⟪v, y⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp y.2
  have pythag : 1 = a ^ 2 + ‖y‖ ^ 2 :=
    by
    have hvy' : ⟪a • v, y⟫_ℝ = 0 := by simp [inner_smul_left, hvy]
    convert norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero _ _ hvy' using 2
    · simp [← split]
    · simp [norm_smul, hv, ← sq, sq_abs]
    · exact sq _
  -- two facts which will be helpful for clearing denominators in the main calculation
  have ha : 1 - a ≠ 0 :=
    by
    have : a < 1 := (inner_lt_one_iff_real_of_norm_one hv (by simp)).mpr hx.symm
    linarith
  have : 2 ^ 2 * ‖y‖ ^ 2 + 4 * (1 - a) ^ 2 ≠ 0 :=
    by
    refine' ne_of_gt _
    have := norm_nonneg (y : E)
    have : 0 < (1 - a) ^ 2 := sq_pos_of_ne_zero (1 - a) ha
    nlinarith
  -- the core of the problem is these two algebraic identities:
  have h₁ : (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 + 4)⁻¹ * 4 * (2 / (1 - a)) = 1 :=
    by
    field_simp
    simp only [Submodule.coe_norm] at *
    nlinarith
  have h₂ : (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 + 4)⁻¹ * (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 - 4) = a :=
    by
    field_simp
    trans (1 - a) ^ 2 * (a * (2 ^ 2 * ‖y‖ ^ 2 + 4 * (1 - a) ^ 2))
    · congr
      simp only [Submodule.coe_norm] at *
      nlinarith
    ring
  -- deduce the result
  convert congr_arg₂ Add.add (congr_arg (fun t => t • (y : E)) h₁)
      (congr_arg (fun t => t • v) h₂) using
    1
  ·
    simp [inner_add_right, inner_smul_right, hvy, real_inner_self_eq_norm_mul_norm, hv, mul_smul,
      mul_pow, Real.norm_eq_abs, sq_abs, norm_smul]
  · simp [split, add_comm]
#align stereo_left_inv stereo_left_inv

theorem stereo_right_inv (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) : stereoToFun v (stereoInvFun hv w) = w :=
  by
  have : 2 / (1 - (‖(w : E)‖ ^ 2 + 4)⁻¹ * (‖(w : E)‖ ^ 2 - 4)) * (‖(w : E)‖ ^ 2 + 4)⁻¹ * 4 = 1 :=
    by
    have : ‖(w : E)‖ ^ 2 + 4 ≠ 0 := by nlinarith
    have : (4 : ℝ) + 4 ≠ 0 := by nlinarith
    field_simp
    ring
  convert congr_arg (fun c => c • w) this
  · have h₁ : orthogonalProjection (ℝ ∙ v)ᗮ v = 0 :=
      orthogonalProjection_orthogonal_complement_singleton_eq_zero v
    have h₂ : orthogonalProjection (ℝ ∙ v)ᗮ w = w := orthogonalProjection_mem_subspace_eq_self w
    have h₃ : innerSL _ v w = (0 : ℝ) := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2
    have h₄ : innerSL _ v v = (1 : ℝ) := by simp [real_inner_self_eq_norm_mul_norm, hv]
    simp [h₁, h₂, h₃, h₄, ContinuousLinearMap.map_add, ContinuousLinearMap.map_smul, mul_smul]
  · simp
#align stereo_right_inv stereo_right_inv

/-- Stereographic projection from the unit sphere in `E`, centred at a unit vector `v` in `E`; this
is the version as a local homeomorphism. -/
def stereographic (hv : ‖v‖ = 1) : LocalHomeomorph (sphere (0 : E) 1) (ℝ ∙ v)ᗮ
    where
  toFun := stereoToFun v ∘ coe
  invFun := stereoInvFun hv
  source := {⟨v, by simp [hv]⟩}ᶜ
  target := Set.univ
  map_source' := by simp
  map_target' w _ := stereoInvFun_ne_north_pole hv w
  left_inv' _ hx := stereo_left_inv hv fun h => hx (Subtype.ext h)
  right_inv' w _ := stereo_right_inv hv w
  open_source := isOpen_compl_singleton
  open_target := isOpen_univ
  continuous_toFun :=
    continuousOn_stereoToFun.comp continuous_subtype_val.ContinuousOn fun w h =>
      h ∘ Subtype.ext ∘ Eq.symm ∘ (inner_eq_norm_mul_iff_of_norm_one hv (by simp)).mp
  continuous_invFun := (continuous_stereoInvFun hv).ContinuousOn
#align stereographic stereographic

theorem stereographic_apply (hv : ‖v‖ = 1) (x : sphere (0 : E) 1) :
    stereographic hv x = (2 / ((1 : ℝ) - inner v x)) • orthogonalProjection (ℝ ∙ v)ᗮ x :=
  rfl
#align stereographic_apply stereographic_apply

@[simp]
theorem stereographic_source (hv : ‖v‖ = 1) : (stereographic hv).source = {⟨v, by simp [hv]⟩}ᶜ :=
  rfl
#align stereographic_source stereographic_source

@[simp]
theorem stereographic_target (hv : ‖v‖ = 1) : (stereographic hv).target = Set.univ :=
  rfl
#align stereographic_target stereographic_target

@[simp]
theorem stereographic_apply_neg (v : sphere (0 : E) 1) :
    stereographic (norm_eq_of_mem_sphere v) (-v) = 0 := by
  simp [stereographic_apply, orthogonalProjection_orthogonal_complement_singleton_eq_zero]
#align stereographic_apply_neg stereographic_apply_neg

@[simp]
theorem stereographic_neg_apply (v : sphere (0 : E) 1) :
    stereographic (norm_eq_of_mem_sphere (-v)) v = 0 :=
  by
  convert stereographic_apply_neg (-v)
  ext1
  simp
#align stereographic_neg_apply stereographic_neg_apply

end StereographicProjection

section ChartedSpace

/-!
### Charted space structure on the sphere

In this section we construct a charted space structure on the unit sphere in a finite-dimensional
real inner product space `E`; that is, we show that it is locally homeomorphic to the Euclidean
space of dimension one less than `E`.

The restriction to finite dimension is for convenience.  The most natural `charted_space`
structure for the sphere uses the stereographic projection from the antipodes of a point as the
canonical chart at this point.  However, the codomain of the stereographic projection constructed
in the previous section is `(ℝ ∙ v)ᗮ`, the orthogonal complement of the vector `v` in `E` which is
the "north pole" of the projection, so a priori these charts all have different codomains.

So it is necessary to prove that these codomains are all continuously linearly equivalent to a
fixed normed space.  This could be proved in general by a simple case of Gram-Schmidt
orthogonalization, but in the finite-dimensional case it follows more easily by dimension-counting.
-/

/-- Variant of the stereographic projection, for the sphere in an `n + 1`-dimensional inner product
space `E`.  This version has codomain the Euclidean space of dimension `n`, and is obtained by
composing the original sterographic projection (`stereographic`) with an arbitrary linear isometry
from `(ℝ ∙ v)ᗮ` to the Euclidean space. -/
def stereographic' (n : ℕ) [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1) :
    LocalHomeomorph (sphere (0 : E) 1) (EuclideanSpace ℝ (Fin n)) :=
  stereographic (norm_eq_of_mem_sphere v) ≫ₕ
    (OrthonormalBasis.fromOrthogonalSpanSingleton n
            (ne_zero_of_mem_unit_sphere v)).repr.toHomeomorph.toLocalHomeomorph
#align stereographic' stereographic'

@[simp]
theorem stereographic'_source {n : ℕ} [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1) :
    (stereographic' n v).source = {v}ᶜ := by simp [stereographic']
#align stereographic'_source stereographic'_source

@[simp]
theorem stereographic'_target {n : ℕ} [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1) :
    (stereographic' n v).target = Set.univ := by simp [stereographic']
#align stereographic'_target stereographic'_target

/-- The unit sphere in an `n + 1`-dimensional inner product space `E` is a charted space
modelled on the Euclidean space of dimension `n`. -/
instance {n : ℕ} [Fact (finrank ℝ E = n + 1)] :
    ChartedSpace (EuclideanSpace ℝ (Fin n)) (sphere (0 : E) 1)
    where
  atlas := { f | ∃ v : sphere (0 : E) 1, f = stereographic' n v }
  chartAt v := stereographic' n (-v)
  mem_chart_source v := by simpa using ne_neg_of_mem_unit_sphere ℝ v
  chart_mem_atlas v := ⟨-v, rfl⟩

end ChartedSpace

section SmoothManifold

theorem sphere_ext_iff (u v : sphere (0 : E) 1) : u = v ↔ ⟪(u : E), v⟫_ℝ = 1 := by
  simp [Subtype.ext_iff, inner_eq_norm_mul_iff_of_norm_one]
#align sphere_ext_iff sphere_ext_iff

theorem stereographic'_symm_apply {n : ℕ} [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1)
    (x : EuclideanSpace ℝ (Fin n)) :
    ((stereographic' n v).symm x : E) =
      let U : (ℝ ∙ (v : E))ᗮ ≃ₗᵢ[ℝ] EuclideanSpace ℝ (Fin n) :=
        (OrthonormalBasis.fromOrthogonalSpanSingleton n (ne_zero_of_mem_unit_sphere v)).repr
      (‖(U.symm x : E)‖ ^ 2 + 4)⁻¹ • (4 : ℝ) • (U.symm x : E) +
        (‖(U.symm x : E)‖ ^ 2 + 4)⁻¹ • (‖(U.symm x : E)‖ ^ 2 - 4) • v :=
  by simp [real_inner_comm, stereographic, stereographic', ← Submodule.coe_norm]
#align stereographic'_symm_apply stereographic'_symm_apply

/-! ### Smooth manifold structure on the sphere -/

/-- The unit sphere in an `n + 1`-dimensional inner product space `E` is a smooth manifold,
modelled on the Euclidean space of dimension `n`. -/
instance {n : ℕ} [Fact (finrank ℝ E = n + 1)] :
    SmoothManifoldWithCorners (𝓡 n) (sphere (0 : E) 1) :=
  smoothManifoldWithCorners_of_contDiffOn (𝓡 n) (sphere (0 : E) 1)
    (by
      rintro _ _ ⟨v, rfl⟩ ⟨v', rfl⟩
      let U :=
        (-- Removed type ascription, and this helped for some reason with timeout issues?
            OrthonormalBasis.fromOrthogonalSpanSingleton
            n (ne_zero_of_mem_unit_sphere v)).repr
      let U' :=
        (-- Removed type ascription, and this helped for some reason with timeout issues?
            OrthonormalBasis.fromOrthogonalSpanSingleton
            n (ne_zero_of_mem_unit_sphere v')).repr
      have hUv :
        stereographic' n v =
          stereographic (norm_eq_of_mem_sphere v) ≫ₕ U.to_homeomorph.to_local_homeomorph :=
        rfl
      have hU'v' :
        stereographic' n v' =
          (stereographic (norm_eq_of_mem_sphere v')).trans U'.to_homeomorph.to_local_homeomorph :=
        rfl
      have H₁ := U'.cont_diff.comp_cont_diff_on contDiffOn_stereoToFun
      have H₂ :=
        (cont_diff_stereo_inv_fun_aux.comp (ℝ ∙ (v : E))ᗮ.subtypeL.ContDiff).comp U.symm.cont_diff
      convert H₁.comp' (H₂.cont_diff_on : ContDiffOn ℝ ⊤ _ Set.univ) using 1
      -- squeezed from `ext, simp [sphere_ext_iff, stereographic'_symm_apply, real_inner_comm]`
      simp only [LocalHomeomorph.trans_toLocalEquiv, LocalHomeomorph.symm_toLocalEquiv,
        LocalEquiv.trans_source, LocalEquiv.symm_source, stereographic'_target,
        stereographic'_source]
      simp only [modelWithCornersSelf_coe, modelWithCornersSelf_coe_symm, Set.preimage_id,
        Set.range_id, Set.inter_univ, Set.univ_inter, Set.compl_singleton_eq, Set.preimage_setOf_eq]
      simp only [id.def, comp_apply, Submodule.subtypeL_apply, LocalHomeomorph.coe_coe_symm,
        innerSL_apply, Ne.def, sphere_ext_iff, real_inner_comm (v' : E)]
      rfl)

/-- The inclusion map (i.e., `coe`) from the sphere in `E` to `E` is smooth.  -/
theorem contMdiff_coe_sphere {n : ℕ} [Fact (finrank ℝ E = n + 1)] :
    ContMdiff (𝓡 n) 𝓘(ℝ, E) ∞ (coe : sphere (0 : E) 1 → E) :=
  by
  rw [contMdiff_iff]
  constructor
  · exact continuous_subtype_val
  · intro v _
    let U : _ ≃ₗᵢ[ℝ] _ :=
      (-- Again, partially removing type ascription...
          OrthonormalBasis.fromOrthogonalSpanSingleton
          n (ne_zero_of_mem_unit_sphere (-v))).repr
    exact
      ((cont_diff_stereo_inv_fun_aux.comp (ℝ ∙ (-v : E))ᗮ.subtypeL.ContDiff).comp
          U.symm.cont_diff).ContDiffOn
#align cont_mdiff_coe_sphere contMdiff_coe_sphere

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace ℝ F]

variable {H : Type _} [TopologicalSpace H] {I : ModelWithCorners ℝ F H}

variable {M : Type _} [TopologicalSpace M] [ChartedSpace H M] [SmoothManifoldWithCorners I M]

/-- If a `cont_mdiff` function `f : M → E`, where `M` is some manifold, takes values in the
sphere, then it restricts to a `cont_mdiff` function from `M` to the sphere. -/
theorem ContMdiff.codRestrict_sphere {n : ℕ} [Fact (finrank ℝ E = n + 1)] {m : ℕ∞} {f : M → E}
    (hf : ContMdiff I 𝓘(ℝ, E) m f) (hf' : ∀ x, f x ∈ sphere (0 : E) 1) :
    ContMdiff I (𝓡 n) m (Set.codRestrict _ _ hf' : M → sphere (0 : E) 1) :=
  by
  rw [contMdiff_iff_target]
  refine' ⟨continuous_induced_rng.2 hf.continuous, _⟩
  intro v
  let U : _ ≃ₗᵢ[ℝ] _ :=
    (-- Again, partially removing type ascription... Weird that this helps!
        OrthonormalBasis.fromOrthogonalSpanSingleton
        n (ne_zero_of_mem_unit_sphere (-v))).repr
  have h : ContDiffOn ℝ ⊤ _ Set.univ := U.cont_diff.cont_diff_on
  have H₁ := (h.comp' contDiffOn_stereoToFun).ContMdiffOn
  have H₂ : ContMdiffOn _ _ _ _ Set.univ := hf.cont_mdiff_on
  convert(H₁.of_le le_top).comp' H₂ using 1
  ext x
  have hfxv : f x = -↑v ↔ ⟪f x, -↑v⟫_ℝ = 1 :=
    by
    have hfx : ‖f x‖ = 1 := by simpa using hf' x
    rw [inner_eq_norm_mul_iff_of_norm_one hfx]
    exact norm_eq_of_mem_sphere (-v)
  dsimp [chart_at]
  simp [not_iff_not, Subtype.ext_iff, hfxv, real_inner_comm]
#align cont_mdiff.cod_restrict_sphere ContMdiff.codRestrict_sphere

/-- The antipodal map is smooth. -/
theorem contMdiff_neg_sphere {n : ℕ} [Fact (finrank ℝ E = n + 1)] :
    ContMdiff (𝓡 n) (𝓡 n) ∞ fun x : sphere (0 : E) 1 => -x :=
  by
  -- this doesn't elaborate well in term mode
  apply ContMdiff.codRestrict_sphere
  apply cont_diff_neg.cont_mdiff.comp _
  exact contMdiff_coe_sphere
#align cont_mdiff_neg_sphere contMdiff_neg_sphere

/-- Consider the differential of the inclusion of the sphere in `E` at the point `v` as a continuous
linear map from `tangent_space (𝓡 n) v` to `E`.  The range of this map is the orthogonal complement
of `v` in `E`.

Note that there is an abuse here of the defeq between `E` and the tangent space to `E` at `(v:E`).
In general this defeq is not canonical, but in this case (the tangent space of a vector space) it is
canonical. -/
theorem range_mfderiv_coe_sphere {n : ℕ} [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1) :
    (mfderiv (𝓡 n) 𝓘(ℝ, E) (coe : sphere (0 : E) 1 → E) v : TangentSpace (𝓡 n) v →L[ℝ] E).range =
      (ℝ ∙ (v : E))ᗮ :=
  by
  rw [((contMdiff_coe_sphere v).MdifferentiableAt le_top).mfderiv]
  simp only [chart_at, stereographic', stereographic_neg_apply, fderivWithin_univ,
    LinearIsometryEquiv.toHomeomorph_symm, LinearIsometryEquiv.coe_toHomeomorph,
    LinearIsometryEquiv.map_zero, mfld_simps]
  let U := (OrthonormalBasis.fromOrthogonalSpanSingleton n (ne_zero_of_mem_unit_sphere (-v))).repr
  change (fderiv ℝ ((stereoInvFunAux (-v : E) ∘ coe) ∘ U.symm) 0).range = (ℝ ∙ (v : E))ᗮ
  have :
    HasFderivAt (stereoInvFunAux (-v : E) ∘ (coe : (ℝ ∙ (↑(-v) : E))ᗮ → E))
      (ℝ ∙ (↑(-v) : E))ᗮ.subtypeL (U.symm 0) :=
    by
    convert hasFderivAt_stereoInvFunAux_comp_coe (-v : E)
    simp
  rw [(this.comp 0 U.symm.to_continuous_linear_equiv.has_fderiv_at).fderiv]
  convert(U.symm : EuclideanSpace ℝ (Fin n) ≃ₗᵢ[ℝ] (ℝ ∙ (↑(-v) : E))ᗮ).range_comp
      (ℝ ∙ (↑(-v) : E))ᗮ.Subtype using
    1
  simp only [Submodule.range_subtype, coe_neg_sphere]
  congr 1
  -- we must show `submodule.span ℝ {v} = submodule.span ℝ {-v}`
  apply Submodule.span_eq_span
  · simp only [Set.singleton_subset_iff, SetLike.mem_coe]
    rw [← Submodule.neg_mem_iff]
    exact Submodule.mem_span_singleton_self (-v)
  · simp only [Set.singleton_subset_iff, SetLike.mem_coe]
    rw [Submodule.neg_mem_iff]
    exact Submodule.mem_span_singleton_self v
#align range_mfderiv_coe_sphere range_mfderiv_coe_sphere

/-- Consider the differential of the inclusion of the sphere in `E` at the point `v` as a continuous
linear map from `tangent_space (𝓡 n) v` to `E`.  This map is injective. -/
theorem mfderiv_coe_sphere_injective {n : ℕ} [Fact (finrank ℝ E = n + 1)] (v : sphere (0 : E) 1) :
    Injective (mfderiv (𝓡 n) 𝓘(ℝ, E) (coe : sphere (0 : E) 1 → E) v) :=
  by
  rw [((contMdiff_coe_sphere v).MdifferentiableAt le_top).mfderiv]
  simp only [chart_at, stereographic', stereographic_neg_apply, fderivWithin_univ,
    LinearIsometryEquiv.toHomeomorph_symm, LinearIsometryEquiv.coe_toHomeomorph,
    LinearIsometryEquiv.map_zero, mfld_simps]
  let U := (OrthonormalBasis.fromOrthogonalSpanSingleton n (ne_zero_of_mem_unit_sphere (-v))).repr
  change injective (fderiv ℝ ((stereoInvFunAux (-v : E) ∘ coe) ∘ U.symm) 0)
  have :
    HasFderivAt (stereoInvFunAux (-v : E) ∘ (coe : (ℝ ∙ (↑(-v) : E))ᗮ → E))
      (ℝ ∙ (↑(-v) : E))ᗮ.subtypeL (U.symm 0) :=
    by
    convert hasFderivAt_stereoInvFunAux_comp_coe (-v : E)
    simp
  rw [(this.comp 0 U.symm.to_continuous_linear_equiv.has_fderiv_at).fderiv]
  simpa using Subtype.coe_injective
#align mfderiv_coe_sphere_injective mfderiv_coe_sphere_injective

end SmoothManifold

section circle

open Complex

attribute [local instance] finrank_real_complex_fact

/-- The unit circle in `ℂ` is a charted space modelled on `euclidean_space ℝ (fin 1)`.  This
follows by definition from the corresponding result for `metric.sphere`. -/
instance : ChartedSpace (EuclideanSpace ℝ (Fin 1)) circle :=
  Metric.sphere.chartedSpace

instance : SmoothManifoldWithCorners (𝓡 1) circle :=
  Metric.sphere.smoothManifoldWithCorners

/-- The unit circle in `ℂ` is a Lie group. -/
instance : LieGroup (𝓡 1) circle
    where
  smooth_mul := by
    apply ContMdiff.codRestrict_sphere
    let c : circle → ℂ := coe
    have h₂ : ContMdiff (𝓘(ℝ, ℂ).Prod 𝓘(ℝ, ℂ)) 𝓘(ℝ, ℂ) ∞ fun z : ℂ × ℂ => z.fst * z.snd :=
      by
      rw [contMdiff_iff]
      exact ⟨continuous_mul, fun x y => cont_diff_mul.cont_diff_on⟩
    suffices h₁ : ContMdiff _ _ _ (Prod.map c c)
    · apply h₂.comp h₁
    -- this elaborates much faster with `apply`
      apply ContMdiff.prod_map <;>
      exact contMdiff_coe_sphere
  smooth_inv := by
    apply ContMdiff.codRestrict_sphere
    simp only [← coe_inv_circle, coe_inv_circle_eq_conj]
    exact complex.conj_cle.cont_diff.cont_mdiff.comp contMdiff_coe_sphere

/-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ` is smooth. -/
theorem contMdiff_expMapCircle : ContMdiff 𝓘(ℝ, ℝ) (𝓡 1) ∞ expMapCircle :=
  (contDiff_exp.comp (contDiff_id.smul contDiff_const)).ContMdiff.codRestrict_sphere _
#align cont_mdiff_exp_map_circle contMdiff_expMapCircle

end circle


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.continuous_function.bounded
import analysis.normed_space.linear_isometry
import topology.uniform_space.compact_separated
import tactic.equiv_rw

/-!
# Continuous functions on a compact space

Continuous functions `C(α, β)` from a compact space `α` to a metric space `β`
are automatically bounded, and so acquire various structures inherited from `α →ᵇ β`.

This file transfers these structures, and restates some lemmas
characterising these structures.

If you need a lemma which is proved about `α →ᵇ β` but not for `C(α, β)` when `α` is compact,
you should restate it here. You can also use
`bounded_continuous_function.equiv_continuous_map_of_compact` to functions back and forth.

-/

noncomputable theory
open_locale topological_space classical nnreal bounded_continuous_function

open set filter metric

open bounded_continuous_function

namespace continuous_map

variables (α : Type*) (β : Type*) [topological_space α] [compact_space α] [normed_group β]

/--
When `α` is compact, the bounded continuous maps `α →ᵇ 𝕜` are
equivalent to `C(α, 𝕜)`.
-/
@[simps]
def equiv_bounded_of_compact : C(α, β) ≃ (α →ᵇ β) :=
⟨mk_of_compact, forget_boundedness α β, λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

/--
When `α` is compact, the bounded continuous maps `α →ᵇ 𝕜` are
additively equivalent to `C(α, 𝕜)`.
-/
@[simps]
def add_equiv_bounded_of_compact : C(α, β) ≃+ (α →ᵇ β) :=
({ ..forget_boundedness_add_hom α β,
  ..(equiv_bounded_of_compact α β).symm, } : (α →ᵇ β) ≃+ C(α, β)).symm

-- It would be nice if `@[simps]` produced this directly,
-- instead of the unhelpful `add_equiv_bounded_of_compact_apply_to_continuous_map`.
@[simp]
lemma add_equiv_bounded_of_compact_apply_apply (f : C(α, β)) (a : α) :
  add_equiv_bounded_of_compact α β f a = f a :=
rfl

@[simp]
lemma add_equiv_bounded_of_compact_to_equiv :
  (add_equiv_bounded_of_compact α β).to_equiv = equiv_bounded_of_compact α β :=
rfl

instance : metric_space C(α,β) :=
metric_space.induced
  (equiv_bounded_of_compact α β)
  (equiv_bounded_of_compact α β).injective
  (by apply_instance)

section
variables {α β} (f g : C(α, β)) {C : ℝ}

/-- The distance between two functions is controlled by the supremum of the pointwise distances -/
lemma dist_le (C0 : (0 : ℝ) ≤ C) : dist f g ≤ C ↔ ∀x:α, dist (f x) (g x) ≤ C :=
@bounded_continuous_function.dist_le  _ _ _ _
  ((equiv_bounded_of_compact α β) f) ((equiv_bounded_of_compact α β) g) _ C0

lemma dist_le_iff_of_nonempty [nonempty α] :
  dist f g ≤ C ↔ ∀ x, dist (f x) (g x) ≤ C :=
@bounded_continuous_function.dist_le_iff_of_nonempty  _ _ _ _
  ((equiv_bounded_of_compact α β) f) ((equiv_bounded_of_compact α β) g) _ _

lemma dist_lt_of_nonempty [nonempty α]
  (w : ∀x:α, dist (f x) (g x) < C) : dist f g < C :=
@bounded_continuous_function.dist_lt_of_nonempty_compact  _ _ _ _
  ((equiv_bounded_of_compact α β) f) ((equiv_bounded_of_compact α β) g) _ _ _ w

lemma dist_lt_iff (C0 : (0 : ℝ) < C) :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
@bounded_continuous_function.dist_lt_iff_of_compact  _ _ _ _
  ((equiv_bounded_of_compact α β) f) ((equiv_bounded_of_compact α β) g) _ _ C0

lemma dist_lt_iff_of_nonempty [nonempty α] :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
@bounded_continuous_function.dist_lt_iff_of_nonempty_compact  _ _ _ _
  ((equiv_bounded_of_compact α β) f) ((equiv_bounded_of_compact α β) g) _ _ _

end

variables (α β)

/--
When `α` is compact, and `β` is a metric space, the bounded continuous maps `α →ᵇ β` are
isometric to `C(α, β)`.
-/
@[simps]
def isometric_bounded_of_compact :
  C(α, β) ≃ᵢ (α →ᵇ β) :=
{ isometry_to_fun := λ x y, rfl,
  to_equiv := equiv_bounded_of_compact α β }

-- TODO at some point we will need lemmas characterising this norm!
-- At the moment the only way to reason about it is to transfer `f : C(α,β)` back to `α →ᵇ β`.
instance : has_norm C(α,β) :=
{ norm := λ x, dist x 0 }

instance : normed_group C(α,β) :=
{ dist_eq := λ x y,
  begin
    change dist x y = dist (x-y) 0,
     -- it would be nice if `equiv_rw` could rewrite in multiple places at once
    equiv_rw (equiv_bounded_of_compact α β) at x,
    equiv_rw (equiv_bounded_of_compact α β) at y,
    have p : dist x y = dist (x-y) 0, { rw dist_eq_norm, rw dist_zero_right, },
    convert p,
    exact ((add_equiv_bounded_of_compact α β).symm.map_sub _ _).symm,
  end, }

section
variables {α β} (f : C(α, β))
-- The corresponding lemmas for `bounded_continuous_function` are stated with `{f}`,
-- and so can not be used in dot notation.

lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ :=
((equiv_bounded_of_compact α β) f).norm_coe_le_norm x

/-- Distance between the images of any two points is at most twice the norm of the function. -/
lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ∥f∥ :=
((equiv_bounded_of_compact α β) f).dist_le_two_norm x y

/-- The norm of a function is controlled by the supremum of the pointwise norms -/
lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
@bounded_continuous_function.norm_le _ _ _ _
  ((equiv_bounded_of_compact α β) f) _ C0

lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
@bounded_continuous_function.norm_le_of_nonempty _ _ _ _ _
  ((equiv_bounded_of_compact α β) f) _

lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_compact _ _ _ _ _
  ((equiv_bounded_of_compact α β) f) _ M0

lemma norm_lt_iff_of_nonempty [nonempty α] {M : ℝ} :
  ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_nonempty_compact _ _ _ _ _ _
  ((equiv_bounded_of_compact α β) f) _

lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ∥f∥ :=
le_trans (le_abs.mpr (or.inl (le_refl (f x)))) (f.norm_coe_le_norm x)

lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -∥f∥ ≤ f x :=
le_trans (neg_le_neg (f.norm_coe_le_norm x)) (neg_le.mp (neg_le_abs_self (f x)))

end

section
variables {R : Type*} [normed_ring R]

instance : normed_ring C(α,R) :=
{ norm_mul := λ f g,
  begin
    equiv_rw (equiv_bounded_of_compact α R) at f,
    equiv_rw (equiv_bounded_of_compact α R) at g,
    exact norm_mul_le f g,
  end,
  ..(infer_instance : normed_group C(α,R)) }

end

section
variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]

instance : normed_space 𝕜 C(α,β) :=
{ norm_smul_le := λ c f,
  begin
    equiv_rw (equiv_bounded_of_compact α β) at f,
    exact le_of_eq (norm_smul c f),
  end }

variables (α 𝕜)

/--
When `α` is compact and `𝕜` is a normed field,
the `𝕜`-algebra of bounded continuous maps `α →ᵇ β` is
`𝕜`-linearly isometric to `C(α, β)`.
-/
def linear_isometry_bounded_of_compact :
  C(α, β) ≃ₗᵢ[𝕜] (α →ᵇ β) :=
{ map_smul' := λ c f, by { ext, simp, },
  norm_map' := λ f, rfl,
  ..add_equiv_bounded_of_compact α β }

@[simp]
lemma linear_isometry_bounded_of_compact_to_isometric :
  (linear_isometry_bounded_of_compact α β 𝕜).to_isometric =
    isometric_bounded_of_compact α β :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_add_equiv :
  (linear_isometry_bounded_of_compact α β 𝕜).to_linear_equiv.to_add_equiv =
    add_equiv_bounded_of_compact α β :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_of_compact_to_equiv :
  (linear_isometry_bounded_of_compact α β 𝕜).to_linear_equiv.to_equiv =
    equiv_bounded_of_compact α β :=
rfl

end

section
variables {𝕜 : Type*} {γ : Type*} [normed_field 𝕜] [normed_ring γ] [normed_algebra 𝕜 γ]

instance [nonempty α] : normed_algebra 𝕜 C(α, γ) :=
{ norm_algebra_map_eq := λ c, (norm_algebra_map_eq (α →ᵇ γ) c : _), }

end

end continuous_map

namespace continuous_map

section uniform_continuity
variables {α β : Type*}
variables [metric_space α] [compact_space α] [metric_space β]

/-!
We now set up some declarations making it convenient to use uniform continuity.
-/

lemma uniform_continuity
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) :
  ∃ δ > 0, ∀ {x y}, dist x y < δ → dist (f x) (f y) < ε :=
metric.uniform_continuous_iff.mp
  (compact_space.uniform_continuous_of_continuous f.continuous) ε h

/--
An arbitrarily chosen modulus of uniform continuity for a given function `f` and `ε > 0`.
-/
-- This definition allows us to separate the choice of some `δ`,
-- and the corresponding use of `dist a b < δ → dist (f a) (f b) < ε`,
-- even across different declarations.
def modulus (f : C(α, β)) (ε : ℝ) (h : 0 < ε) : ℝ :=
classical.some (uniform_continuity f ε h)

lemma modulus_pos (f : C(α, β)) {ε : ℝ} {h : 0 < ε} : 0 < f.modulus ε h :=
classical.some (classical.some_spec (uniform_continuity f ε h))

lemma dist_lt_of_dist_lt_modulus
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) {a b : α} (w : dist a b < f.modulus ε h) :
  dist (f a) (f b) < ε :=
classical.some_spec (classical.some_spec (uniform_continuity f ε h)) w

end uniform_continuity

/-!
We now setup variations on `comp_right_* f`, where `f : C(X, Y)`
(that is, precomposition by a continuous map),
as a morphism `C(Y, T) → C(X, T)`, respecting various types of structure.

In particular:
* `comp_right_continuous_map`, the bundled continuous map (for this we need `X Y` compact).
* `comp_right_homeomorph`, when we precompose by a homeomorphism.
* `comp_right_alg_hom`, when `T = R` is a topological ring.
-/
section comp_right

/--
Precomposition by a continuous map is itself a continuous map between spaces of continuous maps.
-/
def comp_right_continuous_map {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) : C(C(Y, T), C(X, T)) :=
{ to_fun := λ g, g.comp f,
  continuous_to_fun :=
  begin
    refine metric.continuous_iff.mpr _,
    intros g ε ε_pos,
    refine ⟨ε, ε_pos, λ g' h, _⟩,
    rw continuous_map.dist_lt_iff _ _ ε_pos at h ⊢,
    { exact λ x, h (f x), },
  end }

@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) (g : C(Y, T)) :
  (comp_right_continuous_map T f) g = g.comp f :=
rfl

/--
Precomposition by a homeomorphism is itself a homeomorphism between spaces of continuous maps.
-/
def comp_right_homeomorph {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : X ≃ₜ Y) : C(Y, T) ≃ₜ C(X, T) :=
{ to_fun := comp_right_continuous_map T f.to_continuous_map,
  inv_fun := comp_right_continuous_map T f.symm.to_continuous_map,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
Precomposition of functions into a normed ring by continuous map is an algebra homomorphism.
-/
def comp_right_alg_hom {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) :
  C(Y, R) →ₐ[R] C(X, R) :=
{ to_fun := λ g, g.comp f,
  map_zero' := by { ext, simp, },
  map_add' := λ g₁ g₂, by { ext, simp, },
  map_one' := by { ext, simp, },
  map_mul' := λ g₁ g₂, by { ext, simp, },
  commutes' := λ r, by { ext, simp, }, }

@[simp] lemma comp_right_alg_hom_apply {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) (g : C(Y, R)) :
  (comp_right_alg_hom R f) g = g.comp f :=
rfl

lemma comp_right_alg_hom_continuous {X Y : Type*} (R : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y]
  [normed_comm_ring R] (f : C(X, Y)) :
  continuous (comp_right_alg_hom R f) :=
begin
  change continuous (comp_right_continuous_map R f),
  continuity,
end

end comp_right

end continuous_map


-- import data.nat.basic

-- open nat
-- #check nat

inductive my_nat
| zero : my_nat
| succ : my_nat → my_nat
notation `ℕ'` := my_nat

open my_nat

def my_add : my_nat → my_nat → my_nat
| m zero      := m
| m (succ n') := succ (my_add m n')

notation m `+` n := my_add m n

instance : has_zero my_nat := ⟨zero⟩

lemma zero_add (n : ℕ') : 0 + n = n := begin
  induction n with n' ih,
  -- Base Case
  refl,
  -- Inductive Step
  simp [my_add],
  apply ih,
end

-- def closest_pair (p q : point) (ps : list point) : Prop :=
--   (p ∈ ps) ∧
--   (q ∈ ps) ∧
--   (p ≠ q) ∧
--   (∀ (r s : point),
--       (same_pair (p, q) (r, s) ↔ ∥ p - q ∥ = ∥ r - s ∥) ∧
--      (¬(same_pair (p, q) (r, s)) ↔ ∥ p - q ∥ < ∥ r - s ∥))

-- def cp_with_help (p q : point) (ps : list point) (c : ℕ⁺) : Prop :=
--   (closest_pair p q ps) ∧ (1 < ∥ p - q ∥) ∧ (∥ p - q ∥ ≤ c)

-- def find_closest_pair (ps : list point) (c : ℕ⁺) : (point × point) := sorry

-- theorem find_closest_pair_correct :
--   ∀ (ps : list point) (c : ℕ⁺),
--     (∃ (p q : point),
--       (closest_pair p q ps) ∧ (1 < ∥ p - q ∥) ∧ (∥ p - q ∥ ≤ c)) →
--     (∃ (p q : point),
--       find_closest_pair ps c = (p, q) ∧
--       closest_pair p q ps)

lemma aux_gives_closest_pair:
  ∀ (g : grid_2D),
    -- If there's a closest pair within distance `c`,
    (∃ (p q : point),
      cp_with_help p q g.ps g.c) →
    -- TODO we'll need a supposition that the closest pair is within distance `c`
    (∃ (p q : point),
      aux g g.ps = some (p, q)
      ∧ closest_pair p q g.ps) := begin
  intros g cp_help,
  apply cp_with_help_and_cp_in_balls_implies_closest_pair,
  assumption,
  apply aux_finds_closest_pair_in_ball_union,
  simp,
end

lemma grid_pts_dot_c_with_c_eq_c :
  ∀ (c : ℕ⁺) (ps : list point),
    (grid_points c ps).c = c := sorry

lemma grid_pts_dot_ps_with_ps_eq_ps :
  ∀ (c : ℕ⁺) (ps : list point),
    (grid_points c ps).ps = ps := sorry


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez, Eric Wieser
-/
import data.list.chain

/-!
# Destuttering of Lists

This file proves theorems about `list.destutter` (in `data.list.defs`), which greedily removes all
non-related items that are adjacent in a list, e.g. `[2, 2, 3, 3, 2].destutter (≠) = [2, 3, 2]`.
Note that we make no guarantees of being the longest sublist with this property; e.g.,
`[123, 1, 2, 5, 543, 1000].destutter (<) = [123, 543, 1000]`, but a longer ascending chain could be
`[1, 2, 5, 543, 1000]`.

## Main statements

* `list.destutter_sublist`: `l.destutter` is a sublist of `l`.
* `list.destutter_is_chain'`: `l.destutter` satisfies `chain' R`.
* Analogies of these theorems for `list.destutter'`, which is the `destutter` equivalent of `chain`.

## Tags

adjacent, chain, duplicates, remove, list, stutter, destutter
-/

variables {α : Type*} (l : list α) (R : α → α → Prop) [decidable_rel R] {a b : α}

namespace list

@[simp] lemma destutter'_nil : destutter' R a [] = [a] := rfl

lemma destutter'_cons :
  (b :: l).destutter' R a = if R a b then a :: destutter' R b l else destutter' R a l := rfl

variables {R}

@[simp] lemma destutter'_cons_pos (h : R b a) :
  (a :: l).destutter' R b = b :: l.destutter' R a :=
by rw [destutter', if_pos h]

@[simp] lemma destutter'_cons_neg (h : ¬ R b a) :
  (a :: l).destutter' R b = l.destutter' R b :=
by rw [destutter', if_neg h]

variables (R)

@[simp] lemma destutter'_singleton : [b].destutter' R a = if R a b then [a, b] else [a] :=
by split_ifs; simp! [h]

lemma destutter'_sublist (a) : l.destutter' R a <+ a :: l :=
begin
  induction l with b l hl generalizing a,
  { simp },
  rw destutter',
  split_ifs,
  { exact sublist.cons2 _ _ _ (hl b) },
  { exact (hl a).trans ((l.sublist_cons b).cons_cons a) }
end

lemma mem_destutter' (a) : a ∈ l.destutter' R a :=
begin
  induction l with b l hl,
  { simp },
  rw destutter',
  split_ifs,
  { simp },
  { assumption }
end

lemma destutter'_is_chain : ∀ l : list α, ∀ {a b}, R a b → (l.destutter' R b).chain R a
| [] a b h := chain_singleton.mpr h
| (c :: l) a b h :=
begin
  rw destutter',
  split_ifs with hbc,
  { rw chain_cons,
    exact ⟨h, destutter'_is_chain l hbc⟩ },
  { exact destutter'_is_chain l h },
end

lemma destutter'_is_chain' (a) : (l.destutter' R a).chain' R :=
begin
  induction l with b l hl generalizing a,
  { simp },
  rw destutter',
  split_ifs,
  { exact destutter'_is_chain R l h },
  { exact hl a },
end

lemma destutter'_of_chain (h : l.chain R a) : l.destutter' R a = a :: l :=
begin
  induction l with b l hb generalizing a,
  { simp },
  obtain ⟨h, hc⟩ := chain_cons.mp h,
  rw [l.destutter'_cons_pos h, hb hc]
end

@[simp] lemma destutter'_eq_self_iff (a) : l.destutter' R a = a :: l ↔ l.chain R a :=
⟨λ h, by { rw [←chain', ←h], exact l.destutter'_is_chain' R a }, destutter'_of_chain _ _⟩

lemma destutter'_ne_nil : l.destutter' R a ≠ [] :=
ne_nil_of_mem $ l.mem_destutter' R a

@[simp] lemma destutter_nil : ([] : list α).destutter R = [] := rfl

lemma destutter_cons' : (a :: l).destutter R = destutter' R a l := rfl

lemma destutter_cons_cons : (a :: b :: l).destutter R =
  if R a b then a :: destutter' R b l else destutter' R a l := rfl

@[simp] lemma destutter_singleton : destutter R [a] = [a] := rfl

@[simp] lemma destutter_pair : destutter R [a, b] = if R a b then [a, b] else [a] :=
destutter_cons_cons _ R

lemma destutter_is_chain' : ∀ (l : list α), (l.destutter R).chain' R
| [] := list.chain'_nil
| (h :: l) := l.destutter'_is_chain' R h

lemma destutter_of_chain' : ∀ (l : list α), l.chain' R → l.destutter R = l
| [] h := rfl
| (a :: l) h := l.destutter'_of_chain _ h

@[simp] lemma destutter_eq_self_iff : ∀ (l : list α), l.destutter R = l ↔ l.chain' R
| [] := by simp
| (a :: l) := l.destutter'_eq_self_iff R a

lemma destutter_idem : (l.destutter R).destutter R = l.destutter R :=
destutter_of_chain' R _ $ l.destutter_is_chain' R

@[simp] lemma destutter_eq_nil : ∀ {l : list α}, destutter R l = [] ↔ l = []
| [] := iff.rfl
| (a :: l) := ⟨λ h, absurd h $ l.destutter'_ne_nil R, λ h, match h with end⟩

end list


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_329
  (x y : ℝ)
  (h₀ : 3 * y = x)
  (h₁ : 2 * x + 5 * y = 11) :
  x + y = 4 :=
begin
  linarith,
end


--import G_module.hom
import cochain
import algebra.pi_instances
import add_group_hom.basic
import add_subquotient.basic

variables (n:ℕ )(G : Type*) [group G] (M : Type*) [add_comm_group M] [G_module G M]
(N : Type*) [add_comm_group N] [G_module G N]

def cocycle := (add_group_hom.ker (d (n+1) G M))

def coboundary := add_group_hom.range (d n G M)

theorem cob_sub_of_coc: coboundary n G M ≤ cocycle n G M:=
range_d_sub_ker_d _ G M

def cohomology : add_subquotient (cochain (n + 1) G M) :=
{bottom := coboundary n G M,
top := cocycle n G M,
incl := cob_sub_of_coc n G M}

def h0 : add_subquotient (cochain 0 G M):=
{bottom := ⊥ ,
top := (add_group_hom.ker (d 0 G M)),
incl := begin
show  ⊥ ⊆ add_group_hom.ker (d 0 G M),
intro a,
intro ha,
rw add_subgroup.mem_coe,
have h1:a=0,
exact ha,
rw add_group_hom.mem_ker,
rw h1,
show d.to_fun 0=0,
exact (d 0 G M).map_zero',
end}

--def H_n : add_subquotient (cochain n G M):= if n=0 then h0 G M else cohomology (n-1) G M


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

import tactic.basic

/-!
# A compiler for arithmetic expressions

A formalization of the correctness of a compiler from arithmetic expressions to machine language
described by McCarthy and Painter, which is considered the first proof of compiler correctness.

## Main definitions

* `expr`       : the syntax of the source language.
* `value`      : the semantics of the source language.
* `instruction`: the syntax of the target language.
* `step`       : the semantics of the target language.
* `compile`    : the compiler.

## Main results

* `compiler_correctness`: the compiler correctness theorem.

## Notation

* `≃[t]/ac`: partial equality of two machine states excluding registers x ≥ t and the accumulator.
* `≃[t]`   : partial equality of two machine states excluding registers x ≥ t.

## References

* John McCarthy and James Painter. Correctness of a compiler for arithmetic expressions.
  In Mathematical Aspects of Computer Science, volume 19 of Proceedings of Symposia in
  Applied Mathematics. American Mathematical Society, 1967.
  <http://jmc.stanford.edu/articles/mcpain/mcpain.pdf>

## Tags

compiler
-/

namespace arithcc

section types

/-! ### Types -/

/-- Value type shared by both source and target languages. -/
@[reducible]
def word := ℕ

/-- Variable identifier type in the source language. -/
@[reducible]
def identifier := string

/-- Register name type in the target language. -/
@[reducible]
def register := ℕ

lemma register.lt_succ_self :
  ∀ (r : register), r < r + 1 :=
nat.lt_succ_self

lemma register.le_of_lt_succ {r₁ r₂ : register} :
  r₁ < r₂ + 1 → r₁ ≤ r₂ :=
nat.le_of_succ_le_succ

end types

section source

/-! ### Source language -/

/-- An expression in the source language is formed by constants, variables, and sums. -/
@[derive inhabited]
inductive expr
| const (v : word) : expr
| var (x : identifier) : expr
| sum (s₁ s₂ : expr) : expr

/-- The semantics of the source language (2.1). -/
@[simp]
def value : expr → (identifier → word) → word
| (expr.const v)   _ := v
| (expr.var x)     ξ := ξ x
| (expr.sum s₁ s₂) ξ := (value s₁ ξ) + (value s₂ ξ)

end source

section target

/-! ### Target language -/

/-- Instructions of the target machine language (3.1--3.7). -/
@[derive inhabited]
inductive instruction
| li   : word → instruction
| load : register → instruction
| sto  : register → instruction
| add  : register → instruction

/-- Machine state consists of the accumulator and a vector of registers.

The paper uses two functions `c` and `a` for accessing both the accumulator and registers.
For clarity, we make accessing the accumulator explicit and use `read`/`write` for registers.
-/
structure state :=
mk :: (ac : word) (rs : register → word)

instance : inhabited state :=
⟨{ac := 0, rs := λ x, 0}⟩

/-- This is similar to the `c` function (3.8), but for registers only. -/
@[simp]
def read (r : register) (η : state) : word :=
η.rs r

/-- This is similar to the `a` function (3.9), but for registers only. -/
@[simp]
def write (r : register) (v : word) (η : state) : state :=
{rs := λ x, if x = r then v else η.rs x, ..η}

/-- The semantics of the target language (3.11). -/
def step : instruction → state → state
| (instruction.li   v) η := {ac := v, ..η}
| (instruction.load r) η := {ac := read r η, ..η}
| (instruction.sto  r) η := write r η.ac η
| (instruction.add  r) η := {ac := read r η + η.ac, ..η}

/-- The resulting machine state of running a target program from a given machine state (3.12). -/
@[simp]
def outcome : list instruction → state → state
| []        η := η
| (i :: is) η := outcome is (step i η)

/-- A lemma on the concatenation of two programs (3.13). -/
@[simp]
lemma outcome_append (p₁ p₂ : list instruction) (η : state) :
  outcome (p₁ ++ p₂) η = outcome p₂ (outcome p₁ η) :=
begin
  revert η,
  induction p₁; intros; simp,
  apply p₁_ih
end

end target

section compiler

open instruction

/-! ### Compiler -/

/-- Map a variable in the source expression to a machine register. -/
@[simp]
def loc (ν : identifier) (map : identifier → register) : register :=
map ν

/-- The implementation of the compiler (4.2).

This definition explicitly takes a map from variables to registers.
-/
@[simp]
def compile (map : identifier → register) : expr → register → (list instruction)
| (expr.const v)   _ := [li v]
| (expr.var x)     _ := [load (loc x map)]
| (expr.sum s₁ s₂) t := compile s₁ t ++ [sto t] ++ compile s₂ (t + 1) ++ [add t]

end compiler

section correctness

/-! ### Correctness -/

/-- Machine states ζ₁ and ζ₂ are equal except for the accumulator and registers {x | x ≥ t}. -/
def state_eq_rs (t : register) (ζ₁ ζ₂ : state) : Prop :=
∀ (r : register), r < t → ζ₁.rs r = ζ₂.rs r

notation ζ₁ ` ≃[`:50 t `]/ac ` ζ₂:50 := state_eq_rs t ζ₁ ζ₂

@[refl]
protected lemma state_eq_rs.refl (t : register) (ζ : state) :
  ζ ≃[t]/ac ζ :=
by simp [state_eq_rs]

@[symm]
protected lemma state_eq_rs.symm {t : register} (ζ₁ ζ₂ : state) :
  ζ₁ ≃[t]/ac ζ₂ →
  ζ₂ ≃[t]/ac ζ₁ :=
by finish [state_eq_rs]

@[trans]
protected lemma state_eq_rs.trans {t : register} (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t]/ac ζ₂ →
  ζ₂ ≃[t]/ac ζ₃ →
  ζ₁ ≃[t]/ac ζ₃ :=
by finish [state_eq_rs]

/-- Machine states ζ₁ and ζ₂ are equal except for registers {x | x ≥ t}. -/
def state_eq (t : register) (ζ₁ ζ₂ : state) : Prop :=
ζ₁.ac = ζ₂.ac ∧ state_eq_rs t ζ₁ ζ₂

notation ζ₁ ` ≃[`:50 t `] ` ζ₂:50 := state_eq t ζ₁ ζ₂

@[refl]
protected lemma state_eq.refl (t : register) (ζ : state) :
  ζ ≃[t] ζ :=
by simp [state_eq]

@[symm]
protected lemma state_eq.symm {t : register} (ζ₁ ζ₂ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t] ζ₁ :=
begin
  simp [state_eq], intros,
  split; try { cc },
  symmetry,
  assumption
end

@[trans]
protected lemma state_eq.trans {t : register} (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t] ζ₃ →
  ζ₁ ≃[t] ζ₃ :=
begin
  simp [state_eq], intros,
  split; try { cc },
  transitivity ζ₂; assumption
end

/-- Transitivity of chaining `≃[t]` and `≃[t]/ac`. -/
@[trans]
protected theorem state_eq_state_eq_rs.trans (t : register) (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t]/ac ζ₃ →
  ζ₁ ≃[t]/ac ζ₃ :=
begin
  simp [state_eq], intros,
  transitivity ζ₂; assumption
end

/-- Writing the same value to register `t` gives `≃[t + 1]` from `≃[t]`. -/
lemma state_eq_implies_write_eq {t : register} {ζ₁ ζ₂ : state} (h : ζ₁ ≃[t] ζ₂) (v : word) :
  write t v ζ₁ ≃[t + 1] write t v ζ₂ :=
begin
  simp [state_eq, state_eq_rs] at *,
  split ; try { cc },
  intros _ hr,
  have hr : r ≤ t := register.le_of_lt_succ hr,
  cases lt_or_eq_of_le hr with hr hr,
  { cases h with _ h,
    specialize h r hr,
    cc },
  { cc }
end

/-- Writing the same value to any register preserves `≃[t]/ac`. -/
lemma state_eq_rs_implies_write_eq_rs {t : register} {ζ₁ ζ₂ : state} (h : ζ₁ ≃[t]/ac ζ₂)
                                      (r : register) (v : word) :
  write r v ζ₁ ≃[t]/ac write r v ζ₂ :=
begin
  simp [state_eq_rs] at *,
  intros r' hr',
  specialize h r' hr',
  cc
end

/-- `≃[t + 1]` with writing to register `t` implies `≃[t]`. -/
lemma write_eq_implies_state_eq {t : register} {v : word} {ζ₁ ζ₂ : state}
                                (h : ζ₁ ≃[t + 1] write t v ζ₂) :
  ζ₁ ≃[t] ζ₂ :=
begin
  simp [state_eq, state_eq_rs] at *,
  split; try { cc },
  intros r hr,
  cases h with _ h,
  specialize h r (lt_trans hr (register.lt_succ_self _)),
  rwa if_neg (ne_of_lt hr) at h
end

/-- The main theorem on compiler correctness.

Unlike Theorem 1 in the paper, both `map` and the assumption on `t` are explicit.
-/
theorem compiler_correctness :
  ∀ (map : identifier → register) (e : expr) (ξ : identifier → word) (η : state) (t : register),
    (∀ x, read (loc x map) η = ξ x) →
    (∀ x, loc x map < t) →
    outcome (compile map e t) η ≃[t] {ac := value e ξ, ..η} :=
begin
  intros _ _ _ _ _ hmap ht,
  revert η t,
  induction e; intros,

  -- 5.I
  case expr.const { simp [state_eq, step] },

  -- 5.II
  case expr.var   { finish [hmap, state_eq, step] },

  -- 5.III
  case expr.sum   { simp,
    generalize_hyp dν₁ : value e_s₁ ξ = ν₁ at e_ih_s₁ ⊢,
    generalize_hyp dν₂ : value e_s₂ ξ = ν₂ at e_ih_s₂ ⊢,
    generalize     dν  : ν₁ + ν₂ = ν,

    generalize dζ₁ : outcome (compile _ e_s₁ t) η        = ζ₁,
    generalize dζ₂ : step (instruction.sto t) ζ₁         = ζ₂,
    generalize dζ₃ : outcome (compile _ e_s₂ (t + 1)) ζ₂ = ζ₃,
    generalize dζ₄ : step (instruction.add t) ζ₃         = ζ₄,

    have hζ₁ : ζ₁ ≃[t] {ac := ν₁, ..η},
    calc ζ₁
        = outcome (compile map e_s₁ t) η : by cc
    ... ≃[t] {ac := ν₁, ..η}             : by apply e_ih_s₁; assumption,

    have hζ₁_ν₁ : ζ₁.ac = ν₁,
    { finish [state_eq] },

    have hζ₂ : ζ₂ ≃[t + 1]/ac write t ν₁ η,
    calc ζ₂
        = step (instruction.sto t) ζ₁       : by cc
    ... = write t ζ₁.ac ζ₁                  : by simp [step]
    ... = write t ν₁ ζ₁                     : by cc
    ... ≃[t + 1] write t ν₁ {ac := ν₁, ..η} : by apply state_eq_implies_write_eq hζ₁
    ... ≃[t + 1]/ac write t ν₁ η            : by { apply state_eq_rs_implies_write_eq_rs,
                                                   simp [state_eq_rs] },

    have hζ₂_ν₂ : read t ζ₂ = ν₁,
    { simp [state_eq_rs] at hζ₂ ⊢,
      specialize hζ₂ t (register.lt_succ_self _),
      cc },

    have ht' : ∀ x, loc x map < t + 1,
    { intros,
      apply lt_trans (ht _) (register.lt_succ_self _) },

    have hmap' : ∀ x, read (loc x map) ζ₂ = ξ x,
    { intros,
      calc read (loc x map) ζ₂
          = read (loc x map) (write t ν₁ η) : hζ₂ _ (ht' _)
      ... = read (loc x map) η              : by { simp only [loc] at ht, simp [(ht _).ne] }
      ... = ξ x                             : hmap x },

    have hζ₃ : ζ₃ ≃[t + 1] {ac := ν₂, ..(write t ν₁ η)},
    calc ζ₃
        = outcome (compile map e_s₂ (t + 1)) ζ₂ : by cc
    ... ≃[t + 1] {ac := ν₂, ..ζ₂}               : by apply e_ih_s₂; assumption
    ... ≃[t + 1] {ac := ν₂, ..(write t ν₁ η)}   : by { simp [state_eq], apply hζ₂ },

    have hζ₃_ν₂ : ζ₃.ac = ν₂,
    { finish [state_eq] },

    have hζ₃_ν₁ : read t ζ₃ = ν₁,
    { simp [state_eq, state_eq_rs] at hζ₃ ⊢,
      cases hζ₃ with _ hζ₃,
      specialize hζ₃ t (register.lt_succ_self _),
      cc },

    have hζ₄ : ζ₄ ≃[t + 1] {ac := ν, ..write t ν₁ η},
    calc ζ₄
        = step (instruction.add t) ζ₃      : by cc
    ... = {ac := read t ζ₃ + ζ₃.ac, ..ζ₃}  : by simp [step]
    ... = {ac := ν, ..ζ₃}                  : by cc
    ... ≃[t + 1] {ac := ν, ..{ac := ν₂, ..write t ν₁ η}}
                                           : by { simp [state_eq] at hζ₃ ⊢, cases hζ₃, assumption }
    ... ≃[t + 1] {ac := ν, ..write t ν₁ η} : by simp,

    apply write_eq_implies_state_eq; assumption }
end

end correctness

section test

open instruction

/-- The example in the paper for compiling (x + 3) + (x + (y + 2)). -/
example (x y t : register) :
  let map := λ v, if v = "x" then x else if v = "y" then y else 0,
      p   := expr.sum (expr.sum (expr.var "x") (expr.const 3))
                      (expr.sum (expr.var "x") (expr.sum (expr.var "y") (expr.const 2))) in
  compile map p t =
  [ load x,
    sto  t,
    li   3,
    add  t,
    sto  t,
    load x,
    sto  (t + 1),
    load y,
    sto  (t + 2),
    li   2,
    add  (t + 2),
    add  (t + 1),
    add  t ] :=
rfl

end test

end arithcc


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Bhavik Mehta

! This file was ported from Lean 3 source module data.finset.sigma
! leanprover-community/mathlib commit cc70d9141824ea8982d1562ce009952f2c3ece30
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Lattice
import Mathbin.Data.Set.Sigma

/-!
# Finite sets in a sigma type

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

This file defines a few `finset` constructions on `Σ i, α i`.

## Main declarations

* `finset.sigma`: Given a finset `s` in `ι` and finsets `t i` in each `α i`, `s.sigma t` is the
  finset of the dependent sum `Σ i, α i`
* `finset.sigma_lift`: Lifts maps `α i → β i → finset (γ i)` to a map
  `Σ i, α i → Σ i, β i → finset (Σ i, γ i)`.

## TODO

`finset.sigma_lift` can be generalized to any alternative functor. But to make the generalization
worth it, we must first refactor the functor library so that the `alternative` instance for `finset`
is computable and universe-polymorphic.
-/

open Function Multiset

variable {ι : Type _}

namespace Finset

section Sigma

variable {α : ι → Type _} {β : Type _} (s s₁ s₂ : Finset ι) (t t₁ t₂ : ∀ i, Finset (α i))

#print Finset.sigma /-
/-- `s.sigma t` is the finset of dependent pairs `⟨i, a⟩` such that `i ∈ s` and `a ∈ t i`. -/
protected def sigma : Finset (Σi, α i) :=
  ⟨_, s.Nodup.Sigma fun i => (t i).Nodup⟩
#align finset.sigma Finset.sigma
-/

variable {s s₁ s₂ t t₁ t₂}

/- warning: finset.mem_sigma -> Finset.mem_sigma is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s : Finset.{u1} ι} {t : forall (i : ι), Finset.{u2} (α i)} {a : Sigma.{u1, u2} ι (fun (i : ι) => α i)}, Iff (Membership.Mem.{max u1 u2, max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.hasMem.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) a (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t)) (And (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) s) (Membership.Mem.{u2, u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a)) (Finset.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a))) (Finset.hasMem.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a))) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (t (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s : Finset.{u2} ι} {t : forall (i : ι), Finset.{u1} (α i)} {a : Sigma.{u2, u1} ι (fun (i : ι) => α i)}, Iff (Membership.mem.{max u2 u1, max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.instMembershipFinset.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) a (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t)) (And (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) s) (Membership.mem.{u1, u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a)) (Finset.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a))) (Finset.instMembershipFinset.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a))) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (t (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a))))
Case conversion may be inaccurate. Consider using '#align finset.mem_sigma Finset.mem_sigmaₓ'. -/
@[simp]
theorem mem_sigma {a : Σi, α i} : a ∈ s.Sigma t ↔ a.1 ∈ s ∧ a.2 ∈ t a.1 :=
  mem_sigma
#align finset.mem_sigma Finset.mem_sigma

/- warning: finset.coe_sigma -> Finset.coe_sigma is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} (s : Finset.{u1} ι) (t : forall (i : ι), Finset.{u2} (α i)), Eq.{succ (max u1 u2)} (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) ((fun (a : Type.{max u1 u2}) (b : Type.{max u1 u2}) [self : HasLiftT.{succ (max u1 u2), succ (max u1 u2)} a b] => self.0) (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (HasLiftT.mk.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (CoeTCₓ.coe.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.Set.hasCoeT.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))))) (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t)) (Set.Sigma.{u1, u2} ι (fun (i : ι) => α i) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s) (fun (i : ι) => (fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} (α i)) (Set.{u2} (α i)) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} (α i)) (Set.{u2} (α i)) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} (α i)) (Set.{u2} (α i)) (Finset.Set.hasCoeT.{u2} (α i)))) (t i)))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} (s : Finset.{u2} ι) (t : forall (i : ι), Finset.{u1} (α i)), Eq.{max (succ u2) (succ u1)} (Set.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.toSet.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t)) (Set.Sigma.{u2, u1} ι (fun (i : ι) => α i) (Finset.toSet.{u2} ι s) (fun (i : ι) => Finset.toSet.{u1} (α i) (t i)))
Case conversion may be inaccurate. Consider using '#align finset.coe_sigma Finset.coe_sigmaₓ'. -/
@[simp, norm_cast]
theorem coe_sigma (s : Finset ι) (t : ∀ i, Finset (α i)) :
    (s.Sigma t : Set (Σi, α i)) = (s : Set ι).Sigma fun i => t i :=
  Set.ext fun _ => mem_sigma
#align finset.coe_sigma Finset.coe_sigma

/- warning: finset.sigma_nonempty -> Finset.sigma_nonempty is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s : Finset.{u1} ι} {t : forall (i : ι), Finset.{u2} (α i)}, Iff (Finset.Nonempty.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t)) (Exists.{succ u1} ι (fun (i : ι) => Exists.{0} (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) (fun (H : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) => Finset.Nonempty.{u2} (α i) (t i))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s : Finset.{u2} ι} {t : forall (i : ι), Finset.{u1} (α i)}, Iff (Finset.Nonempty.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t)) (Exists.{succ u2} ι (fun (i : ι) => And (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) (Finset.Nonempty.{u1} (α i) (t i))))
Case conversion may be inaccurate. Consider using '#align finset.sigma_nonempty Finset.sigma_nonemptyₓ'. -/
@[simp]
theorem sigma_nonempty : (s.Sigma t).Nonempty ↔ ∃ i ∈ s, (t i).Nonempty := by simp [Finset.Nonempty]
#align finset.sigma_nonempty Finset.sigma_nonempty

/- warning: finset.sigma_eq_empty -> Finset.sigma_eq_empty is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s : Finset.{u1} ι} {t : forall (i : ι), Finset.{u2} (α i)}, Iff (Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t) (EmptyCollection.emptyCollection.{max u1 u2} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.hasEmptyc.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))))) (forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> (Eq.{succ u2} (Finset.{u2} (α i)) (t i) (EmptyCollection.emptyCollection.{u2} (Finset.{u2} (α i)) (Finset.hasEmptyc.{u2} (α i)))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s : Finset.{u2} ι} {t : forall (i : ι), Finset.{u1} (α i)}, Iff (Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t) (EmptyCollection.emptyCollection.{max u2 u1} (Finset.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.instEmptyCollectionFinset.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i))))) (forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> (Eq.{succ u1} (Finset.{u1} (α i)) (t i) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} (α i)) (Finset.instEmptyCollectionFinset.{u1} (α i)))))
Case conversion may be inaccurate. Consider using '#align finset.sigma_eq_empty Finset.sigma_eq_emptyₓ'. -/
@[simp]
theorem sigma_eq_empty : s.Sigma t = ∅ ↔ ∀ i ∈ s, t i = ∅ := by
  simp only [← not_nonempty_iff_eq_empty, sigma_nonempty, not_exists]
#align finset.sigma_eq_empty Finset.sigma_eq_empty

/- warning: finset.sigma_mono -> Finset.sigma_mono is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s₁ : Finset.{u1} ι} {s₂ : Finset.{u1} ι} {t₁ : forall (i : ι), Finset.{u2} (α i)} {t₂ : forall (i : ι), Finset.{u2} (α i)}, (HasSubset.Subset.{u1} (Finset.{u1} ι) (Finset.hasSubset.{u1} ι) s₁ s₂) -> (forall (i : ι), HasSubset.Subset.{u2} (Finset.{u2} (α i)) (Finset.hasSubset.{u2} (α i)) (t₁ i) (t₂ i)) -> (HasSubset.Subset.{max u1 u2} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.hasSubset.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i))) (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s₁ t₁) (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s₂ t₂))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s₁ : Finset.{u2} ι} {s₂ : Finset.{u2} ι} {t₁ : forall (i : ι), Finset.{u1} (α i)} {t₂ : forall (i : ι), Finset.{u1} (α i)}, (HasSubset.Subset.{u2} (Finset.{u2} ι) (Finset.instHasSubsetFinset.{u2} ι) s₁ s₂) -> (forall (i : ι), HasSubset.Subset.{u1} (Finset.{u1} (α i)) (Finset.instHasSubsetFinset.{u1} (α i)) (t₁ i) (t₂ i)) -> (HasSubset.Subset.{max u2 u1} (Finset.{max u1 u2} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.instHasSubsetFinset.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i))) (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s₁ t₁) (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s₂ t₂))
Case conversion may be inaccurate. Consider using '#align finset.sigma_mono Finset.sigma_monoₓ'. -/
@[mono]
theorem sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.Sigma t₁ ⊆ s₂.Sigma t₂ :=
  fun ⟨i, a⟩ h =>
  let ⟨hi, ha⟩ := mem_sigma.1 h
  mem_sigma.2 ⟨hs hi, ht i ha⟩
#align finset.sigma_mono Finset.sigma_mono

/- warning: finset.pairwise_disjoint_map_sigma_mk -> Finset.pairwiseDisjoint_map_sigmaMk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s : Finset.{u1} ι} {t : forall (i : ι), Finset.{u2} (α i)}, Set.PairwiseDisjoint.{max u1 u2, u1} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (x : ι) => α x))) ι (Finset.partialOrder.{max u1 u2} (Sigma.{u1, u2} ι (fun (x : ι) => α x))) (Finset.orderBot.{max u1 u2} (Sigma.{u1, u2} ι (fun (x : ι) => α x))) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s) (fun (i : ι) => Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (t i))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s : Finset.{u2} ι} {t : forall (i : ι), Finset.{u1} (α i)}, Set.PairwiseDisjoint.{max u2 u1, u2} (Finset.{max u2 u1} (Sigma.{u2, u1} ι (fun (x : ι) => α x))) ι (Finset.partialOrder.{max u2 u1} (Sigma.{u2, u1} ι (fun (x : ι) => α x))) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{max u2 u1} (Sigma.{u2, u1} ι (fun (x : ι) => α x))) (Finset.toSet.{u2} ι s) (fun (i : ι) => Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι (fun (i : ι) => α i) i) (t i))
Case conversion may be inaccurate. Consider using '#align finset.pairwise_disjoint_map_sigma_mk Finset.pairwiseDisjoint_map_sigmaMkₓ'. -/
theorem pairwiseDisjoint_map_sigmaMk :
    (s : Set ι).PairwiseDisjoint fun i => (t i).map (Embedding.sigmaMk i) :=
  by
  intro i hi j hj hij
  rw [Function.onFun, disjoint_left]
  simp_rw [mem_map, Function.Embedding.sigmaMk_apply]
  rintro _ ⟨y, hy, rfl⟩ ⟨z, hz, hz'⟩
  exact hij (congr_arg Sigma.fst hz'.symm)
#align finset.pairwise_disjoint_map_sigma_mk Finset.pairwiseDisjoint_map_sigmaMk

/- warning: finset.disj_Union_map_sigma_mk -> Finset.disjUnionᵢ_map_sigma_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {s : Finset.{u1} ι} {t : forall (i : ι), Finset.{u2} (α i)}, Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι (fun (x : ι) => α x))) (Finset.disjUnionₓ.{u1, max u1 u2} ι (Sigma.{u1, u2} ι (fun (x : ι) => α x)) s (fun (i : ι) => Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (t i)) (Finset.pairwiseDisjoint_map_sigmaMk.{u1, u2} ι α s (fun (i : ι) => t i))) (Finset.sigma.{u1, u2} ι (fun (x : ι) => α x) s t)
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {s : Finset.{u2} ι} {t : forall (i : ι), Finset.{u1} (α i)}, Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sigma.{u2, u1} ι (fun (x : ι) => α x))) (Finset.disjUnionᵢ.{u2, max u2 u1} ι (Sigma.{u2, u1} ι (fun (x : ι) => α x)) s (fun (i : ι) => Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι (fun (i : ι) => α i) i) (t i)) (Finset.pairwiseDisjoint_map_sigmaMk.{u1, u2} ι (fun (i : ι) => α i) s (fun (i : ι) => t i))) (Finset.sigma.{u2, u1} ι (fun (x : ι) => α x) s t)
Case conversion may be inaccurate. Consider using '#align finset.disj_Union_map_sigma_mk Finset.disjUnionᵢ_map_sigma_mkₓ'. -/
@[simp]
theorem disjUnionᵢ_map_sigma_mk :
    s.disjUnionₓ (fun i => (t i).map (Embedding.sigmaMk i)) pairwiseDisjoint_map_sigmaMk =
      s.Sigma t :=
  rfl
#align finset.disj_Union_map_sigma_mk Finset.disjUnionᵢ_map_sigma_mk

#print Finset.sigma_eq_bunionᵢ /-
theorem sigma_eq_bunionᵢ [DecidableEq (Σi, α i)] (s : Finset ι) (t : ∀ i, Finset (α i)) :
    s.Sigma t = s.bunionᵢ fun i => (t i).map <| Embedding.sigmaMk i :=
  by
  ext ⟨x, y⟩
  simp [and_left_comm]
#align finset.sigma_eq_bUnion Finset.sigma_eq_bunionᵢ
-/

variable (s t) (f : (Σi, α i) → β)

/- warning: finset.sup_sigma -> Finset.sup_sigma is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : Type.{u3}} (s : Finset.{u1} ι) (t : forall (i : ι), Finset.{u2} (α i)) (f : (Sigma.{u1, u2} ι (fun (i : ι) => α i)) -> β) [_inst_1 : SemilatticeSup.{u3} β] [_inst_2 : OrderBot.{u3} β (Preorder.toLE.{u3} β (PartialOrder.toPreorder.{u3} β (SemilatticeSup.toPartialOrder.{u3} β _inst_1)))], Eq.{succ u3} β (Finset.sup.{u3, max u1 u2} β (Sigma.{u1, u2} ι (fun (i : ι) => α i)) _inst_1 _inst_2 (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t) f) (Finset.sup.{u3, u1} β ι _inst_1 _inst_2 s (fun (i : ι) => Finset.sup.{u3, u2} β (α i) _inst_1 _inst_2 (t i) (fun (b : α i) => f (Sigma.mk.{u1, u2} ι (fun (i : ι) => α i) i b))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {β : Type.{u3}} (s : Finset.{u2} ι) (t : forall (i : ι), Finset.{u1} (α i)) (f : (Sigma.{u2, u1} ι (fun (i : ι) => α i)) -> β) [_inst_1 : SemilatticeSup.{u3} β] [_inst_2 : OrderBot.{u3} β (Preorder.toLE.{u3} β (PartialOrder.toPreorder.{u3} β (SemilatticeSup.toPartialOrder.{u3} β _inst_1)))], Eq.{succ u3} β (Finset.sup.{u3, max u2 u1} β (Sigma.{u2, u1} ι (fun (i : ι) => α i)) _inst_1 _inst_2 (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t) f) (Finset.sup.{u3, u2} β ι _inst_1 _inst_2 s (fun (i : ι) => Finset.sup.{u3, u1} β (α i) _inst_1 _inst_2 (t i) (fun (b : α i) => f (Sigma.mk.{u2, u1} ι (fun (i : ι) => α i) i b))))
Case conversion may be inaccurate. Consider using '#align finset.sup_sigma Finset.sup_sigmaₓ'. -/
theorem sup_sigma [SemilatticeSup β] [OrderBot β] :
    (s.Sigma t).sup f = s.sup fun i => (t i).sup fun b => f ⟨i, b⟩ :=
  by
  simp only [le_antisymm_iff, Finset.sup_le_iff, mem_sigma, and_imp, Sigma.forall]
  exact
    ⟨fun i a hi ha => (le_sup hi).trans' <| le_sup ha, fun i hi a ha =>
      le_sup <| mem_sigma.2 ⟨hi, ha⟩⟩
#align finset.sup_sigma Finset.sup_sigma

/- warning: finset.inf_sigma -> Finset.inf_sigma is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : Type.{u3}} (s : Finset.{u1} ι) (t : forall (i : ι), Finset.{u2} (α i)) (f : (Sigma.{u1, u2} ι (fun (i : ι) => α i)) -> β) [_inst_1 : SemilatticeInf.{u3} β] [_inst_2 : OrderTop.{u3} β (Preorder.toLE.{u3} β (PartialOrder.toPreorder.{u3} β (SemilatticeInf.toPartialOrder.{u3} β _inst_1)))], Eq.{succ u3} β (Finset.inf.{u3, max u1 u2} β (Sigma.{u1, u2} ι (fun (i : ι) => α i)) _inst_1 _inst_2 (Finset.sigma.{u1, u2} ι (fun (i : ι) => α i) s t) f) (Finset.inf.{u3, u1} β ι _inst_1 _inst_2 s (fun (i : ι) => Finset.inf.{u3, u2} β (α i) _inst_1 _inst_2 (t i) (fun (b : α i) => f (Sigma.mk.{u1, u2} ι (fun (i : ι) => α i) i b))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} {β : Type.{u3}} (s : Finset.{u2} ι) (t : forall (i : ι), Finset.{u1} (α i)) (f : (Sigma.{u2, u1} ι (fun (i : ι) => α i)) -> β) [_inst_1 : SemilatticeInf.{u3} β] [_inst_2 : OrderTop.{u3} β (Preorder.toLE.{u3} β (PartialOrder.toPreorder.{u3} β (SemilatticeInf.toPartialOrder.{u3} β _inst_1)))], Eq.{succ u3} β (Finset.inf.{u3, max u2 u1} β (Sigma.{u2, u1} ι (fun (i : ι) => α i)) _inst_1 _inst_2 (Finset.sigma.{u2, u1} ι (fun (i : ι) => α i) s t) f) (Finset.inf.{u3, u2} β ι _inst_1 _inst_2 s (fun (i : ι) => Finset.inf.{u3, u1} β (α i) _inst_1 _inst_2 (t i) (fun (b : α i) => f (Sigma.mk.{u2, u1} ι (fun (i : ι) => α i) i b))))
Case conversion may be inaccurate. Consider using '#align finset.inf_sigma Finset.inf_sigmaₓ'. -/
theorem inf_sigma [SemilatticeInf β] [OrderTop β] :
    (s.Sigma t).inf f = s.inf fun i => (t i).inf fun b => f ⟨i, b⟩ :=
  @sup_sigma _ _ βᵒᵈ _ _ _ _ _
#align finset.inf_sigma Finset.inf_sigma

end Sigma

section SigmaLift

variable {α β γ : ι → Type _} [DecidableEq ι]

#print Finset.sigmaLift /-
/-- Lifts maps `α i → β i → finset (γ i)` to a map `Σ i, α i → Σ i, β i → finset (Σ i, γ i)`. -/
def sigmaLift (f : ∀ ⦃i⦄, α i → β i → Finset (γ i)) (a : Sigma α) (b : Sigma β) :
    Finset (Sigma γ) :=
  dite (a.1 = b.1) (fun h => (f (h.rec a.2) b.2).map <| Embedding.sigmaMk _) fun _ => ∅
#align finset.sigma_lift Finset.sigmaLift
-/

/- warning: finset.mem_sigma_lift -> Finset.mem_sigmaLift is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (a : Sigma.{u1, u2} ι α) (b : Sigma.{u1, u3} ι β) (x : Sigma.{u1, u4} ι γ), Iff (Membership.Mem.{max u1 u4, max u1 u4} (Sigma.{u1, u4} ι γ) (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasMem.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (Exists.{0} (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι α a) (Sigma.fst.{u1, u4} ι γ x)) (fun (ha : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι α a) (Sigma.fst.{u1, u4} ι γ x)) => Exists.{0} (Eq.{succ u1} ι (Sigma.fst.{u1, u3} ι β b) (Sigma.fst.{u1, u4} ι γ x)) (fun (hb : Eq.{succ u1} ι (Sigma.fst.{u1, u3} ι β b) (Sigma.fst.{u1, u4} ι γ x)) => Membership.Mem.{u4, u4} (γ (Sigma.fst.{u1, u4} ι γ x)) (Finset.{u4} (γ (Sigma.fst.{u1, u4} ι γ x))) (Finset.hasMem.{u4} (γ (Sigma.fst.{u1, u4} ι γ x))) (Sigma.snd.{u1, u4} ι γ x) (f (Sigma.fst.{u1, u4} ι γ x) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι α a) α (Sigma.snd.{u1, u2} ι α a) (Sigma.fst.{u1, u4} ι γ x) ha) (Eq.ndrec.{succ u3, succ u1} ι (Sigma.fst.{u1, u3} ι β b) β (Sigma.snd.{u1, u3} ι β b) (Sigma.fst.{u1, u4} ι γ x) hb)))))
but is expected to have type
  forall {ι : Type.{u3}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u3} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (a : Sigma.{u3, u2} ι α) (b : Sigma.{u3, u1} ι β) (x : Sigma.{u3, u4} ι γ), Iff (Membership.mem.{max u3 u4, max u4 u3} (Sigma.{u3, u4} ι γ) (Finset.{max u4 u3} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.instMembershipFinset.{max u3 u4} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (Exists.{0} (Eq.{succ u3} ι (Sigma.fst.{u3, u2} ι α a) (Sigma.fst.{u3, u4} ι γ x)) (fun (ha : Eq.{succ u3} ι (Sigma.fst.{u3, u2} ι α a) (Sigma.fst.{u3, u4} ι γ x)) => Exists.{0} (Eq.{succ u3} ι (Sigma.fst.{u3, u1} ι β b) (Sigma.fst.{u3, u4} ι γ x)) (fun (hb : Eq.{succ u3} ι (Sigma.fst.{u3, u1} ι β b) (Sigma.fst.{u3, u4} ι γ x)) => Membership.mem.{u4, u4} (γ (Sigma.fst.{u3, u4} ι γ x)) (Finset.{u4} (γ (Sigma.fst.{u3, u4} ι γ x))) (Finset.instMembershipFinset.{u4} (γ (Sigma.fst.{u3, u4} ι γ x))) (Sigma.snd.{u3, u4} ι γ x) (f (Sigma.fst.{u3, u4} ι γ x) (Eq.rec.{succ u2, succ u3} ι (Sigma.fst.{u3, u2} ι α a) (fun (x._@.Mathlib.Data.Finset.Sigma._hyg.1290 : ι) (h._@.Mathlib.Data.Finset.Sigma._hyg.1291 : Eq.{succ u3} ι (Sigma.fst.{u3, u2} ι α a) x._@.Mathlib.Data.Finset.Sigma._hyg.1290) => α x._@.Mathlib.Data.Finset.Sigma._hyg.1290) (Sigma.snd.{u3, u2} ι α a) (Sigma.fst.{u3, u4} ι γ x) ha) (Eq.rec.{succ u1, succ u3} ι (Sigma.fst.{u3, u1} ι β b) (fun (x._@.Mathlib.Data.Finset.Sigma._hyg.1295 : ι) (h._@.Mathlib.Data.Finset.Sigma._hyg.1296 : Eq.{succ u3} ι (Sigma.fst.{u3, u1} ι β b) x._@.Mathlib.Data.Finset.Sigma._hyg.1295) => β x._@.Mathlib.Data.Finset.Sigma._hyg.1295) (Sigma.snd.{u3, u1} ι β b) (Sigma.fst.{u3, u4} ι γ x) hb)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_sigma_lift Finset.mem_sigmaLiftₓ'. -/
theorem mem_sigmaLift (f : ∀ ⦃i⦄, α i → β i → Finset (γ i)) (a : Sigma α) (b : Sigma β)
    (x : Sigma γ) :
    x ∈ sigmaLift f a b ↔ ∃ (ha : a.1 = x.1)(hb : b.1 = x.1), x.2 ∈ f (ha.rec a.2) (hb.rec b.2) :=
  by
  obtain ⟨⟨i, a⟩, j, b⟩ := a, b
  obtain rfl | h := Decidable.eq_or_ne i j
  · constructor
    · simp_rw [sigma_lift, dif_pos rfl, mem_map, embedding.sigma_mk_apply]
      rintro ⟨x, hx, rfl⟩
      exact ⟨rfl, rfl, hx⟩
    · rintro ⟨⟨⟩, ⟨⟩, hx⟩
      rw [sigma_lift, dif_pos rfl, mem_map]
      exact ⟨_, hx, by simp [Sigma.ext_iff]⟩
  · rw [sigma_lift, dif_neg h]
    refine' iff_of_false (not_mem_empty _) _
    rintro ⟨⟨⟩, ⟨⟩, _⟩
    exact h rfl
#align finset.mem_sigma_lift Finset.mem_sigmaLift

/- warning: finset.mk_mem_sigma_lift -> Finset.mk_mem_sigmaLift is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (i : ι) (a : α i) (b : β i) (x : γ i), Iff (Membership.Mem.{max u1 u4, max u1 u4} (Sigma.{u1, u4} ι γ) (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasMem.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Sigma.mk.{u1, u4} ι γ i x) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f (Sigma.mk.{u1, u2} ι (fun (i : ι) => α i) i a) (Sigma.mk.{u1, u3} ι (fun (i : ι) => β i) i b))) (Membership.Mem.{u4, u4} (γ i) (Finset.{u4} (γ i)) (Finset.hasMem.{u4} (γ i)) x (f i a b))
but is expected to have type
  forall {ι : Type.{u3}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u3} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (i : ι) (a : α i) (b : β i) (x : γ i), Iff (Membership.mem.{max u3 u4, max u4 u3} (Sigma.{u3, u4} ι γ) (Finset.{max u4 u3} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.instMembershipFinset.{max u3 u4} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Sigma.mk.{u3, u4} ι γ i x) (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f (Sigma.mk.{u3, u2} ι (fun (i : ι) => α i) i a) (Sigma.mk.{u3, u1} ι (fun (i : ι) => β i) i b))) (Membership.mem.{u4, u4} (γ i) (Finset.{u4} (γ i)) (Finset.instMembershipFinset.{u4} (γ i)) x (f i a b))
Case conversion may be inaccurate. Consider using '#align finset.mk_mem_sigma_lift Finset.mk_mem_sigmaLiftₓ'. -/
theorem mk_mem_sigmaLift (f : ∀ ⦃i⦄, α i → β i → Finset (γ i)) (i : ι) (a : α i) (b : β i)
    (x : γ i) : (⟨i, x⟩ : Sigma γ) ∈ sigmaLift f ⟨i, a⟩ ⟨i, b⟩ ↔ x ∈ f a b :=
  by
  rw [sigma_lift, dif_pos rfl, mem_map]
  refine' ⟨_, fun hx => ⟨_, hx, rfl⟩⟩
  rintro ⟨x, hx, _, rfl⟩
  exact hx
#align finset.mk_mem_sigma_lift Finset.mk_mem_sigmaLift

/- warning: finset.not_mem_sigma_lift_of_ne_left -> Finset.not_mem_sigmaLift_of_ne_left is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (a : Sigma.{u1, u2} ι α) (b : Sigma.{u1, u3} ι β) (x : Sigma.{u1, u4} ι γ), (Ne.{succ u1} ι (Sigma.fst.{u1, u2} ι α a) (Sigma.fst.{u1, u4} ι γ x)) -> (Not (Membership.Mem.{max u1 u4, max u1 u4} (Sigma.{u1, u4} ι γ) (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasMem.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)))
but is expected to have type
  forall {ι : Type.{u3}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u3} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (a : Sigma.{u3, u2} ι α) (b : Sigma.{u3, u1} ι β) (x : Sigma.{u3, u4} ι γ), (Ne.{succ u3} ι (Sigma.fst.{u3, u2} ι α a) (Sigma.fst.{u3, u4} ι γ x)) -> (Not (Membership.mem.{max u3 u4, max u4 u3} (Sigma.{u3, u4} ι γ) (Finset.{max u4 u3} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.instMembershipFinset.{max u3 u4} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)))
Case conversion may be inaccurate. Consider using '#align finset.not_mem_sigma_lift_of_ne_left Finset.not_mem_sigmaLift_of_ne_leftₓ'. -/
theorem not_mem_sigmaLift_of_ne_left (f : ∀ ⦃i⦄, α i → β i → Finset (γ i)) (a : Sigma α)
    (b : Sigma β) (x : Sigma γ) (h : a.1 ≠ x.1) : x ∉ sigmaLift f a b :=
  by
  rw [mem_sigma_lift]
  exact fun H => h H.fst
#align finset.not_mem_sigma_lift_of_ne_left Finset.not_mem_sigmaLift_of_ne_left

/- warning: finset.not_mem_sigma_lift_of_ne_right -> Finset.not_mem_sigmaLift_of_ne_right is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) {a : Sigma.{u1, u2} ι α} (b : Sigma.{u1, u3} ι β) {x : Sigma.{u1, u4} ι γ}, (Ne.{succ u1} ι (Sigma.fst.{u1, u3} ι β b) (Sigma.fst.{u1, u4} ι γ x)) -> (Not (Membership.Mem.{max u1 u4, max u1 u4} (Sigma.{u1, u4} ι γ) (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasMem.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)))
but is expected to have type
  forall {ι : Type.{u3}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u3} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) {a : Sigma.{u3, u2} ι α} (b : Sigma.{u3, u1} ι β) {x : Sigma.{u3, u4} ι γ}, (Ne.{succ u3} ι (Sigma.fst.{u3, u1} ι β b) (Sigma.fst.{u3, u4} ι γ x)) -> (Not (Membership.mem.{max u3 u4, max u4 u3} (Sigma.{u3, u4} ι γ) (Finset.{max u4 u3} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.instMembershipFinset.{max u3 u4} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) x (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)))
Case conversion may be inaccurate. Consider using '#align finset.not_mem_sigma_lift_of_ne_right Finset.not_mem_sigmaLift_of_ne_rightₓ'. -/
theorem not_mem_sigmaLift_of_ne_right (f : ∀ ⦃i⦄, α i → β i → Finset (γ i)) {a : Sigma α}
    (b : Sigma β) {x : Sigma γ} (h : b.1 ≠ x.1) : x ∉ sigmaLift f a b :=
  by
  rw [mem_sigma_lift]
  exact fun H => h H.snd.fst
#align finset.not_mem_sigma_lift_of_ne_right Finset.not_mem_sigmaLift_of_ne_right

variable {f g : ∀ ⦃i⦄, α i → β i → Finset (γ i)} {a : Σi, α i} {b : Σi, β i}

/- warning: finset.sigma_lift_nonempty -> Finset.sigmaLift_nonempty is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))} {a : Sigma.{u1, u2} ι (fun (i : ι) => α i)} {b : Sigma.{u1, u3} ι (fun (i : ι) => β i)}, Iff (Finset.Nonempty.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i)) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (Exists.{0} (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) => Finset.Nonempty.{u4} (γ (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) (f (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u1, u3} ι (fun (i : ι) => β i) b))))
but is expected to have type
  forall {ι : Type.{u4}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u3}} [_inst_1 : DecidableEq.{succ u4} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u3} (γ i))} {a : Sigma.{u4, u2} ι (fun (i : ι) => α i)} {b : Sigma.{u4, u1} ι (fun (i : ι) => β i)}, Iff (Finset.Nonempty.{max u4 u3} (Sigma.{u4, u3} ι (fun (i : ι) => γ i)) (Finset.sigmaLift.{u4, u2, u1, u3} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (Exists.{0} (Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) (fun (h : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) => Finset.Nonempty.{u3} (γ (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) (f (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) (Eq.rec.{succ u2, succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Finset.Sigma._hyg.1918 : ι) (h._@.Mathlib.Data.Finset.Sigma._hyg.1919 : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Finset.Sigma._hyg.1918) => α x._@.Mathlib.Data.Finset.Sigma._hyg.1918) (Sigma.snd.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u4, u1} ι (fun (i : ι) => β i) b))))
Case conversion may be inaccurate. Consider using '#align finset.sigma_lift_nonempty Finset.sigmaLift_nonemptyₓ'. -/
theorem sigmaLift_nonempty :
    (sigmaLift f a b).Nonempty ↔ ∃ h : a.1 = b.1, (f (h.rec a.2) b.2).Nonempty :=
  by
  simp_rw [nonempty_iff_ne_empty]
  convert dite_ne_right_iff
  ext h
  simp_rw [← nonempty_iff_ne_empty]
  exact map_nonempty.symm
#align finset.sigma_lift_nonempty Finset.sigmaLift_nonempty

/- warning: finset.sigma_lift_eq_empty -> Finset.sigmaLift_eq_empty is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))} {a : Sigma.{u1, u2} ι (fun (i : ι) => α i)} {b : Sigma.{u1, u3} ι (fun (i : ι) => β i)}, Iff (Eq.{succ (max u1 u4)} (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b) (EmptyCollection.emptyCollection.{max u1 u4} (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasEmptyc.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))))) (forall (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)), Eq.{succ u4} (Finset.{u4} (γ (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b))) (f (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u1, u3} ι (fun (i : ι) => β i) b)) (EmptyCollection.emptyCollection.{u4} (Finset.{u4} (γ (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b))) (Finset.hasEmptyc.{u4} (γ (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)))))
but is expected to have type
  forall {ι : Type.{u4}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u3}} [_inst_1 : DecidableEq.{succ u4} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u3} (γ i))} {a : Sigma.{u4, u2} ι (fun (i : ι) => α i)} {b : Sigma.{u4, u1} ι (fun (i : ι) => β i)}, Iff (Eq.{max (succ u4) (succ u3)} (Finset.{max u3 u4} (Sigma.{u4, u3} ι (fun (i : ι) => γ i))) (Finset.sigmaLift.{u4, u2, u1, u3} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b) (EmptyCollection.emptyCollection.{max u4 u3} (Finset.{max u3 u4} (Sigma.{u4, u3} ι (fun (i : ι) => γ i))) (Finset.instEmptyCollectionFinset.{max u4 u3} (Sigma.{u4, u3} ι (fun (i : ι) => γ i))))) (forall (h : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)), Eq.{succ u3} (Finset.{u3} (γ (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b))) (f (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) (Eq.rec.{succ u2, succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Finset.Sigma._hyg.2035 : ι) (h._@.Mathlib.Data.Finset.Sigma._hyg.2036 : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Finset.Sigma._hyg.2035) => α x._@.Mathlib.Data.Finset.Sigma._hyg.2035) (Sigma.snd.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u4, u1} ι (fun (i : ι) => β i) b)) (EmptyCollection.emptyCollection.{u3} (Finset.{u3} (γ (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b))) (Finset.instEmptyCollectionFinset.{u3} (γ (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)))))
Case conversion may be inaccurate. Consider using '#align finset.sigma_lift_eq_empty Finset.sigmaLift_eq_emptyₓ'. -/
theorem sigmaLift_eq_empty : sigmaLift f a b = ∅ ↔ ∀ h : a.1 = b.1, f (h.rec a.2) b.2 = ∅ :=
  by
  convert dite_eq_right_iff
  exact forall_congr fun h => propext map_eq_empty.symm
#align finset.sigma_lift_eq_empty Finset.sigmaLift_eq_empty

/- warning: finset.sigma_lift_mono -> Finset.sigmaLift_mono is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))} {g : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))}, (forall {{i : ι}} {{a : α i}} {{b : β i}}, HasSubset.Subset.{u4} (Finset.{u4} (γ i)) (Finset.hasSubset.{u4} (γ i)) (f i a b) (g i a b)) -> (forall (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u3} ι (fun (i : ι) => β i)), HasSubset.Subset.{max u1 u4} (Finset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.hasSubset.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i))) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) g a b))
but is expected to have type
  forall {ι : Type.{u3}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u3} ι] {f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))} {g : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))}, (forall {{i : ι}} {{a : α i}} {{b : β i}}, HasSubset.Subset.{u4} (Finset.{u4} (γ i)) (Finset.instHasSubsetFinset.{u4} (γ i)) (f i a b) (g i a b)) -> (forall (a : Sigma.{u3, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u3, u1} ι (fun (i : ι) => β i)), HasSubset.Subset.{max u4 u3} (Finset.{max u4 u3} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.instHasSubsetFinset.{max u3 u4} (Sigma.{u3, u4} ι (fun (i : ι) => γ i))) (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b) (Finset.sigmaLift.{u3, u2, u1, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) g a b))
Case conversion may be inaccurate. Consider using '#align finset.sigma_lift_mono Finset.sigmaLift_monoₓ'. -/
theorem sigmaLift_mono (h : ∀ ⦃i⦄ ⦃a : α i⦄ ⦃b : β i⦄, f a b ⊆ g a b) (a : Σi, α i) (b : Σi, β i) :
    sigmaLift f a b ⊆ sigmaLift g a b := by
  rintro x hx
  rw [mem_sigma_lift] at hx⊢
  obtain ⟨ha, hb, hx⟩ := hx
  exact ⟨ha, hb, h hx⟩
#align finset.sigma_lift_mono Finset.sigmaLift_mono

variable (f a b)

/- warning: finset.card_sigma_lift -> Finset.card_sigmaLift is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} {β : ι -> Type.{u3}} {γ : ι -> Type.{u4}} [_inst_1 : DecidableEq.{succ u1} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u4} (γ i))) (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u3} ι (fun (i : ι) => β i)), Eq.{1} Nat (Finset.card.{max u1 u4} (Sigma.{u1, u4} ι (fun (i : ι) => γ i)) (Finset.sigmaLift.{u1, u2, u3, u4} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (dite.{1} Nat (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) (_inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) => Finset.card.{u4} (γ (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b)) (f (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u1, u3} ι (fun (i : ι) => β i) b))) (fun (_x : Not (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u3} ι (fun (i : ι) => β i) b))) => OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall {ι : Type.{u4}} {α : ι -> Type.{u2}} {β : ι -> Type.{u1}} {γ : ι -> Type.{u3}} [_inst_1 : DecidableEq.{succ u4} ι] (f : forall {{i : ι}}, (α i) -> (β i) -> (Finset.{u3} (γ i))) (a : Sigma.{u4, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u4, u1} ι (fun (i : ι) => β i)), Eq.{1} Nat (Finset.card.{max u4 u3} (Sigma.{u4, u3} ι (fun (i : ι) => γ i)) (Finset.sigmaLift.{u4, u2, u1, u3} ι (fun (i : ι) => α i) (fun (i : ι) => β i) (fun (i : ι) => γ i) (fun (a : ι) (b : ι) => _inst_1 a b) f a b)) (dite.{1} Nat (Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) (_inst_1 (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) (fun (h : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) => Finset.card.{u3} (γ (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b)) (f (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) (Eq.rec.{succ u2, succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Finset.Sigma._hyg.2367 : ι) (h._@.Mathlib.Data.Finset.Sigma._hyg.2368 : Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Finset.Sigma._hyg.2367) => α x._@.Mathlib.Data.Finset.Sigma._hyg.2367) (Sigma.snd.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b) h) (Sigma.snd.{u4, u1} ι (fun (i : ι) => β i) b))) (fun (_x : Not (Eq.{succ u4} ι (Sigma.fst.{u4, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u4, u1} ι (fun (i : ι) => β i) b))) => OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align finset.card_sigma_lift Finset.card_sigmaLiftₓ'. -/
theorem card_sigmaLift :
    (sigmaLift f a b).card = dite (a.1 = b.1) (fun h => (f (h.rec a.2) b.2).card) fun _ => 0 :=
  by
  convert apply_dite _ _ _ _
  ext h
  exact (card_map _).symm
#align finset.card_sigma_lift Finset.card_sigmaLift

end SigmaLift

end Finset