/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
-/
import tactic.split_ifs
import tactic.simpa
import tactic.congr
import algebra.group.to_additive
/-!
# Instances and theorems on pi types

This file provides basic definitions and notation instances for Pi types.

Instances of more sophisticated classes are defined in `pi.lean` files elsewhere.
-/

open function

universes u v₁ v₂ v₃
variable {I : Type u}     -- The indexing type
variables {α β γ : Type*}
-- The families of types already equipped with instances
variables {f : I → Type v₁} {g : I → Type v₂} {h : I → Type v₃}
variables (x y : Π i, f i) (i : I)

namespace pi

/-! `1`, `0`, `+`, `*`, `-`, `⁻¹`, and `/` are defined pointwise. -/

@[to_additive] instance has_one [∀ i, has_one $ f i] :
  has_one (Π i : I, f i) :=
⟨λ _, 1⟩
@[simp, to_additive] lemma one_apply [∀ i, has_one $ f i] : (1 : Π i, f i) i = 1 := rfl

@[to_additive] lemma one_def [Π i, has_one $ f i] : (1 : Π i, f i) = λ i, 1 := rfl

@[simp, to_additive] lemma const_one [has_one β] : const α (1 : β) = 1 := rfl

@[simp, to_additive] lemma one_comp [has_one γ] (x : α → β) : (1 : β → γ) ∘ x = 1 := rfl

@[simp, to_additive] lemma comp_one [has_one β] (x : β → γ) : x ∘ 1 = const α (x 1) := rfl

@[to_additive]
instance has_mul [∀ i, has_mul $ f i] :
  has_mul (Π i : I, f i) :=
⟨λ f g i, f i * g i⟩
@[simp, to_additive] lemma mul_apply [∀ i, has_mul $ f i] : (x * y) i = x i * y i := rfl

@[to_additive] lemma mul_def [Π i, has_mul $ f i] : x * y = λ i, x i * y i := rfl

@[simp, to_additive] lemma const_mul [has_mul β] (a b : β) :
  const α a * const α b = const α (a * b) := rfl

@[to_additive] lemma mul_comp [has_mul γ] (x y : β → γ) (z : α → β) :
  (x * y) ∘ z = x ∘ z * y ∘ z := rfl

@[simp] lemma bit0_apply [Π i, has_add $ f i] : (bit0 x) i = bit0 (x i) := rfl

@[simp] lemma bit1_apply [Π i, has_add $ f i] [Π i, has_one $ f i] : (bit1 x) i = bit1 (x i) := rfl

@[to_additive] instance has_inv [∀ i, has_inv $ f i] :
  has_inv (Π i : I, f i) :=
  ⟨λ f i, (f i)⁻¹⟩
@[simp, to_additive] lemma inv_apply [∀ i, has_inv $ f i] : x⁻¹ i = (x i)⁻¹ := rfl
@[to_additive] lemma inv_def [Π i, has_inv $ f i] : x⁻¹ = λ i, (x i)⁻¹ := rfl

@[to_additive] lemma const_inv [has_inv β] (a : β) : (const α a)⁻¹ = const α a⁻¹ := rfl

@[to_additive] lemma inv_comp [has_inv γ] (x : β → γ) (y : α → β) : x⁻¹ ∘ y = (x ∘ y)⁻¹ := rfl

@[to_additive] instance has_div [Π i, has_div $ f i] :
  has_div (Π i : I, f i) :=
⟨λ f g i, f i / g i⟩
@[simp, to_additive] lemma div_apply [Π i, has_div $ f i] : (x / y) i = x i / y i := rfl
@[to_additive] lemma div_def [Π i, has_div $ f i] : x / y = λ i, x i / y i := rfl

@[to_additive] lemma div_comp [has_div γ] (x y : β → γ) (z : α → β) :
  (x / y) ∘ z = x ∘ z / y ∘ z := rfl

@[simp, to_additive] lemma const_div [has_div β] (a b : β) :
  const α a / const α b = const α (a / b) := rfl

section

variables [decidable_eq I]
variables [Π i, has_zero (f i)] [Π i, has_zero (g i)] [Π i, has_zero (h i)]

/-- The function supported at `i`, with value `x` there. -/
def single (i : I) (x : f i) : Π i, f i :=
function.update 0 i x

@[simp] lemma single_eq_same (i : I) (x : f i) : single i x i = x :=
function.update_same i x _

@[simp] lemma single_eq_of_ne {i i' : I} (h : i' ≠ i) (x : f i) : single i x i' = 0 :=
function.update_noteq h x _

