/-
Copyright (c) 2019 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import data.bracket
import algebra.algebra.basic
import tactic.noncomm_ring

/-!
# Lie algebras

This file defines Lie rings and Lie algebras over a commutative ring together with their
modules, morphisms and equivalences, as well as various lemmas to make these definitions usable.

## Main definitions

  * `lie_ring`
  * `lie_algebra`
  * `lie_ring_module`
  * `lie_module`
  * `lie_hom`
  * `lie_equiv`
  * `lie_module_hom`
  * `lie_module_equiv`

## Notation

Working over a fixed commutative ring `R`, we introduce the notations:
 * `L →ₗ⁅R⁆ L'` for a morphism of Lie algebras,
 * `L ≃ₗ⁅R⁆ L'` for an equivalence of Lie algebras,
 * `M →ₗ⁅R,L⁆ N` for a morphism of Lie algebra modules `M`, `N` over a Lie algebra `L`,
 * `M ≃ₗ⁅R,L⁆ N` for an equivalence of Lie algebra modules `M`, `N` over a Lie algebra `L`.

## Implementation notes

Lie algebras are defined as modules with a compatible Lie ring structure and thus, like modules,
are partially unbundled.

## References
* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975)

## Tags

lie bracket, jacobi identity, lie ring, lie algebra, lie module
-/

universes u v w w₁ w₂

/-- A Lie ring is an additive group with compatible product, known as the bracket, satisfying the
Jacobi identity. -/
@[protect_proj] class lie_ring (L : Type v) extends add_comm_group L, has_bracket L L :=
(add_lie : ∀ (x y z : L), ⁅x + y, z⁆ = ⁅x, z⁆ + ⁅y, z⁆)
(lie_add : ∀ (x y z : L), ⁅x, y + z⁆ = ⁅x, y⁆ + ⁅x, z⁆)
(lie_self : ∀ (x : L), ⁅x, x⁆ = 0)
(leibniz_lie : ∀ (x y z : L), ⁅x, ⁅y, z⁆⁆ = ⁅⁅x, y⁆, z⁆ + ⁅y, ⁅x, z⁆⁆)

/-- A Lie algebra is a module with compatible product, known as the bracket, satisfying the Jacobi
identity. Forgetting the scalar multiplication, every Lie algebra is a Lie ring. -/
@[protect_proj] class lie_algebra (R : Type u) (L : Type v) [comm_ring R] [lie_ring L]
  extends module R L :=
(lie_smul : ∀ (t : R) (x y : L), ⁅x, t • y⁆ = t • ⁅x, y⁆)

/-- A Lie ring module is an additive group, together with an additive action of a
Lie ring on this group, such that the Lie bracket acts as the commutator of endomorphisms.
(For representations of Lie *algebras* see `lie_module`.) -/
@[protect_proj] class lie_ring_module (L : Type v) (M : Type w)
  [lie_ring L] [add_comm_group M] extends has_bracket L M :=
(add_lie : ∀ (x y : L) (m : M), ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆)
(lie_add : ∀ (x : L) (m n : M), ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆)
(leibniz_lie : ∀ (x y : L) (m : M), ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆)

/-- A Lie module is a module over a commutative ring, together with a linear action of a Lie
algebra on this module, such that the Lie bracket acts as the commutator of endomorphisms. -/
@[protect_proj] class lie_module (R : Type u) (L : Type v) (M : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
  [lie_ring_module L M] :=
(smul_lie : ∀ (t : R) (x : L) (m : M), ⁅t • x, m⁆ = t • ⁅x, m⁆)
(lie_smul : ∀ (t : R) (x : L) (m : M), ⁅x, t • m⁆ = t • ⁅x, m⁆)

section basic_properties

variables {R : Type u} {L : Type v} {M : Type w} {N : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables (t : R) (x y z : L) (m n : M)

@[simp] lemma add_lie : ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆ := lie_ring_module.add_lie x y m

@[simp] lemma lie_add : ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆ := lie_ring_module.lie_add x m n

@[simp] lemma smul_lie : ⁅t • x, m⁆ = t • ⁅x, m⁆ := lie_module.smul_lie t x m

@[simp] lemma lie_smul : ⁅x, t • m⁆ = t • ⁅x, m⁆ := lie_module.lie_smul t x m

lemma leibniz_lie : ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆ := lie_ring_module.leibniz_lie x y m

@[simp] lemma lie_zero : ⁅x, 0⁆ = (0 : M) := (add_monoid_hom.mk' _ (lie_add x)).map_zero

@[simp] lemma zero_lie : ⁅(0 : L), m⁆ = 0 :=
(add_monoid_hom.mk' (λ (x : L), ⁅x, m⁆) (λ x y, add_lie x y m)).map_zero

@[simp] lemma lie_self : ⁅x, x⁆ = 0 := lie_ring.lie_self x

instance lie_ring_self_module : lie_ring_module L L := { ..(infer_instance : lie_ring L) }

@[simp] lemma lie_skew : -⁅y, x⁆ = ⁅x, y⁆ :=
have h : ⁅x + y, x⁆ + ⁅x + y, y⁆ = 0, { rw ← lie_add, apply lie_self, },
by simpa [neg_eq_iff_add_eq_zero] using h

/-- Every Lie algebra is a module over itself. -/
instance lie_algebra_self_module : lie_module R L L :=
{ smul_lie := λ t x m, by rw [←lie_skew, ←lie_skew x m, lie_algebra.lie_smul, smul_neg],
  lie_smul := by apply lie_algebra.lie_smul, }

@[simp] lemma neg_lie : ⁅-x, m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←add_lie], simp, }

@[simp] lemma lie_neg : ⁅x, -m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←lie_add], simp, }

@[simp] lemma sub_lie : ⁅x - y, m⁆ = ⁅x, m⁆ - ⁅y, m⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma lie_sub : ⁅x, m - n⁆ = ⁅x, m⁆ - ⁅x, n⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma nsmul_lie (n : ℕ) : ⁅n • x, m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_nsmul (n : ℕ) : ⁅x, n • m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma gsmul_lie (a : ℤ) : ⁅a • x, m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_gsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_gsmul (a : ℤ) : ⁅x, a • m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_gsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma lie_lie : ⁅⁅x, y⁆, m⁆ = ⁅x, ⁅y, m⁆⁆ - ⁅y, ⁅x, m⁆⁆ :=
by rw [leibniz_lie, add_sub_cancel]

lemma lie_jacobi : ⁅x, ⁅y, z⁆⁆ + ⁅y, ⁅z, x⁆⁆ + ⁅z, ⁅x, y⁆⁆ = 0 :=
by { rw [← neg_neg ⁅x, y⁆, lie_neg z, lie_skew y x, ← lie_skew, lie_lie], abel, }

instance : lie_ring_module L (M →ₗ[R] N) :=
{ bracket     := λ x f,
  { to_fun    := λ m, ⁅x, f m⁆ - f ⁅x, m⁆,
    map_add'  := λ m n, by { simp only [lie_add, linear_map.map_add], abel, },
    map_smul' := λ t m, by simp only [smul_sub, linear_map.map_smul, lie_smul], },
  add_lie     := λ x y f, by
    { ext n, simp only [add_lie, linear_map.coe_mk, linear_map.add_apply, linear_map.map_add],
      abel, },
  lie_add     := λ x f g, by
    { ext n, simp only [linear_map.coe_mk, lie_add, linear_map.add_apply], abel, },
  leibniz_lie := λ x y f, by
    { ext n,
      simp only [lie_lie, linear_map.coe_mk, linear_map.map_sub, linear_map.add_apply, lie_sub],
      abel, }, }

@[simp] lemma lie_hom.lie_apply (f : M →ₗ[R] N) (x : L) (m : M) :
  ⁅x, f⁆ m = ⁅x, f m⁆ - f ⁅x, m⁆ :=
rfl

instance : lie_module R L (M →ₗ[R] N) :=
{ smul_lie := λ t x f, by
    { ext n,
      simp only [smul_sub, smul_lie, linear_map.smul_apply, lie_hom.lie_apply,
        linear_map.map_smul], },
  lie_smul := λ t x f, by
    { ext n, simp only [smul_sub, linear_map.smul_apply, lie_hom.lie_apply, lie_smul], }, }

end basic_properties

set_option old_structure_cmd true
/-- A morphism of Lie algebras is a linear map respecting the bracket operations. -/
structure lie_hom (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ[R] L' :=
(map_lie' : ∀ {x y : L}, to_fun ⁅x, y⁆ = ⁅to_fun x, to_fun y⁆)

attribute [nolint doc_blame] lie_hom.to_linear_map

notation L ` →ₗ⁅`:25 R:25 `⁆ `:0 L':0 := lie_hom R L L'

namespace lie_hom

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_ring L₃]
variables [lie_algebra R L₁] [lie_algebra R L₂] [lie_algebra R L₃]

instance : has_coe (L₁ →ₗ⁅R⁆ L₂) (L₁ →ₗ[R] L₂) := ⟨lie_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ →ₗ⁅R⁆ L₂) := ⟨_, lie_hom.to_fun⟩

initialize_simps_projections lie_hom (to_fun → apply)

@[simp, norm_cast] lemma coe_to_linear_map (f : L₁ →ₗ⁅R⁆ L₂) : ((f : L₁ →ₗ[R] L₂) : L₁ → L₂) = f :=
rfl

@[simp] lemma map_smul (f : L₁ →ₗ⁅R⁆ L₂) (c : R) (x : L₁) : f (c • x) = c • f x :=
linear_map.map_smul (f : L₁ →ₗ[R] L₂) c x

@[simp] lemma map_add (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_sub (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_neg (f : L₁ →ₗ⁅R⁆ L₂) (x : L₁) : f (-x) = -(f x) :=
linear_map.map_neg (f : L₁ →ₗ[R] L₂) x

@[simp] lemma map_lie (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f ⁅x, y⁆ = ⁅f x, f y⁆ := lie_hom.map_lie' f

@[simp] lemma map_zero (f : L₁ →ₗ⁅R⁆ L₂) : f 0 = 0 := (f : L₁ →ₗ[R] L₂).map_zero

/-- The constant 0 map is a Lie algebra morphism. -/
instance : has_zero (L₁ →ₗ⁅R⁆ L₂) := ⟨{ map_lie' := by simp, ..(0 : L₁ →ₗ[R] L₂)}⟩

@[norm_cast, simp] lemma coe_zero : ((0 : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = 0 := rfl

lemma zero_apply (x : L₁) : (0 : L₁ →ₗ⁅R⁆ L₂) x = 0 := rfl

/-- The identity map is a Lie algebra morphism. -/
instance : has_one (L₁ →ₗ⁅R⁆ L₁) := ⟨{ map_lie' := by simp, ..(1 : L₁ →ₗ[R] L₁)}⟩

instance : inhabited (L₁ →ₗ⁅R⁆ L₂) := ⟨0⟩

lemma coe_injective : function.injective (λ f : L₁ →ₗ⁅R⁆ L₂, show L₁ → L₂, from f) :=
by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr

@[ext] lemma ext {f g : L₁ →ₗ⁅R⁆ L₂} (h : ∀ x, f x = g x) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : L₁ →ₗ⁅R⁆ L₂} : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

@[simp] lemma mk_coe (f : L₁ →ₗ⁅R⁆ L₂) (h₁ h₂ h₃) :
  (⟨f, h₁, h₂, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : L₁ → L₂) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = f := rfl

@[norm_cast, simp] lemma coe_linear_mk (f : L₁ →ₗ[R] L₂) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) : L₁ →ₗ[R] L₂) = ⟨f, h₁, h₂⟩ :=
by { ext, refl, }

/-- The composition of morphisms is a morphism. -/
def comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) : L₁ →ₗ⁅R⁆ L₃ :=
{ map_lie' := λ x y, by { change f (g ⁅x, y⁆) = ⁅f (g x), f (g y)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) (x : L₁) :
  f.comp g x = f (g x) := rfl

@[norm_cast, simp]
lemma coe_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ → L₃) = f ∘ g :=
rfl

@[norm_cast, simp]
lemma coe_linear_map_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ →ₗ[R] L₃) = (f : L₂ →ₗ[R] L₃).comp (g : L₁ →ₗ[R] L₂) :=
rfl

/-- The inverse of a bijective morphism is a morphism. -/
def inverse (f : L₁ →ₗ⁅R⁆ L₂) (g : L₂ → L₁)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : L₂ →ₗ⁅R⁆ L₁ :=
{ map_lie' := λ x y,
  calc g ⁅x, y⁆ = g ⁅f (g x), f (g y)⁆ : by { conv_lhs { rw [←h₂ x, ←h₂ y], }, }
            ... = g (f ⁅g x, g y⁆) : by rw map_lie
            ... = ⁅g x, g y⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

end lie_hom

/-- An equivalence of Lie algebras is a morphism which is also a linear equivalence. We could
instead define an equivalence to be a morphism which is also a (plain) equivalence. However it is
more convenient to define via linear equivalence to get `.to_linear_equiv` for free. -/
structure lie_equiv (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ⁅R⁆ L', L ≃ₗ[R] L'

attribute [nolint doc_blame] lie_equiv.to_lie_hom
attribute [nolint doc_blame] lie_equiv.to_linear_equiv

notation L ` ≃ₗ⁅`:50 R `⁆ ` L' := lie_equiv R L L'

namespace lie_equiv

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_ring L₃]
variables [lie_algebra R L₁] [lie_algebra R L₂] [lie_algebra R L₃]

instance has_coe_to_lie_hom : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ →ₗ⁅R⁆ L₂) := ⟨to_lie_hom⟩
instance has_coe_to_linear_equiv : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ ≃ₗ[R] L₂) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ ≃ₗ⁅R⁆ L₂) := ⟨_, to_fun⟩

@[simp, norm_cast] lemma coe_to_lie_equiv (e : L₁ ≃ₗ⁅R⁆ L₂) : ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = e :=
  rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : L₁ ≃ₗ⁅R⁆ L₂) :
  ((e : L₁ ≃ₗ[R] L₂) : L₁ → L₂) = e := rfl