/-- Abbreviation for `single_eq_of_ne h.symm`, for ease of use by `simp`. -/
@[simp] lemma single_eq_of_ne' {i i' : I} (h : i ≠ i') (x : f i) : single i x i' = 0 :=
single_eq_of_ne h.symm x

@[simp] lemma single_zero (i : I) : single i (0 : f i) = 0 :=
function.update_eq_self _ _

/-- On non-dependent functions, `pi.single` can be expressed as an `ite` -/
lemma single_apply {β : Sort*} [has_zero β] (i : I) (x : β) (i' : I) :
  single i x i' = if i' = i then x else 0 :=
function.update_apply 0 i x i'

/-- On non-dependent functions, `pi.single` is symmetric in the two indices. -/
lemma single_comm {β : Sort*} [has_zero β] (i : I) (x : β) (i' : I) :
  single i x i' = single i' x i :=
by simp [single_apply, eq_comm]

lemma apply_single (f' : Π i, f i → g i) (hf' : ∀ i, f' i 0 = 0) (i : I) (x : f i) (j : I):
  f' j (single i x j) = single i (f' i x) j :=
by simpa only [pi.zero_apply, hf', single] using function.apply_update f' 0 i x j

lemma apply_single₂ (f' : Π i, f i → g i → h i) (hf' : ∀ i, f' i 0 0 = 0)
  (i : I) (x : f i) (y : g i) (j : I):
  f' j (single i x j) (single i y j) = single i (f' i x y) j :=
begin
  by_cases h : j = i,
  { subst h, simp only [single_eq_same] },
  { simp only [single_eq_of_ne h, hf'] },
end

lemma single_op {g : I → Type*} [Π i, has_zero (g i)] (op : Π i, f i → g i) (h : ∀ i, op i 0 = 0)
  (i : I) (x : f i) :
  single i (op i x) = λ j, op j (single i x j) :=
eq.symm $ funext $ apply_single op h i x

lemma single_op₂ {g₁ g₂ : I → Type*} [Π i, has_zero (g₁ i)] [Π i, has_zero (g₂ i)]
  (op : Π i, g₁ i → g₂ i → f i) (h : ∀ i, op i 0 0 = 0) (i : I) (x₁ : g₁ i) (x₂ : g₂ i) :
  single i (op i x₁ x₂) = λ j, op j (single i x₁ j) (single i x₂ j) :=
eq.symm $ funext $ apply_single₂ op h i x₁ x₂

variables (f)

lemma single_injective (i : I) : function.injective (single i : f i → Π i, f i) :=
function.update_injective _ i

@[simp] lemma single_inj (i : I) {x y : f i} : pi.single i x = pi.single i y ↔ x = y :=
(pi.single_injective _ _).eq_iff

end
end pi

namespace function

section extend
@[to_additive]
lemma extend_one [has_one γ] (f : α → β) :
  function.extend f (1 : α → γ) (1 : β → γ) = 1 :=
funext $ λ _, by apply if_t_t _ _

@[to_additive]
lemma extend_mul [has_mul γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ) :
  function.extend f (g₁ * g₂) (e₁ * e₂) = function.extend f g₁ e₁ * function.extend f g₂ e₂ :=
funext $ λ _, by convert (apply_dite2 (*) _ _ _ _ _).symm

@[to_additive]
lemma extend_inv [has_inv γ] (f : α → β) (g : α → γ) (e : β → γ) :
  function.extend f (g⁻¹) (e⁻¹) = (function.extend f g e)⁻¹ :=
funext $ λ _, by convert (apply_dite has_inv.inv _ _ _).symm

@[to_additive]
lemma extend_div [has_div γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ) :
  function.extend f (g₁ / g₂) (e₁ / e₂) = function.extend f g₁ e₁ / function.extend f g₂ e₂ :=
funext $ λ _, by convert (apply_dite2 (/) _ _ _ _ _).symm

end extend

lemma surjective_pi_map {F : Π i, f i → g i} (hF : ∀ i, surjective (F i)) :
  surjective (λ x : Π i, f i, λ i, F i (x i)) :=
λ y, ⟨λ i, (hF i (y i)).some, funext $ λ i, (hF i (y i)).some_spec⟩

lemma injective_pi_map {F : Π i, f i → g i} (hF : ∀ i, injective (F i)) :
  injective (λ x : Π i, f i, λ i, F i (x i)) :=
λ x y h, funext $ λ i, hF i $ (congr_fun h i : _)

lemma bijective_pi_map {F : Π i, f i → g i} (hF : ∀ i, bijective (F i)) :
  bijective (λ x : Π i, f i, λ i, F i (x i)) :=
⟨injective_pi_map (λ i, (hF i).injective), surjective_pi_map (λ i, (hF i).surjective)⟩

end function

lemma subsingleton.pi_single_eq {α : Type*} [decidable_eq I] [subsingleton I] [has_zero α]
  (i : I) (x : α) :
  pi.single i x = λ _, x :=
funext $ λ j, by rw [subsingleton.elim j i, pi.single_eq_same]


import mathlib.data.set.image
import logic.lemmas
import measure_theory.measure.measure_space

open function measure_theory set
open_locale ennreal measure_theory

variables {α β : Type*} [measurable_space β]  {f g : α → β} {s : set β}

namespace measure_theory

variables [measurable_space α] {μ : measure α}

namespace measure

@[simp] lemma map_eq_zero_iff (hf : ae_measurable f μ) : μ.map f = 0 ↔ μ = 0 :=
begin
  refine ⟨λ h, _, _⟩,
  { replace h := congr_fun (congr_arg coe_fn h) set.univ,
    rwa [map_apply_of_ae_measurable hf measurable_set.univ, set.preimage_univ, coe_zero,
      pi.zero_apply, measure_univ_eq_zero] at h },
  { rintro rfl,
    exact measure.map_zero _ }
end

@[simp] lemma mapₗ_eq_zero_iff (hf : measurable f) : measure.mapₗ f μ = 0 ↔ μ = 0 :=
begin
  classical,
  rw [← map_eq_zero_iff hf.ae_measurable, map, dif_pos hf.ae_measurable,
    mapₗ_congr hf hf.ae_measurable.measurable_mk],
  exact hf.ae_measurable.ae_eq_mk,
end

lemma map_ne_zero_iff (hf : ae_measurable f μ) : μ.map f ≠ 0 ↔ μ ≠ 0 := (map_eq_zero_iff hf).not
lemma mapₗ_ne_zero_iff (hf : measurable f) : measure.mapₗ f μ ≠ 0 ↔ μ ≠ 0 :=
(mapₗ_eq_zero_iff hf).not

end measure

instance Prop.measurable_space : measurable_space Prop := ⊤
instance Prop.measurable_singleton_class : measurable_singleton_class Prop := ⟨λ _, trivial⟩
instance {α} : measurable_space (set α) := ⊤
instance {α} : measurable_singleton_class (set α) := ⟨λ _, trivial⟩

instance is_probability_measure_ne_zero {α : Type*} [measurable_space α] {μ : measure α}
  [is_probability_measure μ] : ne_zero μ :=
⟨is_probability_measure.ne_zero μ⟩

end measure_theory

namespace measurable_space
variables [boolean_algebra β] (p : α → Prop)

lemma comap_of_involutive {g : β → β} (hg : involutive g) (hg' : measurable g) (f : α → β) :
  measurable_space.comap (λ a, g (f a)) infer_instance = measurable_space.comap f infer_instance :=
begin
  ext,
  set e : set β ≃ set β :=
  { to_fun := preimage g,
    inv_fun := preimage g,
    left_inv := hg.preimage,
    right_inv := hg.preimage },
  refine e.exists_congr_left.trans (exists_congr $ λ t, _),
  simp only [preimage_preimage, compl_compl, equiv.coe_fn_symm_mk, and.congr_left_iff, hg _],
  rintro rfl,
  refine ⟨λ ht, _, λ ht, hg' ht⟩,
  convert hg' ht,
  simp_rw [preimage_preimage, hg _, preimage_id'],
end

lemma comap_compl (h : measurable (compl : β → β)) (f : α → β) :
  measurable_space.comap (λ a, (f a)ᶜ) infer_instance = measurable_space.comap f infer_instance :=
comap_of_involutive compl_involutive h _

@[simp] lemma comap_not :
  measurable_space.comap (λ a, ¬ p a) infer_instance = measurable_space.comap p infer_instance :=
comap_compl (λ _ _, trivial) _

end measurable_space

lemma ae_measurable.null_measurable_set_preimage
  [measurable_space α] {μ : measure α} (hf : ae_measurable f μ) (hs : measurable_set s) :
  null_measurable_set (f ⁻¹' s) μ :=
⟨hf.mk _ ⁻¹' s, hf.measurable_mk hs, hf.ae_eq_mk.preimage _⟩

namespace measure_theory

variables [measurable_space α] {μ : measure α}

-- change `measure_compl` to `measurable_set.compl` in the `measure_theory` namespace
lemma null_measurable_set.measure_compl {s : set α} (h : null_measurable_set s μ) (hs : μ s ≠ ∞) :
  μ sᶜ = μ set.univ - μ s :=
begin
  rw [← measure_congr h.to_measurable_ae_eq, ← measure_compl (measurable_set_to_measurable _ _)],
  { exact measure_congr h.to_measurable_ae_eq.symm.compl },
  { rwa measure_congr h.to_measurable_ae_eq },
end

lemma null_measurable_set.prob_compl_eq_one_sub [is_probability_measure μ]
  {s : set α} (h : null_measurable_set s μ) :
  μ sᶜ = 1 - μ s :=
by rw [h.measure_compl (measure_ne_top _ _), measure_univ]

end measure_theory

namespace measurable_space

/-- The sigma-algebra generated by a single set `s` is `{∅, s, sᶜ, univ}`. -/
@[simp] lemma generate_from_singleton (s : set α) :
  generate_from {s} = measurable_space.comap (∈ s) ⊤ :=
begin
  classical,
  refine le_antisymm (generate_from_le $ λ t ht, ⟨{true}, trivial, by simp [ht.symm]⟩) _,
  rintro _ ⟨u, -, rfl⟩,
  by_cases hu₁ : true ∈ u; by_cases hu₀ : false ∈ u,
  { rw [(_ : u = univ), preimage_univ],
    { exact measurable_set.univ },
    { rw [eq_univ_iff_forall, Prop.forall],
      exact ⟨hu₁, hu₀⟩ } },
  { rw [(_ : u = {true}), preimage_mem_singleton_true],
    { exact generate_measurable.basic _ (mem_singleton _) },
    { simp [eq_singleton_iff_unique_mem, Prop.forall, hu₁, hu₀] } },
  { rw [(_ : u = {false}), preimage_mem_singleton_false],
    { exact generate_measurable.compl _ (generate_measurable.basic _ $ mem_singleton _) },
    { simp [eq_singleton_iff_unique_mem, Prop.forall, hu₁, hu₀] } },
  { rw [(_ : u = ∅), preimage_empty],
    { exact @measurable_set.empty _ (generate_from _) },
    { simp [eq_empty_iff_forall_not_mem, Prop.forall, hu₁, hu₀] } }
end

end measurable_space


import analysis.normed_space.bounded_linear_maps
import analysis.normed_space.finite_dimension

noncomputable theory

local notation u ` ⬝ `:70 φ:65 :=
  continuous_linear_map.comp (continuous_linear_map.to_span_singleton ℝ u) φ

variables {𝕜 E F G Fₗ Gₗ X : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E]
  [normed_add_comm_group Fₗ] [normed_add_comm_group Gₗ] [normed_add_comm_group F]
  [normed_add_comm_group G]
  [normed_space 𝕜 E] [normed_space 𝕜 Fₗ] [normed_space 𝕜 Gₗ] [normed_space 𝕜 F] [normed_space 𝕜 G]
  [topological_space X]

lemma continuous_linear_map.le_op_norm_of_le' {𝕜 : Type*} {𝕜₂ : Type*} {E : Type*} {F : Type*}
  [normed_add_comm_group E] [seminormed_add_comm_group F] [nontrivially_normed_field 𝕜]
  [nontrivially_normed_field 𝕜₂] [normed_space 𝕜 E] [normed_space 𝕜₂ F] {σ₁₂ : 𝕜 →+* 𝕜₂}
  [ring_hom_isometric σ₁₂] (f : E →SL[σ₁₂] F) {x : E} (hx : x ≠ 0) {C : ℝ} (h : C * ‖x‖ ≤ ‖f x‖) :
  C ≤ ‖f‖ :=
begin
  apply le_of_mul_le_mul_right (h.trans (f.le_op_norm x)),
  rwa norm_pos_iff',
end

@[simp]
lemma continuous_linear_map.to_span_singleton_zero (𝕜 : Type*) {E : Type*} [seminormed_add_comm_group E] [nontrivially_normed_field 𝕜]
  [normed_space 𝕜 E] : continuous_linear_map.to_span_singleton 𝕜 (0 : E) = 0 :=
begin
  ext u,
  simp only [continuous_linear_map.to_span_singleton_apply, continuous_linear_map.zero_apply,
             linear_map.to_span_singleton_apply, linear_map.mk_continuous_apply, smul_zero]
end

@[simp]
lemma continuous_linear_map.comp_to_span_singleton_apply {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]
  (φ : E →L[ℝ] ℝ) (v : E) (u : F) : (u ⬝ φ) v = (φ v) • u:=
rfl

universes u₁ u₂ u₃ u₄

/-- The natural linear map `(M →ₗ[R] M₃) × (M₂ →ₗ[R] M₃) →ₗ[R] M × M₂ →ₗ[R] M₃` for `R`-modules `M`,
`M₂`, `M₃` over a commutative ring `R`.

If `f : M →ₗ[R] M₃` and `g : M₂ →ₗ[R] M₃` then `linear_map.coprodₗ (f, g)` is the map
`(m, n) ↦ f m + g n`. -/
def linear_map.coprodₗ (R : Type u₁) (M : Type u₂) (M₂ : Type u₃) (M₃ : Type u₄) [comm_ring R]
  [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [module R M]
  [module R M₂] [module R M₃] : ((M →ₗ[R] M₃) × (M₂ →ₗ[R] M₃)) →ₗ[R] (M × M₂ →ₗ[R] M₃) :=
{ to_fun := λ p, p.1.coprod p.2,
  map_add' := begin
    intros p q,
    apply linear_map.coe_injective,
    ext x,
    simp only [prod.fst_add, linear_map.coprod_apply, linear_map.add_apply, prod.snd_add],
    ac_refl
  end,
  map_smul' := begin
    intros r p,
    apply linear_map.coe_injective,
    ext x,
    simp only [prod.smul_fst, prod.smul_snd, linear_map.coprod_apply, linear_map.smul_apply,
               ring_hom.id_apply, smul_add]
  end }

lemma add_le_twice_max (a b : ℝ) : a + b ≤ 2*max a b :=
calc a + b ≤ max a b + max a b : add_le_add (le_max_left a b) (le_max_right a b)
... = _ : by ring

lemma is_bounded_linear_map_coprod (𝕜 : Type*) [nontrivially_normed_field 𝕜] (E : Type*) [normed_add_comm_group E]
  [normed_space 𝕜 E] (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F]
  (G : Type*) [normed_add_comm_group G] [normed_space 𝕜 G] : is_bounded_linear_map 𝕜
  (λ p : (E →L[𝕜] G) × (F →L[𝕜] G), p.1.coprod p.2) :=
{ map_add := begin
    intros,
    apply continuous_linear_map.coe_fn_injective,
    ext u,
    simp only [prod.fst_add, prod.snd_add, continuous_linear_map.coprod_apply,
               continuous_linear_map.add_apply],
    ac_refl
  end,
  map_smul := begin
    intros r p,
    apply continuous_linear_map.coe_fn_injective,
    ext x,
    simp only [prod.smul_fst, prod.smul_snd, continuous_linear_map.coprod_apply,
               continuous_linear_map.coe_smul', pi.smul_apply, smul_add],
  end,
  bound := begin
    refine ⟨2, zero_lt_two, _⟩,
    rintros ⟨φ, ψ⟩,
    apply continuous_linear_map.op_norm_le_bound,
    exact mul_nonneg zero_le_two (norm_nonneg _),
    rintros ⟨e, f⟩,
    calc ‖φ e + ψ f‖ ≤ ‖φ e‖ + ‖ψ f‖ : norm_add_le _ _
    ... ≤  ‖φ‖ * ‖e‖ + ‖ψ‖ * ‖f‖ : add_le_add (φ.le_op_norm e) (ψ.le_op_norm f)
    ... ≤ (max ‖φ‖ ‖ψ‖) * ‖e‖ + (max ‖φ‖ ‖ψ‖) * ‖f‖ : _
    ... ≤ (2*(max ‖φ‖ ‖ψ‖)) * (max ‖e‖ ‖f‖) : _,
    apply add_le_add,
    exact mul_le_mul_of_nonneg_right (le_max_left ‖φ‖ ‖ψ‖) (norm_nonneg e),
    exact mul_le_mul_of_nonneg_right (le_max_right ‖φ‖ ‖ψ‖) (norm_nonneg f),
    rw [← mul_add, mul_comm (2 : ℝ), mul_assoc],
    apply mul_le_mul_of_nonneg_left (add_le_twice_max _ _) (le_max_of_le_left $ norm_nonneg _)
  end }

/-- The natural continuous linear map `((E →L[𝕜] G) × (F →L[𝕜] G)) →L[𝕜] (E × F →L[𝕜] G)` for
normed spaces `E`, `F`, `G` over a normed field `𝕜`.

If `g₁ : E →L[𝕜] G` and `g₂ : F →L[𝕜] G` then `continuous_linear_map.coprodL (g₁, g₂)` is the map
`(e, f) ↦ g₁ e + g₂ f`. -/
def continuous_linear_map.coprodL :
  ((E →L[𝕜] G) × (F →L[𝕜] G)) →L[𝕜] (E × F →L[𝕜] G) :=
(is_bounded_linear_map_coprod 𝕜 E F G).to_continuous_linear_map

@[continuity]
lemma continuous.coprodL
  {f : X → E →L[𝕜] G} {g : X → F →L[𝕜] G}
  (hf : continuous f) (hg : continuous g) : continuous (λ x, (f x).coprod (g x)) :=
continuous_linear_map.coprodL.continuous.comp₂ hf hg

lemma continuous.prodL' {𝕜 : Type*} {E : Type*} {Fₗ : Type*} {Gₗ : Type*} [seminormed_add_comm_group E]
  [seminormed_add_comm_group Fₗ] [seminormed_add_comm_group Gₗ] [nontrivially_normed_field 𝕜]
  [normed_space 𝕜 E] [normed_space 𝕜 Fₗ] [normed_space 𝕜 Gₗ] (R : Type*)
  [semiring R] [module R Fₗ] [module R Gₗ]
  [has_continuous_const_smul R Fₗ] [has_continuous_const_smul R Gₗ]
  [smul_comm_class 𝕜 R Fₗ] [smul_comm_class 𝕜 R Gₗ]
  {X : Type*} [topological_space X]
  {f : X → E →L[𝕜] Fₗ} {g : X → E →L[𝕜] Gₗ}
  (hf : continuous f) (hg : continuous g) : continuous (λ x, (f x).prod (g x)) :=
(continuous_linear_map.prodₗᵢ 𝕜).continuous.comp₂ hf hg

@[continuity]
lemma continuous.prodL {𝕜 : Type*} {E : Type*} {Fₗ : Type*} {Gₗ : Type*} [seminormed_add_comm_group E]
  [seminormed_add_comm_group Fₗ] [seminormed_add_comm_group Gₗ] [nontrivially_normed_field 𝕜]
  [normed_space 𝕜 E] [normed_space 𝕜 Fₗ] [normed_space 𝕜 Gₗ]
  {X : Type*} [topological_space X]
  {f : X → E →L[𝕜] Fₗ} {g : X → E →L[𝕜] Gₗ}
  (hf : continuous f) (hg : continuous g) : continuous (λ x, (f x).prod (g x)) :=
hf.prodL' 𝕜 hg

@[continuity]
lemma continuous.compL {f : X → Fₗ →L[𝕜] Gₗ} {g : X → E →L[𝕜] Fₗ}
  (hf : continuous f) (hg : continuous g) : continuous (λ x, (f x).comp (g x)) :=
(continuous_linear_map.apply 𝕜 (E →L[𝕜] Gₗ) : (E →L[𝕜] Fₗ) →L[𝕜]
  ((E →L[𝕜] Fₗ) →L[𝕜] E →L[𝕜] Gₗ) →L[𝕜] E →L[𝕜] Gₗ).is_bounded_bilinear_map.continuous.comp₂ hg $
  (continuous_linear_map.compL 𝕜 E Fₗ Gₗ).continuous.comp hf

@[continuity]
lemma continuous_at.compL {f : X → Fₗ →L[𝕜] Gₗ} {g : X → E →L[𝕜] Fₗ} {x₀ : X}
  (hf : continuous_at f x₀) (hg : continuous_at g x₀) : continuous_at (λ x, (f x).comp (g x)) x₀ :=
begin
  have cont₁ := (continuous_linear_map.compL 𝕜 E Fₗ Gₗ).continuous.continuous_at.comp hf,
  have cont₂ := (continuous_linear_map.apply 𝕜 (E →L[𝕜] Gₗ) : (E →L[𝕜] Fₗ) →L[𝕜]
    ((E →L[𝕜] Fₗ) →L[𝕜] E →L[𝕜] Gₗ) →L[𝕜] E →L[𝕜] Gₗ).is_bounded_bilinear_map.continuous,
  exact cont₂.continuous_at.comp (hg.prod cont₁)
end

section finite_dimensional

open function finite_dimensional

variables [finite_dimensional 𝕜 E]

lemma continuous_linear_map.inj_iff_antilip [complete_space 𝕜] (φ : E →L[𝕜] F) :
  injective φ ↔ ∃ K > 0, antilipschitz_with K φ :=
begin
  change injective φ.to_linear_map ↔ _,
  split,
  { rw ← linear_map.ker_eq_bot,
    exact φ.exists_antilipschitz_with },
  { rintro ⟨K, K_pos, H⟩,
    exact H.injective }
end
open_locale topology nnreal

lemma eventually_nnorm_sub_lt (x₀ : E) {ε : ℝ≥0} {ε_pos : 0 < ε} :
∀ᶠ x in 𝓝 x₀, ‖x - x₀‖₊ < ε :=
begin
  rw metric.nhds_basis_ball.eventually_iff,
  use [ε, ε_pos],
  simp [dist_eq_norm],
  exact λ x, id
end

lemma eventually_norm_sub_lt (x₀ : E) {ε : ℝ} {ε_pos : 0 < ε} :
∀ᶠ x in 𝓝 x₀, ‖x - x₀‖ < ε :=
begin
  rw metric.nhds_basis_ball.eventually_iff,
  use [ε, ε_pos],
  simp [dist_eq_norm]
end

lemma continuous_linear_map.is_open_injective [complete_space 𝕜] :
  is_open {L : E →L[𝕜] F | injective L} :=
begin
  rw is_open_iff_eventually,
  rintros φ₀ (hφ₀ : injective φ₀),
  rcases φ₀.inj_iff_antilip.mp hφ₀ with ⟨K, K_pos, H⟩,
  have : ∀ᶠ φ in 𝓝 φ₀, ‖φ - φ₀‖₊ < K⁻¹,
  { apply eventually_nnorm_sub_lt,
    apply inv_pos_of_pos K_pos },
  apply this.mono, dsimp only [set.mem_set_of_eq],
  intros φ hφ,
  apply φ.inj_iff_antilip.mpr,
  refine ⟨(K⁻¹ - ‖φ - φ₀‖₊)⁻¹, inv_pos_of_pos (tsub_pos_of_lt hφ), _⟩,
  exact antilipschitz_with.add_sub_lipschitz_with H (φ - φ₀).lipschitz hφ
end

end finite_dimensional


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

! This file was ported from Lean 3 source module data.set_like.basic
! leanprover-community/mathlib commit feb99064803fd3108e37c18b0f77d0a8344677a3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Basic
import Mathlib.Tactic.Monotonicity.Attr

/-!
# Typeclass for types with a set-like extensionality property

The `Membership` typeclass is used to let terms of a type have elements.
Many instances of `Membership` have a set-like extensionality property:
things are equal iff they have the same elements.  The `SetLike`
typeclass provides a unified interface to define a `Membership` that is
extensional in this way.

The main use of `SetLike` is for algebraic subobjects (such as
`Submonoid` and `Submodule`), whose non-proof data consists only of a
carrier set.  In such a situation, the projection to the carrier set
is injective.

In general, a type `A` is `SetLike` with elements of type `B` if it
has an injective map to `Set B`.  This module provides standard
boilerplate for every `SetLike`: a `coe_sort`, a `coe` to set, a
`PartialOrder`, and various extensionality and simp lemmas.

A typical subobject should be declared as:
```
structure MySubobject (X : Type _) [ObjectTypeclass X] :=
(carrier : Set X)
(op_mem' : ∀ {x : X}, x ∈ carrier → sorry ∈ carrier)

namespace MySubobject

variables {X : Type _} [ObjectTypeclass X] {x : X}

instance : SetLike (MySubobject X) X :=
⟨MySubobject.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp] lemma mem_carrier {p : MySubobject X} : x ∈ p.carrier ↔ x ∈ (p : Set X) := Iff.rfl

@[ext] theorem ext {p q : MySubobject X} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := SetLike.ext h

/-- Copy of a `MySubobject` with a new `carrier` equal to the old one. Useful to fix definitional
equalities. See Note [range copy pattern]. -/
protected def copy (p : MySubobject X) (s : Set X) (hs : s = ↑p) : MySubobject X :=
{ carrier := s,
  op_mem' := hs.symm ▸ p.op_mem' }

@[simp] lemma coe_copy (p : MySubobject X) (s : Set X) (hs : s = ↑p) :
  (p.copy s hs : Set X) = s := rfl

lemma copy_eq (p : MySubobject X) (s : Set X) (hs : s = ↑p) : p.copy s hs = p :=
SetLike.coe_injective hs

end MySubobject
```

An alternative to `SetLike` could have been an extensional `Membership` typeclass:
```
class ExtMembership (α : out_param $ Type u) (β : Type v) extends Membership α β :=
(ext_iff : ∀ {s t : β}, s = t ↔ ∀ (x : α), x ∈ s ↔ x ∈ t)
```
While this is equivalent, `SetLike` conveniently uses a carrier set projection directly.

## Tags

subobjects
-/

/-- A class to indicate that there is a canonical injection between `A` and `Set B`.

This has the effect of giving terms of `A` elements of type `B` (through a `Membership`
instance) and a compatible coercion to `Type _` as a subtype.

Note: if `SetLike.coe` is a projection, implementers should create a simp lemma such as
```
@[simp] lemma mem_carrier {p : MySubobject X} : x ∈ p.carrier ↔ x ∈ (p : Set X) := Iff.rfl
```
to normalize terms.

If you declare an unbundled subclass of `SetLike`, for example:
```
class MulMemClass (S : Type _) (M : Type _) [Mul M] [SetLike S M] where
  ...
```
Then you should *not* repeat the `outParam` declaration so `SetLike` will supply the value instead.
This ensures your subclass will not have issues with synthesis of the `[Mul M]` parameter starting
before the value of `M` is known.
-/
@[notation_class * carrier Simps.findCoercionArgs]
class SetLike (A : Type _) (B : outParam <| Type _) where
  /-- The coercion from a term of a `SetLike` to its corresponding `Set`. -/
  protected coe : A → Set B
  /-- The coercion from a term of a `SetLike` to its corresponding `Set` is injective. -/
  protected coe_injective' : Function.Injective coe
#align set_like SetLike

attribute [coe] SetLike.coe
namespace SetLike

variable {A : Type _} {B : Type _} [i : SetLike A B]

instance : CoeTC A (Set B) where coe := SetLike.coe

instance (priority := 100) : Membership B A :=
  ⟨fun x p => x ∈ (p : Set B)⟩

instance (priority := 100) : CoeSort A (Type _) :=
  ⟨fun p => { x : B // x ∈ p }⟩

variable (p q : A)

@[simp, norm_cast]
theorem coe_sort_coe : ((p : Set B) : Type _) = p :=
  rfl
#align set_like.coe_sort_coe SetLike.coe_sort_coe

variable {p q}

protected theorem «exists» {q : p → Prop} : (∃ x, q x) ↔ ∃ (x : B) (h : x ∈ p), q ⟨x, ‹_›⟩ :=
  SetCoe.exists
#align set_like.exists SetLike.exists

protected theorem «forall» {q : p → Prop} : (∀ x, q x) ↔ ∀ (x : B) (h : x ∈ p), q ⟨x, ‹_›⟩ :=
  SetCoe.forall
#align set_like.forall SetLike.forall

theorem coe_injective : Function.Injective (SetLike.coe : A → Set B) := fun _ _ h =>
  SetLike.coe_injective' h
#align set_like.coe_injective SetLike.coe_injective

@[simp, norm_cast]
theorem coe_set_eq : (p : Set B) = q ↔ p = q :=
  coe_injective.eq_iff
#align set_like.coe_set_eq SetLike.coe_set_eq

theorem ext' (h : (p : Set B) = q) : p = q :=
  coe_injective h
#align set_like.ext' SetLike.ext'

theorem ext'_iff : p = q ↔ (p : Set B) = q :=
  coe_set_eq.symm
#align set_like.ext'_iff SetLike.ext'_iff

/-- Note: implementers of `SetLike` must copy this lemma in order to tag it with `@[ext]`. -/
theorem ext (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q :=
  coe_injective <| Set.ext h
#align set_like.ext SetLike.ext

theorem ext_iff : p = q ↔ ∀ x, x ∈ p ↔ x ∈ q :=
  coe_injective.eq_iff.symm.trans Set.ext_iff
#align set_like.ext_iff SetLike.ext_iff

@[simp]
theorem mem_coe {x : B} : x ∈ (p : Set B) ↔ x ∈ p :=
  Iff.rfl
#align set_like.mem_coe SetLike.mem_coe

@[simp, norm_cast]
theorem coe_eq_coe {x y : p} : (x : B) = y ↔ x = y :=
  Subtype.ext_iff_val.symm
#align set_like.coe_eq_coe SetLike.coe_eq_coe

-- porting note: this is not necessary anymore due to the way coercions work
#noalign set_like.coe_mk

@[simp]
theorem coe_mem (x : p) : (x : B) ∈ p :=
  x.2
#align set_like.coe_mem SetLike.coe_mem

-- porting note: removed `@[simp]` because `simpNF` linter complained
protected theorem eta (x : p) (hx : (x : B) ∈ p) : (⟨x, hx⟩ : p) = x := rfl
#align set_like.eta SetLike.eta

instance (priority := 100) : PartialOrder A :=
  { PartialOrder.lift (SetLike.coe : A → Set B) coe_injective with
    le := fun H K => ∀ ⦃x⦄, x ∈ H → x ∈ K }

theorem le_def {S T : A} : S ≤ T ↔ ∀ ⦃x : B⦄, x ∈ S → x ∈ T :=
  Iff.rfl
#align set_like.le_def SetLike.le_def

@[simp, norm_cast]
theorem coe_subset_coe {S T : A} : (S : Set B) ⊆ T ↔ S ≤ T :=
  Iff.rfl
#align set_like.coe_subset_coe SetLike.coe_subset_coe

@[mono]
theorem coe_mono : Monotone (SetLike.coe : A → Set B) := fun _ _ => coe_subset_coe.mpr
#align set_like.coe_mono SetLike.coe_mono

@[simp, norm_cast]
theorem coe_ssubset_coe {S T : A} : (S : Set B) ⊂ T ↔ S < T :=
  Iff.rfl
#align set_like.coe_ssubset_coe SetLike.coe_ssubset_coe

@[mono]
theorem coe_strictMono : StrictMono (SetLike.coe : A → Set B) := fun _ _ => coe_ssubset_coe.mpr
#align set_like.coe_strict_mono SetLike.coe_strictMono

theorem not_le_iff_exists : ¬p ≤ q ↔ ∃ x ∈ p, x ∉ q :=
  Set.not_subset
#align set_like.not_le_iff_exists SetLike.not_le_iff_exists

theorem exists_of_lt : p < q → ∃ x ∈ q, x ∉ p :=
  Set.exists_of_ssubset
#align set_like.exists_of_lt SetLike.exists_of_lt

theorem lt_iff_le_and_exists : p < q ↔ p ≤ q ∧ ∃ x ∈ q, x ∉ p := by
  rw [lt_iff_le_not_le, not_le_iff_exists]
#align set_like.lt_iff_le_and_exists SetLike.lt_iff_le_and_exists

end SetLike


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.presheafed_space.has_colimits
import topology.sheaves.functors

/-!
# Sheafed spaces

Introduces the category of topological spaces equipped with a sheaf (taking values in an
arbitrary target category `C`.)

We further describe how to apply functors and natural transformations to the values of the
presheaves.
-/

universes v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.limits
open category_theory.category category_theory.functor

variables (C : Type u) [category.{v} C]

local attribute [tidy] tactic.op_induction'

namespace algebraic_geometry

/-- A `SheafedSpace C` is a topological space equipped with a sheaf of `C`s. -/
structure SheafedSpace extends PresheafedSpace.{v} C :=
(is_sheaf : presheaf.is_sheaf)

variables {C}

namespace SheafedSpace

instance coe_carrier : has_coe (SheafedSpace C) Top :=
{ coe := λ X, X.carrier }

/-- Extract the `sheaf C (X : Top)` from a `SheafedSpace C`. -/
def sheaf (X : SheafedSpace C) : sheaf C (X : Top.{v}) := ⟨X.presheaf, X.is_sheaf⟩

@[simp] lemma as_coe (X : SheafedSpace.{v} C) : X.carrier = (X : Top.{v}) := rfl
@[simp] lemma mk_coe (carrier) (presheaf) (h) :
  (({ carrier := carrier, presheaf := presheaf, is_sheaf := h } : SheafedSpace.{v} C) :
  Top.{v}) = carrier :=
rfl

instance (X : SheafedSpace.{v} C) : topological_space X := X.carrier.str

/-- The trivial `unit` valued sheaf on any topological space. -/
def unit (X : Top) : SheafedSpace (discrete unit) :=
{ is_sheaf := presheaf.is_sheaf_unit _,
  ..@PresheafedSpace.const (discrete unit) _ X ⟨⟨⟩⟩ }

instance : inhabited (SheafedSpace (discrete _root_.unit)) := ⟨unit (Top.of pempty)⟩

instance : category (SheafedSpace C) :=
show category (induced_category (PresheafedSpace.{v} C) SheafedSpace.to_PresheafedSpace),
by apply_instance

/-- Forgetting the sheaf condition is a functor from `SheafedSpace C` to `PresheafedSpace C`. -/
@[derive [full, faithful]]
def forget_to_PresheafedSpace : (SheafedSpace.{v} C) ⥤ (PresheafedSpace.{v} C) :=
induced_functor _

instance is_PresheafedSpace_iso {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) [is_iso f] :
  @is_iso (PresheafedSpace C) _ _ _ f :=
SheafedSpace.forget_to_PresheafedSpace.map_is_iso f

variables {C}

section
local attribute [simp] id comp

@[simp] lemma id_base (X : SheafedSpace C) :
  ((𝟙 X) : X ⟶ X).base = (𝟙 (X : Top.{v})) := rfl

lemma id_c (X : SheafedSpace C) :
  ((𝟙 X) : X ⟶ X).c = eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm := rfl

@[simp] lemma id_c_app (X : SheafedSpace C) (U) :
  ((𝟙 X) : X ⟶ X).c.app U = eq_to_hom (by { induction U using opposite.rec, cases U, refl }) :=
by { induction U using opposite.rec, cases U, simp only [id_c], dsimp, simp, }

@[simp] lemma comp_base {X Y Z : SheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).base = f.base ≫ g.base := rfl

@[simp] lemma comp_c_app {X Y Z : SheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
  (α ≫ β).c.app U = (β.c).app U ≫ (α.c).app (op ((opens.map (β.base)).obj (unop U)))
:= rfl

lemma comp_c_app' {X Y Z : SheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
  (α ≫ β).c.app (op U) = (β.c).app (op U) ≫ (α.c).app (op ((opens.map (β.base)).obj U))
:= rfl

lemma congr_app {X Y : SheafedSpace C} {α β : X ⟶ Y} (h : α = β) (U) :
  α.c.app U = β.c.app U ≫ X.presheaf.map (eq_to_hom (by subst h)) :=
PresheafedSpace.congr_app h U

variables (C)

/-- The forgetful functor from `SheafedSpace` to `Top`. -/
def forget : SheafedSpace C ⥤ Top :=
{ obj := λ X, (X : Top.{v}),
  map := λ X Y f, f.base }

end

open Top.presheaf

/--
The restriction of a sheafed space along an open embedding into the space.
-/
def restrict {U : Top} (X : SheafedSpace C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : SheafedSpace C :=
{ is_sheaf := is_sheaf_of_open_embedding h X.is_sheaf,
  ..X.to_PresheafedSpace.restrict h }

/--
The restriction of a sheafed space `X` to the top subspace is isomorphic to `X` itself.
-/
def restrict_top_iso (X : SheafedSpace C) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
forget_to_PresheafedSpace.preimage_iso X.to_PresheafedSpace.restrict_top_iso

/--
The global sections, notated Gamma.
-/
def Γ : (SheafedSpace C)ᵒᵖ ⥤ C :=
forget_to_PresheafedSpace.op ⋙ PresheafedSpace.Γ

lemma Γ_def : (Γ : _ ⥤ C) = forget_to_PresheafedSpace.op ⋙ PresheafedSpace.Γ := rfl

@[simp]

lemma Γ_obj_op (X : SheafedSpace C) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

@[simp] lemma Γ_map {X Y : (SheafedSpace C)ᵒᵖ} (f : X ⟶ Y) :
  Γ.map f = f.unop.c.app (op ⊤) := rfl

lemma Γ_map_op {X Y : SheafedSpace C} (f : X ⟶ Y) :
  Γ.map f.op = f.c.app (op ⊤) := rfl

noncomputable
instance [has_limits C] : creates_colimits (forget_to_PresheafedSpace : SheafedSpace C ⥤ _) :=
⟨λ J hJ, by exactI ⟨λ K, creates_colimit_of_fully_faithful_of_iso
  ⟨(PresheafedSpace.colimit_cocone (K ⋙ forget_to_PresheafedSpace)).X,
    limit_is_sheaf _ (λ j, sheaf.pushforward_sheaf_of_sheaf _ (K.obj (unop j)).2)⟩
  (colimit.iso_colimit_cocone ⟨_, PresheafedSpace.colimit_cocone_is_colimit _⟩).symm⟩⟩

instance [has_limits C] : has_colimits (SheafedSpace C) :=
has_colimits_of_has_colimits_creates_colimits forget_to_PresheafedSpace

noncomputable instance [has_limits C] : preserves_colimits (forget C) :=
limits.comp_preserves_colimits forget_to_PresheafedSpace (PresheafedSpace.forget C)

end SheafedSpace

end algebraic_geometry


import ..library_dev.data.list.set ..library_dev.data.list.perm .quot .misc
open list subtype nat

definition nodup_list (A : Type) := {l : list A // nodup l}

variable {A : Type}

definition to_nodup_list_of_nodup {l : list A} (n : nodup l) : nodup_list A := ⟨l,n⟩

definition to_nodup_list [decidable_eq A] (l : list A) : nodup_list A :=
@to_nodup_list_of_nodup A (erase_dup l) (nodup_erase_dup l)

private definition eqv (l₁ l₂ : nodup_list A) :=
perm (l₁.1) (l₂.1)

local infix ~ := eqv

private definition eqv.refl (l : nodup_list A) : l ~ l :=
perm.refl _

private definition eqv.symm {l₁ l₂ : nodup_list A} : l₁ ~ l₂ → l₂ ~ l₁ :=
perm.symm

private definition eqv.trans {l₁ l₂ l₃ : nodup_list A} : l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
perm.trans

attribute [instance]
definition finset.nodup_list_setoid (A : Type) : setoid (nodup_list A) :=
setoid.mk (@eqv A) (mk_equivalence (@eqv A) (@eqv.refl A) (@eqv.symm A) (@eqv.trans A))

definition finset (A : Type) : Type :=
quotient (finset.nodup_list_setoid A)

namespace finset

-- give finset notation higher priority than set notation, so that it is tried first
-- protected definition prio : num := num.succ std.priority.default

definition to_finset_of_nodup (l : list A) (n : nodup l) : finset A :=
⟦to_nodup_list_of_nodup n⟧

definition to_finset [decidable_eq A] (l : list A) : finset A :=
⟦to_nodup_list l⟧

-- lemma to_finset_eq_of_nodup [decidable_eq A] {l : list A} (n : nodup l) :
--   to_finset_of_nodup l n = to_finset l :=
-- have P : to_nodup_list_of_nodup n = to_nodup_list l, from
--   begin
--     rewrite [↑to_nodup_list, ↑to_nodup_list_of_nodup],
--     congruence,
--     rewrite [erase_dup_eq_of_nodup n]
--   end,
-- quot.sound (eq.subst P !setoid.refl)

attribute [instance]
definition has_decidable_eq [decidable_eq A] : decidable_eq (finset A) :=
λ s₁ s₂, quot.rec_on_subsingleton₂ s₁ s₂
  (λ l₁ l₂,
     match perm.decidable_perm (l₁.1) (l₂.1) with
     | decidable.is_true e := decidable.is_true (quot.sound e)
     | decidable.is_false n := decidable.is_false (λ e : ⟦l₁⟧ = ⟦l₂⟧, absurd (quot.exact' e) n)
     end)

definition mem (a : A) (s : finset A) : Prop :=
quot.lift_on s (λ l, a ∈ l.1)
 (λ l₁ l₂ (e : l₁ ~ l₂), propext (iff.intro
   (λ ainl₁, perm.mem_perm e ainl₁)
(λ ainl₂, perm.mem_perm (perm.symm e) ainl₂)))

infix ∈ := mem
notation a ∉ b := ¬ mem a b

theorem mem_of_mem_list {a : A} {l : nodup_list A} : a ∈ l.1 → a ∈ ⟦l⟧ :=
λ ainl, ainl

theorem mem_list_of_mem {a : A} {l : nodup_list A} : a ∈ ⟦l⟧ → a ∈ l.1 :=
λ ainl, ainl

attribute [instance]
definition decidable_mem [h : decidable_eq A] : ∀ (a : A) (s : finset A), decidable (a ∈ s) :=
λ a s, quot.rec_on_subsingleton s
  (λ l, match list.decidable_mem a l.1 with
        | decidable.is_true p := decidable.is_true (mem_of_mem_list p)
        | decidable.is_false n := decidable.is_false (λ p, absurd (mem_list_of_mem p) n)
end)

theorem mem_to_finset [decidable_eq A] {a : A} {l : list A} : a ∈ l → a ∈ to_finset l :=
λ ainl, mem_erase_dup ainl

theorem mem_to_finset_of_nodup {a : A} {l : list A} (n : nodup l) : a ∈ l → a ∈ to_finset_of_nodup l n :=
λ ainl, ainl

/- extensionality -/
theorem ext {s₁ s₂ : finset A} : (∀ a, a ∈ s₁ ↔ a ∈ s₂) → s₁ = s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ e, quot.sound (perm.perm_ext (l₁.2) (l₂.2) e))

/- empty -/
definition empty : finset A :=
to_finset_of_nodup [] nodup_nil

-- notation [priority finset.prio] `∅` := empty _

attribute [simp]
theorem not_mem_empty (a : A) : a ∉ empty :=
λ aine, aine

attribute [simp]
theorem mem_empty_iff (x : A) : mem x empty ↔ false :=
iff_false_intro (not_mem_empty _)

theorem mem_empty_eq (x : A) : mem x empty = false :=
propext (mem_empty_iff _)

theorem eq_empty_of_forall_not_mem {s : finset A} (H : ∀x : A, ¬ mem x s) : s = empty :=
ext (λ x, iff_false_intro (H x))

-- /- universe -/
-- definition univ [h : fintype A] : finset A :=
-- to_finset_of_nodup (@fintype.elems A h) (@fintype.unique A h)

-- theorem mem_univ [fintype A] (x : A) : x ∈ univ :=
-- fintype.complete x

-- theorem mem_univ_eq [fintype A] (x : A) : x ∈ univ = true := propext (iff_true_intro !mem_univ)

/- card -/
definition card (s : finset A) : nat :=
quot.lift_on s
  (λ l, length l.1)
  (λ l₁ l₂ p, perm.length_eq_length_of_perm p)

theorem card_empty : card (@empty A) = 0 := rfl

lemma ne_empty_of_card_eq_succ {s : finset A} {n : nat} : card s = succ n → s ≠ empty :=
begin intros, intro eq, rw [eq] at a, contradiction end

/- insert -/
section insert
variable [h : decidable_eq A]
include h

definition insert (a : A) (s : finset A) : finset A :=
quot.lift_on s
  (λ l, to_finset_of_nodup (insert a l.1) (nodup_insert l.2)) -- implicit 'a'
  (λ (l₁ l₂ : nodup_list A) (p : l₁ ~ l₂), quot.sound (perm.perm_insert a p))

-- set builder notation
-- notation [priority finset.prio] `'{`:max a:(foldr `, ` (x b, insert x b) ∅) `}`:0 := a

theorem mem_insert (a : A) (s : finset A) : a ∈ insert a s :=
quot.induction_on s
 (λ l : nodup_list A, mem_to_finset_of_nodup _ (list.mem_insert_self _ _))

theorem mem_insert_of_mem {a : A} {s : finset A} (b : A) : a ∈ s → a ∈ insert b s :=
quot.induction_on s
 (λ (l : nodup_list A) (ainl : a ∈ ⟦l⟧), mem_to_finset_of_nodup _ (list.mem_insert_of_mem ainl))

theorem eq_or_mem_of_mem_insert {x a : A} {s : finset A} : x ∈ insert a s → x = a ∨ x ∈ s :=
quot.induction_on s (λ l : nodup_list A, λ H, list.eq_or_mem_of_mem_insert H)

theorem mem_of_mem_insert_of_ne {x a : A} {s : finset A} (xin : x ∈ insert a s) : x ≠ a → x ∈ s :=
or_resolve_right (eq_or_mem_of_mem_insert xin)

theorem mem_insert_iff (x a : A) (s : finset A) : x ∈ insert a s ↔ (x = a ∨ x ∈ s) :=
iff.intro eq_or_mem_of_mem_insert
(λ h, or.elim h (λ l, by rw l; apply mem_insert) (λ r, mem_insert_of_mem _ r))

theorem mem_insert_eq (x a : A) (s : finset A) : x ∈ insert a s = (x = a ∨ x ∈ s) :=
propext (mem_insert_iff _ _ _)

theorem mem_singleton_iff (x a : A) : x ∈ insert a empty ↔ (x = a) :=
by rewrite [mem_insert_eq, mem_empty_eq, or_false]

theorem mem_singleton (a : A) : a ∈ insert a empty := mem_insert a empty

theorem mem_singleton_of_eq {x a : A} (H : x = a) : x ∈ insert a empty :=
by rewrite H; apply mem_insert

theorem eq_of_mem_singleton {x a : A} (H : x ∈ insert a empty) : x = a := iff.mp (mem_singleton_iff _ _) H

theorem eq_of_singleton_eq {a b : A} (H : insert a empty = insert b empty) : a = b :=
have a ∈ insert b empty, by rewrite -H; apply mem_singleton,
eq_of_mem_singleton this

-- #check @eq.substr

theorem insert_eq_of_mem {a : A} {s : finset A} (H : a ∈ s) : insert a s = s :=
ext (λ x, iff.intro (λ l, or.elim (eq_or_mem_of_mem_insert l)
    (λll, by rw ll;exact H) (λ rr, rr))
(λ r, mem_insert_of_mem _ r))

theorem singleton_ne_empty (a : A) : insert a empty ≠ empty :=
begin
  intro H,
  apply not_mem_empty a,
  rewrite -H,
  apply mem_insert
end

-- useful in proofs by induction
theorem forall_of_forall_insert {P : A → Prop} {a : A} {s : finset A}
    (H : ∀ x, x ∈ insert a s → P x) :
  ∀ x, x ∈ s → P x :=
λ x xs, H x ((mem_insert_of_mem _)xs)

theorem insert.comm (x y : A) (s : finset A) : insert x (insert y s) = insert y (insert x s) :=
ext (take a, begin repeat {rw mem_insert_eq},  rw [propext or.left_comm] end)

theorem card_insert_of_mem {a : A} {s : finset A} : a ∈ s → card (insert a s) = card s :=
quot.induction_on s
  (λ (l : nodup_list A) (ainl : a ∈ ⟦l⟧), list.length_insert_of_mem ainl)

theorem card_insert_of_not_mem {a : A} {s : finset A} : a ∉ s → card (insert a s) = card s + 1 :=
quot.induction_on s
  (λ (l : nodup_list A) (nainl : a ∉ ⟦l⟧), list.length_insert_of_not_mem nainl)

theorem card_insert_le (a : A) (s : finset A) :
  card (insert a s) ≤ card s + 1 :=
if H : a ∈ s then by rewrite [card_insert_of_mem H]; apply le_succ
else by rewrite [card_insert_of_not_mem H]

attribute [recursor 6]
protected theorem induction {P : finset A → Prop}
    (H1 : P empty)
    (H2 : ∀ ⦃a : A⦄, ∀{s : finset A}, a ∉ s → P s → P (insert a s)) :
  ∀s, P s :=
take s,
quot.induction_on s
 (take u,
  subtype.rec_on u
   (take l,
    list.rec_on l
      (assume nodup_l, H1)
      (take a l',
        assume IH nodup_al',
        have aux₁: a ∉ l', from not_mem_of_nodup_cons nodup_al',
        have ndl' : nodup l', from nodup_of_nodup_cons nodup_al',
        have p1 : P (quot.mk _ (subtype.mk l' ndl')), from IH ndl',
        have ¬ mem a (quot.mk _ (subtype.mk l' ndl')), from aux₁,
        have P (insert a (quot.mk _ (subtype.mk l' _))), from H2 this p1,
        have hperm : perm (list.insert a l') (a :: l'), from perm.perm_insert_cons_of_not_mem aux₁,
        begin
          apply @eq.subst _ P _ _ _ this,
          apply quot.sound,
          exact hperm
        end)))

protected theorem induction_on {P : finset A → Prop} (s : finset A)
    (H1 : P empty)
    (H2 : ∀ ⦃a : A⦄, ∀{s : finset A}, a ∉ s → P s → P (insert a s)) :
  P s := finset.induction H1 H2 s

theorem exists_mem_of_ne_empty {s : finset A} : s ≠ empty → ∃ a : A, a ∈ s :=
@finset.induction_on _ _ (λ x, x ≠ empty → ∃ a : A, mem a x) s
(λ h, absurd rfl h)
(by intros a s nin ih h; existsi a; apply mem_insert)

theorem eq_empty_of_card_eq_zero {s : finset A} : card s = 0 → s = empty :=
@finset.induction_on _ _ (λ x, card x = 0 → x = empty) s
(λ h, rfl)
(by intros a s' H1 Ih H; rw (card_insert_of_not_mem H1) at H; contradiction)

end insert

/- erase -/
section erase
variable [h : decidable_eq A]
include h

definition erase (a : A) (s : finset A) : finset A :=
quot.lift_on s
  (λ l, to_finset_of_nodup (erase' a l.1) (nodup_erase_of_nodup a l.2))
  (λ (l₁ l₂ : nodup_list A) (p : l₁ ~ l₂), quot.sound (perm.erase_perm_erase_of_perm a p))

theorem not_mem_erase (a : A) (s : finset A) : a ∉ erase a s :=
quot.induction_on s
  (λ l, list.mem_erase_of_nodup _ l.2)

theorem card_erase_of_mem {a : A} {s : finset A} : a ∈ s → card (erase a s) = pred (card s) :=
quot.induction_on s (λ l ainl, list.length_erase_of_mem ainl)

theorem card_erase_of_not_mem {a : A} {s : finset A} : a ∉ s → card (erase a s) = card s :=
quot.induction_on s (λ l nainl, list.length_erase_of_not_mem nainl)

theorem erase_empty (a : A) : erase a empty = empty :=
rfl

theorem ne_of_mem_erase {a b : A} {s : finset A} : b ∈ erase a s → b ≠ a :=
by intros h beqa; subst b; exact absurd h (not_mem_erase _ _)

theorem mem_of_mem_erase {a b : A} {s : finset A} : b ∈ erase a s → b ∈ s :=
quot.induction_on s (λ l bin, mem_of_mem_erase bin)

theorem mem_erase_of_ne_of_mem {a b : A} {s : finset A} : a ≠ b → a ∈ s → a ∈ erase b s :=
quot.induction_on s (λ l n ain, list.mem_erase_of_ne_of_mem n ain)

theorem mem_erase_iff (a b : A) (s : finset A) : a ∈ erase b s ↔ a ∈ s ∧ a ≠ b :=
iff.intro
  (assume H, and.intro (mem_of_mem_erase H) (ne_of_mem_erase H))
(assume H, mem_erase_of_ne_of_mem (and.right H) (and.left H))

theorem mem_erase_eq (a b : A) (s : finset A) : a ∈ erase b s = (a ∈ s ∧ a ≠ b) :=
propext (mem_erase_iff _ _ _)

open decidable
theorem erase_insert {a : A} {s : finset A} : a ∉ s → erase a (insert a s) = s :=
λ anins, finset.ext (λ b, by_cases
  (λ beqa : b = a, iff.intro
    (λ bin, by subst b; exact absurd bin (not_mem_erase _ _))
    (λ bin, by subst b; contradiction))
  (λ bnea : b ≠ a, iff.intro
    (λ bin,
       have b ∈ insert a s, from mem_of_mem_erase bin,
       mem_of_mem_insert_of_ne this bnea)
    (λ bin,
      have b ∈ insert a s, from mem_insert_of_mem _ bin,
mem_erase_of_ne_of_mem bnea this)))

theorem insert_erase {a : A} {s : finset A} : a ∈ s → insert a (erase a s) = s :=
λ ains, finset.ext (λ b, by_cases
  (suppose b = a, iff.intro
    (λ bin, by subst b; assumption)
    (λ bin, by subst b; apply mem_insert))
  (assume neq, iff.intro
    (λ bin, mem_of_mem_erase (mem_of_mem_insert_of_ne bin neq))
(λ bin, mem_insert_of_mem _ (mem_erase_of_ne_of_mem neq bin))))

end erase

section union
variable [h : decidable_eq A]
include h

definition union (s₁ s₂ : finset A) : finset A :=
quot.lift_on₂ s₁ s₂
  (λ l₁ l₂,
    to_finset_of_nodup (list.union l₁.1 l₂.1)
                       (nodup_union_of_nodup_of_nodup l₁.2 l₂.2))
  (λ v₁ v₂ w₁ w₂ p₁ p₂, quot.sound (perm.perm_union p₁ p₂))

infix ∪ := union

theorem mem_union_left {a : A} {s₁ : finset A} (s₂ : finset A) : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁, list.mem_union_left ainl₁ _)

theorem mem_union_l {a : A} {s₁ : finset A} {s₂ : finset A} : a ∈ s₁ → a ∈ s₁ ∪ s₂ :=
mem_union_left s₂

theorem mem_union_right {a : A} {s₂ : finset A} (s₁ : finset A) : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₂, list.mem_union_right _ ainl₂)

theorem mem_union_r {a : A} {s₂ : finset A} {s₁ : finset A} : a ∈ s₂ → a ∈ s₁ ∪ s₂ :=
mem_union_right s₁

theorem mem_or_mem_of_mem_union {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∪ s₂ → a ∈ s₁ ∨ a ∈ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_or_mem_of_mem_union ainl₁l₂)

theorem mem_union_iff (a : A) (s₁ s₂ : finset A) : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
iff.intro
 (λ h, mem_or_mem_of_mem_union h)
 (λ d, or.elim d
   (λ i, mem_union_left _ i)
(λ i, mem_union_right _ i))

theorem mem_union_eq (a : A) (s₁ s₂ : finset A) : (a ∈ s₁ ∪ s₂) = (a ∈ s₁ ∨ a ∈ s₂) :=
propext (mem_union_iff _ _ _)

theorem union_comm (s₁ s₂ : finset A) : s₁ ∪ s₂ = s₂ ∪ s₁ :=
ext (λ a, by repeat {rw mem_union_eq}; exact or.comm)

theorem union_assoc (s₁ s₂ s₃ : finset A) : (s₁ ∪ s₂) ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) :=
ext (λ a, by repeat {rw mem_union_eq}; exact or.assoc)

theorem union_left_comm (s₁ s₂ s₃ : finset A) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
left_comm _ union_comm union_assoc s₁ s₂ s₃

theorem union_right_comm (s₁ s₂ s₃ : finset A) : (s₁ ∪ s₂) ∪ s₃ = (s₁ ∪ s₃) ∪ s₂ :=
right_comm _ union_comm union_assoc s₁ s₂ s₃

theorem union_self (s : finset A) : s ∪ s = s :=
ext (λ a, iff.intro
  (λ ain, or.elim (mem_or_mem_of_mem_union ain) (λ i, i) (λ i, i))
  (λ i, mem_union_left _ i))

theorem union_empty (s : finset A) : s ∪ empty = s :=
ext (λ a, iff.intro
  (suppose a ∈ s ∪ empty, or.elim (mem_or_mem_of_mem_union this) (λ i, i) (λ i, absurd i (not_mem_empty _)))
  (suppose a ∈ s, mem_union_left _ this))

theorem empty_union (s : finset A) : empty ∪ s = s :=
calc empty ∪ s = s ∪ empty : union_comm _ _
     ... = s : union_empty _

theorem insert_eq (a : A) (s : finset A) : insert a s = (insert a empty) ∪ s :=
ext (take x, by rewrite [mem_insert_iff, mem_union_iff, mem_singleton_iff])

theorem insert_union (a : A) (s t : finset A) : insert a (s ∪ t) = insert a s ∪ t :=
by rewrite [insert_eq, insert_eq a s, union_assoc]

end union

/- inter -/
section inter
variable [h : decidable_eq A]
include h

definition inter (s₁ s₂ : finset A) : finset A :=
quot.lift_on₂ s₁ s₂
  (λ l₁ l₂,
    to_finset_of_nodup (list.inter l₁.1 l₂.1)
                       (nodup_inter_of_nodup _ l₁.2))
  (λ v₁ v₂ w₁ w₂ p₁ p₂, quot.sound (perm.perm_inter p₁ p₂))

infix  ∩ := inter

theorem mem_of_mem_inter_left {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∩ s₂ → a ∈ s₁ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_of_mem_inter_left ainl₁l₂)

theorem mem_of_mem_inter_right {a : A} {s₁ s₂ : finset A} : a ∈ s₁ ∩ s₂ → a ∈ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁l₂, list.mem_of_mem_inter_right ainl₁l₂)

theorem mem_inter {a : A} {s₁ s₂ : finset A} : a ∈ s₁ → a ∈ s₂ → a ∈ s₁ ∩ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ ainl₁ ainl₂, list.mem_inter_of_mem_of_mem ainl₁ ainl₂)

theorem mem_inter_iff (a : A) (s₁ s₂ : finset A) : a ∈ s₁ ∩ s₂ ↔ a ∈ s₁ ∧ a ∈ s₂ :=
iff.intro
 (λ h, and.intro (mem_of_mem_inter_left h) (mem_of_mem_inter_right h))
(λ h, mem_inter (and.elim_left h) (and.elim_right h))

theorem mem_inter_eq (a : A) (s₁ s₂ : finset A) : (a ∈ s₁ ∩ s₂) = (a ∈ s₁ ∧ a ∈ s₂) :=
propext (mem_inter_iff _ _ _)

theorem inter_comm (s₁ s₂ : finset A) : s₁ ∩ s₂ = s₂ ∩ s₁ :=
ext (λ a, by repeat {rw mem_inter_eq}; exact and.comm)

theorem inter_assoc (s₁ s₂ s₃ : finset A) : (s₁ ∩ s₂) ∩ s₃ = s₁ ∩ (s₂ ∩ s₃) :=
ext (λ a, by repeat {rw mem_inter_eq}; exact and.assoc)

theorem inter_left_comm (s₁ s₂ s₃ : finset A) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
left_comm _ inter_comm inter_assoc s₁ s₂ s₃

theorem inter_right_comm (s₁ s₂ s₃ : finset A) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
right_comm _ inter_comm inter_assoc s₁ s₂ s₃

theorem inter_self (s : finset A) : s ∩ s = s :=
ext (λ a, iff.intro
  (λ h, mem_of_mem_inter_right h)
  (λ h, mem_inter h h))

theorem inter_empty (s : finset A) : s ∩ empty = empty :=
ext (λ a, iff.intro
  (suppose a ∈ s ∩ empty, absurd (mem_of_mem_inter_right this) (not_mem_empty _))
  (assume h, absurd h (not_mem_empty _)))

theorem empty_inter (s : finset A) : empty ∩ s = empty :=
calc empty ∩ s = s ∩ empty : inter_comm _ _
       ... = empty     : inter_empty _

theorem singleton_inter_of_mem {a : A} {s : finset A} (H : a ∈ s) :
  insert a empty ∩ s = insert a empty :=
ext (take x,
  begin
    rewrite [mem_inter_eq, mem_singleton_iff],
    exact iff.intro
      (suppose x = a ∧ x ∈ s, and.left this)
      (suppose x = a, and.intro this (eq.subst (eq.symm this) H))
  end)

theorem singleton_inter_of_not_mem {a : A} {s : finset A} (H : a ∉ s) :
  insert a empty ∩ s = empty :=
ext (take x,
  begin
    rewrite [mem_inter_eq, mem_singleton_iff, mem_empty_eq],
    exact iff.intro
      (suppose x = a ∧ x ∈ s, H (eq.subst (and.left this) (and.right this)))
      (false.elim)
end)

end inter

/- distributivity laws -/
section inter
variable [h : decidable_eq A]
include h

theorem inter_distrib_left (s t u : finset A) : s ∩ (t ∪ u) = (s ∩ t) ∪ (s ∩ u) :=
ext (λ x, by rw [mem_inter_eq];repeat {rw mem_union_eq};repeat {rw mem_inter_eq}; super)

theorem inter_distrib_right (s t u : finset A) : (s ∪ t) ∩ u = (s ∩ u) ∪ (t ∩ u) :=
ext (take x, by rw [mem_inter_eq]; repeat {rw mem_union_eq}; repeat {rw mem_inter_eq}; super)

theorem union_distrib_left (s t u : finset A) : s ∪ (t ∩ u) = (s ∪ t) ∩ (s ∪ u) :=
ext (take x, by rw [mem_union_eq]; repeat {rw mem_inter_eq}; repeat {rw mem_union_eq}; super)

theorem union_distrib_right (s t u : finset A) : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) :=
ext (take x, by rw [mem_union_eq]; repeat {rw mem_inter_eq}; repeat {rw mem_union_eq}; super)

end inter

/- subset -/
-- definition subset (s₁ s₂ : finset A) : Prop :=
-- quot.lift_on₂ s₁ s₂
--   (λ l₁ l₂, sublist l₁.1 l₂.1)
--   (λ v₁ v₂ w₁ w₂ p₁ p₂, propext (iff.intro
--     (λ s₁ a i, perm.mem_perm p₂ (s₁ a (perm.mem_perm (perm.symm p₁) i)))
--     (λ s₂ a i, perm.mem_perm (perm.symm p₂) (s₂ a (perm.mem_perm p₁ i)))))

definition sublist' {T : Type} (l₁ l₂ : list T) := ∀ ⦃a : T⦄, a ∈ l₁ → a ∈ l₂

definition subset (s₁ s₂ : finset A) : Prop :=
quot.lift_on₂ s₁ s₂
  (λ l₁ l₂, sublist' l₁.1 l₂.1)
  (λ v₁ v₂ w₁ w₂ p₁ p₂, propext (iff.intro
    (λ s₁ a i, perm.mem_perm p₂ (s₁ (perm.mem_perm (perm.symm p₁) i)))
    (λ s₂ a i, perm.mem_perm (perm.symm p₂) (s₂ (perm.mem_perm p₁ i)))))

infix ⊆ := subset

theorem empty_subset (s : finset A) : empty ⊆ s :=
quot.induction_on s (λ l, list.nil_subset l.1)

-- theorem subset_univ [h : fintype A] (s : finset A) : s ⊆ univ :=
-- quot.induction_on s (λ l a i, fintype.complete a)

theorem subset.refl (s : finset A) : s ⊆ s :=
quot.induction_on s (λ l, list.subset.refl l.1)

theorem subset.trans {s₁ s₂ s₃ : finset A} : s₁ ⊆ s₂ → s₂ ⊆ s₃ → s₁ ⊆ s₃ :=
quot.induction_on₃ s₁ s₂ s₃ (λ l₁ l₂ l₃ h₁ h₂, list.subset.trans h₁ h₂)

theorem mem_of_subset_of_mem {s₁ s₂ : finset A} {a : A} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ h₁ h₂, h₁ h₂)

theorem subset.antisymm {s₁ s₂ : finset A} (H₁ : s₁ ⊆ s₂) (H₂ : s₂ ⊆ s₁) : s₁ = s₂ :=
ext (take x, iff.intro (assume H, mem_of_subset_of_mem H₁ H) (assume H, mem_of_subset_of_mem H₂ H))

-- alternative name
theorem eq_of_subset_of_subset {s₁ s₂ : finset A} (H₁ : s₁ ⊆ s₂) (H₂ : s₂ ⊆ s₁) : s₁ = s₂ :=
subset.antisymm H₁ H₂

theorem subset_of_forall {s₁ s₂ : finset A} : (∀x, x ∈ s₁ → x ∈ s₂) → s₁ ⊆ s₂ :=
quot.induction_on₂ s₁ s₂ (λ l₁ l₂ H, H)

theorem subset_insert [h : decidable_eq A] (s : finset A) (a : A) : s ⊆ insert a s :=
subset_of_forall (take x, suppose x ∈ s, mem_insert_of_mem _ this)

theorem eq_empty_of_subset_empty {x : finset A} (H : x ⊆ empty) : x = empty :=
subset.antisymm H (empty_subset x)

theorem subset_empty_iff (x : finset A) : x ⊆ empty ↔ x = empty :=
iff.intro eq_empty_of_subset_empty (take xeq, by rewrite xeq; apply subset.refl empty)

section
variable [decA : decidable_eq A]
include decA

theorem erase_subset_erase (a : A) {s t : finset A} (H : s ⊆ t) : erase a s ⊆ erase a t :=
begin
  apply subset_of_forall,
  intro x,
  repeat {rw mem_erase_eq},
  intro H',
  show x ∈ t ∧ x ≠ a, from and.intro (mem_of_subset_of_mem H (and.left H')) (and.right H')
end

theorem erase_subset  (a : A) (s : finset A) : erase a s ⊆ s :=
begin
  apply subset_of_forall,
  intro x,
  rewrite mem_erase_eq,
  intro H,
  apply and.left H
end

theorem erase_eq_of_not_mem {a : A} {s : finset A} (anins : a ∉ s) : erase a s = s :=
eq_of_subset_of_subset (erase_subset _ _)
  (subset_of_forall (take x, assume xs : x ∈ s,
    have x ≠ a, from assume H', anins (eq.subst H' xs),
mem_erase_of_ne_of_mem this xs))

theorem erase_insert_subset (a : A) (s : finset A) : erase a (insert a s) ⊆ s :=
decidable.by_cases
  (assume ains : a ∈ s, by rewrite [insert_eq_of_mem ains]; apply erase_subset)
  (assume nains : a ∉ s, by rewrite [erase_insert nains]; apply subset.refl)

theorem erase_subset_of_subset_insert {a : A} {s t : finset A} (H : s ⊆ insert a t) :
  erase a s ⊆ t :=
subset.trans (erase_subset_erase _ H) (erase_insert_subset _ _)

theorem insert_erase_subset (a : A) (s : finset A) : s ⊆ insert a (erase a s) :=
decidable.by_cases
  (assume ains : a ∈ s, by rewrite [insert_erase ains]; apply subset.refl)
  (assume nains : a ∉ s, by rewrite[erase_eq_of_not_mem nains]; apply subset_insert)

theorem insert_subset_insert (a : A) {s t : finset A} (H : s ⊆ t) : insert a s ⊆ insert a t :=
begin
  apply subset_of_forall,
  intro x,
  repeat {rw mem_insert_eq},
  intro H',
  cases H' with xeqa xins,
    exact (or.inl xeqa),
  exact (or.inr (mem_of_subset_of_mem H xins))
end

theorem subset_insert_of_erase_subset {s t : finset A} {a : A} (H : erase a s ⊆ t) :
  s ⊆ insert a t :=
subset.trans (insert_erase_subset a s) (insert_subset_insert _ H)

theorem subset_insert_iff (s t : finset A) (a : A) : s ⊆ insert a t ↔ erase a s ⊆ t :=
iff.intro erase_subset_of_subset_insert subset_insert_of_erase_subset

end

/- upto -/
section upto

definition upto (n : nat) : finset nat :=
to_finset_of_nodup (list.upto n) (nodup_upto n)

theorem card_upto : ∀ n, card (upto n) = n :=
list.length_upto

theorem lt_of_mem_upto {n a : nat} : a ∈ upto n → a < n :=
@list.lt_of_mem_upto n a

theorem mem_upto_succ_of_mem_upto {n a : nat} : a ∈ upto n → a ∈ upto (succ n) :=
list.mem_upto_succ_of_mem_upto

theorem mem_upto_of_lt {n a : nat} : a < n → a ∈ upto n :=
@list.mem_upto_of_lt n a

theorem mem_upto_iff (a n : nat) : a ∈ upto n ↔ a < n :=
iff.intro lt_of_mem_upto mem_upto_of_lt

theorem mem_upto_eq (a n : nat) : a ∈ upto n = (a < n) :=
propext (mem_upto_iff _ _)

end upto

theorem upto_zero : upto 0 = empty := rfl

theorem upto_succ (n : ℕ) : upto (succ n) = upto n ∪ (insert n empty) :=
begin
  apply ext, intro x,
  rw [mem_union_iff], repeat {rw mem_upto_iff}, simp [mem_singleton_iff, nat.le_iff_lt_or_eq, lt_succ_iff_le]
end

/- useful rules for calculations with quantifiers -/
theorem exists_mem_empty_iff {A : Type} (P : A → Prop) : (∃ x, mem x empty ∧ P x) ↔ false :=
iff.intro
  (assume H,
    let ⟨x,H1⟩ := H in
    not_mem_empty _ (H1^.left))
  (assume H, false.elim H)

theorem exists_mem_empty_eq {A : Type} (P : A → Prop) : (∃ x, mem x empty ∧ P x) = false :=
propext (exists_mem_empty_iff _)

theorem exists_mem_insert_iff {A : Type} [d : decidable_eq A]
    (a : A) (s : finset A) (P : A → Prop) :
  (∃ x, x ∈ insert a s ∧ P x) ↔ P a ∨ (∃ x, x ∈ s ∧ P x) :=
iff.intro
  (assume H,
    let ⟨x,H1,H2⟩ := H in
    or.elim (eq_or_mem_of_mem_insert H1)
      (suppose x = a, or.inl (eq.subst this H2))
      (suppose x ∈ s, or.inr (exists.intro x (and.intro this H2))))
  (assume H,
    or.elim H
      (suppose P a, exists.intro a (and.intro (mem_insert _ _) this))
      (suppose ∃ x, x ∈ s ∧ P x,
        let ⟨x,H2,H3⟩ := this in
        exists.intro x (and.intro (mem_insert_of_mem _ H2) H3)))

theorem exists_mem_insert_eq {A : Type} [d : decidable_eq A] (a : A) (s : finset A) (P : A → Prop) :
  (∃ x, x ∈ insert a s ∧ P x) = (P a ∨ (∃ x, x ∈ s ∧ P x)) :=
propext (exists_mem_insert_iff _ _ _)

theorem forall_mem_empty_iff {A : Type} (P : A → Prop) : (∀ x, mem x empty → P x) ↔ true :=
iff.intro
  (assume H, trivial)
(assume H, take x, assume H', absurd H' (not_mem_empty _))

theorem forall_mem_empty_eq {A : Type} (P : A → Prop) : (∀ x, mem x empty → P x) = true :=
propext (forall_mem_empty_iff _)

theorem forall_mem_insert_iff {A : Type} [d : decidable_eq A]
    (a : A) (s : finset A) (P : A → Prop) :
  (∀ x, x ∈ insert a s → P x) ↔ P a ∧ (∀ x, x ∈ s → P x) :=
iff.intro
  (assume H, and.intro (H _ (mem_insert _ _)) (take x, assume H', H _ (mem_insert_of_mem _ H')))
  (assume H, take x, assume H' : x ∈ insert a s,
    or.elim (eq_or_mem_of_mem_insert H')
      (suppose x = a, eq.subst (eq.symm this) (and.left H))
(suppose x ∈ s, and.right H _ this))

theorem forall_mem_insert_eq {A : Type} [d : decidable_eq A] (a : A) (s : finset A) (P : A → Prop) :
  (∀ x, x ∈ insert a s → P x) = (P a ∧ (∀ x, x ∈ s → P x)) :=
propext (forall_mem_insert_iff _ _ _)

end finset


import mathlib_someday
import tactic.ring
import data.zsqrtd.basic

-- Z[alpha] where alpha := (1 + sqrt(5))/2, representing the minimal ring
-- (with addition, subtraction, and multiplication) containing the roots
-- of x^2-x-1 = 0: alpha := (1 + sqrt(5))/2 and beta (1 - sqrt(5))/2
-- (with beta < alpha)
--
-- i as in int, r as in root
@[derive decidable_eq]
structure Zalpha : Type :=
(i : ℤ) (r : ℤ)

notation `ℤα` := Zalpha

namespace Zalpha

@[simp] theorem eta : ∀ z : ℤα, Zalpha.mk z.i z.r = z
| ⟨a, b⟩ := rfl

@[ext] theorem ext : ∀ {z w : ℤα}, z.i = w.i → z.r = w.r → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℤα} : z = w ↔ z.i = w.i ∧ z.r = w.r :=
⟨λ H, by simp [H], and.rec ext⟩

def of_int (z : ℤ) : ℤα := ⟨z, 0⟩
@[simp] lemma of_int_i (r : ℤ) : (of_int r : ℤα).i = r := rfl
@[simp] lemma of_int_r (r : ℤ) : (of_int r : ℤα).r = 0 := rfl

@[reducible] def of_nat (n : ℕ) : ℤα := of_int n
@[simp] lemma of_nat_i (r : ℕ) : (of_nat r : ℤα).i = r := rfl
@[simp] lemma of_nat_r (r : ℕ) : (of_nat r : ℤα).r = 0 := rfl

instance : has_zero ℤα := ⟨⟨(0 : ℤ), 0⟩⟩
instance : inhabited ℤα := ⟨0⟩

@[simp] lemma zero_i : (0 : ℤα).i = 0 := rfl
@[simp] lemma zero_r : (0 : ℤα).r = 0 := rfl
lemma of_int_zero : (of_int (0 : ℤ) : ℤα) = 0 := rfl

instance : has_one ℤα := ⟨⟨(1 : ℤ), 0⟩⟩

@[simp] lemma one_i : (1 : ℤα).i = 1 := rfl
@[simp] lemma one_r : (1 : ℤα).r = 0 := rfl
@[simp] lemma of_int_one : (of_int (1 : ℤ) : ℤα) = 1 := rfl

def α : ℤα := ⟨0, 1⟩

@[simp] lemma α_i : α.i = 0 := rfl
@[simp] lemma α_r : α.r = 1 := rfl

def β : ℤα := ⟨1, -1⟩

@[simp] lemma β_i : β.i = 1 := rfl
@[simp] lemma β_r : β.r = -1 := rfl

instance : has_add ℤα := ⟨λ z w, ⟨z.i + w.i, z.r + w.r⟩⟩

@[simp] lemma add_i (z w : ℤα) : (z + w).i = z.i + w.i := rfl
@[simp] lemma add_r (z w : ℤα) : (z + w).r = z.r + w.r := rfl
@[simp] lemma of_int_add (r s : ℤ) : (of_int (r + s : ℤ) : ℤα) = of_int (r + s) := rfl

@[simp] lemma of_int_bit0 (r : ℤ) : (of_int (bit0 r : ℤ) : ℤα) = bit0 (of_int r) := rfl
@[simp] lemma of_int_bit1 (r : ℤ) : (of_int (bit1 r : ℤ) : ℤα) = bit1 (of_int r) := rfl

instance : has_neg ℤα := ⟨λ z, ⟨-z.i, -z.r⟩⟩

@[simp] lemma neg_i (z : ℤα) : (-z).i = -z.i := rfl
@[simp] lemma neg_r (z : ℤα) : (-z).r = -z.r := rfl
@[simp] lemma of_int_neg (r : ℤ) : (of_int (-r : ℤ) : ℤα) = -of_int r := ext_iff.2 $ by simp

--   bα * dα
-- = (b/2 + b*sqrt(5)/2) * (d/2 + d*sqrt(5)/2)
-- = (b*d/4 + b*d*5/4) + (b*d*sqrt(5)/4) + (b*d*sqrt(5)/4)
-- = 3*b*d/2 + b*d*sqrt(5)/2
-- = 2*b*d/2 + b*d*α
-- = b*d + b*d*α

--   (a + bα) * (c + dα)
-- = a*c + (a*d + b*c)α + bα * dα
-- = a*c + (a*d + b*c)α + b*d + b*d*α
-- = (a*c + b*d) + (a*d + b*c + b*d)α

-- a: z.i, b: z.r,
-- c: w.i, d: w.r
instance : has_mul ℤα := ⟨λ z w, ⟨z.i * w.i + z.r * w.r, z.i * w.r + z.r * w.i + z.r * w.r⟩⟩

@[simp] lemma mul_i (z w : ℤα) : (z * w).i = z.i * w.i + z.r * w.r := rfl
@[simp] lemma mul_r (z w : ℤα) : (z * w).r = z.i * w.r + z.r * w.i + z.r * w.r := rfl
@[simp] lemma of_int_mul (r s : ℤ) : (of_int (r * s : ℤ) : ℤα) = of_int r * of_int s := ext_iff.2 $ by simp

lemma mk_eq_add_mul_α (a b : ℤ) : Zalpha.mk a b = of_int a + of_int b * α :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℤα) : (of_int z.i : ℤα) + of_int z.r * α = z :=
ext_iff.2 $ by simp

instance : comm_ring ℤα :=
by refine
{ add      := (+),
  zero     := 0,
  neg      := has_neg.neg,
  mul      := (*),
  one      := 1,
  mul_comm := by intros; apply ext; simp [mul_comm],
  ..
}; { intros; apply ext; simp [left_distrib, right_distrib, mul_assoc] }

@[simp] lemma comm_ring_zero : comm_ring.zero ℤα = 0 := rfl

@[simp] lemma of_int_eq_coe (r : ℤ) : ↑r = of_int r :=
  eq.symm (int.eq_cast of_int rfl (λ _ _, rfl) r)
@[simp] lemma coe_int_i (r : ℤ) : (r : ℤα).i = r := by simp
@[simp] lemma coe_int_r (r : ℤ) : (r : ℤα).r = 0 := by simp

@[simp] lemma of_nat_eq_coe (r : ℕ) : ↑r = of_nat r :=
  eq.symm (nat.eq_cast of_nat rfl rfl (λ a b, rfl) r)
@[simp] lemma coe_nat_i (r : ℕ) : (↑r : ℤα).i = r := by simp
@[simp] lemma coe_nat_r (r : ℕ) : (↑r : ℤα).r = 0 := by simp

@[simp] theorem of_int_inj {z w : ℤ} : (z : ℤα) = w ↔ z = w :=
⟨eq.substr (of_int_eq_coe z) $ eq.substr (of_int_eq_coe w) (congr_arg i), congr_arg _⟩

@[simp] theorem of_int_eq_zero {z : ℤ} : (z : ℤα) = 0 ↔ z = 0 :=
  by show (z : ℤα) = ↑0 ↔ z = ↑0; exact @of_int_inj z 0
@[simp] theorem of_int_ne_zero {z : ℤ} : (z : ℤα) ≠ 0 ↔ z ≠ 0 :=
  not_congr of_int_eq_zero

@[simp] lemma of_nat_eq_nat_cast (r : ℕ) : nat.cast r = of_nat r :=
  eq.symm (nat.eq_cast of_nat rfl rfl (λ a b, rfl) r)
@[simp] lemma nat_cast_i (r : ℕ) : (nat.cast r : ℤα).i = r := by simp
@[simp] lemma nat_cast_r (r : ℕ) : (nat.cast r : ℤα).i = r := by simp

@[simp] lemma re_add_im_coe (z : ℤα) : (z.i : ℤα) + z.r * α = z :=
ext_iff.2 $ by simp

/- Extra instances to short-circuit type class resolution -/
instance : has_sub ℤα            := by apply_instance
instance : add_comm_monoid ℤα    := by apply_instance
instance : add_monoid ℤα         := by apply_instance
instance : monoid ℤα             := by apply_instance
instance : comm_monoid ℤα        := by apply_instance
instance : comm_semigroup ℤα     := by apply_instance
instance : semigroup ℤα          := by apply_instance
instance : add_comm_semigroup ℤα := by apply_instance
instance : add_semigroup ℤα      := by apply_instance
instance : comm_semiring ℤα      := by apply_instance
instance : semiring ℤα           := by apply_instance
instance : ring ℤα               := by apply_instance
instance : distrib ℤα            := by apply_instance

instance : has_pow ℤα ℕ := { pow := @monoid.pow ℤα _ }

instance : has_repr ℤα :=
{ repr := λ a, repr a.i ++ " + " ++ repr a.r ++ "α" }

@[simp]
lemma coe_int_add {a b : ℤ} : (of_int (a + b) : ℤα) = of_int a + of_int b := rfl
@[simp]
lemma coe_int_neg {a : ℤ} : -of_int a = of_int (-a) := rfl
@[simp]
lemma coe_nat_add {a b : ℕ} : (of_int (↑(a + b) : ℤ) : ℤα) = of_int ↑a + of_int ↑b :=
by rw [int.coe_nat_add, @coe_int_add ↑a ↑b]

@[simp] lemma αβsum : α + β = 1 := rfl
@[simp] lemma αβprod : α * β = -1 := rfl
lemma α_sqr : α^2 = α + 1 := rfl

theorem α_mul_right (z : ℤα) : α * z = ⟨z.r, z.i + z.r⟩ :=
by apply ext; simp

theorem β_mul_right (z : ℤα) : β * z = ⟨z.i - z.r, -z.i⟩ :=
by apply ext; simp

def sqrt5 : ℤα := ⟨-1, 2⟩
@[simp] lemma sqrt5_i : sqrt5.i = -1 := rfl
@[simp] lemma sqrt5_r : sqrt5.r = 2 := rfl
@[simp] lemma sqrt5_squared : sqrt5 ^ 2 = 5 := rfl

-- multiply by two, i.e. (a+bα) ↦ 2a+b(1+√5)
def to_Zsqrt5 (z : ℤα) : ℤ√5 :=
⟨2*z.i + z.r, z.r⟩

@[simp] lemma to_Zsqrt5_zero : (0:ℤα).to_Zsqrt5 = 0 := rfl

@[simp] lemma to_Zsqrt5_add (z w : ℤα) :
  (z + w).to_Zsqrt5 = z.to_Zsqrt5 + w.to_Zsqrt5 :=
by simp [to_Zsqrt5, mul_add]

@[simp] lemma to_Zsqrt5_mul (z w : ℤα) :
  (z * w).to_Zsqrt5 * 2 = z.to_Zsqrt5 * w.to_Zsqrt5 :=
by rw [zsqrtd.ext, mul_two]; unfold to_Zsqrt5; split; simp; ring

theorem to_Zsqrt5_inj : function.injective to_Zsqrt5 :=
begin
  intros z w H,
  unfold to_Zsqrt5 at H,
  cases zsqrtd.ext.1 H with H1 H2,
  dsimp at H1 H2,
  rw [H2, add_right_cancel_iff] at H1,
  have H3 := eq_of_mul_eq_mul_left dec_trivial H1,
  apply ext; assumption
end

theorem eq_zero_of_to_Zsqrt5_eq_zero (z : ℤα)
  (H : z.to_Zsqrt5 = 0) : z = 0 :=
to_Zsqrt5_inj H

/- conj (a + bα)
 = a + bβ
 = a + b(1 - α)
 = (a + b) - bα
-/
def conj (z : ℤα) : ℤα := ⟨z.i + z.r, -z.r⟩

/- norm (a + bα)
 = (a + bα) (a + bβ)
 = a² + ab(α + β) + b²αβ
 = a² + ab - b²
-/
def norm (z : ℤα) : ℤ := z.i * z.i + z.i * z.r - z.r * z.r

@[simp] lemma add_conj (z : ℤα) : z + z.conj = 2 * z.i + z.r :=
by apply ext; simp [conj, two_mul]

@[simp] lemma mul_conj_eq_norm (z : ℤα) : z * z.conj = z.norm :=
by apply ext; simp [conj, norm, mul_add, mul_comm]

@[simp] lemma conj_conj (z : ℤα) : z.conj.conj = z :=
by apply ext; simp [conj]

instance : is_ring_hom conj :=
{ map_add := λ z w, by apply ext; simp [conj],
  map_mul := λ z w, by apply ext; simp [conj, add_mul, mul_add, -add_comm]; ac_refl,
  map_one := rfl }

@[simp] lemma conj_zero : (0:ℤα).conj = 0 :=
is_ring_hom.map_zero conj

lemma conj_bijective : function.bijective conj :=
⟨λ x y H, by rw [← x.conj_conj, H, y.conj_conj],
  λ x, ⟨x.conj, conj_conj x⟩⟩

lemma eq_zero_of_conj_eq_zero (z : ℤα) (H : z.conj = 0) : z = 0 :=
conj_bijective.1 H

lemma to_Zsqrt5_conj (z : ℤα) : z.conj.to_Zsqrt5 = z.to_Zsqrt5.conj :=
by rw zsqrtd.ext; split; simp [conj, to_Zsqrt5, two_mul]

lemma norm_mul (z w : ℤα) : (z * w).norm = z.norm * w.norm :=
by simp [norm, add_mul, mul_add]; ring

instance decidable_linear_ordered_comm_ring_Z_sqrt_5 :
  decidable_linear_ordered_comm_ring ℤ√5 :=
zsqrtd.decidable_linear_ordered_comm_ring

instance : decidable_linear_ordered_comm_ring ℤα :=
{ le := λ z w, to_Zsqrt5 z ≤ to_Zsqrt5 w,
  le_refl := λ z, show to_Zsqrt5 z ≤ to_Zsqrt5 z, from le_refl _,
  le_trans := λ z₁ z₂ z₃ H12 H23, show to_Zsqrt5 z₁ ≤ to_Zsqrt5 z₃, from le_trans H12 H23,
  le_antisymm := λ z w Hzw Hwz, to_Zsqrt5_inj $ le_antisymm Hzw Hwz,
  lt := λ z w, to_Zsqrt5 z < to_Zsqrt5 w,
  lt_iff_le_not_le := λ z w, show to_Zsqrt5 z < to_Zsqrt5 w ↔ _, from lt_iff_le_not_le,
  add_le_add_left := λ z₁ z₂ H12 z₃, calc _ = _ : to_Zsqrt5_add _ _
    ... ≤ _ : zsqrtd.add_le_add_left _ _ H12 _
    ... = _ : (to_Zsqrt5_add _ _).symm,
  add_lt_add_left := λ z₁ z₂ H12 z₃, calc _ = _ : to_Zsqrt5_add _ _
    ... < _ : zsqrtd.add_lt_add_left _ _ H12 _
    ... = _ : (to_Zsqrt5_add _ _).symm,
  mul_nonneg := λ z w (Hz : to_Zsqrt5 z ≥ 0) (Hw : to_Zsqrt5 w ≥ 0),
    show to_Zsqrt5 (z * w) ≥ 0,
    from nonneg_of_mul_nonneg_right
      (trans_rel_left _ (mul_nonneg Hz Hw) (to_Zsqrt5_mul z w).symm)
      (add_pos zero_lt_one zero_lt_one),
  mul_pos := λ z w (Hz : to_Zsqrt5 z > 0) (Hw : to_Zsqrt5 w > 0),
    show to_Zsqrt5 (z * w) > 0,
    from pos_of_mul_pos_right
      (trans_rel_left _ (mul_pos Hz Hw) (to_Zsqrt5_mul z w).symm)
      (add_nonneg zero_le_one zero_le_one),
  le_total := λ z w, zsqrtd.le_total _ _,
  zero_lt_one := show 0 < to_Zsqrt5 1, from dec_trivial,
  zero_ne_one := dec_trivial,
  decidable_le := λ z w, show decidable (to_Zsqrt5 z ≤ to_Zsqrt5 w), by apply_instance,
  .. Zalpha.comm_ring }

lemma zero_of_norm_zero (z : ℤα) (H : z.norm = 0) : z = 0 :=
have H1 : z * z.conj = 0,
  by rw [mul_conj_eq_norm, H]; refl,
(eq_zero_or_eq_zero_of_mul_eq_zero H1).cases_on
  id z.eq_zero_of_conj_eq_zero

theorem zero_iff_norm_zero (z : ℤα) : z = 0 ↔ z.norm = 0 :=
⟨λ H, H.symm ▸ rfl, zero_of_norm_zero z⟩

instance : integral_domain ℤα := by apply_instance

theorem char_eq (z : ℤα) (H : z * z - z - 1 = 0) : z = α ∨ z = β :=
have H1 : (z - α) * (z - β) = 0,
  by rw [← H, α, β]; ring,
(eq_zero_or_eq_zero_of_mul_eq_zero H1).cases_on
  (or.inl ∘ eq_of_sub_eq_zero)
  (or.inr ∘ eq_of_sub_eq_zero)

theorem gal (f : ℤα → ℤα) [is_ring_hom f] : f = id ∨ f = conj :=
have H : f α * f α - f α - 1 = 0,
  by rw [← is_ring_hom.map_mul f, ← is_ring_hom.map_sub f];
    rw [← is_ring_hom.map_one f]; apply sub_self,
(char_eq (f α) H).cases_on
  (assume H : f α = α, or.inl $ funext $ show ∀ z, f z = z,
    from λ z, by rw [← re_add_im_coe z];
      rw [is_ring_hom.map_add f, is_ring_hom.map_mul f, H];
      rw [is_ring_hom.map_int f, is_ring_hom.map_int f])
  (assume H : f α = β, or.inr $ funext $ show ∀ z, f z = conj z,
    from λ z, by rw [← re_add_im_coe z];
      rw [is_ring_hom.map_add f, is_ring_hom.map_mul f, H];
      rw [is_ring_hom.map_int f, is_ring_hom.map_int f];
      rw [is_ring_hom.map_add conj, is_ring_hom.map_mul conj];
      rw [is_ring_hom.map_int conj, is_ring_hom.map_int conj]; refl)

namespace units

def α : units ℤα :=
⟨α, -β, rfl, rfl⟩

@[simp] lemma α_coe : (↑α : ℤα) = Zalpha.α := rfl
@[simp] lemma α_inv_coe : (↑α⁻¹ : ℤα) = -Zalpha.β := rfl

def β : units ℤα :=
⟨β, -α, rfl, rfl⟩

@[simp] lemma β_coe : (↑β : ℤα) = Zalpha.β := rfl
@[simp] lemma β_inv_coe : (↑β⁻¹ : ℤα) = -Zalpha.α := rfl

@[simp] lemma α_mul_β : α * β = -1 := rfl
@[simp] lemma β_mul_α : β * α = -1 := rfl

instance : has_repr (units ℤα) :=
⟨λ u, repr (↑u : ℤα)⟩

end units

end Zalpha


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Heterogeneous lists
-/
import data.list logic.cast
open list

inductive hlist {A : Type} (B : A → Type) : list A → Type :=
| nil {} : hlist B []
| cons   : ∀ {a : A}, B a → ∀ {l : list A}, hlist B l → hlist B (a::l)

namespace hlist
variables {A : Type} {B : A → Type}

definition head : Π {a l}, hlist B (a :: l) → B a
| a l (cons b h) := b

lemma head_cons : ∀ {a l} (b : B a) (h : hlist B l), head (cons b h) = b :=
by intros; reflexivity

definition tail : Π {a l}, hlist B (a :: l) → hlist B l
| a l (cons b h) := h

lemma tail_cons : ∀ {a l} (b : B a) (h : hlist B l), tail (cons b h) = h :=
by intros; reflexivity

lemma eta_cons : ∀ {a l} (h : hlist B (a::l)), h = cons (head h) (tail h) :=
begin intros, cases h, esimp end

lemma eta_nil : ∀ (h : hlist B []), h = nil :=
begin intros, cases h, esimp end

definition append : Π {l₁ l₂}, hlist B l₁ → hlist B l₂ → hlist B (l₁++l₂)
| ⌞[]⌟    l₂ nil         h₂ := h₂
| ⌞a::l₁⌟ l₂ (cons b h₁) h₂ := cons b (append h₁ h₂)

lemma append_nil_left : ∀ {l} (h : hlist B l), append nil h = h :=
by intros; reflexivity

open eq.ops
lemma eq_rec_on_cons : ∀ {a₁ a₂ l₁ l₂} (b : B a₁) (h : hlist B l₁) (e : a₁::l₁ = a₂::l₂),
                         e ▹ cons b h = cons (head_eq_of_cons_eq e ▹ b) (tail_eq_of_cons_eq e ▹ h) :=
begin
  intros, injection e with e₁ e₂, revert e, subst a₂, subst l₂, intro e, esimp
end

lemma append_nil_right : ∀ {l} (h : hlist B l), append h nil = (list.append_nil_right l)⁻¹ ▹ h
| []     nil        := by esimp
| (a::l) (cons b h) :=
  begin
    unfold append, rewrite [append_nil_right h], xrewrite eq_rec_on_cons
  end

lemma append_nil_right_heq {l} (h : hlist B l) : append h nil == h :=
by rewrite append_nil_right; apply eq_rec_heq

section get
variables [decA : decidable_eq A]
include decA

definition get {a : A} : ∀ {l : list A}, hlist B l → a ∈ l → B a
| []     nil        e := absurd e !not_mem_nil
| (t::l) (cons b h) e :=
  or.by_cases (eq_or_mem_of_mem_cons e)
    (suppose a = t, by subst t; exact b)
    (suppose a ∈ l, get h this)
end get

section map
variable {C : A → Type}
variable (f : Π ⦃a⦄, B a → C a)

definition map : ∀ {l}, hlist B l → hlist C l
| ⌞[]⌟   nil        := nil
| ⌞a::l⌟ (cons b h) := cons (f b) (map h)

lemma map_nil : map f nil = nil :=
rfl

lemma map_cons : ∀ {a l} (b : B a) (h : hlist B l), map f (cons b h) = cons (f b) (map f h) :=
by intros; reflexivity
end map
end hlist


/- LoVe Demo 8: Operational Semantics -/

import .lovelib

namespace LoVe

/- A Minimalistic Imperative Language -/

inductive program : Type
| skip {} : program
| assign  : string → (state → ℕ) → program
| seq     : program → program → program
| ite     : (state → Prop) → program → program → program
| while   : (state → Prop) → program → program

infixr ` ;; `:90 := program.seq

export program (skip assign seq ite while)

/- Big-Step Semantics -/

inductive big_step : (program × state) → state → Prop
| skip {s} :
  big_step (skip, s) s
| assign {x a s} :
  big_step (assign x a, s) (s{x ↦ a s})
| seq {S T s t u} (h₁ : big_step (S, s) t)
    (h₂ : big_step (T, t) u) :
  big_step (S ;; T, s) u
| ite_true {b : state → Prop} {S₁ S₂ s t} (hcond : b s)
    (hbody : big_step (S₁, s) t) :
  big_step (ite b S₁ S₂, s) t
| ite_false {b : state → Prop} {S₁ S₂ s t} (hcond : ¬ b s)
    (hbody : big_step (S₂, s) t) :
  big_step (ite b S₁ S₂, s) t
| while_true {b : state → Prop} {S s t u} (hcond : b s)
    (hbody : big_step (S, s) t)
    (hrest : big_step (while b S, t) u) :
  big_step (while b S, s) u
| while_false {b : state → Prop} {S s} (hcond : ¬ b s) :
  big_step (while b S, s) s

infix ` ⟹ `:110 := big_step

/- Lemmas about the Big-Step Semantics -/

lemma big_step_unique {S s l r} (hl : (S, s) ⟹ l)
	  (hr : (S, s) ⟹ r) :
  l = r :=
begin
  induction hl generalizing r,
  { cases hr,
    refl },
  { cases hr,
    refl },
  { cases hr,
    rename hl_S S, rename hl_T T, rename hl_s s, rename hl_t t,
    rename hl_u l, rename hr_t t', rename hl_h₁ hSst,
    rename hl_h₂ hTtl, rename hr_h₂ hTt'r, rename hr_h₁ hSst',
    rename hl_ih_h₁ ihS, rename hl_ih_h₂ ihT,
    specialize ihS hSst',
    rw ihS at *,
    specialize ihT hTt'r,
    rw ihT at *},
  { cases hr,
    { apply hl_ih,
      cc },
    { apply hl_ih,
      cc } },
  { cases hr,
    { apply hl_ih,
      cc },
    { apply hl_ih,
      assumption } },
  { cases hr,
    { specialize hl_ih_hbody hr_hbody,
      rw hl_ih_hbody at *,
      specialize hl_ih_hrest hr_hrest,
      rw hl_ih_hrest at *},
    { cc } },
  { cases hr,
    { cc },
    { refl } }
end

@[simp] lemma big_step_skip_iff {s t} :
  (skip, s) ⟹ t ↔ t = s :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    refl },
  { intro h,
    rw h,
    exact big_step.skip }
end

@[simp] lemma big_step_assign_iff {x a s t} :
  (assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    refl },
  { intro h,
    rw h,
    exact big_step.assign }
end

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (S₁ ;; S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    apply exists.intro,
    apply and.intro,
    repeat { assumption } },
  { intro h,
    cases h,
    cases h_h,
    apply big_step.seq,
    repeat { assumption } }
end

@[simp] lemma big_step_ite_iff {b S₁ S₂ s t} :
  (ite b S₁ S₂, s) ⟹ t ↔
  (b s ∧ (S₁, s) ⟹ t) ∨ (¬ b s ∧ (S₂, s) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases h;
    cases h,
    { apply big_step.ite_true,
      repeat { assumption }},
    { apply big_step.ite_false,
      repeat { assumption }}
  }
end

lemma big_step_while_iff {b S s u} :
  (while b S, s) ⟹ u ↔
  (∃t, b s ∧ (S, s) ⟹ t ∧ (while b S, t) ⟹ u)
  ∨ (¬ b s ∧ u = s) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    { apply or.intro_left,
      apply exists.intro h_t,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases h,
    { cases h,
      cases h_h,
      cases h_h_right,
      apply big_step.while_true,
      repeat { assumption } },
    { cases h,
      rw h_right,
      apply big_step.while_false,
      assumption } }
end

@[simp] lemma big_step_while_true_iff {b : state → Prop} {S s u}
    (hcond : b s) :
  (while b S, s) ⟹ u ↔
  (∃t, (S, s) ⟹ t ∧ (while b S, t) ⟹ u) :=
by rw [big_step_while_iff]; simp [hcond]

@[simp] lemma big_step_while_false_iff {b : state → Prop}
    {S s t} (hcond : ¬ b s) :
  (while b S, s) ⟹ t ↔ t = s :=
by rw [big_step_while_iff]; simp [hcond]

/- Small-Step Semantics -/

inductive small_step : program × state → program × state → Prop
| assign {x a s} :
  small_step (assign x a, s) (skip, s{x ↦ a s})
| seq_step {S T s s'} (S') :
  small_step (S, s) (S', s') →
  small_step (S ;; T, s) (S' ;; T, s')
| seq_skip {T s} :
  small_step (skip ;; T, s) (T, s)
| ite_true {b : state → Prop} {S₁ S₂ s} :
  b s → small_step (ite b S₁ S₂, s) (S₁, s)
| ite_false {b : state → Prop} {S₁ S₂ s} :
  ¬ b s → small_step (ite b S₁ S₂, s) (S₂, s)
| while {b : state → Prop} {S s} :
  small_step (while b S, s) (ite b (S ;; while b S) skip, s)

infixr ` ⇒ ` := small_step
infixr ` ⇒* ` : 100 := refl_trans small_step

/- Lemmas about the Small-Step Semantics -/

@[simp] lemma small_step_skip {S s t} :
  ¬ ((skip, s) ⇒ (S, t)) :=
by intro h; cases h

lemma small_step_seq_iff {S T s Ut} :
  (S ;; T, s) ⇒ Ut ↔
  (∃S' t, (S, s) ⇒ (S', t) ∧ Ut = (S' ;; T, t))
  ∨ (S = skip ∧ Ut = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    { apply or.intro_left,
      apply exists.intro h_S',
      apply exists.intro h_s',
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases h,
    { cases h,
      cases h_h,
      cases h_h_h,
      rw h_h_h_right,
      apply small_step.seq_step,
      assumption },
    { cases h,
      rw [h_left, h_right],
      apply small_step.seq_skip } }
end

@[simp] lemma small_step_ite_iff {b S T s Us} :
  (ite b S T, s) ⇒ Us ↔
  (b s ∧ Us = (S, s)) ∨ (¬ b s ∧ Us = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases h,
    { cases h,
      rw h_right,
      apply small_step.ite_true,
      assumption },
    { cases h,
      rw h_right,
      apply small_step.ite_false,
      assumption } }
end

/- **optional** Correspondence between the Big-Step and the
Small-Step Semantics -/

lemma refl_trans_small_step_seq {S₁ S₂ s u}
    (h : (S₁, s) ⇒* (skip, u)) :
  (S₁ ;; S₂, s) ⇒* (skip ;; S₂, u) :=
begin
  apply refl_trans.lift
    (λSs : program × state, (Ss.1 ;; S₂, Ss.2)) _ h,
  intros Ss Ss' h,
  cases Ss,
  cases Ss',
  dsimp,
  apply small_step.seq_step,
  assumption
end

lemma big_step_imp_refl_trans_small_step {S s t}
    (h : (S, s) ⟹ t) :
  (S, s) ⇒* (skip, t) :=
begin
  induction h,
  case big_step.skip { refl },
  case big_step.assign {
    exact refl_trans.single small_step.assign },
  case big_step.seq : S₁ S₂ s t u h₁ h₂ ih₁ ih₂ {
    transitivity,
    exact refl_trans_small_step_seq ih₁,
    exact ih₂.head small_step.seq_skip },
  case big_step.ite_true : B S₁ S₂ s t hs hst ih {
    exact ih.head (small_step.ite_true hs) },
  case big_step.ite_false : B S₁ S₂ s t hs hst ih {
    exact ih.head (small_step.ite_false hs) },
  case big_step.while_true : B S s t u hs h₁ h₂ ih₁ ih₂ {
    exact (refl_trans.head (small_step.while)
      (refl_trans.head (small_step.ite_true hs)
         (refl_trans.trans (refl_trans_small_step_seq ih₁)
            (refl_trans.head small_step.seq_skip ih₂)))) },
  case big_step.while_false : c p s hs {
    exact (refl_trans.single small_step.while).tail
      (small_step.ite_false hs) }
end

lemma big_step_of_small_step_of_big_step {S₀ S₁ s₀ s₁ s₂} :
  (S₀, s₀) ⇒ (S₁, s₁) → (S₁, s₁) ⟹ s₂ → (S₀, s₀) ⟹ s₂ :=
begin
  generalize hv₀ : (S₀, s₀) = v₀,
  generalize hv₁ : (S₁, s₁) = v₀,
  intro h,
  induction h
      generalizing S₀ s₀ S₁ s₁ s₂;
    cases hv₁;
    clear hv₁;
    cases hv₀;
    clear hv₀;
    simp [*, big_step_while_true_iff] { contextual := tt },
  { intros u h₁ h₂,
    use u,
    exact and.intro (h_ih rfl rfl h₁) h₂ }
end

lemma refl_trans_small_step_imp_big_step {S s t} :
  (S, s) ⇒* (skip, t) → (S, s) ⟹ t :=
begin
  generalize hv₀ : (S, s) = v₀,
  intro h,
  induction h
      using LoVe.refl_trans.head_induction_on
      with v₀ v₁ h h' ih
      generalizing S s;
    cases hv₀;
    clear hv₀,
  { exact big_step.skip },
  { cases v₁ with S' s',
    specialize ih rfl,
    exact big_step_of_small_step_of_big_step h ih }
end

lemma big_step_iff_refl_trans_small_step {S s t} :
  (S, s) ⟹ t ↔ (S, s) ⇒* (skip, t) :=
iff.intro
  big_step_imp_refl_trans_small_step
  refl_trans_small_step_imp_big_step

end LoVe


/-
Copyright (c) 2019 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.lift
import Mathlib.topology.opens
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

/-- The type of open subgroups of a topological additive group. -/
structure open_add_subgroup (G : Type u_1) [add_group G] [topological_space G]
    extends add_subgroup G where
  is_open' : is_open carrier

/-- The type of open subgroups of a topological group. -/
structure open_subgroup (G : Type u_1) [group G] [topological_space G] extends subgroup G where
  is_open' : is_open carrier

/-- Reinterpret an `open_subgroup` as a `subgroup`. -/
/-- Reinterpret an `open_add_subgroup` as an `add_subgroup`. -/
-- Tell Lean that `open_add_subgroup` is a namespace

namespace open_add_subgroup

end open_add_subgroup

namespace open_subgroup

protected instance has_coe_set {G : Type u_1} [group G] [topological_space G] :
    has_coe_t (open_subgroup G) (set G) :=
  has_coe_t.mk fun (U : open_subgroup G) => carrier U

protected instance has_mem {G : Type u_1} [group G] [topological_space G] :
    has_mem G (open_subgroup G) :=
  has_mem.mk fun (g : G) (U : open_subgroup G) => g ∈ ↑U

protected instance has_coe_subgroup {G : Type u_1} [group G] [topological_space G] :
    has_coe_t (open_subgroup G) (subgroup G) :=
  has_coe_t.mk to_subgroup

protected instance has_coe_opens {G : Type u_1} [group G] [topological_space G] :
    has_coe_t (open_subgroup G) (topological_space.opens G) :=
  has_coe_t.mk fun (U : open_subgroup G) => { val := ↑U, property := is_open' U }

@[simp] theorem mem_coe {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

@[simp] theorem mem_coe_opens {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

@[simp] theorem mem_coe_subgroup {G : Type u_1} [group G] [topological_space G]
    {U : open_subgroup G} {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

theorem coe_injective {G : Type u_1} [group G] [topological_space G] : function.injective coe :=
  sorry

theorem ext {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {V : open_subgroup G} (h : ∀ (x : G), x ∈ U ↔ x ∈ V) : U = V :=
  coe_injective (set.ext h)

theorem ext_iff {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {V : open_subgroup G} : U = V ↔ ∀ (x : G), x ∈ U ↔ x ∈ V :=
  { mp := fun (h : U = V) (x : G) => h ▸ iff.rfl, mpr := ext }

protected theorem is_open {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) :
    is_open ↑U :=
  is_open' U

protected theorem one_mem {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) :
    1 ∈ U :=
  one_mem' U

protected theorem inv_mem {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G)
    {g : G} (h : g ∈ U) : g⁻¹ ∈ U :=
  inv_mem' U h

protected theorem Mathlib.open_add_subgroup.add_mem {G : Type u_1} [add_group G]
    [topological_space G] (U : open_add_subgroup G) {g₁ : G} {g₂ : G} (h₁ : g₁ ∈ U) (h₂ : g₂ ∈ U) :
    g₁ + g₂ ∈ U :=
  open_add_subgroup.add_mem' U h₁ h₂

theorem mem_nhds_one {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) :
    ↑U ∈ nhds 1 :=
  mem_nhds_sets (open_subgroup.is_open U) (open_subgroup.one_mem U)

protected instance has_top {G : Type u_1} [group G] [topological_space G] :
    has_top (open_subgroup G) :=
  has_top.mk (mk (subgroup.carrier ⊤) sorry sorry sorry is_open_univ)

protected instance inhabited {G : Type u_1} [group G] [topological_space G] :
    Inhabited (open_subgroup G) :=
  { default := ⊤ }

theorem is_closed {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G]
    (U : open_subgroup G) : is_closed ↑U :=
  sorry

/-- The product of two open subgroups as an open subgroup of the product group. -/
def prod {G : Type u_1} [group G] [topological_space G] {H : Type u_2} [group H]
    [topological_space H] (U : open_subgroup G) (V : open_subgroup H) : open_subgroup (G × H) :=
  mk (set.prod ↑U ↑V) sorry sorry sorry sorry

protected instance partial_order {G : Type u_1} [group G] [topological_space G] :
    partial_order (open_subgroup G) :=
  partial_order.mk (fun (U V : open_subgroup G) => ∀ {x : G}, x ∈ U → x ∈ V) partial_order.lt sorry
    sorry sorry

protected instance semilattice_inf_top {G : Type u_1} [group G] [topological_space G] :
    semilattice_inf_top (open_subgroup G) :=
  semilattice_inf_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry
    (fun (U V : open_subgroup G) => mk (subgroup.carrier (↑U ⊓ ↑V)) sorry sorry sorry sorry) sorry
    sorry sorry

@[simp] theorem coe_inf {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {V : open_subgroup G} : ↑(U ⊓ V) = ↑U ∩ ↑V :=
  rfl

@[simp] theorem coe_subset {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {V : open_subgroup G} : ↑U ⊆ ↑V ↔ U ≤ V :=
  iff.rfl

@[simp] theorem coe_subgroup_le {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G}
    {V : open_subgroup G} : ↑U ≤ ↑V ↔ U ≤ V :=
  iff.rfl

end open_subgroup

namespace subgroup

theorem Mathlib.add_subgroup.is_open_of_mem_nhds {G : Type u_1} [add_group G] [topological_space G]
    [has_continuous_add G] (H : add_subgroup G) {g : G} (hg : ↑H ∈ nhds g) : is_open ↑H :=
  sorry

theorem is_open_of_open_subgroup {G : Type u_1} [group G] [topological_space G]
    [has_continuous_mul G] (H : subgroup G) {U : open_subgroup G}
    (h : open_subgroup.carrier U ≤ ↑H) : is_open ↑H :=
  is_open_of_mem_nhds H (filter.mem_sets_of_superset (open_subgroup.mem_nhds_one U) h)

theorem is_open_mono {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G]
    {H₁ : subgroup G} {H₂ : subgroup G} (h : H₁ ≤ H₂) (h₁ : is_open ↑H₁) : is_open ↑H₂ :=
  is_open_of_open_subgroup H₂ h

end subgroup

namespace open_subgroup

protected instance semilattice_sup_top {G : Type u_1} [group G] [topological_space G]
    [has_continuous_mul G] : semilattice_sup_top (open_subgroup G) :=
  semilattice_sup_top.mk semilattice_inf_top.top semilattice_inf_top.le semilattice_inf_top.lt sorry
    sorry sorry sorry
    (fun (U V : open_subgroup G) => mk (subgroup.carrier (↑U ⊔ ↑V)) sorry sorry sorry sorry) sorry
    sorry sorry

end open_subgroup

namespace submodule

theorem is_open_mono {R : Type u_1} {M : Type u_2} [comm_ring R] [add_comm_group M]
    [topological_space M] [topological_add_group M] [module R M] {U : submodule R M}
    {P : submodule R M} (h : U ≤ P) (hU : is_open ↑U) : is_open ↑P :=
  add_subgroup.is_open_mono h hU

end submodule

namespace ideal

theorem is_open_of_open_subideal {R : Type u_1} [comm_ring R] [topological_space R]
    [topological_ring R] {U : ideal R} {I : ideal R} (h : U ≤ I) (hU : is_open ↑U) : is_open ↑I :=
  submodule.is_open_mono h hU

end Mathlib


import homotopy.equiv
import homotopy.loop

noncomputable theory

class contractible (X : Type _) [topological_space X] : Prop :=
(hequiv : nonempty (homotopy_equiv X unit))

variables {X : Type _} [topological_space X] [contractible X] {x₀ : X}

instance nonempty_of_contractible : nonempty X :=
begin
  obtain ⟨⟨f, g, h₁, h₂⟩⟩ := @contractible.hequiv X _ _,
  exact ⟨g ()⟩
end

instance path_connected_space_of_contractible : path_connected_space X :=
begin
  refine_struct { nonempty := nonempty_of_contractible },
  obtain ⟨⟨f, g, ⟨h₁⟩, h₂⟩⟩ := @contractible.hequiv X _ _,
  intros x y,
  refine ⟨path'.to_path _⟩,
  have : ∀ t, f t = (),
  { intro t,
    cases f t,
    refl },
  let x₀ := g (),
  let p₁ : path' x₀ x,
  { refine_struct { to_fun := { to_fun := λ t, h₁ (x, t) } },
    continuity,
    simp only [this, homotopy_with.to_fun_zero, continuous_map.comp_coe, continuous_map.coe_mk,
               function.comp_app],
    simp only [homotopy_with.to_fun_one, continuous_map.id_coe, id.def, continuous_map.coe_mk] },
  let p₂ : path' x₀ y,
  { refine_struct { to_fun := { to_fun := λ t, h₁ (y, t) } },
    continuity,
    simp only [this, homotopy_with.to_fun_zero, continuous_map.comp_coe, continuous_map.coe_mk,
               function.comp_app],
    simp only [homotopy_with.to_fun_one, continuous_map.id_coe, id.def, continuous_map.coe_mk] },
  exact p₁.inv.trans p₂,
  recover,
  exact _inst_2,
end .

-- example : π₁ x₀ ≃* unit :=
-- _