instance : has_one (L₁ ≃ₗ⁅R⁆ L₁) :=
⟨{ map_lie' := λ x y,
    by { change ((1 : L₁→ₗ[R] L₁) ⁅x, y⁆) = ⁅(1 : L₁→ₗ[R] L₁) x, (1 : L₁→ₗ[R] L₁) y⁆, simp, },
  ..(1 : L₁ ≃ₗ[R] L₁)}⟩

@[simp] lemma one_apply (x : L₁) : (1 : (L₁ ≃ₗ⁅R⁆ L₁)) x = x := rfl

instance : inhabited (L₁ ≃ₗ⁅R⁆ L₁) := ⟨1⟩

/-- Lie algebra equivalences are reflexive. -/
@[refl]
def refl : L₁ ≃ₗ⁅R⁆ L₁ := 1

@[simp] lemma refl_apply (x : L₁) : (refl : L₁ ≃ₗ⁅R⁆ L₁) x = x := rfl

/-- Lie algebra equivalences are symmetric. -/
@[symm]
def symm (e : L₁ ≃ₗ⁅R⁆ L₂) : L₂ ≃ₗ⁅R⁆ L₁ :=
{ ..lie_hom.inverse e.to_lie_hom e.inv_fun e.left_inv e.right_inv,
  ..e.to_linear_equiv.symm }

@[simp] lemma symm_symm (e : L₁ ≃ₗ⁅R⁆ L₂) : e.symm.symm = e :=
by { cases e, refl, }

@[simp] lemma apply_symm_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

/-- Lie algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) : L₁ ≃ₗ⁅R⁆ L₃ :=
{ ..lie_hom.comp e₂.to_lie_hom e₁.to_lie_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma trans_apply (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) (x : L₁) :
  (e₁.trans e₂) x = e₂ (e₁ x) := rfl

@[simp] lemma symm_trans_apply (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) (x : L₃) :
  (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl

lemma bijective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.bijective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.bijective

lemma injective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.injective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.injective

lemma surjective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.surjective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.surjective

end lie_equiv

section lie_module_morphisms

variables (R : Type u) (L : Type v) (M : Type w) (N : Type w₁) (P : Type w₂)
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [add_comm_group N] [add_comm_group P]
variables [module R M] [module R N] [module R P]
variables [lie_ring_module L M] [lie_ring_module L N] [lie_ring_module L P]
variables [lie_module R L M] [lie_module R L N] [lie_module R L P]

set_option old_structure_cmd true

/-- A morphism of Lie algebra modules is a linear map which commutes with the action of the Lie
algebra. -/
structure lie_module_hom extends M →ₗ[R] N :=
(map_lie' : ∀ {x : L} {m : M}, to_fun ⁅x, m⁆ = ⁅x, to_fun m⁆)

attribute [nolint doc_blame] lie_module_hom.to_linear_map

notation M ` →ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_hom R L M N

namespace lie_module_hom

variables {R L M N P}

instance : has_coe (M →ₗ⁅R,L⁆ N) (M →ₗ[R] N) := ⟨lie_module_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M →ₗ⁅R,L⁆ N) := ⟨_, lie_module_hom.to_fun⟩

@[simp, norm_cast] lemma coe_to_linear_map (f : M →ₗ⁅R,L⁆ N) : ((f : M →ₗ[R] N) : M → N) = f :=
rfl

@[simp] lemma map_smul (f : M →ₗ⁅R,L⁆ N) (c : R) (x : M) : f (c • x) = c • f x :=
linear_map.map_smul (f : M →ₗ[R] N) c x

@[simp] lemma map_add (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : M →ₗ[R] N) x y

@[simp] lemma map_sub (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : M →ₗ[R] N) x y

@[simp] lemma map_neg (f : M →ₗ⁅R,L⁆ N) (x : M) : f (-x) = -(f x) :=
linear_map.map_neg (f : M →ₗ[R] N) x

@[simp] lemma map_lie (f : M →ₗ⁅R,L⁆ N) (x : L) (m : M) : f ⁅x, m⁆ = ⁅x, f m⁆ :=
lie_module_hom.map_lie' f

lemma map_lie₂ (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) (x : L) (m : M) (n : N) :
  ⁅x, f m n⁆ = f ⁅x, m⁆ n + f m ⁅x, n⁆ :=
by simp only [sub_add_cancel, map_lie, lie_hom.lie_apply]

@[simp] lemma map_zero (f : M →ₗ⁅R,L⁆ N) : f 0 = 0 :=
linear_map.map_zero (f : M →ₗ[R] N)

/-- The constant 0 map is a Lie module morphism. -/
instance : has_zero (M →ₗ⁅R,L⁆ N) := ⟨{ map_lie' := by simp, ..(0 : M →ₗ[R] N) }⟩

@[norm_cast, simp] lemma coe_zero : ((0 : M →ₗ⁅R,L⁆ N) : M → N) = 0 := rfl

lemma zero_apply (m : M) : (0 : M →ₗ⁅R,L⁆ N) m = 0 := rfl

/-- The identity map is a Lie module morphism. -/
instance : has_one (M →ₗ⁅R,L⁆ M) := ⟨{ map_lie' := by simp, ..(1 : M →ₗ[R] M) }⟩

instance : inhabited (M →ₗ⁅R,L⁆ N) := ⟨0⟩

lemma coe_injective : function.injective (λ f : M →ₗ⁅R,L⁆ N, show M → N, from f) :=
by { rintros ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩, congr, }

@[ext] lemma ext {f g : M →ₗ⁅R,L⁆ N} (h : ∀ m, f m = g m) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : M →ₗ⁅R,L⁆ N} : f = g ↔ ∀ m, f m = g m :=
⟨by { rintro rfl m, refl, }, ext⟩

@[simp] lemma mk_coe (f : M →ₗ⁅R,L⁆ N) (h₁ h₂ h₃) :
  (⟨f, h₁, h₂, h₃⟩ : M →ₗ⁅R,L⁆ N) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : M → N) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : M →ₗ⁅R,L⁆ N) : M → N) = f := rfl

@[norm_cast, simp] lemma coe_linear_mk (f : M →ₗ[R] N) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : M →ₗ⁅R,L⁆ N) : M →ₗ[R] N) = ⟨f, h₁, h₂⟩ :=
by { ext, refl, }

/-- The composition of Lie module morphisms is a morphism. -/
def comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) : M →ₗ⁅R,L⁆ P :=
{ map_lie' := λ x m, by { change f (g ⁅x, m⁆) = ⁅x, f (g m)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) (m : M) :
  f.comp g m = f (g m) := rfl

@[norm_cast, simp] lemma coe_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M → P) = f ∘ g :=
rfl

@[norm_cast, simp] lemma coe_linear_map_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M →ₗ[R] P) = (f : N →ₗ[R] P).comp (g : M →ₗ[R] N) :=
rfl

/-- The inverse of a bijective morphism of Lie modules is a morphism of Lie modules. -/
def inverse (f : M →ₗ⁅R,L⁆ N) (g : N → M)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : N →ₗ⁅R,L⁆ M :=
{ map_lie' := λ x n,
    calc g ⁅x, n⁆ = g ⁅x, f (g n)⁆ : by rw h₂
              ... = g (f ⁅x, g n⁆) : by rw map_lie
              ... = ⁅x, g n⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

instance : has_add (M →ₗ⁅R,L⁆ N) :=
{ add := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) + (g : M →ₗ[R] N)) }, }

instance : has_sub (M →ₗ⁅R,L⁆ N) :=
{ sub := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) - (g : M →ₗ[R] N)) }, }

instance : has_neg (M →ₗ⁅R,L⁆ N) :=
{ neg := λ f, { map_lie' := by simp, ..(-(f : (M →ₗ[R] N))) }, }

@[norm_cast, simp] lemma coe_add (f g : M →ₗ⁅R,L⁆ N) : ⇑(f + g) = f + g := rfl

lemma add_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f + g) m = f m + g m := rfl

@[norm_cast, simp] lemma coe_sub (f g : M →ₗ⁅R,L⁆ N) : ⇑(f - g) = f - g := rfl

lemma sub_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f - g) m = f m - g m := rfl

@[norm_cast, simp] lemma coe_neg (f : M →ₗ⁅R,L⁆ N) : ⇑(-f) = -f := rfl

lemma neg_apply (f : M →ₗ⁅R,L⁆ N) (m : M) : (-f) m = -(f m) := rfl

instance : add_comm_group (M →ₗ⁅R,L⁆ N) :=
{ zero           := 0,
  add            := (+),
  neg            := has_neg.neg,
  sub            := has_sub.sub,
  nsmul          := λ n f, { map_lie' := λ x m, by simp, ..(n • (f : M →ₗ[R] N)) },
  nsmul_zero'    := λ f, by { ext, simp, },
  nsmul_succ'    := λ n f, by { ext, simp [nat.succ_eq_one_add, add_nsmul], },
  ..(coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub :
    add_comm_group (M →ₗ⁅R,L⁆ N)) }

instance : has_scalar R (M →ₗ⁅R,L⁆ N) :=
{ smul := λ t f, { map_lie' := by simp, ..(t • (f : M →ₗ[R] N)) }, }

@[norm_cast, simp] lemma coe_smul (t : R) (f : M →ₗ⁅R,L⁆ N) : ⇑(t • f) = t • f := rfl

lemma smul_apply (t : R) (f : M →ₗ⁅R,L⁆ N) (m : M) : (t • f) m = t • (f m) := rfl

instance : module R (M →ₗ⁅R,L⁆ N) :=
function.injective.module R ⟨to_fun, rfl, coe_add⟩ coe_injective coe_smul

end lie_module_hom

/-- An equivalence of Lie algebra modules is a linear equivalence which is also a morphism of
Lie algebra modules. -/
structure lie_module_equiv extends M ≃ₗ[R] N, M →ₗ⁅R,L⁆ N, M ≃ N

attribute [nolint doc_blame] lie_module_equiv.to_equiv
attribute [nolint doc_blame] lie_module_equiv.to_lie_module_hom
attribute [nolint doc_blame] lie_module_equiv.to_linear_equiv

notation M ` ≃ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_equiv R L M N

namespace lie_module_equiv

variables {R L M N P}

instance has_coe_to_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ N) := ⟨to_equiv⟩
instance has_coe_to_lie_module_hom : has_coe (M ≃ₗ⁅R,L⁆ N) (M →ₗ⁅R,L⁆ N) := ⟨to_lie_module_hom⟩
instance has_coe_to_linear_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ₗ[R] N) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M ≃ₗ⁅R,L⁆ N) := ⟨_, to_fun⟩

@[simp] lemma coe_mk (f : M → N) (h₁ h₂ F h₃ h₄ h₅) :
  ((⟨f, h₁, h₂, F, h₃, h₄, h₅⟩ : M ≃ₗ⁅R,L⁆ N) : M → N) = f := rfl

@[simp, norm_cast] lemma coe_to_lie_module_hom (e : M ≃ₗ⁅R,L⁆ N) :
  ((e : M →ₗ⁅R,L⁆ N) : M → N) = e := rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : M ≃ₗ⁅R,L⁆ N) : ((e : M ≃ₗ[R] N) : M → N) = e :=
rfl

lemma to_equiv_injective : function.injective (to_equiv : (M ≃ₗ⁅R,L⁆ N) → M ≃ N) :=
λ ⟨_, _, _, _, _, _, _⟩ ⟨_, _, _, _, _, _, _⟩ h, lie_module_equiv.mk.inj_eq.mpr (equiv.mk.inj h)

@[ext] lemma ext (e₁ e₂ : M ≃ₗ⁅R,L⁆ N) (h : ∀ m, e₁ m = e₂ m) : e₁ = e₂ :=
to_equiv_injective (equiv.ext h)

instance : has_one (M ≃ₗ⁅R,L⁆ M) := ⟨{ map_lie' := λ x m, rfl, ..(1 : M ≃ₗ[R] M) }⟩

@[simp] lemma one_apply (m : M) : (1 : (M ≃ₗ⁅R,L⁆ M)) m = m := rfl

instance : inhabited (M ≃ₗ⁅R,L⁆ M) := ⟨1⟩

/-- Lie module equivalences are reflexive. -/
@[refl] def refl : M ≃ₗ⁅R,L⁆ M := 1

@[simp] lemma refl_apply (m : M) : (refl : M ≃ₗ⁅R,L⁆ M) m = m := rfl

/-- Lie module equivalences are syemmtric. -/
@[symm] def symm (e : M ≃ₗ⁅R,L⁆ N) : N ≃ₗ⁅R,L⁆ M :=
{ ..lie_module_hom.inverse e.to_lie_module_hom e.inv_fun e.left_inv e.right_inv,
  ..(e : M ≃ₗ[R] N).symm }

@[simp] lemma symm_symm (e : M ≃ₗ⁅R,L⁆ N) : e.symm.symm = e :=
by { cases e, refl, }

@[simp] lemma apply_symm_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

/-- Lie module equivalences are transitive. -/
@[trans] def trans (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) : M ≃ₗ⁅R,L⁆ P :=
{ ..lie_module_hom.comp e₂.to_lie_module_hom e₁.to_lie_module_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma trans_apply (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) (m : M) :
  (e₁.trans e₂) m = e₂ (e₁ m) := rfl

@[simp] lemma symm_trans_apply (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) (p : P) :
  (e₁.trans e₂).symm p = e₁.symm (e₂.symm p) := rfl

end lie_module_equiv

end lie_module_morphisms


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.group_action.group
import group_theory.group_action.pi

/-!
# Group actions on embeddings

This file provides a `mul_action G (α ↪ β)` instance that agrees with the `mul_action G (α → β)`
instances defined by `pi.mul_action`.

Note that unlike the `pi` instance, this requires `G` to be a group.
-/

universes u v w
variables {G G' α β : Type*}

namespace function.embedding

@[to_additive function.embedding.has_vadd]
instance [group G] [mul_action G β] : has_scalar G (α ↪ β) :=
⟨λ g f, f.trans (mul_action.to_perm g).to_embedding⟩

@[to_additive]
lemma smul_def [group G] [mul_action G β] (g : G) (f : α ↪ β) :
  g • f = f.trans (mul_action.to_perm g).to_embedding := rfl
@[simp, to_additive]
lemma smul_apply [group G] [mul_action G β] (g : G) (f : α ↪ β) (a : α) : (g • f) a = g • f a :=
rfl
@[to_additive]
lemma coe_smul [group G] [mul_action G β] (g : G) (f : α ↪ β) : ⇑(g • f) = g • f := rfl

instance [group G] [group G'] [has_scalar G G'] [mul_action G β] [mul_action G' β]
  [is_scalar_tower G G' β] : is_scalar_tower G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_assoc x y (z i)⟩

@[to_additive]
instance [group G] [group G'] [mul_action G β] [mul_action G' β] [smul_comm_class G G' β] :
  smul_comm_class G G' (α ↪ β) :=
⟨λ x y z, function.embedding.ext $ λ i, smul_comm x y (z i)⟩

instance [group G] [mul_action G β] [mul_action Gᵐᵒᵖ β] [is_central_scalar G β] :
  is_central_scalar G (α ↪ β) :=
⟨λ r m, function.embedding.ext $ λ i, op_smul_eq_smul _ _⟩

@[to_additive]
instance [group G] [mul_action G β] : mul_action G (α ↪ β) :=
fun_like.coe_injective.mul_action _ coe_smul

end function.embedding


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

! This file was ported from Lean 3 source module topology.sheaves.forget
! leanprover-community/mathlib commit 85d6221d32c37e68f05b2e42cde6cee658dae5e9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.Products
import Mathbin.Topology.Sheaves.SheafCondition.EqualizerProducts

/-!
# Checking the sheaf condition on the underlying presheaf of types.

If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices
to check it on the underlying sheaf of types.

## References
* https://stacks.math.columbia.edu/tag/0073
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

open TopologicalSpace

open Opposite

namespace TopCat

namespace Presheaf

namespace SheafCondition

open SheafConditionEqualizerProducts

universe v u₁ u₂

variable {C : Type u₁} [Category.{v} C] [HasLimits C]

variable {D : Type u₂} [Category.{v} D] [HasLimits D]

variable (G : C ⥤ D) [PreservesLimits G]

variable {X : TopCat.{v}} (F : Presheaf C X)

variable {ι : Type v} (U : ι → Opens X)

attribute [local reducible] diagram left_res right_res

/-- When `G` preserves limits, the sheaf condition diagram for `F` composed with `G` is
naturally isomorphic to the sheaf condition diagram for `F ⋙ G`.
-/
def diagramCompPreservesLimits : diagram F U ⋙ G ≅ diagram.{v} (F ⋙ G) U :=
  by
  fapply nat_iso.of_components
  rintro ⟨j⟩
  exact preserves_product.iso _ _
  exact preserves_product.iso _ _
  rintro ⟨⟩ ⟨⟩ ⟨⟩
  · ext
    simp
    dsimp
    simp
  -- non-terminal `simp`, but `squeeze_simp` fails
  · ext
    simp only [limit.lift_π, functor.comp_map, map_lift_pi_comparison, fan.mk_π_app,
      preserves_product.iso_hom, parallel_pair_map_left, functor.map_comp, category.assoc]
    dsimp
    simp
  · ext
    simp only [limit.lift_π, functor.comp_map, parallel_pair_map_right, fan.mk_π_app,
      preserves_product.iso_hom, map_lift_pi_comparison, functor.map_comp, category.assoc]
    dsimp
    simp
  · ext
    simp
    dsimp
    simp
#align Top.presheaf.sheaf_condition.diagram_comp_preserves_limits TopCat.Presheaf.SheafCondition.diagramCompPreservesLimits

attribute [local reducible] res

/-- When `G` preserves limits, the image under `G` of the sheaf condition fork for `F`
is the sheaf condition fork for `F ⋙ G`,
postcomposed with the inverse of the natural isomorphism `diagram_comp_preserves_limits`.
-/
def mapConeFork :
    G.mapCone (fork.{v} F U) ≅
      (Cones.postcompose (diagramCompPreservesLimits G F U).inv).obj (fork (F ⋙ G) U) :=
  Cones.ext (Iso.refl _) fun j => by
    dsimp; simp [diagram_comp_preserves_limits]; cases j <;> dsimp
    · rw [iso.eq_comp_inv]
      ext
      simp
      dsimp
      simp
    · rw [iso.eq_comp_inv]
      ext
      simp
      -- non-terminal `simp`, but `squeeze_simp` fails
      dsimp
      simp only [limit.lift_π, fan.mk_π_app, ← G.map_comp, limit.lift_π_assoc, fan.mk_π_app]
#align Top.presheaf.sheaf_condition.map_cone_fork TopCat.Presheaf.SheafCondition.mapConeFork

end SheafCondition

universe v u₁ u₂

open SheafCondition SheafConditionEqualizerProducts

variable {C : Type u₁} [Category.{v} C] {D : Type u₂} [Category.{v} D]

variable (G : C ⥤ D)

variable [ReflectsIsomorphisms G]

variable [HasLimits C] [HasLimits D] [PreservesLimits G]

variable {X : TopCat.{v}} (F : Presheaf C X)

/-- If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices to check it on the underlying sheaf of types.

Another useful example is the forgetful functor `TopCommRing ⥤ Top`.

See <https://stacks.math.columbia.edu/tag/0073>.
In fact we prove a stronger version with arbitrary complete target category.
-/
theorem isSheaf_iff_isSheaf_comp : Presheaf.IsSheaf F ↔ Presheaf.IsSheaf (F ⋙ G) :=
  by
  rw [presheaf.is_sheaf_iff_is_sheaf_equalizer_products,
    presheaf.is_sheaf_iff_is_sheaf_equalizer_products]
  constructor
  · intro S ι U
    -- We have that the sheaf condition fork for `F` is a limit fork,
    obtain ⟨t₁⟩ := S U
    -- and since `G` preserves limits, the image under `G` of this fork is a limit fork too.
    letI := preserves_smallest_limits_of_preserves_limits G
    have t₂ := @preserves_limit.preserves _ _ _ _ _ _ _ G _ _ t₁
    -- As we established above, that image is just the sheaf condition fork
    -- for `F ⋙ G` postcomposed with some natural isomorphism,
    have t₃ := is_limit.of_iso_limit t₂ (map_cone_fork G F U)
    -- and as postcomposing by a natural isomorphism preserves limit cones,
    have t₄ := is_limit.postcompose_inv_equiv _ _ t₃
    -- we have our desired conclusion.
    exact ⟨t₄⟩
  · intro S ι U
    refine' ⟨_⟩
    -- Let `f` be the universal morphism from `F.obj U` to the equalizer
    -- of the sheaf condition fork, whatever it is.
    -- Our goal is to show that this is an isomorphism.
    let f := equalizer.lift _ (w F U)
    -- If we can do that,
    suffices is_iso (G.map f) by
      skip
      -- we have that `f` itself is an isomorphism, since `G` reflects isomorphisms
      haveI : is_iso f := is_iso_of_reflects_iso f G
      -- TODO package this up as a result elsewhere:
      apply is_limit.of_iso_limit (limit.is_limit _)
      apply iso.symm
      fapply cones.ext
      exact as_iso f
      rintro ⟨_ | _⟩ <;>
        · dsimp [f]
          simp
    · -- Returning to the task of shwoing that `G.map f` is an isomorphism,
      -- we note that `G.map f` is almost but not quite (see below) a morphism
      -- from the sheaf condition cone for `F ⋙ G` to the
      -- image under `G` of the equalizer cone for the sheaf condition diagram.
      let c := fork (F ⋙ G) U
      obtain ⟨hc⟩ := S U
      let d := G.map_cone (equalizer.fork (leftRes.{v} F U) (right_res F U))
      letI := preserves_smallest_limits_of_preserves_limits G
      have hd : is_limit d := preserves_limit.preserves (limit.is_limit _)
      -- Since both of these are limit cones
      -- (`c` by our hypothesis `S`, and `d` because `G` preserves limits),
      -- we hope to be able to conclude that `f` is an isomorphism.
      -- We say "not quite" above because `c` and `d` don't quite have the same shape:
      -- we need to postcompose by the natural isomorphism `diagram_comp_preserves_limits`
      -- introduced above.
      let d' := (cones.postcompose (diagram_comp_preserves_limits G F U).Hom).obj d
      have hd' : is_limit d' :=
        (is_limit.postcompose_hom_equiv (diagram_comp_preserves_limits G F U : _) d).symm hd
      -- Now everything works: we verify that `f` really is a morphism between these cones:
      let f' : c ⟶ d' :=
        fork.mk_hom (G.map f)
          (by
            dsimp only [c, d, d', f, diagram_comp_preserves_limits, res]
            dsimp only [fork.ι]
            ext1 j
            dsimp
            simp only [category.assoc, ← functor.map_comp_assoc, equalizer.lift_ι,
              map_lift_pi_comparison_assoc]
            dsimp [res]; simp)
      -- conclude that it is an isomorphism,
      -- just because it's a morphism between two limit cones.
      haveI : is_iso f' := is_limit.hom_is_iso hc hd' f'
      -- A cone morphism is an isomorphism exactly if the morphism between the cone points is,
      -- so we're done!
      exact is_iso.of_iso ((cones.forget _).mapIso (as_iso f'))
#align Top.presheaf.is_sheaf_iff_is_sheaf_comp TopCat.Presheaf.isSheaf_iff_isSheaf_comp

/-!
As an example, we now have everything we need to check the sheaf condition
for a presheaf of commutative rings, merely by checking the sheaf condition
for the underlying sheaf of types.
```
import algebra.category.Ring.limits
example (X : Top) (F : presheaf CommRing X) (h : presheaf.is_sheaf (F ⋙ (forget CommRing))) :
  F.is_sheaf :=
(is_sheaf_iff_is_sheaf_comp (forget CommRing) F).mpr h
```
-/

end Presheaf

end TopCat


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import topology.separation
import topology.bases

/-!
# Dense embeddings

This file defines three properties of functions:

* `dense_range f`      means `f` has dense image;
* `dense_inducing i`   means `i` is also `inducing`;
* `dense_embedding e`  means `e` is also an `embedding`.

The main theorem `continuous_extend` gives a criterion for a function
`f : X → Z` to a regular (T₃) space Z to extend along a dense embedding
`i : X → Y` to a continuous function `g : Y → Z`. Actually `i` only
has to be `dense_inducing` (not necessarily injective).

-/

noncomputable theory

open set filter
open_locale classical topological_space filter

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- `i : α → β` is "dense inducing" if it has dense range and the topology on `α`
  is the one induced by `i` from the topology on `β`. -/
@[protect_proj] structure dense_inducing [topological_space α] [topological_space β] (i : α → β)
  extends inducing i : Prop :=
(dense : dense_range i)

namespace dense_inducing
variables [topological_space α] [topological_space β]
variables {i : α → β} (di : dense_inducing i)

lemma nhds_eq_comap (di : dense_inducing i) :
  ∀ a : α, 𝓝 a = comap i (𝓝 $ i a) :=
di.to_inducing.nhds_eq_comap

protected lemma continuous (di : dense_inducing i) : continuous i :=
di.to_inducing.continuous

lemma closure_range : closure (range i) = univ :=
di.dense.closure_range

lemma preconnected_space [preconnected_space α] (di : dense_inducing i) : preconnected_space β :=
di.dense.preconnected_space di.continuous

lemma closure_image_mem_nhds {s : set α} {a : α} (di : dense_inducing i) (hs : s ∈ 𝓝 a) :
  closure (i '' s) ∈ 𝓝 (i a) :=
begin
  rw [di.nhds_eq_comap a, ((nhds_basis_opens _).comap _).mem_iff] at hs,
  rcases hs with ⟨U, ⟨haU, hUo⟩, sub : i ⁻¹' U ⊆ s⟩,
  refine mem_of_superset (hUo.mem_nhds haU) _,
  calc U ⊆ closure (i '' (i ⁻¹' U)) : di.dense.subset_closure_image_preimage_of_is_open hUo
     ... ⊆ closure (i '' s)         : closure_mono (image_subset i sub)
end

lemma dense_image (di : dense_inducing i) {s : set α} : dense (i '' s) ↔ dense s :=
begin
  refine ⟨λ H x, _, di.dense.dense_image di.continuous⟩,
  rw [di.to_inducing.closure_eq_preimage_closure_image, H.closure_eq, preimage_univ],
  trivial
end

/-- The product of two dense inducings is a dense inducing -/
protected lemma prod [topological_space γ] [topological_space δ]
  {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_inducing e₁) (de₂ : dense_inducing e₂) :
  dense_inducing (λ(p : α × γ), (e₁ p.1, e₂ p.2)) :=
{ induced := (de₁.to_inducing.prod_mk de₂.to_inducing).induced,
  dense := de₁.dense.prod_map de₂.dense }

open topological_space

/-- If the domain of a `dense_inducing` map is a separable space, then so is the codomain. -/
protected lemma separable_space [separable_space α] : separable_space β :=
di.dense.separable_space di.continuous

variables [topological_space δ] {f : γ → α} {g : γ → δ} {h : δ → β}
/--
 γ -f→ α
g↓     ↓e
 δ -h→ β
-/
lemma tendsto_comap_nhds_nhds  {d : δ} {a : α} (di : dense_inducing i)
  (H : tendsto h (𝓝 d) (𝓝 (i a))) (comm : h ∘ g = i ∘ f) : tendsto f (comap g (𝓝 d)) (𝓝 a) :=
begin
  have lim1 : map g (comap g (𝓝 d)) ≤ 𝓝 d := map_comap_le,
  replace lim1 : map h (map g (comap g (𝓝 d))) ≤ map h (𝓝 d) := map_mono lim1,
  rw [filter.map_map, comm, ← filter.map_map, map_le_iff_le_comap] at lim1,
  have lim2 :  comap i (map h (𝓝 d)) ≤  comap i  (𝓝 (i a)) := comap_mono H,
  rw ← di.nhds_eq_comap at lim2,
  exact le_trans lim1 lim2,
end

protected lemma nhds_within_ne_bot (di : dense_inducing i) (b : β) :
  ne_bot (𝓝[range i] b) :=
di.dense.nhds_within_ne_bot b

lemma comap_nhds_ne_bot (di : dense_inducing i) (b : β) : ne_bot (comap i (𝓝 b)) :=
comap_ne_bot $ λ s hs,
let ⟨_, ⟨ha, a, rfl⟩⟩ := mem_closure_iff_nhds.1 (di.dense b) s hs in ⟨a, ha⟩

variables [topological_space γ]

/-- If `i : α → β` is a dense inducing, then any function `f : α → γ` "extends"
  to a function `g = extend di f : β → γ`. If `γ` is Hausdorff and `f` has a
  continuous extension, then `g` is the unique such extension. In general,
  `g` might not be continuous or even extend `f`. -/
def extend (di : dense_inducing i) (f : α → γ) (b : β) : γ :=
@@lim _ ⟨f (di.dense.some b)⟩ (comap i (𝓝 b)) f

lemma extend_eq_of_tendsto [t2_space γ] {b : β} {c : γ} {f : α → γ}
  (hf : tendsto f (comap i (𝓝 b)) (𝓝 c)) :
  di.extend f b = c :=
by haveI := di.comap_nhds_ne_bot; exact hf.lim_eq

lemma extend_eq_at [t2_space γ] {f : α → γ} {a : α} (hf : continuous_at f a) :
  di.extend f (i a) = f a :=
extend_eq_of_tendsto _ $ di.nhds_eq_comap a ▸ hf

lemma extend_eq_at' [t2_space γ] {f : α → γ} {a : α} (c : γ) (hf : tendsto f (𝓝 a) (𝓝 c)) :
  di.extend f (i a) = f a :=
di.extend_eq_at (continuous_at_of_tendsto_nhds hf)

lemma extend_eq [t2_space γ] {f : α → γ} (hf : continuous f) (a : α) :
  di.extend f (i a) = f a :=
di.extend_eq_at hf.continuous_at

/-- Variation of `extend_eq` where we ask that `f` has a limit along `comap i (𝓝 b)` for each
`b : β`. This is a strictly stronger assumption than continuity of `f`, but in a lot of cases
you'd have to prove it anyway to use `continuous_extend`, so this avoids doing the work twice. -/
lemma extend_eq' [t2_space γ] {f : α → γ}
  (di : dense_inducing i) (hf : ∀ b, ∃ c, tendsto f (comap i (𝓝 b)) (𝓝 c)) (a : α) :
  di.extend f (i a) = f a :=
begin
  rcases hf (i a) with ⟨b, hb⟩,
  refine di.extend_eq_at' b _,
  rwa ← di.to_inducing.nhds_eq_comap at hb,
end

lemma extend_unique_at [t2_space γ] {b : β} {f : α → γ} {g : β → γ} (di : dense_inducing i)
  (hf : ∀ᶠ x in comap i (𝓝 b), g (i x) = f x) (hg : continuous_at g b) :
  di.extend f b = g b :=
begin
  refine di.extend_eq_of_tendsto (λ s hs, mem_map.2 _),
  suffices : ∀ᶠ (x : α) in comap i (𝓝 b), g (i x) ∈ s,
    from hf.mp (this.mono $ λ x hgx hfx, hfx ▸ hgx),
  clear hf f,
  refine eventually_comap.2 ((hg.eventually hs).mono _),
  rintros _ hxs x rfl,
  exact hxs
end

lemma extend_unique [t2_space γ] {f : α → γ} {g : β → γ} (di : dense_inducing i)
  (hf : ∀ x, g (i x) = f x) (hg : continuous g) :
  di.extend f = g :=
funext $ λ b, extend_unique_at di (eventually_of_forall hf) hg.continuous_at

lemma continuous_at_extend [regular_space γ] {b : β} {f : α → γ} (di : dense_inducing i)
  (hf : ∀ᶠ x in 𝓝 b, ∃c, tendsto f (comap i $ 𝓝 x) (𝓝 c)) :
  continuous_at (di.extend f) b :=
begin
  set φ := di.extend f,
  haveI := di.comap_nhds_ne_bot,
  suffices : ∀ V' ∈ 𝓝 (φ b), is_closed V' → φ ⁻¹' V' ∈ 𝓝 b,
    by simpa [continuous_at, (closed_nhds_basis _).tendsto_right_iff],
  intros V' V'_in V'_closed,
  set V₁ := {x | tendsto f (comap i $ 𝓝 x) (𝓝 $ φ x)},
  have V₁_in : V₁ ∈ 𝓝 b,
  { filter_upwards [hf],
    rintros x ⟨c, hc⟩,
    dsimp [V₁, φ],
    rwa di.extend_eq_of_tendsto hc },
  obtain ⟨V₂, V₂_in, V₂_op, hV₂⟩ : ∃ V₂ ∈ 𝓝 b, is_open V₂ ∧ ∀ x ∈ i ⁻¹' V₂, f x ∈ V',
  { simpa [and_assoc] using ((nhds_basis_opens' b).comap i).tendsto_left_iff.mp
                            (mem_of_mem_nhds V₁_in : b ∈ V₁) V' V'_in },
  suffices : ∀ x ∈ V₁ ∩ V₂, φ x ∈ V',
  { filter_upwards [inter_mem V₁_in V₂_in], exact this },
  rintros x ⟨x_in₁, x_in₂⟩,
  have hV₂x : V₂ ∈ 𝓝 x := is_open.mem_nhds V₂_op x_in₂,
  apply V'_closed.mem_of_tendsto x_in₁,
  use V₂,
  tauto,
end

lemma continuous_extend [regular_space γ] {f : α → γ} (di : dense_inducing i)
  (hf : ∀b, ∃c, tendsto f (comap i (𝓝 b)) (𝓝 c)) : continuous (di.extend f) :=
continuous_iff_continuous_at.mpr $ assume b, di.continuous_at_extend $ univ_mem' hf

lemma mk'
  (i : α → β)
  (c     : continuous i)
  (dense : ∀x, x ∈ closure (range i))
  (H     : ∀ (a:α) s ∈ 𝓝 a,
    ∃t ∈ 𝓝 (i a), ∀ b, i b ∈ t → b ∈ s) :
  dense_inducing i :=
{ induced := (induced_iff_nhds_eq i).2 $
    λ a, le_antisymm (tendsto_iff_comap.1 $ c.tendsto _) (by simpa [filter.le_def] using H a),
  dense := dense }
end dense_inducing

/-- A dense embedding is an embedding with dense image. -/
structure dense_embedding [topological_space α] [topological_space β] (e : α → β)
  extends dense_inducing e : Prop :=
(inj : function.injective e)

theorem dense_embedding.mk'
  [topological_space α] [topological_space β] (e : α → β)
  (c     : continuous e)
  (dense : dense_range e)
  (inj   : function.injective e)
  (H     : ∀ (a:α) s ∈ 𝓝 a,
    ∃t ∈ 𝓝 (e a), ∀ b, e b ∈ t → b ∈ s) :
  dense_embedding e :=
{ inj := inj,
  ..dense_inducing.mk' e c dense H}

namespace dense_embedding
open topological_space
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
variables {e : α → β} (de : dense_embedding e)

lemma inj_iff {x y} : e x = e y ↔ x = y := de.inj.eq_iff

lemma to_embedding : embedding e :=
{ induced := de.induced,
  inj := de.inj }

/-- If the domain of a `dense_embedding` is a separable space, then so is its codomain. -/
protected lemma separable_space [separable_space α] : separable_space β :=
de.to_dense_inducing.separable_space

/-- The product of two dense embeddings is a dense embedding. -/
protected lemma prod {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_embedding e₁)
  (de₂ : dense_embedding e₂) :
  dense_embedding (λ(p : α × γ), (e₁ p.1, e₂ p.2)) :=
{ inj := assume ⟨x₁, x₂⟩ ⟨y₁, y₂⟩,
    by simp; exact assume h₁ h₂, ⟨de₁.inj h₁, de₂.inj h₂⟩,
  ..dense_inducing.prod de₁.to_dense_inducing de₂.to_dense_inducing }

/-- The dense embedding of a subtype inside its closure. -/
@[simps] def subtype_emb {α : Type*} (p : α → Prop) (e : α → β) (x : {x // p x}) :
  {x // x ∈ closure (e '' {x | p x})} :=
⟨e x, subset_closure $ mem_image_of_mem e x.prop⟩

protected lemma subtype (p : α → Prop) : dense_embedding (subtype_emb p e) :=
{ dense := dense_iff_closure_eq.2 $
    begin
      ext ⟨x, hx⟩,
      rw image_eq_range at hx,
      simpa [closure_subtype, ← range_comp, (∘)],
    end,
  inj := (de.inj.comp subtype.coe_injective).cod_restrict _,
  induced := (induced_iff_nhds_eq _).2 (assume ⟨x, hx⟩,
    by simp [subtype_emb, nhds_subtype_eq_comap, de.to_inducing.nhds_eq_comap, comap_comap, (∘)]) }

lemma dense_image {s : set α} : dense (e '' s) ↔ dense s :=
de.to_dense_inducing.dense_image

end dense_embedding

lemma dense.dense_embedding_coe [topological_space α] {s : set α} (hs : dense s) :
  dense_embedding (coe : s → α) :=
{ dense := hs.dense_range_coe,
  .. embedding_subtype_coe }

lemma is_closed_property [topological_space β] {e : α → β} {p : β → Prop}
  (he : dense_range e) (hp : is_closed {x | p x}) (h : ∀a, p (e a)) :
  ∀b, p b :=
have univ ⊆ {b | p b},
  from calc univ = closure (range e) : he.closure_range.symm
    ... ⊆ closure {b | p b} : closure_mono $ range_subset_iff.mpr h
    ... = _ : hp.closure_eq,
assume b, this trivial

lemma is_closed_property2 [topological_space β] {e : α → β} {p : β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β | p q.1 q.2}) (h : ∀a₁ a₂, p (e a₁) (e a₂)) :
  ∀b₁ b₂, p b₁ b₂ :=
have ∀q:β×β, p q.1 q.2,
  from is_closed_property (he.prod_map he) hp $ λ _, h _ _,
assume b₁ b₂, this ⟨b₁, b₂⟩

lemma is_closed_property3 [topological_space β] {e : α → β} {p : β → β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β×β | p q.1 q.2.1 q.2.2})
  (h : ∀a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃)) :
  ∀b₁ b₂ b₃, p b₁ b₂ b₃ :=
have ∀q:β×β×β, p q.1 q.2.1 q.2.2,
  from is_closed_property (he.prod_map $ he.prod_map he) hp $ λ _, h _ _ _,
assume b₁ b₂ b₃, this ⟨b₁, b₂, b₃⟩

@[elab_as_eliminator]
lemma dense_range.induction_on [topological_space β] {e : α → β} (he : dense_range e) {p : β → Prop}
  (b₀ : β) (hp : is_closed {b | p b}) (ih : ∀a:α, p $ e a) : p b₀ :=
is_closed_property he hp ih b₀

@[elab_as_eliminator]
lemma dense_range.induction_on₂ [topological_space β] {e : α → β} {p : β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β | p q.1 q.2}) (h : ∀a₁ a₂, p (e a₁) (e a₂))
  (b₁ b₂ : β) : p b₁ b₂ := is_closed_property2 he hp h _ _

@[elab_as_eliminator]
lemma dense_range.induction_on₃ [topological_space β] {e : α → β} {p : β → β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β×β | p q.1 q.2.1 q.2.2})
  (h : ∀a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃))
  (b₁ b₂ b₃ : β) : p b₁ b₂ b₃ := is_closed_property3 he hp h _ _ _

section
variables [topological_space β] [topological_space γ] [t2_space γ]
variables {f : α → β}

/-- Two continuous functions to a t2-space that agree on the dense range of a function are equal. -/
lemma dense_range.equalizer (hfd : dense_range f)
  {g h : β → γ} (hg : continuous g) (hh : continuous h) (H : g ∘ f = h ∘ f) :
  g = h :=
funext $ λ y, hfd.induction_on y (is_closed_eq hg hh) $ congr_fun H
end


import continuous_valuations
import Huber_pair

/-!
# The adic spectrum as a topological space

In this file we define a structure (`rational_open_data`) that will parameterise
a basis for the topology on the adic spectrum of a Huber pair.
-/

open_locale classical
local attribute [instance] set.pointwise_mul_comm_semiring
local attribute [instance] set.smul_set_action

local postfix `⁺` : 66 := λ A : Huber_pair, A.plus

variables {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

-- We reserve the name `Spa` (with upper case `S`) for the bundled adic spectrum (`adic_space.lean`)
/-- The space underlying the adic spectrum of a Huber pair (A,A⁺)
consists of all the equivalence classes of valuations that are continuous
and whose value on the ring A⁺ is ≤ 1. [Wedhorn, Def 7.23]. -/
definition spa (A : Huber_pair) : Type :=
{v : Spv A // v.is_continuous ∧ ∀ r : A⁺, v (algebra_map A r) ≤ 1}

/--The equivalence class of a valuation is contained in spa
if and only if the valuation is continuous and its values on the ring A⁺ are ≤ 1,
since these properties are constant on equivalence classes.-/
lemma mk_mem_spa {A : Huber_pair} {v : valuation A Γ₀} :
  Spv.mk v ∈ {v : Spv A | v.is_continuous ∧ ∀ r : A⁺, v (algebra_map A r) ≤ 1} ↔
  v.is_continuous ∧ ∀ r : A⁺, v (algebra_map A r) ≤ 1 :=
begin
  apply and_congr,
  { exact (Spv.out_mk v).is_continuous_iff, },
  { apply forall_congr,
    intro r,
    simpa using (Spv.out_mk v) (algebra_map A r) 1, }
end

namespace spa
open set algebra
variables {A : Huber_pair}

/-- The coercion from the adic spectrum of a Huber pair to the ambient valuation spectrum.-/
instance : has_coe (spa A) (Spv A) := ⟨subtype.val⟩

@[ext]
lemma ext (v₁ v₂ : spa A) (h : (Spv.out ↑v₁).is_equiv (Spv.out (↑v₂ : Spv A))) :
  v₁ = v₂ :=
subtype.val_injective $ Spv.ext _ _ h

lemma ext_iff {v₁ v₂ : spa A} :
  v₁ = v₂ ↔ ((Spv.out ↑v₁).is_equiv (Spv.out (↑v₂ : Spv A))) :=
by rw [subtype.coe_ext, Spv.ext_iff]

/-- The value monoid of a random representative valuation of a point in the adic spectrum. -/
abbreviation out_Γ₀ (v  : spa A) := Spv.out_Γ₀ (v : Spv A)

/-- A valuation in the adic spectrum is continuous. -/
lemma is_continuous (v : spa A) : Spv.is_continuous (v : Spv A) := v.property.left

/-- The valuation of an integral element is at most 1. -/
lemma map_plus (v : spa A) (a : (A⁺)) : v (algebra_map A a) ≤ 1 := v.property.right a

/-- The valuation of a unit of the ring of integral elements is 1. -/
@[simp] lemma map_unit (v : spa A) (u : units (A⁺)) :
  v ((algebra_map A : (A⁺) → A) u) = 1 :=
begin
  have h₁ := map_plus v u,
  have h₂ := map_plus v (u⁻¹ : _),
  have := actual_ordered_comm_monoid.mul_eq_one_iff_of_le_one' h₁ h₂,
  apply (this.mp _).left,
  erw ← valuation.map_mul,
  rw ← is_ring_hom.map_mul (algebra_map A : (A⁺) → A),
  simp only [units.mul_inv, algebra.map_one, valuation.map_one]
end

-- We are now going to setup the topology on `spa A`.
-- A basis of the topology is indexed by the following data:

/--A rational open subset of `spa A` is indexed by:
* an element s of A, and
* a finite set T ⊆ A that generates an open ideal in A.

In the literature, these sets are commonly denoted by D(T,s).-/
structure rational_open_data (A : Huber_pair) :=
(s : A)
(T : set A)
[Tfin : fintype T]
(Hopen : is_open ((ideal.span T) : set A))

namespace rational_open_data
variables (r : rational_open_data A)

attribute [instance] Tfin

@[ext]
lemma ext {r₁ r₂ : rational_open_data A} (hs : r₁.s = r₂.s) (hT : r₁.T = r₂.T) :
  r₁ = r₂ :=
begin
  cases r₁, cases r₂,
  congr; assumption
end

/--The subset of the adic spectrum associated with the data for a rational open subset.

In the literature, these sets are commonly denoted by D(T,s).-/
def open_set (r : rational_open_data A) : set (spa A) :=
{v : spa A | (∀ t ∈ r.T, (v t ≤ v r.s)) ∧ (v r.s ≠ 0)}

variable (A)

/--The rational open subset covering the entire adic spectrum.-/
def univ : rational_open_data A :=
{ s := 1,
  T := {1},
  Hopen := by { rw ideal.span_singleton_one, exact is_open_univ } }

variable {A}

@[simp] lemma univ_s : (univ A).s = 1 := rfl

@[simp] lemma univ_T : (univ A).T = {1} := rfl

@[simp] lemma univ_open_set :
  (univ A).open_set = set.univ :=
begin
  rw eq_univ_iff_forall,
  intros v,
  split,
  { intros t ht,
    erw mem_singleton_iff at ht,
    rw [ht, univ_s], },
  { erw [univ_s, Spv.map_one],
    exact one_ne_zero }
end

/--The rational open subset D(T,s) is the same as D(T ∪ {s}, s).-/
noncomputable def insert_s (r : rational_open_data A) : rational_open_data A :=
{ s := r.s,
  T := insert r.s r.T,
  Hopen := submodule.is_open_of_open_submodule
    ⟨ideal.span (r.T), r.Hopen, ideal.span_mono $ set.subset_insert _ _⟩ }

@[simp] lemma insert_s_s (r : rational_open_data A) :
(insert_s r).s = r.s := rfl

@[simp] lemma insert_s_T (r : rational_open_data A) :
(insert_s r).T = insert r.s r.T := rfl

@[simp] lemma insert_s_open_set (r : rational_open_data A) :
(insert_s r).open_set = r.open_set :=
begin
  ext v,
  split; rintros ⟨h₁, h₂⟩; split; try { exact h₂ }; intros t ht,
  { apply h₁ t,
    exact mem_insert_of_mem _ ht },
  { cases ht,
    { rw [ht, insert_s_s], },
    { exact h₁ t ht } },
end

lemma mem_insert_s (r : rational_open_data A) :
r.s ∈ (insert_s r).T := by {left, refl}

/-- Auxilliary definition for the intersection of two rational open sets.-/
noncomputable def inter_aux (r1 r2 : rational_open_data A) : rational_open_data A :=
{ s := r1.s * r2.s,
  T := r1.T * r2.T,
  Tfin := set.pointwise_mul_fintype _ _,
  Hopen :=
  begin
    rcases Huber_ring.exists_pod_subset _ (mem_nhds_sets r1.Hopen $ ideal.zero_mem $ ideal.span r1.T)
      with ⟨A₀, _, _, _, ⟨_, emb, I, fg, top⟩, hI⟩,
    dsimp only at hI,
    resetI,
    rw is_ideal_adic_iff at top,
    cases top.2 (algebra_map A ⁻¹' ↑(ideal.span r2.T)) _ with n hn,
    { apply submodule.is_open_of_open_submodule,
      use ideal.map (of_id A₀ A) (I^(n+1)),
      refine ⟨is_open_ideal_map_open_embedding emb _ (top.1 (n+1)), _⟩,
      delta ideal.span,
      erw [pow_succ, ideal.map_mul, ← submodule.span_mul_span],
      apply submodule.mul_le_mul,
      { exact (ideal.span_le.mpr hI) },
      { rw ← image_subset_iff at hn,
        exact (ideal.span_le.mpr hn) } },
    { apply emb.continuous.tendsto,
      rw show algebra.to_fun A (0:A₀) = 0,
      { haveI : is_ring_hom (algebra.to_fun A : A₀ → A) := algebra.is_ring_hom,
        apply is_ring_hom.map_zero },
      exact (mem_nhds_sets r2.Hopen $ ideal.zero_mem $ ideal.span r2.T) }
  end }

/--The intersection of two rational open sets is a rational open set.-/
noncomputable def inter (r1 r2 : rational_open_data A) : rational_open_data A :=
inter_aux (rational_open_data.insert_s r1) (rational_open_data.insert_s r2)

@[simp] lemma inter_s (r1 r2 : rational_open_data A) :
  (r1.inter r2).s = r1.s * r2.s := rfl

@[simp] lemma inter_T (r1 r2 : rational_open_data A) :
  (r1.inter r2).T = (insert r1.s r1.T) * (insert r2.s r2.T) := rfl

lemma inter_open_set (r1 r2 : rational_open_data A) :
(inter r1 r2).open_set = r1.open_set ∩ r2.open_set :=
begin
  rw [← insert_s_open_set r1, ← insert_s_open_set r2],
  apply le_antisymm,
  {  rintros v ⟨hv, hs⟩,
    have vmuls : v (r1.s * r2.s) = v r1.s * v r2.s := valuation.map_mul _ _ _,
    have hs₁ : v r1.s ≠ 0 := λ H, by simpa [-coe_fn_coe_base, vmuls, H] using hs,
    have hs₂ : v r2.s ≠ 0 := λ H, by simpa [-coe_fn_coe_base, vmuls, H] using hs,
    split; split; try { assumption };
    intros t ht,
    { suffices H : v t * v r2.s ≤ v r1.s * v r2.s,
      { simpa [hs₂, mul_assoc, -coe_fn_coe_base] using
          linear_ordered_structure.mul_le_mul_right H (group_with_zero.mk₀ _ hs₂)⁻¹, },
      { simpa using hv (t * r2.s) ⟨t, ht, r2.s, mem_insert_s r2, rfl⟩, } },
    { suffices H : v r1.s * v t ≤ v r1.s * v r2.s,
      { simpa [hs₁, mul_assoc, -coe_fn_coe_base] using
          linear_ordered_structure.mul_le_mul_left H (group_with_zero.mk₀ _ hs₁)⁻¹, },
      { simpa using hv (r1.s * t) ⟨r1.s, mem_insert_s r1, t, ht, rfl⟩, } } },
  { rintros v ⟨⟨hv₁, hs₁⟩, ⟨hv₂, hs₂⟩⟩,
    split,
    { rintros t ⟨t₁, ht₁, t₂, ht₂, rfl⟩,
      convert le_trans
        (linear_ordered_structure.mul_le_mul_right (hv₁ t₁ ht₁) _)
        (linear_ordered_structure.mul_le_mul_left  (hv₂ t₂ ht₂) _);
      apply valuation.map_mul },
    { assume eq_zero, simp at eq_zero, tauto }, }
end

lemma inter_symm (r1 r2 : rational_open_data A) :
  r1.inter r2 = r2.inter r1 :=
ext (mul_comm _ _) (mul_comm _ _)

end rational_open_data

variable (A)

/--The basis for the topology on the adic spectrum, consisting of rational open sets.-/
def rational_basis := {U : set (spa A) | ∃ r : rational_open_data A, U = r.open_set}

/--The topology on the adic spectrum, generated by rational open sets.-/
instance : topological_space (spa A) :=
topological_space.generate_from (rational_basis A)

variable {A}

/--The rational open sets form a basis for the topology on the adic spectrum.-/
lemma rational_basis.is_basis : topological_space.is_topological_basis (rational_basis A) :=
begin
  refine ⟨_, _, rfl⟩,
  { rintros _ ⟨r₁, rfl⟩ _ ⟨r₂, rfl⟩ x hx,
    refine ⟨_, ⟨_, (rational_open_data.inter_open_set r₁ r₂).symm⟩, hx, subset.refl _⟩, },
  { apply subset.antisymm (subset_univ _) (subset_sUnion_of_mem _),
    exact ⟨_, rational_open_data.univ_open_set.symm⟩ }
end

end spa


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite
import data.finset.pointwise
import data.fintype.card
import data.dfinsupp.order

/-!
# Finite intervals of finitely supported functions

This file provides the `locally_finite_order` instance for `Π₀ i, α i` when `α` itself is locally
finite and calculates the cardinality of its finite intervals.
-/

open dfinsupp finset
open_locale big_operators pointwise

variables {ι : Type*} {α : ι → Type*}

namespace finset
variables [decidable_eq ι] [Π i, has_zero (α i)] {s : finset ι} {f : Π₀ i, α i}
  {t : Π i, finset (α i)}

/-- Finitely supported product of finsets. -/
def dfinsupp (s : finset ι) (t : Π i, finset (α i)) : finset (Π₀ i, α i) :=
(s.pi t).map ⟨λ f, dfinsupp.mk s $ λ i, f i i.2, begin
  refine (mk_injective _).comp (λ f g h, _),
  ext i hi,
  convert congr_fun h ⟨i, hi⟩,
  end⟩

@[simp] lemma card_dfinsupp (s : finset ι) (t : Π i, finset (α i)) :
  (s.dfinsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

variables [Π i, decidable_eq (α i)]

lemma mem_dfinsupp_iff : f ∈ s.dfinsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_mk_subset, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact mk_of_mem hi },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    dsimp,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.dfinsupp t` precisely means that `f` is pointwise in `t`.
-/
@[simp] lemma mem_dfinsupp_iff_of_support_subset {t : Π₀ i, finset (α i)} (ht : t.support ⊆ s) :
  f ∈ s.dfinsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_dfinsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (not_mem_mono ht hi)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

end finset

open finset

namespace dfinsupp
variables [decidable_eq ι] [Π i, decidable_eq (α i)]

section bundled_singleton
variables [Π i, has_zero (α i)] {f : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `finset.singleton` bundled as a `dfinsupp`. -/
def singleton (f : Π₀ i, α i) : Π₀ i, finset (α i) :=
⟦{ to_fun := λ i, {f i},
  pre_support := f.support.1,
  zero := λ i, (ne_or_eq (f i) 0).imp mem_support_iff.2 (congr_arg _) }⟧

lemma mem_singleton_apply_iff : a ∈ f.singleton i ↔ a = f i := mem_singleton

end bundled_singleton

section bundled_Icc
variables [Π i, has_zero (α i)] [Π i, partial_order (α i)] [Π i, locally_finite_order (α i)]
  {f g : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `finset.Icc` bundled as a `dfinsupp`. -/
def range_Icc (f g : Π₀ i, α i) : Π₀ i, finset (α i) :=
⟦{ to_fun := λ i, Icc (f i) (g i),
  pre_support := f.support.1 + g.support.1,
  zero := λ i, begin
    refine or_iff_not_imp_left.2 (λ h, _),
    rw [not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_right _ _).subset h),
      not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_left _ _).subset h)],
    exact Icc_self _,
  end }⟧

@[simp] lemma range_Icc_apply (f g : Π₀ i, α i) (i : ι) : f.range_Icc g i = Icc (f i) (g i) := rfl

lemma mem_range_Icc_apply_iff : a ∈ f.range_Icc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc

lemma support_range_Icc_subset : (f.range_Icc g).support ⊆ f.support ∪ g.support :=
begin
  refine λ x hx, _,
  by_contra,
  refine not_mem_support_iff.2 _ hx,
  rw [range_Icc_apply,
    not_mem_support_iff.1 (not_mem_mono (subset_union_left _ _) h),
      not_mem_support_iff.1 (not_mem_mono (subset_union_right _ _) h)],
  exact Icc_self _,
end

end bundled_Icc

section pi
variables [Π i, has_zero (α i)]

/-- Given a finitely supported function `f : Π₀ i, finset (α i)`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : Π₀ i, finset (α i)) : finset (Π₀ i, α i) := f.support.dfinsupp f

@[simp] lemma mem_pi {f : Π₀ i, finset (α i)} {g : Π₀ i, α i} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_dfinsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : Π₀ i, finset (α i)) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_dfinsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end pi

section locally_finite
variables [Π i, partial_order (α i)] [Π i, has_zero (α i)] [Π i, locally_finite_order (α i)]

instance : locally_finite_order (Π₀ i, α i) :=
locally_finite_order.of_Icc (Π₀ i, α i)
  (λ f g, (f.support ∪ g.support).dfinsupp $ f.range_Icc g)
  (λ f g x, begin
    refine (mem_dfinsupp_iff_of_support_subset $ support_range_Icc_subset).trans _,
    simp_rw [mem_range_Icc_apply_iff, forall_and_distrib],
    refl,
  end)

variables (f g : Π₀ i, α i)

lemma card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card :=
card_dfinsupp _ _

lemma card_Ico : (Ico f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 :=
by rw [card_Ico_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioc : (Ioc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 :=
by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]

end locally_finite
end dfinsupp


import fo.basic
import fo.herbrand

@[reducible]
def signature.clause (σ : signature) : Type := multiset σ.literal

@[reducible]
def signature.cnf (σ : signature) : Type := finset σ.clause

def signature.symbols (σ : signature) :=
  σ.function ⊕ σ.relation

def signature.formula.is_closed {σ : signature} (φ : σ.formula) : Prop :=
  ∀ v, φ.is_free v

def signature.formula.is_prenex {σ : signature} (φ : σ.formula) : Prop :=

def signature.formula.prenex_normal_form {σ : signature} (φ : σ.formula) : σ.formula :=

def signature.formula.normal_form {σ : signature} (φ : σ.formula) :  :=

theorem normal_form {σ : signature}  : ∃ f, ∀ φ, f.


--TO DO:
--am_gm_two (set version of it) --> sum/prod of set of card 2
--pred
--Fix names (replace prod_s1_nonneg, a with actual s1_nonempty_keywords with meaning)
--Fix formatting

import cauchy_induction

import tactic
import data.nat.basic
import data.real.basic
import analysis.special_functions.pow

open_locale classical
noncomputable theory

open_locale big_operators

open finset
  --set s := (finset.range(20)).filter( λ (k : ℕ), 3 * k + 7 < 28),
  --finset.mem filter

--Cant find in documentation
lemma finset.exists_nonmem (s : finset ℕ) : ∃ (t : ℕ), t ∉ s :=

begin
  sorry,
end

lemma finset.construct_disj (n : ℕ) : ∃ (s1 s2 : finset ℕ),
(s1.card = n) ∧ (s2.card = n) ∧ (s1 ∩ s2 = ∅) :=
begin
  set s1 := finset.range(n) with s1_def,
  set s2 := finset.range(2 * n) \ s1 with s2_def,
  use s1,
  use s2,
  split,
  refine finset.card_range n,
  split,
  have range_n_sbset : finset.range(n) ⊆ finset.range(2 * n),
  {
    refine finset.range_subset.2 _,
    rw le_iff_exists_add,
    use n,
    rw two_mul,
  },
  have thm := finset.card_sdiff range_n_sbset,
  rw ←s1_def at thm,
  rw ←s2_def at thm,
  rw finset.card_range (2 * n) at thm,
  rw finset.card_range n at thm,
  rw thm,
  rw two_mul,
  rw nat.add_sub_cancel,
  rw ←finset.disjoint_iff_inter_eq_empty,
  rw s2_def,
  refine finset.disjoint_sdiff,
end

lemma finset.split_in_half (s : finset ℕ) (n : ℕ) : s.card = (2 * n) →
∃ (s1 s2 : finset ℕ),
(s1 ⊆ s) ∧ (s2 ⊆ s) ∧ (s1.card = n) ∧ (s2.card = n) ∧ (s1 ∩ s2 = ∅) ∧ (s = s1 ∪ s2):=

begin
  intro s_card,
  have n_leq_s_card : n ≤ s.card,
  {
    rw s_card,
    rw le_iff_exists_add,
    use n,
    rw two_mul,
  },
  have exists_card_n_subset := finset.exists_smaller_set s n n_leq_s_card,
  rcases exists_card_n_subset with ⟨s1, s1_subset, s1_card⟩,
  set s2 := s \ s1 with s2_def,
  use s1,
  use s2,
  split,
  refine s1_subset,
  split,
  refine finset.sdiff_subset s s1,
  split,
  refine s1_card,
  split,
  rw finset.card_sdiff s1_subset,
  rw s_card,
  rw s1_card,
  rw two_mul,
  rw nat.add_sub_cancel,
  split,
  rw ←finset.disjoint_iff_inter_eq_empty,
  refine finset.disjoint_sdiff,
  rw s2_def,
  rw finset.union_sdiff_of_subset s1_subset,
end

lemma finset.sum_card_two (f : ℕ → ℝ) {x y : ℕ} (hxy : x ≠ y): ∑ (i : ℕ) in {x, y}, f i = f x + f y :=

begin
  have split : ({x, y} : finset ℕ) = {x} ∪ {y},
  {
    sorry,
  },
  rw split,
  rw finset.sum_union (finset.disjoint_singleton.2 hxy),
  rw finset.sum_singleton,
  rw finset.sum_singleton,
end

lemma finset.prod_card_two (f : ℕ → ℝ) {x y : ℕ} (hxy : x ≠ y): ∏ (i : ℕ) in {x, y}, f i = f x * f y :=

begin
    have split : ({x, y} : finset ℕ) = {x} ∪ {y},
  {
    sorry,
  },
  rw split,
  rw finset.prod_union (finset.disjoint_singleton.2 hxy),
  rw finset.prod_singleton,
  rw finset.prod_singleton,
end

def finset_am (f : ℕ → ℝ) (s : finset ℕ) : ℝ :=
(∑ i in s, f i) / finset.card(s)

def finset_gm (f : ℕ → ℝ) (s : finset ℕ) : ℝ :=
(∏ i in s, f i) ^ (1 / (finset.card(s) : ℝ))

def am_gm_prop (f : ℕ → ℝ) (n : ℕ) : Prop := ∀ (s : finset ℕ),
(s.card = n) → finset_gm f s ≤ finset_am f s

lemma am_nneg {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), 0 ≤ f k) (s : finset ℕ):
(s ≠ ∅) → 0 ≤ finset_am f s :=

begin
  rw finset_am,
  intro s_nonempty,
  have f_nneg_in_s : ∀ (k : ℕ), k ∈ s → 0 ≤ f k,
  {
    intro k,
    intro s_nonempty,
    refine f_nneg k,
  },
  have s1_nonempty_keyword : 0 < (↑s.card : ℝ),
  {
    refine nat.cast_pos.2 (finset.nonempty.card_pos (finset.nonempty_of_ne_empty s_nonempty)),
  },
  have a := (zero_le_mul_right s1_nonempty_keyword).1,
  swap,
  refine (∑ (i : ℕ) in s, f i) / ↑(s.card),
  have s_card_nonzero : (s.card : ℝ) ≠ 0,
  {
    simp only [ne.def, nat.cast_eq_zero, card_eq_zero],
    rw ne.def at s_nonempty,
    refine s_nonempty,
  },
  rw div_mul_cancel at a,
  refine a (finset.sum_nonneg f_nneg_in_s),
  refine s_card_nonzero,
end

lemma gm_nneg {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), 0 ≤ f k) (s : finset ℕ):
0 ≤ finset_gm f s :=

begin
  rw finset_gm,
  refine real.rpow_nonneg_of_nonneg _ (1 / ↑(s.card)),
  have f_nneg_in_s : ∀ (k : ℕ), k ∈ s → 0 ≤ f k,
  {
    intro k,
    intro k_in_s, --useless
    refine f_nneg k,
  },
  refine finset.prod_nonneg f_nneg_in_s,
end

lemma am_weighted_avg (f : ℕ → ℝ)
{s1 s2 : finset ℕ} (hs1 : s1 ≠ ∅) (hs2 : s2 ≠ ∅) (h_disj : disjoint s1 s2):
(finset_am f s1) * s1.card + (finset_am f s2) * s2.card =
finset_am f (s1 ∪ s2) * (s1.card + s2.card) :=
begin
  unfold finset_am,
  rw finset.sum_union h_disj,
  rw finset.card_union_eq h_disj,
  rw div_mul_cancel (∑ (i : ℕ) in s1, f i),
  swap,
  rw [ne.def, nat.cast_eq_zero, card_eq_zero, ←ne.def],
  refine hs1,
  rw div_mul_cancel (∑ (i : ℕ) in s2, f i),
  swap,
  rw [ne.def, nat.cast_eq_zero, card_eq_zero, ←ne.def],
  refine hs2,
  rw nat.cast_add,
  rw div_mul_cancel (∑ (x : ℕ) in s1, f x + ∑ (x : ℕ) in s2, f x),
  norm_cast,
  simp only [add_eq_zero_iff, card_eq_zero, not_and],
  intro s_nonempty,
  refine hs2,
end

lemma gm_weighted_avg {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), 0 ≤ f k)
{s1 s2 : finset ℕ} (hs1 : s1 ≠ ∅) (hs2 : s2 ≠ ∅) (h_disj : disjoint s1 s2) :
(finset_gm f s1) ^ (s1.card : ℝ) * (finset_gm f s2) ^ (s2.card : ℝ) =
finset_gm f (s1 ∪ s2) ^ ((s1.card + s2.card) : ℝ) :=

begin
  unfold finset_gm,
  have prod_s1_nonneg : 0 ≤ ∏ (i : ℕ) in s1, f i,
  {
    have f_nneg_s1 : ∀ (i : ℕ), i ∈ s1 → 0 ≤ f i,
    {
      intro i,
      intro s_nonempty,
      refine f_nneg i,
    },
    refine finset.prod_nonneg f_nneg_s1,
  },
  have prod_s2_nonneg : 0 ≤ ∏ (i : ℕ) in s2, f i,
  {
    have f_nneg_s2 : ∀ (i : ℕ), i ∈ s2 → 0 ≤ f i,
    {
      intro i,
      intro s_nonempty,
      refine f_nneg i,
    },
    refine finset.prod_nonneg f_nneg_s2,
  },
  have prod_s1_union_s2_nonneg : 0 ≤ ∏ (i : ℕ) in s1 ∪ s2, f i,
  {
    rw finset.prod_union h_disj,
    refine mul_nonneg prod_s1_nonneg prod_s2_nonneg,
  },
  rw ←real.rpow_mul prod_s1_nonneg,
  rw div_mul_cancel,
  swap,
  rw [ne.def, nat.cast_eq_zero, card_eq_zero, ←ne.def],
  refine hs1,
  rw real.rpow_one,
  rw ←real.rpow_mul prod_s2_nonneg,
  rw div_mul_cancel,
  swap,
  rw [ne.def, nat.cast_eq_zero, card_eq_zero, ←ne.def],
  refine hs2,
  rw real.rpow_one,
  rw ←real.rpow_mul prod_s1_union_s2_nonneg,
  rw finset.card_union_eq h_disj,
  rw nat.cast_add,
  rw div_mul_cancel,
  swap,
  norm_cast,
  simp only [add_eq_zero_iff, card_eq_zero, not_and],
  intro s_nonempty,
  refine hs2,
  rw real.rpow_one,
  rw finset.prod_union h_disj,
end

lemma am_add (f : ℕ → ℝ) {s1 s2 : finset ℕ} {n : ℕ}
(s1_card : s1.card = n) (s2_card : s2.card = n) (h_disj : disjoint s1 s2) (n_pos : 0 < n) :
finset_am f s1 + finset_am f s2 = (finset_am f (s1 ∪ s2)) * 2 :=

begin
  have s1_nonempty : s1 ≠ ∅,
  {
    rw ←s1_card at n_pos,
    have s1_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s1_nonempty_keyword,
  },
  have s2_nonempty : s2 ≠ ∅,
  {
    rw ←s2_card at n_pos,
    have s2_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s2_nonempty_keyword,
  },
  have n_nonzero : (n : ℝ) ≠ 0,
  {
    rw nat.cast_ne_zero,
    refine ne_zero_of_lt n_pos,
  },
  have am_weighted := am_weighted_avg f s1_nonempty s2_nonempty h_disj,
  rw s1_card at am_weighted,
  rw s2_card at am_weighted,
  rw ←two_mul at am_weighted,
  rw ←mul_assoc at am_weighted,
  rw ←right_distrib at am_weighted,
  simp only [mul_eq_mul_right_iff, nat.cast_eq_zero] at am_weighted,
  cases am_weighted,
  swap,
  simp only [ne.def, nat.cast_eq_zero] at n_nonzero,
  refine false.elim(n_nonzero am_weighted),
  refine am_weighted,
end

lemma gm_prod {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), 0 ≤ f k) {s1 s2 : finset ℕ} {n : ℕ}
(s1_card : s1.card = n) (s2_card : s2.card = n) (h_disj : disjoint s1 s2) (n_pos : 0 < n) :
finset_gm f s1 * finset_gm f s2 = (finset_gm f (s1 ∪ s2)) ^ (2 : ℝ) :=

begin
  have s1_nonempty : s1 ≠ ∅,
  {
    rw ←s1_card at n_pos,
    have s1_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s1_nonempty_keyword,
  },
  have s2_nonempty : s2 ≠ ∅,
  {
    rw ←s2_card at n_pos,
    have s2_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s2_nonempty_keyword,
  },
  have real_n_nonzero : (n : ℝ) ≠ 0,
  {
    rw nat.cast_ne_zero,
    refine ne_zero_of_lt n_pos,
  },
  have s1_gm_nneg := gm_nneg f_nneg s1,
  have s2_gm_nneg := gm_nneg f_nneg s2,
  have union_gm_nneg := gm_nneg f_nneg (s1 ∪ s2),
  have gm_weighted := gm_weighted_avg f_nneg s1_nonempty s2_nonempty h_disj,
  rw s1_card at gm_weighted,
  rw s2_card at gm_weighted,
  rw ←two_mul at gm_weighted,

  rw ←real.coe_to_nnreal (finset_gm f s1) s1_gm_nneg at gm_weighted,
  rw ←real.coe_to_nnreal (finset_gm f s2) s2_gm_nneg at gm_weighted,
  rw ←real.coe_to_nnreal (finset_gm f (s1 ∪ s2)) union_gm_nneg at gm_weighted,
  rw ←nnreal.coe_rpow at gm_weighted,
  rw ←nnreal.coe_rpow at gm_weighted,
  rw ←nnreal.coe_rpow at gm_weighted,
  rw ←nnreal.coe_mul at gm_weighted,
  rw ←nnreal.mul_rpow at gm_weighted,
  rw nnreal.rpow_mul at gm_weighted,
  rw nnreal.coe_eq at gm_weighted,

  rw nnreal.rpow_eq_rpow_iff real_n_nonzero at gm_weighted,

  rw ←nnreal.coe_eq at gm_weighted,
  rw nnreal.coe_mul at gm_weighted,
  rw nnreal.coe_rpow at gm_weighted,
  rw real.coe_to_nnreal (finset_gm f s1) s1_gm_nneg at gm_weighted,
  rw real.coe_to_nnreal (finset_gm f s2) s2_gm_nneg at gm_weighted,
  rw real.coe_to_nnreal (finset_gm f (s1 ∪ s2)) union_gm_nneg at gm_weighted,

  refine gm_weighted,
end

lemma sum_equiv {f g : ℕ → ℝ} {s : finset ℕ}
(f_g_equiv : ∀ (k : ℕ), k ∈ s → f k = g k) :
∑ (i : ℕ) in s, f i = ∑ (i : ℕ) in s, g i :=

begin
  have induct_on_card : ∀ (n : ℕ), ∀ (t : finset ℕ), t.card = n →
  (∀ (k : ℕ), k ∈ t → f k = g k) →
  ∑ (i : ℕ) in t, f i = ∑ (i : ℕ) in t, g i,
  {
    intro n,
    induction n with k hk,
    {
      intro t,
      intro t_card,
      intro f_g_equiv_in_t,
      have t_empty := finset.card_eq_zero.1 t_card,
      rw t_empty,
      rw finset.sum_empty,
      rw finset.sum_empty,
    },
    {
      intro t,
      intro t_card,
      intro f_g_equiv_in_t,
      have t_card_pos := nat.succ_pos k,
      rw ←t_card at t_card_pos,
      have k_le_t_card := le_of_lt (nat.lt_succ_self k),
      rw ←t_card at k_le_t_card,
      rcases finset.exists_smaller_set t k k_le_t_card with ⟨t', t'_sbset, t'_card⟩,
      have sdiff_union_t'_eq_t := finset.sdiff_union_of_subset t'_sbset,
      rw ←sdiff_union_t'_eq_t,
      rw finset.sum_union finset.sdiff_disjoint,
      rw finset.sum_union finset.sdiff_disjoint,
      have sing_card := finset.card_sdiff t'_sbset,
      rw t_card at sing_card,
      rw t'_card at sing_card,
      rw nat.succ_eq_add_one at sing_card,
      rw nat.add_sub_cancel_left at sing_card,
      --
      cases finset.card_eq_one.1 sing_card with l hl,
      rw hl,
      rw finset.sum_singleton,
      rw finset.sum_singleton,
      have f_equiv_g_in_t' : ∀ (k : ℕ), k ∈ t' → f k = g k,
      {
        intro k,
        intro k_in_t',
        have k_in_t := finset.mem_of_subset t'_sbset k_in_t',
        refine f_g_equiv_in_t k k_in_t,
      },
      rw hk t' t'_card f_equiv_g_in_t',
      rw add_left_inj,
      have sing_in_t := finset.subset_union_left {l} t',
      rw ←hl at sing_in_t,
      rw finset.sdiff_union_of_subset t'_sbset at sing_in_t,
      rw hl at sing_in_t,
      have l_in_t := finset.singleton_subset_iff.1 sing_in_t,
      refine f_g_equiv_in_t l l_in_t,
    },
  },
  have answer := induct_on_card s.card s,
  rw eq_self_iff_true at answer,
  rw forall_true_left at answer,
  refine answer f_g_equiv,
end

lemma prod_equiv {f g : ℕ → ℝ} {s : finset ℕ}
(f_g_equiv : ∀ (k : ℕ), k ∈ s → f k = g k) :
∏ (i : ℕ) in s, f i = ∏ (i : ℕ) in s, g i :=

begin
  have induct_on_card : ∀ (n : ℕ), ∀ (t : finset ℕ), t.card = n →
  (∀ (k : ℕ), k ∈ t → f k = g k) →
  ∏ (i : ℕ) in t, f i = ∏ (i : ℕ) in t, g i,
  {
    intro n,
    induction n with k hk,
    {
      intro t,
      intro t_card,
      intro f_g_equiv_in_t,
      have t_empty := finset.card_eq_zero.1 t_card,
      rw t_empty,
      rw finset.prod_empty,
      rw finset.prod_empty,
    },
    {
      intro t,
      intro t_card,
      intro f_g_equiv_in_t,
      have t_card_pos := nat.succ_pos k,
      rw ←t_card at t_card_pos,
      have k_le_t_card := le_of_lt (nat.lt_succ_self k),
      rw ←t_card at k_le_t_card,
      rcases finset.exists_smaller_set t k k_le_t_card with ⟨t', t'_sbset, t'_card⟩,
      have sdiff_union_t'_eq_t := finset.sdiff_union_of_subset t'_sbset,
      rw ←sdiff_union_t'_eq_t,
      rw finset.prod_union finset.sdiff_disjoint,
      rw finset.prod_union finset.sdiff_disjoint,
      have sing_card := finset.card_sdiff t'_sbset,
      rw t_card at sing_card,
      rw t'_card at sing_card,
      rw nat.succ_eq_add_one at sing_card,
      rw nat.add_sub_cancel_left at sing_card,
      --
      cases finset.card_eq_one.1 sing_card with l hl,
      rw hl,
      rw finset.prod_singleton,
      rw finset.prod_singleton,
      have f_equiv_g_in_t' : ∀ (k : ℕ), k ∈ t' → f k = g k,
      {
        intro k,
        intro k_in_t',
        have k_in_t := finset.mem_of_subset t'_sbset k_in_t',
        refine f_g_equiv_in_t k k_in_t,
      },
      rw hk t' t'_card f_equiv_g_in_t',
      rw mul_eq_mul_right_iff,
      left,
      have sing_in_t := finset.subset_union_left {l} t',
      rw ←hl at sing_in_t,
      rw finset.sdiff_union_of_subset t'_sbset at sing_in_t,
      rw hl at sing_in_t,
      have l_in_t := finset.singleton_subset_iff.1 sing_in_t,
      refine f_g_equiv_in_t l l_in_t,
    },
  },
  have answer := induct_on_card s.card s,
  rw eq_self_iff_true at answer,
  rw forall_true_left at answer,
  refine answer f_g_equiv,
end

lemma am_gm_two' {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) :
(x * y) ^ (1 / (2 : ℝ)) ≤ (x + y) / 2 :=

begin
  set a := x ^ (1 / (2 : ℝ)) with a_def,
  set b := y ^ (1 / (2 : ℝ)) with b_def,

  have ha := real.rpow_nonneg_of_nonneg hx (1 / (2 : ℝ)),
  have hb := real.rpow_nonneg_of_nonneg hy (1 / (2 : ℝ)),
  have difference_sq_nneg := sq_nonneg (a - b),
  rw [sub_sq, add_comm_sub, ←add_sub_assoc] at difference_sq_nneg,
  have refl_le_two_a_b : 2 * a * b ≤ 2 * a * b,
  {
    refl,
  },
  have new := add_le_add difference_sq_nneg refl_le_two_a_b,
  rw [sub_add_cancel, zero_add] at new,
  have divided_by_two : a * b ≤ (a ^ 2 + b ^ 2) / 2,
  {
    --REPLACE WITH "DIRECT" PROOF
    linarith,
  },
  rw a_def at divided_by_two,
  rw b_def at divided_by_two,
  rw ←real.rpow_two (x ^ (1 / (2 : ℝ))) at divided_by_two,
  rw ←real.rpow_two (y ^ (1 / (2 : ℝ))) at divided_by_two,
  rw ←real.rpow_mul hx at divided_by_two,
  rw ←real.rpow_mul hy at divided_by_two,
  rw one_div_mul_cancel at divided_by_two,
  swap,
  refine two_ne_zero,
  rw real.rpow_one at divided_by_two,
  rw real.rpow_one at divided_by_two,
  rw ←real.mul_rpow hx hy at divided_by_two,
  refine divided_by_two,
end

lemma am_gm_two {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), (0 ≤ f k)):
am_gm_prop f 2 :=

begin
  rw am_gm_prop,
  intro s,
  intro s_card,
  rcases finset.card_eq_two.1 s_card with ⟨x, y, x_y_distinct, hxy⟩,
  rw finset_gm,
  rw finset_am,
  rw s_card,
  rw hxy,
  have x_ne_y : x ≠ y,
  {
    sorry,
  },
  have s1_sum_over_two_els := finset.sum_card_two f x_ne_y,
  have s1_prod_over_two_els := finset.prod_card_two f x_ne_y,
  rw s1_sum_over_two_els,
  rw s1_prod_over_two_els,
  simp only [nat.cast_bit0, nat.cast_one],
  refine am_gm_two' (f_nneg x) (f_nneg y),
end

lemma am_gm_doubling {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), (0 ≤ f k)) :
∀ (n : ℕ), am_gm_prop f n → am_gm_prop f (2 * n) :=

begin
  intro n,
  cases em(0 < n) with n_pos n_not_pos,
  swap,
  have n_eq_zero := nat.eq_zero_of_le_zero (le_of_not_lt n_not_pos),
  rw n_eq_zero,
  rw mul_zero,
  intro answer,
  refine answer,
  intro am_gm_prop_n,
  rw am_gm_prop at am_gm_prop_n,
  rw am_gm_prop,
  intro s,
  intro s_card,
  rcases finset.split_in_half s n s_card with ⟨s1, s2, s1_subset, s2_subset, s1_card, s2_card, s1_s2_disjoint, s_eq_s1_union_s2⟩,
  rw ←finset.disjoint_iff_inter_eq_empty at s1_s2_disjoint,
  have s1_nonempty : s1 ≠ ∅,
  {
    rw ←s1_card at n_pos,
    have s1_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s1_nonempty_keyword,
  },
  have s2_nonempty : s2 ≠ ∅,
  {
    rw ←s2_card at n_pos,
    have s2_nonempty_keyword := finset.card_pos.1 n_pos,
    refine finset.nonempty_iff_ne_empty.1 s2_nonempty_keyword,
  },
  have s_nonempty : s ≠ ∅,
  {
    have zero_lt_two_n := add_lt_add n_pos n_pos,
    rw zero_add at zero_lt_two_n,
    rw ←two_mul at zero_lt_two_n,
    rw ←s_card at zero_lt_two_n,
    have s_nonempty_keyword := finset.card_pos.1 zero_lt_two_n,
    refine finset.nonempty_iff_ne_empty.1 s_nonempty_keyword,
  },
  have am_gm_s1 := am_gm_prop_n s1 s1_card,
  have am_gm_s2 := am_gm_prop_n s2 s2_card,
  have sum := add_le_add am_gm_s1 am_gm_s2,
  rw am_add f s1_card s2_card s1_s2_disjoint n_pos at sum,
  rw ←s_eq_s1_union_s2 at sum,
  have half_le_half := le_refl (1 / (2 : ℝ)),
  have one_half_nneg : 0 ≤ (1 / (2 : ℝ)),
  {
    simp only [one_div, inv_nonneg, zero_le_bit0, zero_le_one],
  },
  have two_am_nneg : 0 ≤ finset_am f s * 2,
  {
    have am_nneg := am_nneg f_nneg s s_nonempty,
    have answer := add_le_add am_nneg am_nneg,
    rw zero_add at answer,
    rw ←mul_two at answer,
    refine answer,
  },
  have sum_div_two := mul_le_mul sum half_le_half one_half_nneg two_am_nneg,
  rw mul_one_div at sum_div_two,
  rw ←mul_div_assoc at sum_div_two,
  rw mul_one at sum_div_two,
  rw mul_div_cancel at sum_div_two,
  swap,
  refine two_ne_zero,
  have meta_am_gm := am_gm_two' (gm_nneg f_nneg s1) (gm_nneg f_nneg s2),
  have answer := le_trans meta_am_gm sum_div_two,
  rw gm_prod f_nneg s1_card s2_card s1_s2_disjoint n_pos at answer,
  rw ←real.rpow_mul (gm_nneg f_nneg (s1 ∪ s2)) at answer,
  rw ←mul_div_assoc at answer,
  rw mul_one at answer,
  rw div_self at answer,
  swap,
  refine two_ne_zero,
  rw real.rpow_one at answer,
  rw ←s_eq_s1_union_s2 at answer,
  refine answer,
end

lemma am_gm_pred {f : ℕ → ℝ} (f_nneg : ∀ (k : ℕ), (0 ≤ f k)) :
∀ (n : ℕ), am_gm_prop f (n + 1) → am_gm_prop f n :=

begin
  --DEAL WITH am_gm_prop 0 = false
--set f' : ℕ → ℝ := λ m, if m < n then f n else 1,
  have restating : ∀ (f : ℕ → ℝ), (∀ (k : ℕ), 0 ≤ f k) →
  ∀ (n : ℕ), am_gm_prop f (n + 1) → am_gm_prop f n,
  {
    intro n,
    -- intro am_gm_prop_succ_n,
    -- rw am_gm_prop,
    -- intro s,
    -- intro s_card,
    -- have s_nonmem := finset.exists_nonmem s,
    -- cases s_nonmem with l hl,
    -- have l_disj := finset.disjoint_singleton_right.2 hl,
    -- have s'_card := finset.card_disjoint_union l_disj,
    -- rw s_card at s'_card,
    -- rw finset.card_singleton l at s'_card,
    -- rw am_gm_prop at am_gm_prop_succ_n,
    -- have answer := am_gm_prop_succ_n (s ∪ {l}) s'_card,
    -- rw finset_am at answer,
    -- rw s'_card at answer,
    -- rw finset.sum_union l_disj at answer,
    -- rw finset.sum_singleton at answer,
    -- set f' : ℕ → ℝ := λ x, if x ∈ s then f x else (finset_am f s) with f'_def,
    -- have f_equiv_f' : ∀ (k : ℕ), k ∈ s → f k = f' k,
    -- {
    --   intro k,
    --   intro k_in_s,
    --   rw f'_def,
    --   sorry,
    -- },
    -- have sum_eq := sum_equiv f_equiv_f',
    -- have prod_eq := prod_equiv f_equiv_f',
    sorry,
  },
  intro n,
  intro am_gm_prop_succ_n,
  refine restating f f_nneg n am_gm_prop_succ_n,

  --rw prop_equiv

--   PLAN
-- Assume P(n) and get s of card n - 1.
-- Take some x ∉ s, add make s' = s ∪ {x}
-- Set f x = am s'
-- use P(n) on s'
-- PROFIT
--
--
--
--
end

theorem am_gm' {f : ℕ → ℝ} (f_nneg : (∀ (k : ℕ), 0 ≤ f k)) {n : ℕ} (n_pos : 0 < n):
am_gm_prop f n :=
begin
  have base_case := am_gm_two f_nneg,
  have pred_step := am_gm_pred f_nneg,
  have doubling_step := am_gm_doubling f_nneg,
  have two_lt_zero : 0 < 2,
  {
    simp only [nat.succ_pos'],
  },
  refine cauchy_induction pred_step doubling_step two_lt_zero base_case n,
end

theorem am_gm {f : ℕ → ℝ} {s : finset ℕ} (s_nonempty : 0 < s.card) (f_nneg : (∀ (k : ℕ), 0 ≤ f k)):
finset_gm f s ≤ finset_am f s :=

begin
  have answer := am_gm' f_nneg s_nonempty,
  rw am_gm_prop at answer,
  have reflexivity : s.card = s.card,
  {
    refl,
  },
  refine answer s reflexivity,
end