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

! This file was ported from Lean 3 source module algebra.symmetrized
! leanprover-community/mathlib commit 933547832736be61a5de6576e22db351c6c2fbfd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Jordan.Basic
import Mathbin.Algebra.Module.Basic

/-!
# Symmetrized algebra

A commutative multiplication on a real or complex space can be constructed from any multiplication
by "symmetrization" i.e
$$
a \circ b = \frac{1}{2}(ab + ba)
$$

We provide the symmetrized version of a type `α` as `sym_alg α`, with notation `αˢʸᵐ`.

## Implementation notes

The approach taken here is inspired by algebra.opposites. We use Oxford Spellings
(IETF en-GB-oxendict).

## References

* [Hanche-Olsen and Størmer, Jordan Operator Algebras][hancheolsenstormer1984]
-/

open Function

/-- The symmetrized algebra has the same underlying space as the original algebra.
-/
def SymAlg (α : Type _) : Type _ :=
  α
#align sym_alg SymAlg

-- mathport name: «expr ˢʸᵐ»
postfix:max "ˢʸᵐ" => SymAlg

namespace SymAlg

variable {α : Type _}

/-- The element of `sym_alg α` that represents `a : α`. -/
@[match_pattern, pp_nodot]
def sym : α ≃ αˢʸᵐ :=
  Equiv.refl _
#align sym_alg.sym SymAlg.sym

/-- The element of `α` represented by `x : αˢʸᵐ`. -/
@[pp_nodot]
def unsym : αˢʸᵐ ≃ α :=
  Equiv.refl _
#align sym_alg.unsym SymAlg.unsym

@[simp]
theorem unsym_sym (a : α) : unsym (sym a) = a :=
  rfl
#align sym_alg.unsym_sym SymAlg.unsym_sym

@[simp]
theorem sym_unsym (a : α) : sym (unsym a) = a :=
  rfl
#align sym_alg.sym_unsym SymAlg.sym_unsym

@[simp]
theorem sym_comp_unsym : (sym : α → αˢʸᵐ) ∘ unsym = id :=
  rfl
#align sym_alg.sym_comp_unsym SymAlg.sym_comp_unsym

@[simp]
theorem unsym_comp_sym : (unsym : αˢʸᵐ → α) ∘ sym = id :=
  rfl
#align sym_alg.unsym_comp_sym SymAlg.unsym_comp_sym

@[simp]
theorem sym_symm : (@sym α).symm = unsym :=
  rfl
#align sym_alg.sym_symm SymAlg.sym_symm

@[simp]
theorem unsym_symm : (@unsym α).symm = sym :=
  rfl
#align sym_alg.unsym_symm SymAlg.unsym_symm

theorem sym_bijective : Bijective (sym : α → αˢʸᵐ) :=
  sym.Bijective
#align sym_alg.sym_bijective SymAlg.sym_bijective

theorem unsym_bijective : Bijective (unsym : αˢʸᵐ → α) :=
  unsym.symm.Bijective
#align sym_alg.unsym_bijective SymAlg.unsym_bijective

theorem sym_injective : Injective (sym : α → αˢʸᵐ) :=
  sym.Injective
#align sym_alg.sym_injective SymAlg.sym_injective

theorem sym_surjective : Surjective (sym : α → αˢʸᵐ) :=
  sym.Surjective
#align sym_alg.sym_surjective SymAlg.sym_surjective

theorem unsym_injective : Injective (unsym : αˢʸᵐ → α) :=
  unsym.Injective
#align sym_alg.unsym_injective SymAlg.unsym_injective

theorem unsym_surjective : Surjective (unsym : αˢʸᵐ → α) :=
  unsym.Surjective
#align sym_alg.unsym_surjective SymAlg.unsym_surjective

@[simp]
theorem sym_inj {a b : α} : sym a = sym b ↔ a = b :=
  sym_injective.eq_iff
#align sym_alg.sym_inj SymAlg.sym_inj

@[simp]
theorem unsym_inj {a b : αˢʸᵐ} : unsym a = unsym b ↔ a = b :=
  unsym_injective.eq_iff
#align sym_alg.unsym_inj SymAlg.unsym_inj

instance [Nontrivial α] : Nontrivial αˢʸᵐ :=
  sym_injective.Nontrivial

instance [Inhabited α] : Inhabited αˢʸᵐ :=
  ⟨sym default⟩

instance [Subsingleton α] : Subsingleton αˢʸᵐ :=
  unsym_injective.Subsingleton

instance [Unique α] : Unique αˢʸᵐ :=
  Unique.mk' _

instance [IsEmpty α] : IsEmpty αˢʸᵐ :=
  Function.isEmpty unsym

@[to_additive]
instance [One α] : One αˢʸᵐ where one := sym 1

instance [Add α] : Add αˢʸᵐ where add a b := sym (unsym a + unsym b)

instance [Sub α] : Sub αˢʸᵐ where sub a b := sym (unsym a - unsym b)

instance [Neg α] : Neg αˢʸᵐ where neg a := sym (-unsym a)

-- Introduce the symmetrized multiplication
instance [Add α] [Mul α] [One α] [Invertible (2 : α)] : Mul αˢʸᵐ
    where mul a b := sym (⅟ 2 * (unsym a * unsym b + unsym b * unsym a))

@[to_additive]
instance [Inv α] : Inv αˢʸᵐ where inv a := sym <| (unsym a)⁻¹

instance (R : Type _) [SMul R α] : SMul R αˢʸᵐ where smul r a := sym (r • unsym a)

@[simp, to_additive]
theorem sym_one [One α] : sym (1 : α) = 1 :=
  rfl
#align sym_alg.sym_one SymAlg.sym_one
#align sym_alg.sym_zero SymAlg.sym_zero

@[simp, to_additive]
theorem unsym_one [One α] : unsym (1 : αˢʸᵐ) = 1 :=
  rfl
#align sym_alg.unsym_one SymAlg.unsym_one
#align sym_alg.unsym_zero SymAlg.unsym_zero

@[simp]
theorem sym_add [Add α] (a b : α) : sym (a + b) = sym a + sym b :=
  rfl
#align sym_alg.sym_add SymAlg.sym_add

@[simp]
theorem unsym_add [Add α] (a b : αˢʸᵐ) : unsym (a + b) = unsym a + unsym b :=
  rfl
#align sym_alg.unsym_add SymAlg.unsym_add

@[simp]
theorem sym_sub [Sub α] (a b : α) : sym (a - b) = sym a - sym b :=
  rfl
#align sym_alg.sym_sub SymAlg.sym_sub

@[simp]
theorem unsym_sub [Sub α] (a b : αˢʸᵐ) : unsym (a - b) = unsym a - unsym b :=
  rfl
#align sym_alg.unsym_sub SymAlg.unsym_sub

@[simp]
theorem sym_neg [Neg α] (a : α) : sym (-a) = -sym a :=
  rfl
#align sym_alg.sym_neg SymAlg.sym_neg

@[simp]
theorem unsym_neg [Neg α] (a : αˢʸᵐ) : unsym (-a) = -unsym a :=
  rfl
#align sym_alg.unsym_neg SymAlg.unsym_neg

theorem mul_def [Add α] [Mul α] [One α] [Invertible (2 : α)] (a b : αˢʸᵐ) :
    a * b = sym (⅟ 2 * (unsym a * unsym b + unsym b * unsym a)) := by rfl
#align sym_alg.mul_def SymAlg.mul_def

theorem unsym_mul [Mul α] [Add α] [One α] [Invertible (2 : α)] (a b : αˢʸᵐ) :
    unsym (a * b) = ⅟ 2 * (unsym a * unsym b + unsym b * unsym a) := by rfl
#align sym_alg.unsym_mul SymAlg.unsym_mul

theorem sym_mul_sym [Mul α] [Add α] [One α] [Invertible (2 : α)] (a b : α) :
    sym a * sym b = sym (⅟ 2 * (a * b + b * a)) :=
  rfl
#align sym_alg.sym_mul_sym SymAlg.sym_mul_sym

@[simp, to_additive]
theorem sym_inv [Inv α] (a : α) : sym a⁻¹ = (sym a)⁻¹ :=
  rfl
#align sym_alg.sym_inv SymAlg.sym_inv
#align sym_alg.sym_neg SymAlg.sym_neg

@[simp, to_additive]
theorem unsym_inv [Inv α] (a : αˢʸᵐ) : unsym a⁻¹ = (unsym a)⁻¹ :=
  rfl
#align sym_alg.unsym_inv SymAlg.unsym_inv
#align sym_alg.unsym_neg SymAlg.unsym_neg

@[simp]
theorem sym_smul {R : Type _} [SMul R α] (c : R) (a : α) : sym (c • a) = c • sym a :=
  rfl
#align sym_alg.sym_smul SymAlg.sym_smul

@[simp]
theorem unsym_smul {R : Type _} [SMul R α] (c : R) (a : αˢʸᵐ) : unsym (c • a) = c • unsym a :=
  rfl
#align sym_alg.unsym_smul SymAlg.unsym_smul

@[simp, to_additive]
theorem unsym_eq_one_iff [One α] (a : αˢʸᵐ) : a.unsym = 1 ↔ a = 1 :=
  unsym_injective.eq_iff' rfl
#align sym_alg.unsym_eq_one_iff SymAlg.unsym_eq_one_iff
#align sym_alg.unsym_eq_zero_iff SymAlg.unsym_eq_zero_iff

@[simp, to_additive]
theorem sym_eq_one_iff [One α] (a : α) : sym a = 1 ↔ a = 1 :=
  sym_injective.eq_iff' rfl
#align sym_alg.sym_eq_one_iff SymAlg.sym_eq_one_iff
#align sym_alg.sym_eq_zero_iff SymAlg.sym_eq_zero_iff

@[to_additive]
theorem unsym_ne_one_iff [One α] (a : αˢʸᵐ) : a.unsym ≠ (1 : α) ↔ a ≠ (1 : αˢʸᵐ) :=
  not_congr <| unsym_eq_one_iff a
#align sym_alg.unsym_ne_one_iff SymAlg.unsym_ne_one_iff
#align sym_alg.unsym_ne_zero_iff SymAlg.unsym_ne_zero_iff

@[to_additive]
theorem sym_ne_one_iff [One α] (a : α) : sym a ≠ (1 : αˢʸᵐ) ↔ a ≠ (1 : α) :=
  not_congr <| sym_eq_one_iff a
#align sym_alg.sym_ne_one_iff SymAlg.sym_ne_one_iff
#align sym_alg.sym_ne_zero_iff SymAlg.sym_ne_zero_iff

instance [AddCommSemigroup α] : AddCommSemigroup αˢʸᵐ :=
  unsym_injective.AddCommSemigroup _ unsym_add

instance [AddMonoid α] : AddMonoid αˢʸᵐ :=
  unsym_injective.AddMonoid _ unsym_zero unsym_add fun _ _ => rfl

instance [AddGroup α] : AddGroup αˢʸᵐ :=
  unsym_injective.AddGroup _ unsym_zero unsym_add unsym_neg unsym_sub (fun _ _ => rfl) fun _ _ =>
    rfl

instance [AddCommMonoid α] : AddCommMonoid αˢʸᵐ :=
  { SymAlg.addCommSemigroup, SymAlg.addMonoid with }

instance [AddCommGroup α] : AddCommGroup αˢʸᵐ :=
  { SymAlg.addCommMonoid, SymAlg.addGroup with }

instance {R : Type _} [Semiring R] [AddCommMonoid α] [Module R α] : Module R αˢʸᵐ :=
  Function.Injective.module R ⟨unsym, unsym_zero, unsym_add⟩ unsym_injective unsym_smul

instance [Mul α] [Add α] [One α] [Invertible (2 : α)] (a : α) [Invertible a] : Invertible (sym a)
    where
  invOf := sym (⅟ a)
  invOf_mul_self := by
    rw [sym_mul_sym, mul_invOf_self, invOf_mul_self, ← bit0, invOf_mul_self, sym_one]
  mul_invOf_self := by
    rw [sym_mul_sym, mul_invOf_self, invOf_mul_self, ← bit0, invOf_mul_self, sym_one]

@[simp]
theorem invOf_sym [Mul α] [Add α] [One α] [Invertible (2 : α)] (a : α) [Invertible a] :
    ⅟ (sym a) = sym (⅟ a) :=
  rfl
#align sym_alg.inv_of_sym SymAlg.invOf_sym

instance [Semiring α] [Invertible (2 : α)] : NonAssocSemiring αˢʸᵐ :=
  { SymAlg.addCommMonoid with
    one := 1
    mul := (· * ·)
    zero := 0
    zero_mul := fun _ => by
      rw [mul_def, unsym_zero, MulZeroClass.zero_mul, MulZeroClass.mul_zero, add_zero,
        MulZeroClass.mul_zero, sym_zero]
    mul_zero := fun _ => by
      rw [mul_def, unsym_zero, MulZeroClass.zero_mul, MulZeroClass.mul_zero, add_zero,
        MulZeroClass.mul_zero, sym_zero]
    mul_one := fun _ => by
      rw [mul_def, unsym_one, mul_one, one_mul, ← two_mul, invOf_mul_self_assoc, sym_unsym]
    one_mul := fun _ => by
      rw [mul_def, unsym_one, mul_one, one_mul, ← two_mul, invOf_mul_self_assoc, sym_unsym]
    left_distrib := fun a b c =>
      match a, b, c with
      | Sym a, Sym b, Sym c => by
        rw [sym_mul_sym, sym_mul_sym, ← sym_add, sym_mul_sym, ← sym_add, mul_add a, add_mul _ _ a,
          add_add_add_comm, mul_add]
    right_distrib := fun a b c =>
      match a, b, c with
      | Sym a, Sym b, Sym c => by
        rw [sym_mul_sym, sym_mul_sym, ← sym_add, sym_mul_sym, ← sym_add, mul_add c, add_mul _ _ c,
          add_add_add_comm, mul_add] }

/-- The symmetrization of a real (unital, associative) algebra is a non-associative ring. -/
instance [Ring α] [Invertible (2 : α)] : NonAssocRing αˢʸᵐ :=
  { SymAlg.nonAssocSemiring, SymAlg.addCommGroup with }

/-! The squaring operation coincides for both multiplications -/

theorem unsym_mul_self [Semiring α] [Invertible (2 : α)] (a : αˢʸᵐ) :
    unsym (a * a) = unsym a * unsym a := by rw [mul_def, unsym_sym, ← two_mul, invOf_mul_self_assoc]
#align sym_alg.unsym_mul_self SymAlg.unsym_mul_self

theorem sym_mul_self [Semiring α] [Invertible (2 : α)] (a : α) : sym (a * a) = sym a * sym a := by
  rw [sym_mul_sym, ← two_mul, invOf_mul_self_assoc]
#align sym_alg.sym_mul_self SymAlg.sym_mul_self

theorem mul_comm [Mul α] [AddCommSemigroup α] [One α] [Invertible (2 : α)] (a b : αˢʸᵐ) :
    a * b = b * a := by rw [mul_def, mul_def, add_comm]
#align sym_alg.mul_comm SymAlg.mul_comm

instance [Ring α] [Invertible (2 : α)] : IsCommJordan αˢʸᵐ
    where
  mul_comm := SymAlg.mul_comm
  lmul_comm_rmul_rmul a b :=
    by
    -- Rearrange LHS
    have commute_half_left := fun a : α => (Commute.one_left a).bit0_left.invOf_left.Eq
    rw [mul_def, mul_def a b, unsym_sym, ← mul_assoc, ← commute_half_left (unsym (a * a)),
      mul_assoc, mul_assoc, ← mul_add, ← mul_assoc, add_mul, mul_add (unsym (a * a)), ← add_assoc, ←
      mul_assoc, ← mul_assoc]
    -- Rearrange RHS
    nth_rw_rhs 1 [mul_def]
    nth_rw_rhs 1 [mul_def]
    nth_rw_rhs 3 [mul_def]
    rw [unsym_sym, sym_inj, ← mul_assoc, ← commute_half_left (unsym a), mul_assoc (⅟ 2) (unsym a),
      mul_assoc (⅟ 2) _ (unsym a), ← mul_add, ← mul_assoc]
    nth_rw_rhs 1 [mul_add (unsym a)]
    rw [add_mul, ← add_assoc, ← mul_assoc, ← mul_assoc]
    rw [unsym_mul_self]
    rw [← mul_assoc, ← mul_assoc, ← mul_assoc, ← mul_assoc, ← sub_eq_zero, ← mul_sub]
    convert MulZeroClass.mul_zero (⅟ (2 : α) * ⅟ (2 : α))
    rw [add_sub_add_right_eq_sub, add_assoc, add_assoc, add_sub_add_left_eq_sub, add_comm,
      add_sub_add_right_eq_sub, sub_eq_zero]

end SymAlg


/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/
import data.int.basic
import data.int.range
import order.locally_finite
import algebra.group.basic
import order.filter.basic

import topology.instances.real

import .Folner_amenable

/-!
# Example of a Folner amenable group

We construct an explicit Folner sequence for the additive group ℤ  (which
we have to convert to a multiplicative group first), thus showing that
ℤ is amenable.

## Main Definitions

- `Folner_sequence_Z`  : a Folner sequence for ℤ

## Main Statements

- `Z_amenable`         : The group ℤ is amenable

## References
* [C. Löh, *Geometric Group Theory*, Example 9.2.2][loeh17]

## Tags
integers, Folner amenable, amenable,
-/

open classical

open filter

notation `mulZ` := (multiplicative ℤ) -- the integers as a group (not an add_group)

section example_Folner

/-!
### Construction of a Folner sequence

As sets, we take the (integral) interval [-n,n].
We then just verify the desired properties.

-/

/--Definition of the sets-/
def sets' : ℕ → finset ℤ
 := (λ n, finset.Icc (-(n:ℤ)) n)

/--The sets are nonempty -/
lemma sets_nonempty : ∀ n, sets' n ≠ ∅
:= begin
  assume n,
  dsimp[sets'],
  by norm_num,
end

/--Cardinality of these sets-/
@[simp]
lemma sets_card : ∀ n, (sets' n).card = 2*n+1
:= begin
  assume n,
  unfold sets',
  rw int.card_Icc,
  simp,
  ring_nf,
end

/-- The additive version of left_translate_set-/
def left_add_set
  {G:Type*} [add_group G]
  (g : G)
  (A : finset G)
  : finset G
:= finset.map (function.embedding.mk (λ x, g+x) (add_right_injective g)) A

lemma translate_vs_add
  {G:Type*} [add_group G]
  {g : G}
  {A : finset G}
  : left_add_set g A = @left_translate_set (multiplicative G) _ g A
:= begin
  dsimp[left_add_set, left_translate_set],
  congr,
end

/-- Translation of an interval -/
@[simp]
lemma interval_translate
  {n : ℕ}
  {g : ℤ}
  : @left_translate_set mulZ _ g (sets' n)
  = @finset.Icc ℤ _ _ (-(n:ℤ)+g) (n+g)
:= begin
  rw ← translate_vs_add,
  dsimp[left_add_set],
  ext x,
  dsimp[sets'],
  simp,
  split,
  {
    assume exa,
    rcases exa with ⟨a, ⟨⟨ha₁, ha₂⟩, ha₃⟩⟩,
    split; linarith,
  },
  {
    assume h,
    use x-g,
    simp,
    split;linarith,
  },
end

lemma interval_diff
  {n : ℕ}
  {g : ℤ}
  (g_nonneg: g ≥ 0)
  (n_ge_g : (n:ℤ) ≥ g)
  : symm_diff (sets' n) (@left_translate_set mulZ  _ g (sets' n))
    ⊆ (finset.Ico (-(n:ℤ)) (-n+g)) ∪ (finset.Ioc (n:ℤ) (n+g))
:= begin
  simp,
  dsimp [symm_diff],
  assume x xin,
  simp at xin,
  simp,
  unfold sets' at xin,
  cases xin,
  {
    left,
    simp at xin,
    split,
      exact xin.left.left,
    by_contradiction,
    simp at h,
    have : (n:ℤ)+g < x := xin.right h,
    linarith,
  },
  right,
  simp at xin,
  split,
    apply xin.right,
    linarith,
  exact xin.left.right,
end

lemma interval_diff'
  {n : ℕ}
  {g : ℤ}
  (g_neg: g < 0)
  (n_ge_g : (n:ℤ) ≥ -g)
  : symm_diff (sets' n) (@left_translate_set mulZ _ g (sets' n))
   ⊆ (finset.Ico (-n+g) (-(n:ℤ)) ) ∪ (finset.Ioc (n+g) (n:ℤ) )
:= begin
  simp,
  dsimp [symm_diff],
  assume x xin,
  simp at xin,
  simp,
  unfold sets' at xin,
  cases xin,
  {
    right,
    simp at xin,
    split,
      apply xin.right,
      linarith,
    exact xin.left.right,
  },
  left,
  simp at xin,
  apply and.intro xin.left.left,
  by_contradiction,
  simp at h,
  have : (n:ℤ) < x := xin.right h,
  by linarith,
end

lemma symm_diff_card
  {n : ℕ}
  {g : ℤ}
  (n_ge_g : (n:ℤ) ≥ abs g)
  : (symm_diff (sets' n) (@left_translate_set mulZ _ g (sets' n))).card ≤ 2 * (abs g).to_nat
:= begin
  by_cases g_pos : g ≥ 0,
  {
    have n_ge_g : (n:ℤ) ≥ g,
    {
      rw ← abs_of_nonneg g_pos,
      exact n_ge_g,
    },
    calc  (symm_diff (sets' n) (@left_translate_set mulZ _ g (sets' n))).card
        ≤ ((finset.Ico (-(n:ℤ)) (-(n:ℤ)+g) ) ∪ (finset.Ioc (n:ℤ) (n+g)  )).card
          : by exact finset.card_le_of_subset (interval_diff g_pos n_ge_g)
    ... ≤ (finset.Ico (-(n:ℤ)) (-(n:ℤ)+g) ).card  + (finset.Ioc (n:ℤ) (n+g)  ).card
          : by exact finset.card_union_le _ _
    ... = g.to_nat + g.to_nat
          : by simp
    ... = 2 * g.to_nat
          : by ring
    ... = 2 * (abs g).to_nat
          : by rw abs_of_nonneg g_pos,
  },
 {
    simp at g_pos,
    have n_ge_g : (n:ℤ) ≥ -g,
    {
      rw ← abs_of_neg g_pos,
      exact n_ge_g,
    },
    calc  (symm_diff (sets' n) (@left_translate_set mulZ _ g (sets' n))).card
        ≤ ((finset.Ico(-(n:ℤ)+g) (-(n:ℤ))  ) ∪ (finset.Ioc ((n:ℤ)+g) (n:ℤ)   )).card
          : by exact finset.card_le_of_subset (interval_diff' g_pos n_ge_g)
    ... ≤ (finset.Ico (-(n:ℤ)+g)  (-(n:ℤ)) ).card  + (finset.Ioc ((n:ℤ)+g) (n:ℤ)  ).card
          : by exact finset.card_union_le _ _
    ... = (-g).to_nat + (-g).to_nat
          : by simp
    ... = 2 * (-g).to_nat
          : by ring
    ... = 2 * (abs g).to_nat
          : by rw abs_of_neg g_pos,
  },
end

lemma eq_self_of_int_to_nat
 : ∀ {x:ℤ}, x ≥ 0 → (x.to_nat:ℤ) = x
:= begin
  assume x,
  induction (x:ℤ),
  intro,
  simp,
  assume h,
  exfalso,
  finish,
end

lemma eq_self_abs
  {x:ℤ}
  : |x| = |x|.to_nat
:= begin
  rw eq_self_of_int_to_nat,
  exact abs_nonneg x,
end

/--proof that the Folner condition is satisfied -/
lemma Folner_cond : ∀ g : ℤ ,
        filter.tendsto (@Folner_quotients mulZ _ _ g sets')  filter.at_top (nhds 0)
:= begin
  assume g,
  rw metric.tendsto_at_top,
  assume ε εpos,
  have : ∃ (N:ℕ), (N:ℝ) > (2 * (abs g) ) / ε
    := exists_nat_gt (2 * |g| / ε),
  rcases this with ⟨N', hN'⟩,
  use max N' (abs g).to_nat,
  assume n nge,
  have n_ge_g: (n:ℤ) ≥ abs g,
    {
      simp at nge,
      exact nge.right,
    },
  unfold Folner_quotients,
  simp,
  have : (((@translate_symm_diff mulZ _ _ g (sets' n)).card):ℝ) < abs (2*n+1) * ε,
  {
    unfold translate_symm_diff,
    calc  ((symm_diff (sets' n) (@left_translate_set mulZ _ g (sets' n))).card :ℝ)
        ≤    (((2:ℕ) * ((abs g).to_nat)) :ℝ )
          : by  {
              rw ← nat.cast_mul,
              exact nat.cast_le.mpr (symm_diff_card n_ge_g),
          }
    ... < N' * ε
          : by {
            simp at hN',
            rw (div_lt_iff εpos) at hN',
            simp at hN',
            have : |(g:ℝ)| = |g|.to_nat,
            {
              rw ← int.cast_abs,
              have : |g| = |g|.to_nat
                := eq_self_abs,
              rw this,
              generalize : |g| = z,
              simp,
            },
            rw ← this,
            finish,
          }
    ... < abs (2*n+1) *ε
          : by {
            have : n ≥ N'
              := le_of_max_le_left nge,
            rw mul_lt_mul_right εpos,
            calc  (N':ℝ)
                ≤ n
                  : by {
                    simp,
                    exact this,
                  }
            ... < 2*n+1
                  : by {
                       have : (n:ℝ) ≥ 0 := nat.cast_nonneg n,
                       by linarith,
                  }
            ... ≤ |2 * (n:ℝ) + 1|
                  : le_abs_self _,
          },
  },
  rw div_lt_iff,
    rw mul_comm at this,
    exact this,
  simp,
  have : 2*(n:ℝ) +1 ≥ 1 := by simp [nat.cast_nonneg n],
  by linarith,
end

/--A Folner sequence for ℤ-/
def Folner_sequence_Z
  : Folner_sequence mulZ
:= Folner_sequence.mk sets' sets_nonempty Folner_cond

/--Z (as a multiplicative group) is amenable-/
theorem Z_amenable
  : amenable (multiplicative ℤ)
:= amenable_of_Folner_sequence Folner_sequence_Z

end example_Folner


import game.sets.sets_level05 -- hide
import tactic -- hide

namespace xena -- hide

variable X : Type
/-
# Chapter 1 : Sets

## Level 6
-/

/-
See if you can prove the identity below using the `ext` tactic.

Applying `ext,` with no arguments will apply as many *extensionality* lemmas
as Lean can find. The following extensionality theorems can be found in mathlib.
-/

/- Hint : Propositional Extensionality

`constant propext {a b : Prop} : (a ↔ b) → a = b`

If two propositions imply one another, then those two propositions are equal. Here `constant` indicates that this is not just a theorem but an axiom.

Curly braces indicate that the arguments of `propext` may be left implicit and inferred from context.
-/

/- Hint : Function Extensionality

`theorem funext {f₁ f₂ : Π x : α, β x} (h : ∀ x, f₁ x = f₂ x) : f₁ = f₂.`

If two functions agree on all arguments, then those functions are equal.

-/

/- Hint : Set Extensionality

`theorem ext_iff {s t : set α} : s = t ↔ ∀ x, x ∈ s ↔ x ∈ t`

Two sets are equal if and only if they contain the same elements.

-/

/-
For example, `ext` will reduce a goal `S = T` to a goal `∀x (x ∈ S ↔ x ∈ T)`.
This makes `ext` especially useful for proving identities.

For this level, you need to know that the *complement* of a set `A` is denoted `-A` (usually $A^{c}$ in
textbooks). It is the set of
all elements *not* in `A`.
In Lean this is defined in terms of a universal set `univ` containing
all and only the elements of the domain (here, all members of X).

Given two sets `A` and `B`, the *set
difference* `A \ B` is the set of all elements that are in `A` but not in `B`.

-/

/- Hint : Hint :

A goal of `x ∈ -A` is definitionally equal to a goal of `x ∉ A`.

-/

/- Lemma
If $A$ and $B$ are sets with elements of type $X$, then

$$(A \setminus B) = A \cap B^{c}.$$

-/
theorem setdiff_eq_intersect_comp (A B : set X) : A \ B = A ∩ -B :=
begin
ext,
    split,
    {   intro h1,
        split,
           {  cases h1 with p q,
              exact p
           },
           {  cases h1 with p q,
              exact q,
           }
    },
    {   intro h2,
        exact h2
    }
end

end xena -- hide


/-
Copyright (c) 2021 Paula Neeley. All rights reserved.
Author: Paula Neeley
Following the textbook "Dynamic Epistemic Logic" by
Hans van Ditmarsch, Wiebe van der Hoek, and Barteld Kooi
-/

import del.languageDEL data.set.basic del.semantics.semanticsDEL del.announcements
local attribute [instance] classical.prop_decidable

variables {agents : Type}

---------------------- Soundness ----------------------

theorem soundnessS5 {Γ : ctx agents} {φ : form agents} :
  prfS5 Γ φ → global_sem_csq Γ equiv_class φ :=
begin
intros h1 f h2 v h3 x,
induction h1 generalizing x,
repeat {rename h1_Γ Γ},
repeat {rename h1_φ φ},
repeat {rename h1_h h1},
repeat {rename h1_ψ ψ},
repeat {rename h1_χ χ},
repeat {rename h1_a a},
repeat {rename h1_hp hp},
repeat {rename h1_hpq hpq},
repeat {rename h1_ih ih},
repeat {rename h1_ih_hp ih_hp},
repeat {rename h1_ih_hpq ih_hpq},
{exact h3 φ x h1},
{intros h4 h5, exact h4},
{intros h4 h5 h6, exact (h4 h6) (h5 h6)},
{intros h1 h4,
by_contradiction h5,
exact (h1 h5) (h4 h5)},
{intros h4 h5, exact and.intro h4 h5},
{intros h4, exact h4.left},
{intros h4, exact h4.right},
{intros h1 h4,
repeat {rw forces at h1},
repeat {rw imp_false at h1},
rw not_imp_not at h1,
exact h1 h4},
{intros h3 h4, simp [forces] at *, intros x' h5,
exact (h3 x' h5) (h4 x' h5)},
{intros h1, apply h1, exact (h2 a).left x},
{intros h1 y h4 z h5, apply h1 z,
cases h2 a with h2l h2r, cases h2r with h2r h2rr,
exact h2rr h4 h5},
{intros h1 y h5 h4, apply h1, intros z h6, apply h4 z,
cases h2 a with h2l h2r, cases h2r with h2r h2rr,
exact h2rr (h2r h5) h6},
{exact ih_hpq h3 x (ih_hp h3 x)},
{intros y h1, exact ih h3 y}
end

theorem soundnessPA {Γ : ctxPA agents} {φ : formPA agents} :
  prfPA Γ φ → global_sem_csqPA Γ equiv_class φ :=
begin
intros h1 f h2 v h3 x,
induction h1 generalizing x,
repeat {rename h1_Γ Γ},
repeat {rename h1_φ φ},
repeat {rename h1_h h1},
repeat {rename h1_ψ ψ},
repeat {rename h1_χ χ},
repeat {rename h1_a a},
repeat {rename h1_hp hp},
repeat {rename h1_hpq hpq},
repeat {rename h1_ih ih},
repeat {rename h1_ih_hp ih_hp},
repeat {rename h1_ih_hpq ih_hpq},
{exact h3 φ x h1},
{intros h4 h5, exact h4},
{intros h4 h5 h6, exact (h4 h6) (h5 h6)},
{intros h1 h4,
by_contradiction h5,
exact (h1 h5) (h4 h5)},
{intros h4 h5, exact and.intro h4 h5},
{intros h4, exact h4.left},
{intros h4, exact h4.right},
{intros h1 h4,
repeat {rw forcesPA at h1},
repeat {rw imp_false at h1},
rw not_imp_not at h1,
exact h1 h4},
{intros h3 h4, simp [forcesPA] at *, intros x' h5,
exact (h3 x' h5) (h4 x' h5)},
{intros h1, apply h1, exact (h2 a).left x},
{intros h1 y h4 z h5, apply h1 z,
cases h2 a with h2l h2r, cases h2r with h2r h2rr,
exact h2rr h4 h5},
{intros h1 y h5 h4, apply h1, intros z h6, apply h4 z,
cases h2 a with h2l h2r, cases h2r with h2r h2rr,
exact h2rr (h2r h5) h6},
{exact ih_hpq h3 x (ih_hp h3 x)},
{intros y h1, exact ih h3 y},
{split, repeat {intros h1 h4, apply h1 h4}},
{split, repeat {intros h1 h4, apply h1 h4}},
{split, intros h1 h4 h5, exact (h1 h4) (h5 h4),
intros h1 h4 h5, apply h1 h4, intro h6, exact h5},
{split, intro h1, split, intro h4,
exact (h1 h4).left,
intro h4, exact (h1 h4).right,
intros h1 h4, split, exact h1.left h4, exact h1.right h4},
{split, intros h1 h4 h5,
apply h1 h5, exact h4 h5,
intros h1 h4 h5, exact h1 (λ h4, h5) h4},
{split, rw forcesPA, rw public_announce_know, intro h1, exact h1,
intro h1, rw public_announce_know, exact h1},
{split, intro h1, rw compositionPA.public_announce_comp,
exact h1, intro h1, rw compositionPA.public_announce_comp at h1, exact h1}
end


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

! This file was ported from Lean 3 source module dynamics.ergodic.measure_preserving
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.AeMeasurable

/-!
# Measure preserving maps

We say that `f : α → β` is a measure preserving map w.r.t. measures `μ : measure α` and
`ν : measure β` if `f` is measurable and `map f μ = ν`. In this file we define the predicate
`measure_theory.measure_preserving` and prove its basic properties.

We use the term "measure preserving" because in many applications `α = β` and `μ = ν`.

## References

Partially based on
[this](https://www.isa-afp.org/browser_info/current/AFP/Ergodic_Theory/Measure_Preserving_Transformations.html)
Isabelle formalization.

## Tags

measure preserving map, measure
-/

variable {α β γ δ : Type _} [MeasurableSpace α] [MeasurableSpace β] [MeasurableSpace γ]
  [MeasurableSpace δ]

namespace MeasureTheory

open Measure Function Set

variable {μa : Measure α} {μb : Measure β} {μc : Measure γ} {μd : Measure δ}

/-- `f` is a measure preserving map w.r.t. measures `μa` and `μb` if `f` is measurable
and `map f μa = μb`. -/
@[protect_proj]
structure MeasurePreserving (f : α → β)
  (μa : Measure α := by exact MeasureTheory.MeasureSpace.volume)
  (μb : Measure β := by exact MeasureTheory.MeasureSpace.volume) : Prop where
  Measurable : Measurable f
  map_eq : map f μa = μb
#align measure_theory.measure_preserving MeasureTheory.MeasurePreserving

protected theorem Measurable.measurePreserving {f : α → β} (h : Measurable f) (μa : Measure α) :
    MeasurePreserving f μa (map f μa) :=
  ⟨h, rfl⟩
#align measurable.measure_preserving Measurable.measurePreserving

namespace MeasurePreserving

protected theorem id (μ : Measure α) : MeasurePreserving id μ μ :=
  ⟨measurable_id, map_id⟩
#align measure_theory.measure_preserving.id MeasureTheory.MeasurePreserving.id

protected theorem aeMeasurable {f : α → β} (hf : MeasurePreserving f μa μb) : AeMeasurable f μa :=
  hf.1.AeMeasurable
#align measure_theory.measure_preserving.ae_measurable MeasureTheory.MeasurePreserving.aeMeasurable

theorem symm (e : α ≃ᵐ β) {μa : Measure α} {μb : Measure β} (h : MeasurePreserving e μa μb) :
    MeasurePreserving e.symm μb μa :=
  ⟨e.symm.Measurable, by
    rw [← h.map_eq, map_map e.symm.measurable e.measurable, e.symm_comp_self, map_id]⟩
#align measure_theory.measure_preserving.symm MeasureTheory.MeasurePreserving.symm

theorem restrictPreimage {f : α → β} (hf : MeasurePreserving f μa μb) {s : Set β}
    (hs : MeasurableSet s) : MeasurePreserving f (μa.restrict (f ⁻¹' s)) (μb.restrict s) :=
  ⟨hf.Measurable, by rw [← hf.map_eq, restrict_map hf.measurable hs]⟩
#align measure_theory.measure_preserving.restrict_preimage MeasureTheory.MeasurePreserving.restrictPreimage

theorem restrictPreimageEmb {f : α → β} (hf : MeasurePreserving f μa μb)
    (h₂ : MeasurableEmbedding f) (s : Set β) :
    MeasurePreserving f (μa.restrict (f ⁻¹' s)) (μb.restrict s) :=
  ⟨hf.Measurable, by rw [← hf.map_eq, h₂.restrict_map]⟩
#align measure_theory.measure_preserving.restrict_preimage_emb MeasureTheory.MeasurePreserving.restrictPreimageEmb

theorem restrictImageEmb {f : α → β} (hf : MeasurePreserving f μa μb) (h₂ : MeasurableEmbedding f)
    (s : Set α) : MeasurePreserving f (μa.restrict s) (μb.restrict (f '' s)) := by
  simpa only [preimage_image_eq _ h₂.injective] using hf.restrict_preimage_emb h₂ (f '' s)
#align measure_theory.measure_preserving.restrict_image_emb MeasureTheory.MeasurePreserving.restrictImageEmb

theorem aeMeasurable_comp_iff {f : α → β} (hf : MeasurePreserving f μa μb)
    (h₂ : MeasurableEmbedding f) {g : β → γ} : AeMeasurable (g ∘ f) μa ↔ AeMeasurable g μb := by
  rw [← hf.map_eq, h₂.ae_measurable_map_iff]
#align measure_theory.measure_preserving.ae_measurable_comp_iff MeasureTheory.MeasurePreserving.aeMeasurable_comp_iff

protected theorem quasiMeasurePreserving {f : α → β} (hf : MeasurePreserving f μa μb) :
    QuasiMeasurePreserving f μa μb :=
  ⟨hf.1, hf.2.AbsolutelyContinuous⟩
#align measure_theory.measure_preserving.quasi_measure_preserving MeasureTheory.MeasurePreserving.quasiMeasurePreserving

protected theorem comp {g : β → γ} {f : α → β} (hg : MeasurePreserving g μb μc)
    (hf : MeasurePreserving f μa μb) : MeasurePreserving (g ∘ f) μa μc :=
  ⟨hg.1.comp hf.1, by rw [← map_map hg.1 hf.1, hf.2, hg.2]⟩
#align measure_theory.measure_preserving.comp MeasureTheory.MeasurePreserving.comp

protected theorem comp_left_iff {g : α → β} {e : β ≃ᵐ γ} (h : MeasurePreserving e μb μc) :
    MeasurePreserving (e ∘ g) μa μc ↔ MeasurePreserving g μa μb :=
  by
  refine' ⟨fun hg => _, fun hg => h.comp hg⟩
  convert(measure_preserving.symm e h).comp hg
  simp [← Function.comp.assoc e.symm e g]
#align measure_theory.measure_preserving.comp_left_iff MeasureTheory.MeasurePreserving.comp_left_iff

protected theorem comp_right_iff {g : α → β} {e : γ ≃ᵐ α} (h : MeasurePreserving e μc μa) :
    MeasurePreserving (g ∘ e) μc μb ↔ MeasurePreserving g μa μb :=
  by
  refine' ⟨fun hg => _, fun hg => hg.comp h⟩
  convert hg.comp (measure_preserving.symm e h)
  simp [Function.comp.assoc g e e.symm]
#align measure_theory.measure_preserving.comp_right_iff MeasureTheory.MeasurePreserving.comp_right_iff

protected theorem sigmaFinite {f : α → β} (hf : MeasurePreserving f μa μb) [SigmaFinite μb] :
    SigmaFinite μa :=
  SigmaFinite.ofMap μa hf.AeMeasurable (by rwa [hf.map_eq])
#align measure_theory.measure_preserving.sigma_finite MeasureTheory.MeasurePreserving.sigmaFinite

theorem measure_preimage {f : α → β} (hf : MeasurePreserving f μa μb) {s : Set β}
    (hs : MeasurableSet s) : μa (f ⁻¹' s) = μb s := by rw [← hf.map_eq, map_apply hf.1 hs]
#align measure_theory.measure_preserving.measure_preimage MeasureTheory.MeasurePreserving.measure_preimage

theorem measure_preimage_emb {f : α → β} (hf : MeasurePreserving f μa μb)
    (hfe : MeasurableEmbedding f) (s : Set β) : μa (f ⁻¹' s) = μb s := by
  rw [← hf.map_eq, hfe.map_apply]
#align measure_theory.measure_preserving.measure_preimage_emb MeasureTheory.MeasurePreserving.measure_preimage_emb

protected theorem iterate {f : α → α} (hf : MeasurePreserving f μa μa) :
    ∀ n, MeasurePreserving (f^[n]) μa μa
  | 0 => MeasurePreserving.id μa
  | n + 1 => (iterate n).comp hf
#align measure_theory.measure_preserving.iterate MeasureTheory.MeasurePreserving.iterate

variable {μ : Measure α} {f : α → α} {s : Set α}

/-- If `μ univ < n * μ s` and `f` is a map preserving measure `μ`,
then for some `x ∈ s` and `0 < m < n`, `f^[m] x ∈ s`. -/
theorem exists_mem_image_mem_of_volume_lt_mul_volume (hf : MeasurePreserving f μ μ)
    (hs : MeasurableSet s) {n : ℕ} (hvol : μ (univ : Set α) < n * μ s) :
    ∃ x ∈ s, ∃ m ∈ Ioo 0 n, (f^[m]) x ∈ s :=
  by
  have A : ∀ m, MeasurableSet (f^[m] ⁻¹' s) := fun m => (hf.iterate m).Measurable hs
  have B : ∀ m, μ (f^[m] ⁻¹' s) = μ s := fun m => (hf.iterate m).measure_preimage hs
  have : μ (univ : Set α) < (Finset.range n).Sum fun m => μ (f^[m] ⁻¹' s) := by
    simpa only [B, nsmul_eq_mul, Finset.sum_const, Finset.card_range]
  rcases exists_nonempty_inter_of_measure_univ_lt_sum_measure μ (fun m hm => A m) this with
    ⟨i, hi, j, hj, hij, x, hxi, hxj⟩
  wlog hlt : i < j generalizing i j
  · exact this j hj i hi hij.symm hxj hxi (hij.lt_or_lt.resolve_left hlt)
  simp only [Set.mem_preimage, Finset.mem_range] at hi hj hxi hxj
  refine' ⟨(f^[i]) x, hxi, j - i, ⟨tsub_pos_of_lt hlt, lt_of_le_of_lt (j.sub_le i) hj⟩, _⟩
  rwa [← iterate_add_apply, tsub_add_cancel_of_le hlt.le]
#align measure_theory.measure_preserving.exists_mem_image_mem_of_volume_lt_mul_volume MeasureTheory.MeasurePreserving.exists_mem_image_mem_of_volume_lt_mul_volume

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (m «expr ≠ » 0) -/
/-- A self-map preserving a finite measure is conservative: if `μ s ≠ 0`, then at least one point
`x ∈ s` comes back to `s` under iterations of `f`. Actually, a.e. point of `s` comes back to `s`
infinitely many times, see `measure_theory.measure_preserving.conservative` and theorems about
`measure_theory.conservative`. -/
theorem exists_mem_image_mem [IsFiniteMeasure μ] (hf : MeasurePreserving f μ μ)
    (hs : MeasurableSet s) (hs' : μ s ≠ 0) : ∃ x ∈ s, ∃ (m : _)(_ : m ≠ 0), (f^[m]) x ∈ s :=
  by
  rcases ENNReal.exists_nat_mul_gt hs' (measure_ne_top μ (univ : Set α)) with ⟨N, hN⟩
  rcases hf.exists_mem_image_mem_of_volume_lt_mul_volume hs hN with ⟨x, hx, m, hm, hmx⟩
  exact ⟨x, hx, m, hm.1.ne', hmx⟩
#align measure_theory.measure_preserving.exists_mem_image_mem MeasureTheory.MeasurePreserving.exists_mem_image_mem

end MeasurePreserving

namespace MeasurableEquiv

theorem measurePreservingSymm (μ : Measure α) (e : α ≃ᵐ β) : MeasurePreserving e.symm (map e μ) μ :=
  (e.Measurable.MeasurePreserving μ).symm _
#align measure_theory.measurable_equiv.measure_preserving_symm MeasureTheory.MeasurableEquiv.measurePreservingSymm

end MeasurableEquiv

end MeasureTheory


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module group_theory.group_action.basic
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Card
import Mathlib.GroupTheory.GroupAction.Defs
import Mathlib.GroupTheory.GroupAction.Group
import Mathlib.Data.Setoid.Basic
import Mathlib.Data.Set.Pointwise.SMul
import Mathlib.GroupTheory.Subgroup.Basic

/-!
# Basic properties of group actions

This file primarily concerns itself with orbits, stabilizers, and other objects defined in terms of
actions. Despite this file being called `basic`, low-level helper lemmas for algebraic manipulation
of `•` belong elsewhere.

## Main definitions

* `MulAction.orbit`
* `MulAction.fixedPoints`
* `MulAction.fixedBy`
* `MulAction.stabilizer`

-/

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

open Pointwise

open Function

namespace MulAction

variable (α) [Monoid α] [MulAction α β]

/-- The orbit of an element under an action. -/
@[to_additive "The orbit of an element under an action."]
def orbit (b : β) :=
  Set.range fun x : α => x • b
#align mul_action.orbit MulAction.orbit
#align add_action.orbit AddAction.orbit

variable {α}

@[to_additive]
theorem mem_orbit_iff {b₁ b₂ : β} : b₂ ∈ orbit α b₁ ↔ ∃ x : α, x • b₁ = b₂ :=
  Iff.rfl
#align mul_action.mem_orbit_iff MulAction.mem_orbit_iff
#align add_action.mem_orbit_iff AddAction.mem_orbit_iff

@[to_additive (attr := simp)]
theorem mem_orbit (b : β) (x : α) : x • b ∈ orbit α b :=
  ⟨x, rfl⟩
#align mul_action.mem_orbit MulAction.mem_orbit
#align add_action.mem_orbit AddAction.mem_orbit

@[to_additive (attr := simp)]
theorem mem_orbit_self (b : β) : b ∈ orbit α b :=
  ⟨1, by simp [MulAction.one_smul]⟩
#align mul_action.mem_orbit_self MulAction.mem_orbit_self
#align add_action.mem_orbit_self AddAction.mem_orbit_self

@[to_additive]
theorem orbit_nonempty (b : β) : Set.Nonempty (orbit α b) :=
  Set.range_nonempty _
#align mul_action.orbit_nonempty MulAction.orbit_nonempty
#align add_action.orbit_nonempty AddAction.orbit_nonempty

@[to_additive]
theorem mapsTo_smul_orbit (a : α) (b : β) : Set.MapsTo ((· • ·) a) (orbit α b) (orbit α b) :=
  Set.range_subset_iff.2 fun a' => ⟨a * a', mul_smul _ _ _⟩
#align mul_action.maps_to_smul_orbit MulAction.mapsTo_smul_orbit
#align add_action.maps_to_vadd_orbit AddAction.mapsTo_vadd_orbit

@[to_additive]
theorem smul_orbit_subset (a : α) (b : β) : a • orbit α b ⊆ orbit α b :=
  (mapsTo_smul_orbit a b).image_subset
#align mul_action.smul_orbit_subset MulAction.smul_orbit_subset
#align add_action.vadd_orbit_subset AddAction.vadd_orbit_subset

@[to_additive]
theorem orbit_smul_subset (a : α) (b : β) : orbit α (a • b) ⊆ orbit α b :=
  Set.range_subset_iff.2 fun a' => mul_smul a' a b ▸ mem_orbit _ _
#align mul_action.orbit_smul_subset MulAction.orbit_smul_subset
#align add_action.orbit_vadd_subset AddAction.orbit_vadd_subset

@[to_additive]
instance {b : β} : MulAction α (orbit α b) where
  smul a := (mapsTo_smul_orbit a b).restrict _ _ _
  one_smul a := Subtype.ext (one_smul α (a : β))
  mul_smul a a' b' := Subtype.ext (mul_smul a a' (b' : β))

@[to_additive (attr := simp)]
theorem orbit.coe_smul {b : β} {a : α} {b' : orbit α b} : ↑(a • b') = a • (b' : β) :=
  rfl
#align mul_action.orbit.coe_smul MulAction.orbit.coe_smul
#align add_action.orbit.coe_vadd AddAction.orbit.coe_vadd

variable (α) (β)

/-- The set of elements fixed under the whole action. -/
@[to_additive "The set of elements fixed under the whole action."]
def fixedPoints : Set β :=
  { b : β | ∀ x : α, x • b = b }
#align mul_action.fixed_points MulAction.fixedPoints
#align add_action.fixed_points AddAction.fixedPoints

/-- `fixedBy g` is the subfield of elements fixed by `g`. -/
@[to_additive "`fixedBy g` is the subfield of elements fixed by `g`."]
def fixedBy (g : α) : Set β :=
  { x | g • x = x }
#align mul_action.fixed_by MulAction.fixedBy
#align add_action.fixed_by AddAction.fixedBy

@[to_additive]
theorem fixed_eq_interᵢ_fixedBy : fixedPoints α β = ⋂ g : α, fixedBy α β g :=
  Set.ext fun _ =>
    ⟨fun hx => Set.mem_interᵢ.2 fun g => hx g, fun hx g => (Set.mem_interᵢ.1 hx g : _)⟩
#align mul_action.fixed_eq_Inter_fixed_by MulAction.fixed_eq_interᵢ_fixedBy
#align add_action.fixed_eq_Inter_fixed_by AddAction.fixed_eq_interᵢ_fixedBy

variable {α}

@[to_additive (attr := simp)]
theorem mem_fixedPoints {b : β} : b ∈ fixedPoints α β ↔ ∀ x : α, x • b = b :=
  Iff.rfl
#align mul_action.mem_fixed_points MulAction.mem_fixedPoints
#align add_action.mem_fixed_points AddAction.mem_fixedPoints

@[to_additive (attr := simp)]
theorem mem_fixedBy {g : α} {b : β} : b ∈ fixedBy α β g ↔ g • b = b :=
  Iff.rfl
#align mul_action.mem_fixed_by MulAction.mem_fixedBy
#align add_action.mem_fixed_by AddAction.mem_fixedBy

@[to_additive]
theorem mem_fixedPoints' {b : β} : b ∈ fixedPoints α β ↔ ∀ b', b' ∈ orbit α b → b' = b :=
  ⟨fun h _ h₁ =>
    let ⟨x, hx⟩ := mem_orbit_iff.1 h₁
    hx ▸ h x,
    fun h _ => h _ (mem_orbit _ _)⟩
#align mul_action.mem_fixed_points' MulAction.mem_fixedPoints'
#align add_action.mem_fixed_points' AddAction.mem_fixedPoints'

variable (α) {β}

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
@[to_additive "The stabilizer of a point `b` as an additive submonoid of `α`."]
def Stabilizer.submonoid (b : β) : Submonoid α where
  carrier := { a | a • b = b }
  one_mem' := one_smul _ b
  mul_mem' {a a'} (ha : a • b = b) (hb : a' • b = b) :=
    show (a * a') • b = b by rw [← smul_smul, hb, ha]
#align mul_action.stabilizer.submonoid MulAction.Stabilizer.submonoid
#align add_action.stabilizer.add_submonoid AddAction.Stabilizer.addSubmonoid

@[to_additive (attr := simp)]
theorem mem_stabilizer_submonoid_iff {b : β} {a : α} : a ∈ Stabilizer.submonoid α b ↔ a • b = b :=
  Iff.rfl
#align mul_action.mem_stabilizer_submonoid_iff MulAction.mem_stabilizer_submonoid_iff
#align add_action.mem_stabilizer_add_submonoid_iff AddAction.mem_stabilizer_addSubmonoid_iff

@[to_additive]
theorem orbit_eq_univ [IsPretransitive α β] (x : β) : orbit α x = Set.univ :=
  (surjective_smul α x).range_eq
#align mul_action.orbit_eq_univ MulAction.orbit_eq_univ
#align add_action.orbit_eq_univ AddAction.orbit_eq_univ

variable {α}

@[to_additive]
theorem mem_fixedPoints_iff_card_orbit_eq_one {a : β} [Fintype (orbit α a)] :
    a ∈ fixedPoints α β ↔ Fintype.card (orbit α a) = 1 := by
  rw [Fintype.card_eq_one_iff, mem_fixedPoints]
  constructor
  · exact fun h => ⟨⟨a, mem_orbit_self _⟩, fun ⟨b, ⟨x, hx⟩⟩ => Subtype.eq <| by simp [h x, hx.symm]⟩
  · intro h x
    rcases h with ⟨⟨z, hz⟩, hz₁⟩
    calc
      x • a = z := Subtype.mk.inj (hz₁ ⟨x • a, mem_orbit _ _⟩)
      _ = a := (Subtype.mk.inj (hz₁ ⟨a, mem_orbit_self _⟩)).symm

#align mul_action.mem_fixed_points_iff_card_orbit_eq_one MulAction.mem_fixedPoints_iff_card_orbit_eq_one
#align add_action.mem_fixed_points_iff_card_orbit_eq_zero AddAction.mem_fixedPoints_iff_card_orbit_eq_zero

end MulAction

namespace MulAction

variable (α)

variable [Group α] [MulAction α β]

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
@[to_additive
      "The stabilizer of an element under an action, i.e. what sends the element to itself.
      An additive subgroup."]
def stabilizer (b : β) : Subgroup α :=
  { Stabilizer.submonoid α b with
    inv_mem' := fun {a} (ha : a • b = b) => show a⁻¹ • b = b by rw [inv_smul_eq_iff, ha] }
#align mul_action.stabilizer MulAction.stabilizer
#align add_action.stabilizer AddAction.stabilizer

variable {α}

@[to_additive (attr := simp)]

@[to_additive (attr := simp)]
theorem smul_orbit (a : α) (b : β) : a • orbit α b = orbit α b :=
  (smul_orbit_subset a b).antisymm <|
    calc
      orbit α b = a • a⁻¹ • orbit α b := (smul_inv_smul _ _).symm
      _ ⊆ a • orbit α b := Set.image_subset _ (smul_orbit_subset _ _)

#align mul_action.smul_orbit MulAction.smul_orbit
#align add_action.vadd_orbit AddAction.vadd_orbit

@[to_additive (attr := simp)]
theorem orbit_smul (a : α) (b : β) : orbit α (a • b) = orbit α b :=
  (orbit_smul_subset a b).antisymm <|
    calc
      orbit α b = orbit α (a⁻¹ • a • b) := by rw [inv_smul_smul]
      _ ⊆ orbit α (a • b) := orbit_smul_subset _ _

#align mul_action.orbit_smul MulAction.orbit_smul
#align add_action.orbit_vadd AddAction.orbit_vadd

/-- The action of a group on an orbit is transitive. -/
@[to_additive "The action of an additive group on an orbit is transitive."]
instance (x : β) : IsPretransitive α (orbit α x) :=
  ⟨by
    rintro ⟨_, a, rfl⟩ ⟨_, b, rfl⟩
    use b * a⁻¹
    ext1
    simp [mul_smul]⟩

@[to_additive]
theorem orbit_eq_iff {a b : β} : orbit α a = orbit α b ↔ a ∈ orbit α b :=
  ⟨fun h => h ▸ mem_orbit_self _, fun ⟨_, hc⟩ => hc ▸ orbit_smul _ _⟩
#align mul_action.orbit_eq_iff MulAction.orbit_eq_iff
#align add_action.orbit_eq_iff AddAction.orbit_eq_iff

variable (α)

@[to_additive]
theorem mem_orbit_smul (g : α) (a : β) : a ∈ orbit α (g • a) := by
  simp only [orbit_smul, mem_orbit_self]
#align mul_action.mem_orbit_smul MulAction.mem_orbit_smul
#align add_action.mem_orbit_vadd AddAction.mem_orbit_vadd

@[to_additive]
theorem smul_mem_orbit_smul (g h : α) (a : β) : g • a ∈ orbit α (h • a) := by
  simp only [orbit_smul, mem_orbit]
#align mul_action.smul_mem_orbit_smul MulAction.smul_mem_orbit_smul
#align add_action.vadd_mem_orbit_vadd AddAction.vadd_mem_orbit_vadd

variable (β)

/-- The relation 'in the same orbit'. -/
@[to_additive "The relation 'in the same orbit'."]
def orbitRel : Setoid β where
  r a b := a ∈ orbit α b
  iseqv :=
    ⟨mem_orbit_self, fun {a b} => by simp [orbit_eq_iff.symm, eq_comm], fun {a b} => by
      simp (config := { contextual := true }) [orbit_eq_iff.symm, eq_comm]⟩
#align mul_action.orbit_rel MulAction.orbitRel
#align add_action.orbit_rel AddAction.orbitRel

attribute [local instance] orbitRel

variable {α} {β}

/-- When you take a set `U` in `β`, push it down to the quotient, and pull back, you get the union
of the orbit of `U` under `α`. -/
@[to_additive
      "When you take a set `U` in `β`, push it down to the quotient, and pull back, you get the
      union of the orbit of `U` under `α`."]
theorem quotient_preimage_image_eq_union_mul (U : Set β) :
    Quotient.mk' ⁻¹' (Quotient.mk' '' U) = ⋃ a : α, (· • ·) a '' U := by
  set f : β → Quotient (MulAction.orbitRel α β) := Quotient.mk'
  ext x
  constructor
  · rintro ⟨y, hy, hxy⟩
    obtain ⟨a, rfl⟩ := Quotient.exact hxy
    rw [Set.mem_unionᵢ]
    exact ⟨a⁻¹, a • x, hy, inv_smul_smul a x⟩
  · intro hx
    rw [Set.mem_unionᵢ] at hx
    obtain ⟨a, u, hu₁, hu₂⟩ := hx
    rw [Set.mem_preimage, Set.mem_image_iff_bex]
    refine' ⟨a⁻¹ • x, _, by simp only [Quotient.eq']; use a⁻¹⟩
    rw [← hu₂]
    convert hu₁
    simp only [inv_smul_smul]
#align mul_action.quotient_preimage_image_eq_union_mul MulAction.quotient_preimage_image_eq_union_mul
#align add_action.quotient_preimage_image_eq_union_add AddAction.quotient_preimage_image_eq_union_add

@[to_additive]
theorem disjoint_image_image_iff {U V : Set β} :
    Disjoint (Quotient.mk' '' U) (Quotient.mk' '' V) ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V := by
  set f : β → Quotient (MulAction.orbitRel α β) := Quotient.mk'
  refine'
    ⟨fun h x x_in_U a a_in_V =>
      h.le_bot ⟨⟨x, x_in_U, Quotient.sound ⟨a⁻¹, _⟩⟩, ⟨a • x, a_in_V, rfl⟩⟩, _⟩
  · simp
  · intro h
    rw [Set.disjoint_left]
    rintro x ⟨y, hy₁, hy₂⟩ ⟨z, hz₁, hz₂⟩
    obtain ⟨a, rfl⟩ := Quotient.exact (hz₂.trans hy₂.symm)
    exact h y hy₁ a hz₁
#align mul_action.disjoint_image_image_iff MulAction.disjoint_image_image_iff
#align add_action.disjoint_image_image_iff AddAction.disjoint_image_image_iff

@[to_additive]
theorem image_inter_image_iff (U V : Set β) :
    Quotient.mk' '' U ∩ Quotient.mk' '' V = ∅ ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
  Set.disjoint_iff_inter_eq_empty.symm.trans disjoint_image_image_iff
#align mul_action.image_inter_image_iff MulAction.image_inter_image_iff
#align add_action.image_inter_image_iff AddAction.image_inter_image_iff

variable (α β)

/-- The quotient by `MulAction.orbitRel`, given a name to enable dot notation. -/
@[to_additive (attr := reducible)
    "The quotient by `AddAction.orbitRel`, given a name to enable dot notation."]
def orbitRel.Quotient : Type _ :=
  _root_.Quotient <| orbitRel α β
#align mul_action.orbit_rel.quotient MulAction.orbitRel.Quotient
#align add_action.orbit_rel.quotient AddAction.orbitRel.Quotient

variable {α β}

/-- The orbit corresponding to an element of the quotient by `MulAction.orbitRel` -/
@[to_additive "The orbit corresponding to an element of the quotient by `add_action.orbit_rel`"]
nonrec def orbitRel.Quotient.orbit (x : orbitRel.Quotient α β) : Set β :=
  Quotient.liftOn' x (orbit α) fun _ _ => MulAction.orbit_eq_iff.2
#align mul_action.orbit_rel.quotient.orbit MulAction.orbitRel.Quotient.orbit
#align add_action.orbit_rel.quotient.orbit AddAction.orbitRel.Quotient.orbit

@[to_additive (attr := simp)]
theorem orbitRel.Quotient.orbit_mk (b : β) :
    orbitRel.Quotient.orbit (Quotient.mk'' b : orbitRel.Quotient α β) = MulAction.orbit α b :=
  rfl
#align mul_action.orbit_rel.quotient.orbit_mk MulAction.orbitRel.Quotient.orbit_mk
#align add_action.orbit_rel.quotient.orbit_mk AddAction.orbitRel.Quotient.orbit_mk

@[to_additive]
theorem orbitRel.Quotient.mem_orbit {b : β} {x : orbitRel.Quotient α β} :
    b ∈ x.orbit ↔ Quotient.mk'' b = x := by
  induction x using Quotient.inductionOn'
  rw [Quotient.eq'']
  rfl
#align mul_action.orbit_rel.quotient.mem_orbit MulAction.orbitRel.Quotient.mem_orbit
#align add_action.orbit_rel.quotient.mem_orbit AddAction.orbitRel.Quotient.mem_orbit

/-- Note that `hφ = Quotient.out_eq'` is a useful choice here. -/
@[to_additive "Note that `hφ = quotient.out_eq'` is a useful choice here."]
theorem orbitRel.Quotient.orbit_eq_orbit_out (x : orbitRel.Quotient α β)
    {φ : orbitRel.Quotient α β → β} (hφ : RightInverse φ Quotient.mk') :
    orbitRel.Quotient.orbit x = MulAction.orbit α (φ x) := by
  conv_lhs => rw [← hφ x]
#align mul_action.orbit_rel.quotient.orbit_eq_orbit_out MulAction.orbitRel.Quotient.orbit_eq_orbit_out
#align add_action.orbit_rel.quotient.orbit_eq_orbit_out AddAction.orbitRel.Quotient.orbit_eq_orbit_out

variable (α) (β)

-- mathport name: exprΩ
local notation "Ω" => orbitRel.Quotient α β

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action.

This version is expressed in terms of `MulAction.orbitRel.Quotient.orbit` instead of
`MulAction.orbit`, to avoid mentioning `Quotient.out'`. -/
@[to_additive
      "Decomposition of a type `X` as a disjoint union of its orbits under an additive group action.

      This version is expressed in terms of `AddAction.orbitRel.Quotient.orbit` instead of
      `AddAction.orbit`, to avoid mentioning `Quotient.out'`. "]
def selfEquivSigmaOrbits' : β ≃ Σω : Ω, ω.orbit :=
  calc
    β ≃ Σω : Ω, { b // Quotient.mk' b = ω } := (Equiv.sigmaFiberEquiv Quotient.mk').symm
    _ ≃ Σω : Ω, ω.orbit :=
      Equiv.sigmaCongrRight fun _ =>
        Equiv.subtypeEquivRight fun _ => orbitRel.Quotient.mem_orbit.symm

#align mul_action.self_equiv_sigma_orbits' MulAction.selfEquivSigmaOrbits'
#align add_action.self_equiv_sigma_orbits' AddAction.selfEquivSigmaOrbits'

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action. -/
@[to_additive
      "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
      action."]
def selfEquivSigmaOrbits : β ≃ Σω : Ω, orbit α ω.out' :=
  (selfEquivSigmaOrbits' α β).trans <|
    Equiv.sigmaCongrRight fun _ =>
      Equiv.Set.ofEq <| orbitRel.Quotient.orbit_eq_orbit_out _ Quotient.out_eq'
#align mul_action.self_equiv_sigma_orbits MulAction.selfEquivSigmaOrbits
#align add_action.self_equiv_sigma_orbits AddAction.selfEquivSigmaOrbits

variable {α β}

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g • x` is `gSg⁻¹`. -/
theorem stabilizer_smul_eq_stabilizer_map_conj (g : α) (x : β) :
    stabilizer α (g • x) = (stabilizer α x).map (MulAut.conj g).toMonoidHom := by
  ext h
  rw [mem_stabilizer_iff, ← smul_left_cancel_iff g⁻¹, smul_smul, smul_smul, smul_smul, mul_left_inv,
    one_smul, ← mem_stabilizer_iff, Subgroup.mem_map_equiv, MulAut.conj_symm_apply]
#align mul_action.stabilizer_smul_eq_stabilizer_map_conj MulAction.stabilizer_smul_eq_stabilizer_map_conj

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel {x y : β} (h : (orbitRel α β).Rel x y) :
    stabilizer α x ≃* stabilizer α y :=
  let g : α := Classical.choose h
  have hg : g • y = x := Classical.choose_spec h
  have this : stabilizer α x = (stabilizer α y).map (MulAut.conj g).toMonoidHom := by
    rw [← hg, stabilizer_smul_eq_stabilizer_map_conj]
  (MulEquiv.subgroupCongr this).trans ((MulAut.conj g).subgroupMap <| stabilizer α y).symm
#align mul_action.stabilizer_equiv_stabilizer_of_orbit_rel MulAction.stabilizerEquivStabilizerOfOrbitRel

end MulAction

namespace AddAction

variable [AddGroup α] [AddAction α β]

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g +ᵥ x` is `g + S + (-g)`. -/
theorem stabilizer_vadd_eq_stabilizer_map_conj (g : α) (x : β) :
    stabilizer α (g +ᵥ x) = (stabilizer α x).map (AddAut.conj g).toAddMonoidHom := by
  ext h
  rw [mem_stabilizer_iff, ← vadd_left_cancel_iff (-g), vadd_vadd, vadd_vadd, vadd_vadd,
    add_left_neg, zero_vadd, ← mem_stabilizer_iff, AddSubgroup.mem_map_equiv,
    AddAut.conj_symm_apply]
#align add_action.stabilizer_vadd_eq_stabilizer_map_conj AddAction.stabilizer_vadd_eq_stabilizer_map_conj

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel {x y : β} (h : (orbitRel α β).Rel x y) :
    stabilizer α x ≃+ stabilizer α y :=
  let g : α := Classical.choose h
  have hg : g +ᵥ y = x := Classical.choose_spec h
  have this : stabilizer α x = (stabilizer α y).map (AddAut.conj g).toAddMonoidHom := by
    rw [← hg, stabilizer_vadd_eq_stabilizer_map_conj]
  (AddEquiv.addSubgroupCongr this).trans ((AddAut.conj g).addSubgroupMap <| stabilizer α y).symm
#align add_action.stabilizer_equiv_stabilizer_of_orbit_rel AddAction.stabilizerEquivStabilizerOfOrbitRel

end AddAction

/-- `smul` by a `k : M` over a ring is injective, if `k` is not a zero divisor.
The general theory of such `k` is elaborated by `IsSMulRegular`.
The typeclass that restricts all terms of `M` to have this property is `NoZeroSMulDivisors`. -/
theorem smul_cancel_of_non_zero_divisor {M R : Type _} [Monoid M] [NonUnitalNonAssocRing R]
    [DistribMulAction M R] (k : M) (h : ∀ x : R, k • x = 0 → x = 0) {a b : R} (h' : k • a = k • b) :
    a = b := by
  rw [← sub_eq_zero]
  refine' h _ _
  rw [smul_sub, h', sub_self]
#align smul_cancel_of_non_zero_divisor smul_cancel_of_non_zero_divisor


import tactic
import data.real.basic
import data.nat.choose.sum -- binomial theorem
import data.real.ereal
import data.pnat.basic

section Q2

/-!

# Q2

-/

/-
2.  Fix nonempty sets S_n ⊆ R, n= 1,2,3,....
Prove that sup{sup S1,sup S2,sup S3,...} = sup(⋃_{n=1}^{infty} S_n),
in the sense that if either exists then so does the other, and they are equal.
-/

/-
Let's first answer a better question with fewer restrictions,
using extended reals.
Then Sup {Sup (S_i) : i ∈ I} = Sup (⋃_{i ∈ I} S_i) is *always* true
-/

-- this comes out really cleanly, we just allow infinity
example (I : Type) (S : I → set (ereal)) :
  Sup (set.range (λ i, Sup (S i))) = Sup (⋃ i, S i) :=
begin
  sorry
end

-- useful helper lemma
lemma exists_lub (S : set ℝ) :
  S.nonempty ∧ (upper_bounds S).nonempty → (∃ B, is_lub S B) :=
begin
  sorry
end

-- now the actual question

-- "All the S_i have a sup and the set {sup S1, sup S2, ...} has a sup, if and
-- only if the union of the S_i has a sup"
theorem Q2a (S : ℕ+ → set ℝ)
  (hS : ∀ i : ℕ+, (S i).nonempty) :
  (∀ n : ℕ+, ∃ B, is_lub (S n) B) ∧ (∃ B, is_lub (set.range (λ i, Sup (S i))) B) ↔
  ∃ B, is_lub (⋃ i, S i) B :=
begin
  sorry
end

-- assuming both sides make sense, prove the sups are equal
theorem Q2b (S : ℕ+ → set ℝ)
  (hS : ∀ i : ℕ+, (S i).nonempty)
  (hLHS: ∀ n : ℕ+, ∃ B, is_lub (S n) B) (hLHS' : ∃ B, is_lub (set.range (λ i, Sup (S i))) B)
  (hRHS : ∃ B, is_lub (⋃ i, S i) B) :
  Sup (set.range (λ i, Sup (S i))) = Sup (⋃ i, S i) :=
begin
  sorry
end

end Q2
/-!

# Q3

Take bounded, nonempty `S, T ⊆ ℝ`.
Define `S + T := { s + t : s ∈ S, t ∈ T}`.
Prove `sup(S + T) = sup(S) + sup(T)`

-/

-- useful for rewriting
theorem is_lub_def {S : set ℝ} {a : ℝ} :
  is_lub S a ↔ a ∈ upper_bounds S ∧ ∀ x, x ∈ upper_bounds S → a ≤ x :=
begin
  refl
end

#check mem_upper_bounds -- a ∈ upper_bounds S ↔ ∀ x, x ∈ S → x ≤ a

/-
Useful tactics for this one: push_neg, specialize, have
-/
theorem useful_lemma {S : set ℝ} {a : ℝ} (haS : is_lub S a) (t : ℝ)
  (ht : t < a) : ∃ s, s ∈ S ∧ t < s :=
begin
  sorry
end

/-
Useful tactics for this one:
`rcases h with ⟨s, t, hsS, htT, rfl⟩` if h : x ∈ S + T
`linarith`
`by_contra`
`set ε := a + b - x with hε`
-/
theorem Q3 (S T : set ℝ) (a b : ℝ) :
  is_lub S a → is_lub T b → is_lub (S + T) (a + b) :=
begin
  sorry
end

/-!

# Q4

Fix `a ∈ (0,∞)` and `n : ℕ`. We will prove
`∃ x : ℝ, x^n = a`.

-/

section Q4

noncomputable theory

section one

-- this first section, a and n are going to be variables
variables {a : ℝ} (ha : 0 < a) {n : ℕ} (hn : 0 < n)

include ha hn

-- Note: We do part 1 after parts 2,3,4 because on the problem sheet
-- parts 2,3,4 are written for the specific x=Sup(S) but
-- part 4 for x needs part 3 for 1/x so you can't use part 3 to
-- do part 4 the way it's been set up on the sheet. We prove
-- 2,3,4 for arbitrary 0 ≤ x (or 0 < x for 4)

/-
2) For `ε ∈ (0,1)` and arbitrary `x ≥ 0` show `(x+ε)ⁿ ≤ x^n + ε[(x + 1)ⁿ − xⁿ].`
(Hint: multiply out.)
-/

theorem part2 {x : ℝ} (x_nonneg : 0 ≤ x) (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε < 1) :
  (x + ε)^n ≤ x^n + ε * ((x + 1)^n - x^n) :=
begin
  sorry,
end

/-
3) Hence show that if `x ≥ 0` and `xⁿ < a` then
`∃ ε ∈ (0,1)` such that `(x+ε)ⁿ < a.` (*)
-/

theorem part3 {x : ℝ} (x_nonneg : 0 ≤ x) (h : x ^ n < a) :
  ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (x+ε)^n < a :=
begin
  sorry
end

/-
4) If `x > 0` is arbitrary and `xⁿ > a`, deduce from (∗) (i.e. part 3) that
`∃ ε ∈ (0,1)` such that `(1/x+ε)ⁿ < 1/a`. (∗∗)
-/

theorem part4 {x : ℝ} (hx : 0 < x) (h : a < x^n) : ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (1/x + ε)^n < 1/a :=
begin
  sorry,
end

end one

section two

-- in this section, a and n are going to be fixed parameters

parameters {a : ℝ} (ha : 0 < a) {n : ℕ} (hn : 0 < n)

include ha hn
/-
1) Set `Sₐ := {s ∈ [0,∞) : s^n < a}` and show `Sₐ` is nonempty and
bounded above, so we may define `x := sup Sₐ` BUT WE WILL NOT DEFINE
x TO BE THIS YET.
-/

def S := {s : ℝ | 0 ≤ s ∧ s ^ n < a}

theorem part1 : (∃ s : ℝ, s ∈ S) ∧ (∃ B : ℝ, ∀ s ∈ S, s ≤ B ) :=
begin
  sorry
end

def x := Sup S

-- x is a least upper bound for X
theorem is_lub_x : is_lub S x :=
begin
  sorry,
end

lemma x_nonneg : 0 ≤ x :=
begin
  rcases is_lub_x with ⟨h, -⟩,
  apply h,
  split, refl,
  convert ha,
  simp [hn],
end

lemma easy (h : a < x^n) : x ≠ 0 :=
begin
  intro hx,
  rw hx at h,
  suffices : a < 0,
    linarith,
  convert h,
  symmetry,
  simp [hn],
end

/-
5) Deduce contradictions from (∗) (part 3) and (∗∗) (part 4) to show that `xⁿ = a`.
-/

-- lemma le_of_pow_le_pow (n : ℕ) (hn : 0 < n) (x y : ℝ) (h : x^n ≤ y^n) : x ≤ y :=
-- begin
--   by_contra hxy,
--   push_neg at hxy,
--   sorry,
-- --  have h2 : pow_lt_pow
-- end

theorem part5 : x^n = a :=
begin
  sorry,
end

end two

end Q4

/-!

# Q6

-/

-- We introduce the usual mathematical notation for absolute value
local notation `|` x `|` := abs x

/-
Useful for this one: `unfold`, `split_ifs` if you want to prove
from first principles, or guessing the name of the library function
if you want to use the library.
-/
theorem Q6a (x y : ℝ) : | x + y | ≤ | x | + | y | :=
begin
  sorry
end

-- all the rest you're supposed to do using Q6a somehow:
-- `simp` and `linarith` are useful.

theorem Q6b (x y : ℝ) : |x + y| ≥ |x| - |y| :=
begin
  sorry
end

theorem Q6c (x y : ℝ) : |x + y| ≥ |y| - |x| :=
begin
  sorry
end

theorem Q6d (x y : ℝ) : |x - y| ≥ | |x| - |y| | :=
begin
  sorry,
end

theorem Q6e (x y : ℝ) : |x| ≤ |y| + |x - y| :=
begin
  sorry
end

theorem Q6f (x y : ℝ) : |x| ≥ |y| - |x - y| :=
begin
  sorry
end

theorem Q6g (x y z : ℝ) : |x - y| ≤ |x - z| + |y - z| :=
begin
  sorry
end


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import logic.equiv.nat
import logic.equiv.fin
import data.countable.defs

/-!
# Countable types

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

In this file we provide basic instances of the `countable` typeclass defined elsewhere.
-/

universes u v w

open function

instance : countable ℤ := countable.of_equiv ℕ equiv.int_equiv_nat.symm

/-!
### Definition in terms of `function.embedding`
-/

section embedding

variables {α : Sort u} {β : Sort v}

lemma countable_iff_nonempty_embedding : countable α ↔ nonempty (α ↪ ℕ) :=
⟨λ ⟨⟨f, hf⟩⟩, ⟨⟨f, hf⟩⟩, λ ⟨f⟩, ⟨⟨f, f.2⟩⟩⟩

lemma nonempty_embedding_nat (α) [countable α] : nonempty (α ↪ ℕ) :=
countable_iff_nonempty_embedding.1 ‹_›

protected lemma function.embedding.countable [countable β] (f : α ↪ β) : countable α :=
f.injective.countable

end embedding

/-!
### Operations on `Type*`s
-/

section type

variables {α : Type u} {β : Type v} {π : α → Type w}

instance [countable α] [countable β] : countable (α ⊕ β) :=
begin
  rcases exists_injective_nat α with ⟨f, hf⟩,
  rcases exists_injective_nat β with ⟨g, hg⟩,
  exact (equiv.nat_sum_nat_equiv_nat.injective.comp $ hf.sum_map hg).countable
end

instance [countable α] : countable (option α) :=
countable.of_equiv _ (equiv.option_equiv_sum_punit α).symm

instance [countable α] [countable β] : countable (α × β) :=
begin
  rcases exists_injective_nat α with ⟨f, hf⟩,
  rcases exists_injective_nat β with ⟨g, hg⟩,
  exact (nat.mkpair_equiv.injective.comp $ hf.prod_map hg).countable
end

instance [countable α] [Π a, countable (π a)] : countable (sigma π) :=
begin
  rcases exists_injective_nat α with ⟨f, hf⟩,
  choose g hg using λ a, exists_injective_nat (π a),
  exact ((equiv.sigma_equiv_prod ℕ ℕ).injective.comp $ hf.sigma_map hg).countable
end

end type

section sort

variables {α : Sort u} {β : Sort v} {π : α → Sort w}

/-!
### Operations on and `Sort*`s
-/

@[priority 500]
instance set_coe.countable {α} [countable α] (s : set α) : countable s := subtype.countable

instance [countable α] [countable β] : countable (psum α β) :=
countable.of_equiv (plift α ⊕ plift β) (equiv.plift.sum_psum equiv.plift)

instance [countable α] [countable β] : countable (pprod α β) :=
countable.of_equiv (plift α × plift β) (equiv.plift.prod_pprod equiv.plift)

instance [countable α] [Π a, countable (π a)] : countable (psigma π) :=
countable.of_equiv (Σ a : plift α, plift (π a.down)) (equiv.psigma_equiv_sigma_plift π).symm

instance [finite α] [Π a, countable (π a)] : countable (Π a, π a) :=
begin
  haveI : ∀ n, countable (fin n → ℕ),
  { intro n, induction n with n ihn,
    { apply_instance },
    { exactI countable.of_equiv _ (equiv.pi_fin_succ _ _).symm } },
  rcases finite.exists_equiv_fin α with ⟨n, ⟨e⟩⟩,
  have f := λ a, (nonempty_embedding_nat (π a)).some,
  exact ((embedding.Pi_congr_right f).trans (equiv.Pi_congr_left' _ e).to_embedding).countable
end

end sort


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import linear_algebra.basic
import linear_algebra.prod

/-!
# Partially defined linear maps

A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. We define
a `semilattice_inf_bot` instance on this this, and define three operations:

* `mk_span_singleton` defines a partial linear map defined on the span of a singleton.
* `sup` takes two partial linear maps `f`, `g` that agree on the intersection of their
  domains, and returns the unique partial linear map on `f.domain ⊔ g.domain` that
  extends both `f` and `g`.
* `Sup` takes a `directed_on (≤)` set of partial linear maps, and returns the unique
  partial linear map on the `Sup` of their domains that extends all these maps.

Partially defined maps are currently used in `mathlib` to prove Hahn-Banach theorem
and its variations. Namely, `linear_pmap.Sup` implies that every chain of `linear_pmap`s
is bounded above.

Another possible use (not yet in `mathlib`) would be the theory of unbounded linear operators.
-/

open set

universes u v w

/-- A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. -/
structure linear_pmap (R : Type u) [ring R] (E : Type v) [add_comm_group E] [module R E]
  (F : Type w) [add_comm_group F] [module R F] :=
(domain : submodule R E)
(to_fun : domain →ₗ[R] F)

variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F]
  {G : Type*} [add_comm_group G] [module R G]

namespace linear_pmap

open submodule

instance : has_coe_to_fun (linear_pmap R E F) :=
⟨λ f : linear_pmap R E F, f.domain → F, λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe (f : linear_pmap R E F) (x : f.domain) :
  f.to_fun x = f x := rfl

@[simp] lemma map_zero (f : linear_pmap R E F) : f 0 = 0 := f.to_fun.map_zero

lemma map_add (f : linear_pmap R E F) (x y : f.domain) : f (x + y) = f x + f y :=
f.to_fun.map_add x y

lemma map_neg (f : linear_pmap R E F) (x : f.domain) : f (-x) = -f x :=
f.to_fun.map_neg x

lemma map_sub (f : linear_pmap R E F) (x y : f.domain) : f (x - y) = f x - f y :=
f.to_fun.map_sub x y

lemma map_smul (f : linear_pmap R E F) (c : R) (x : f.domain) : f (c • x) = c • f x :=
f.to_fun.map_smul c x

@[simp] lemma mk_apply (p : submodule R E) (f : p →ₗ[R] F) (x : p) :
  mk p f x = f x := rfl

/-- The unique `linear_pmap` on `R ∙ x` that sends `x` to `y`. This version works for modules
over rings, and requires a proof of `∀ c, c • x = 0 → c • y = 0`. -/
noncomputable def mk_span_singleton' (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
  linear_pmap R E F :=
begin
  replace H : ∀ c₁ c₂ : R, c₁ • x = c₂ • x → c₁ • y = c₂ • y,
  { intros c₁ c₂ h,
    rw [← sub_eq_zero, ← sub_smul] at h ⊢,
    exact H _ h },
  refine ⟨R ∙ x, λ z, _, _, _⟩,
  { exact (classical.some (mem_span_singleton.1 z.prop) • y) },
  { intros z₁ z₂,
    rw [← add_smul],
    apply H,
    simp only [add_smul, sub_smul, classical.some_spec (mem_span_singleton.1 _)],
    apply coe_add },
  { intros c z,
    rw [smul_smul],
    apply H,
    simp only [mul_smul, classical.some_spec (mem_span_singleton.1 _)],
    apply coe_smul }
end

@[simp] lemma domain_mk_span_singleton (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
  (mk_span_singleton' x y H).domain = R ∙ x := rfl

@[simp] lemma mk_span_singleton_apply (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0)
  (c : R) (h) :
  mk_span_singleton' x y H ⟨c • x, h⟩ = c • y :=
begin
  dsimp [mk_span_singleton'],
  rw [← sub_eq_zero, ← sub_smul],
  apply H,
  simp only [sub_smul, one_smul, sub_eq_zero],
  apply classical.some_spec (mem_span_singleton.1 h),
end

/-- The unique `linear_pmap` on `span R {x}` that sends a non-zero vector `x` to `y`.
This version works for modules over division rings. -/
@[reducible] noncomputable def mk_span_singleton {K E F : Type*} [division_ring K]
  [add_comm_group E] [module K E] [add_comm_group F] [module K F] (x : E) (y : F) (hx : x ≠ 0) :
  linear_pmap K E F :=
mk_span_singleton' x y $ λ c hc, (smul_eq_zero.1 hc).elim
  (λ hc, by rw [hc, zero_smul]) (λ hx', absurd hx' hx)

/-- Projection to the first coordinate as a `linear_pmap` -/
protected def fst (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) E :=
{ domain := p.prod p',
  to_fun := (linear_map.fst R E F).comp (p.prod p').subtype }

@[simp] lemma fst_apply (p : submodule R E) (p' : submodule R F) (x : p.prod p') :
  linear_pmap.fst p p' x = (x : E × F).1 := rfl

/-- Projection to the second coordinate as a `linear_pmap` -/
protected def snd (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) F :=
{ domain := p.prod p',
  to_fun := (linear_map.snd R E F).comp (p.prod p').subtype }

@[simp] lemma snd_apply (p : submodule R E) (p' : submodule R F) (x : p.prod p') :
  linear_pmap.snd p p' x = (x : E × F).2 := rfl

instance : has_neg (linear_pmap R E F) :=
⟨λ f, ⟨f.domain, -f.to_fun⟩⟩

@[simp] lemma neg_apply (f : linear_pmap R E F) (x) : (-f) x = -(f x) := rfl

instance : has_le (linear_pmap R E F) :=
⟨λ f g, f.domain ≤ g.domain ∧ ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (h : (x:E) = y), f x = g y⟩

lemma eq_of_le_of_domain_eq {f g : linear_pmap R E F} (hle : f ≤ g) (heq : f.domain = g.domain) :
  f = g :=
begin
  rcases f with ⟨f_dom, f⟩,
  rcases g with ⟨g_dom, g⟩,
  change f_dom = g_dom at heq,
  subst g_dom,
  have : f = g, from linear_map.ext (λ x, hle.2 rfl),
  subst g
end

/-- Given two partial linear maps `f`, `g`, the set of points `x` such that
both `f` and `g` are defined at `x` and `f x = g x` form a submodule. -/
def eq_locus (f g : linear_pmap R E F) : submodule R E :=
{ carrier   := {x | ∃ (hf : x ∈ f.domain) (hg : x ∈ g.domain), f ⟨x, hf⟩ = g ⟨x, hg⟩},
  zero_mem' := ⟨zero_mem _, zero_mem _, f.map_zero.trans g.map_zero.symm⟩,
  add_mem'  := λ x y ⟨hfx, hgx, hx⟩ ⟨hfy, hgy, hy⟩, ⟨add_mem _ hfx hfy, add_mem _ hgx hgy,
    by erw [f.map_add ⟨x, hfx⟩ ⟨y, hfy⟩, g.map_add ⟨x, hgx⟩ ⟨y, hgy⟩, hx, hy]⟩,
  smul_mem' := λ c x ⟨hfx, hgx, hx⟩, ⟨smul_mem _ c hfx, smul_mem _ c hgx,
    by erw [f.map_smul c ⟨x, hfx⟩, g.map_smul c ⟨x, hgx⟩, hx]⟩ }

instance : has_inf (linear_pmap R E F) :=
⟨λ f g, ⟨f.eq_locus g, f.to_fun.comp $ of_le $ λ x hx, hx.fst⟩⟩

instance : has_bot (linear_pmap R E F) := ⟨⟨⊥, 0⟩⟩

instance : inhabited (linear_pmap R E F) := ⟨⊥⟩

instance : semilattice_inf_bot (linear_pmap R E F) :=
{ le := (≤),
  le_refl := λ f, ⟨le_refl f.domain, λ x y h, subtype.eq h ▸ rfl⟩,
  le_trans := λ f g h ⟨fg_le, fg_eq⟩ ⟨gh_le, gh_eq⟩,
    ⟨le_trans fg_le gh_le, λ x z hxz,
      have hxy : (x:E) = of_le fg_le x, from rfl,
      (fg_eq hxy).trans (gh_eq $ hxy.symm.trans hxz)⟩,
  le_antisymm := λ f g fg gf, eq_of_le_of_domain_eq fg (le_antisymm fg.1 gf.1),
  bot := ⊥,
  bot_le := λ f, ⟨bot_le, λ x y h,
    have hx : x = 0, from subtype.eq ((mem_bot R).1 x.2),
    have hy : y = 0, from subtype.eq (h.symm.trans (congr_arg _ hx)),
    by rw [hx, hy, map_zero, map_zero]⟩,
  inf := (⊓),
  le_inf := λ f g h ⟨fg_le, fg_eq⟩ ⟨fh_le, fh_eq⟩,
    ⟨λ x hx, ⟨fg_le hx, fh_le hx,
      by refine (fg_eq _).symm.trans (fh_eq _); [exact ⟨x, hx⟩, refl, refl]⟩,
    λ x ⟨y, yg, hy⟩ h, by { apply fg_eq, exact h }⟩,
  inf_le_left := λ f g, ⟨λ x hx, hx.fst,
    λ x y h, congr_arg f $ subtype.eq $ by exact h⟩,
  inf_le_right := λ f g, ⟨λ x hx, hx.snd.fst,
    λ ⟨x, xf, xg, hx⟩ y h, hx.trans $ congr_arg g $ subtype.eq $ by exact h⟩ }

lemma le_of_eq_locus_ge {f g : linear_pmap R E F} (H : f.domain ≤ f.eq_locus g) :
  f ≤ g :=
suffices f ≤ f ⊓ g, from le_trans this inf_le_right,
⟨H, λ x y hxy, ((inf_le_left : f ⊓ g ≤ f).2 hxy.symm).symm⟩

lemma domain_mono : strict_mono (@domain R _ E _ _ F _ _) :=
λ f g hlt, lt_of_le_of_ne hlt.1.1 $ λ heq, ne_of_lt hlt $
eq_of_le_of_domain_eq (le_of_lt hlt) heq

private lemma sup_aux (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  ∃ fg : ↥(f.domain ⊔ g.domain) →ₗ[R] F,
    ∀ (x : f.domain) (y : g.domain) (z),
      (x:E) + y = ↑z → fg z = f x + g y :=
begin
  choose x hx y hy hxy using λ z : f.domain ⊔ g.domain, mem_sup.1 z.prop,
  set fg := λ z, f ⟨x z, hx z⟩ + g ⟨y z, hy z⟩,
  have fg_eq : ∀ (x' : f.domain) (y' : g.domain) (z' : f.domain ⊔ g.domain) (H : (x':E) + y' = z'),
    fg z' = f x' + g y',
  { intros x' y' z' H,
    dsimp [fg],
    rw [add_comm, ← sub_eq_sub_iff_add_eq_add, eq_comm, ← map_sub, ← map_sub],
    apply h,
    simp only [← eq_sub_iff_add_eq] at hxy,
    simp only [coe_sub, coe_mk, coe_mk, hxy, ← sub_add, ← sub_sub, sub_self, zero_sub, ← H],
    apply neg_add_eq_sub },
  refine ⟨⟨fg, _, _⟩, fg_eq⟩,
  { rintros ⟨z₁, hz₁⟩ ⟨z₂, hz₂⟩,
    rw [← add_assoc, add_right_comm (f _), ← map_add, add_assoc, ← map_add],
    apply fg_eq,
    simp only [coe_add, coe_mk, ← add_assoc],
    rw [add_right_comm (x _), hxy, add_assoc, hxy, coe_mk, coe_mk] },
  { intros c z,
    rw [smul_add, ← map_smul, ← map_smul],
    apply fg_eq,
    simp only [coe_smul, coe_mk, ← smul_add, hxy] },
end

/-- Given two partial linear maps that agree on the intersection of their domains,
`f.sup g h` is the unique partial linear map on `f.domain ⊔ g.domain` that agrees
with `f` and `g`. -/
protected noncomputable def sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  linear_pmap R E F :=
⟨_, classical.some (sup_aux f g h)⟩

@[simp] lemma domain_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  (f.sup g h).domain = f.domain ⊔ g.domain :=
rfl

lemma sup_apply {f g : linear_pmap R E F}
  (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
  (x y z) (hz : (↑x:E) + ↑y = ↑z) :
  f.sup g H z = f x + g y :=
classical.some_spec (sup_aux f g H) x y z hz

protected lemma left_le_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  f ≤ f.sup g h :=
begin
  refine ⟨le_sup_left, λ z₁ z₂ hz, _⟩,
  rw [← add_zero (f _), ← g.map_zero],
  refine (sup_apply h _ _ _ _).symm,
  simpa
end

protected lemma right_le_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  g ≤ f.sup g h :=
begin
  refine ⟨le_sup_right, λ z₁ z₂ hz, _⟩,
  rw [← zero_add (g _), ← f.map_zero],
  refine (sup_apply h _ _ _ _).symm,
  simpa
end

protected lemma sup_le {f g h : linear_pmap R E F}
  (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
  (fh : f ≤ h) (gh : g ≤ h) :
  f.sup g H ≤ h :=
have Hf : f ≤ (f.sup g H) ⊓ h, from le_inf (f.left_le_sup g H) fh,
have Hg : g ≤ (f.sup g H) ⊓ h, from le_inf (f.right_le_sup g H) gh,
le_of_eq_locus_ge $ sup_le Hf.1 Hg.1

/-- Hypothesis for `linear_pmap.sup` holds, if `f.domain` is disjoint with `g.domain`. -/
lemma sup_h_of_disjoint (f g : linear_pmap R E F) (h : disjoint f.domain g.domain)
  (x : f.domain) (y : g.domain) (hxy : (x:E) = y) :
  f x = g y :=
begin
  rw [disjoint_def] at h,
  have hy : y = 0, from subtype.eq (h y (hxy ▸ x.2) y.2),
  have hx : x = 0, from subtype.eq (hxy.trans $ congr_arg _ hy),
  simp [*]
end

section

variables {K : Type*} [division_ring K] [module K E] [module K F]

/-- Extend a `linear_pmap` to `f.domain ⊔ K ∙ x`. -/
noncomputable def sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F) (hx : x ∉ f.domain) :
  linear_pmap K E F :=
f.sup (mk_span_singleton x y (λ h₀, hx $ h₀.symm ▸ f.domain.zero_mem)) $
  sup_h_of_disjoint _ _ $ by simpa [disjoint_span_singleton]

@[simp] lemma domain_sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F)
  (hx : x ∉ f.domain) :
  (f.sup_span_singleton x y hx).domain = f.domain ⊔ K ∙ x := rfl

@[simp] lemma sup_span_singleton_apply_mk (f : linear_pmap K E F) (x : E) (y : F)
  (hx : x ∉ f.domain) (x' : E) (hx' : x' ∈ f.domain) (c : K) :
  f.sup_span_singleton x y hx ⟨x' + c • x,
    mem_sup.2 ⟨x', hx', _, mem_span_singleton.2 ⟨c, rfl⟩, rfl⟩⟩ = f ⟨x', hx'⟩ + c • y :=
begin
  erw [sup_apply _ ⟨x', hx'⟩ ⟨c • x, _⟩, mk_span_singleton_apply],
  refl,
  exact mem_span_singleton.2 ⟨c, rfl⟩
end

end

private lemma Sup_aux (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
  ∃ f : ↥(Sup (domain '' c)) →ₗ[R] F, (⟨_, f⟩ : linear_pmap R E F) ∈ upper_bounds c :=
begin
  cases c.eq_empty_or_nonempty with ceq cne, { subst c, simp },
  have hdir : directed_on (≤) (domain '' c),
    from directed_on_image.2 (hc.mono domain_mono.monotone),
  have P : Π x : Sup (domain '' c), {p : c // (x : E) ∈ p.val.domain },
  { rintros x,
    apply classical.indefinite_description,
    have := (mem_Sup_of_directed (cne.image _) hdir).1 x.2,
    rwa [bex_image_iff, set_coe.exists'] at this },
  set f : Sup (domain '' c) → F := λ x, (P x).val.val ⟨x, (P x).property⟩,
  have f_eq : ∀ (p : c) (x : Sup (domain '' c)) (y : p.1.1) (hxy : (x : E) = y), f x = p.1 y,
  { intros p x y hxy,
    rcases hc (P x).1.1 (P x).1.2 p.1 p.2 with ⟨q, hqc, hxq, hpq⟩,
    refine (hxq.2 _).trans (hpq.2 _).symm,
    exacts [of_le hpq.1 y, hxy, rfl] },
  refine ⟨⟨f, _, _⟩, _⟩,
  { intros x y,
    rcases hc (P x).1.1 (P x).1.2 (P y).1.1 (P y).1.2 with ⟨p, hpc, hpx, hpy⟩,
    set x' := of_le hpx.1 ⟨x, (P x).2⟩,
    set y' := of_le hpy.1 ⟨y, (P y).2⟩,
    rw [f_eq ⟨p, hpc⟩ x x' rfl, f_eq ⟨p, hpc⟩ y y' rfl, f_eq ⟨p, hpc⟩ (x + y) (x' + y') rfl,
      map_add] },
  { intros c x,
    rw [f_eq (P x).1 (c • x) (c • ⟨x, (P x).2⟩) rfl, ← map_smul] },
  { intros p hpc,
    refine ⟨le_Sup $ mem_image_of_mem domain hpc, λ x y hxy, eq.symm _⟩,
    exact f_eq ⟨p, hpc⟩ _ _ hxy.symm }
end

/-- Glue a collection of partially defined linear maps to a linear map defined on `Sup`
of these submodules. -/
protected noncomputable def Sup (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
  linear_pmap R E F :=
⟨_, classical.some $ Sup_aux c hc⟩

protected lemma le_Sup {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
  {f : linear_pmap R E F} (hf : f ∈ c) : f ≤ linear_pmap.Sup c hc :=
classical.some_spec (Sup_aux c hc) hf

protected lemma Sup_le {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
  {g : linear_pmap R E F} (hg : ∀ f ∈ c, f ≤ g) : linear_pmap.Sup c hc ≤ g :=
le_of_eq_locus_ge $ Sup_le $ λ _ ⟨f, hf, eq⟩, eq ▸
have f ≤ (linear_pmap.Sup c hc) ⊓ g, from le_inf (linear_pmap.le_Sup _ hf) (hg f hf),
this.1

end linear_pmap

namespace linear_map

/-- Restrict a linear map to a submodule, reinterpreting the result as a `linear_pmap`. -/
def to_pmap (f : E →ₗ[R] F) (p : submodule R E) : linear_pmap R E F :=
⟨p, f.comp p.subtype⟩

@[simp] lemma to_pmap_apply (f : E →ₗ[R] F) (p : submodule R E) (x : p) :
  f.to_pmap p x = f x := rfl

/-- Compose a linear map with a `linear_pmap` -/
def comp_pmap (g : F →ₗ[R] G) (f : linear_pmap R E F) : linear_pmap R E G :=
{ domain := f.domain,
  to_fun := g.comp f.to_fun }

@[simp] lemma comp_pmap_apply (g : F →ₗ[R] G) (f : linear_pmap R E F) (x) :
  g.comp_pmap f x = g (f x) := rfl

end linear_map

namespace linear_pmap

/-- Restrict codomain of a `linear_pmap` -/
def cod_restrict (f : linear_pmap R E F) (p : submodule R F) (H : ∀ x, f x ∈ p) :
  linear_pmap R E p :=
{ domain := f.domain,
  to_fun := f.to_fun.cod_restrict p H }

/-- Compose two `linear_pmap`s -/
def comp (g : linear_pmap R F G) (f : linear_pmap R E F)
  (H : ∀ x : f.domain, f x ∈ g.domain) :
  linear_pmap R E G :=
g.to_fun.comp_pmap $ f.cod_restrict _ H

/-- `f.coprod g` is the partially defined linear map defined on `f.domain × g.domain`,
and sending `p` to `f p.1 + g p.2`. -/
def coprod (f : linear_pmap R E G) (g : linear_pmap R F G) :
  linear_pmap R (E × F) G :=
{ domain := f.domain.prod g.domain,
  to_fun := (f.comp (linear_pmap.fst f.domain g.domain) (λ x, x.2.1)).to_fun +
    (g.comp (linear_pmap.snd f.domain g.domain) (λ x, x.2.2)).to_fun }

@[simp] lemma coprod_apply (f : linear_pmap R E G) (g : linear_pmap R F G) (x) :
  f.coprod g x = f ⟨(x : E × F).1, x.2.1⟩ + g ⟨(x : E × F).2, x.2.2⟩ :=
rfl

end linear_pmap


import data.nat.parity

namespace nat
variables {n : ℕ}

@[parity_simps] lemma odd_succ : odd (succ n) ↔ ¬ odd n :=
by rw [succ_eq_add_one, odd_add]; simp [not_even_one]

lemma not_even : ¬ even n ↔ odd n := nat.odd_iff_not_even.symm
lemma not_odd : ¬ odd n ↔ even n := nat.even_iff_not_odd.symm

end nat


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import number_theory.class_number.admissible_abs
import number_theory.class_number.finite
import number_theory.number_field.basic

/-!
# Class numbers of number fields

This file defines the class number of a number field as the (finite) cardinality of
the class group of its ring of integers. It also proves some elementary results
on the class number.

## Main definitions
- `number_field.class_number`: the class number of a number field is the (finite)
cardinality of the class group of its ring of integers
-/

namespace number_field

variables (K : Type*) [field K] [number_field K]

namespace ring_of_integers

noncomputable instance : fintype (class_group (ring_of_integers K)) :=
class_group.fintype_of_admissible_of_finite ℚ K absolute_value.abs_is_admissible

end ring_of_integers

/-- The class number of a number field is the (finite) cardinality of the class group. -/
noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers K))

variables {K}

/-- The class number of a number field is `1` iff the ring of integers is a PID. -/
theorem class_number_eq_one_iff :
  class_number K = 1 ↔ is_principal_ideal_ring (ring_of_integers K) :=
card_class_group_eq_one_iff

end number_field

namespace rat

open number_field

theorem class_number_eq : number_field.class_number ℚ = 1 :=
class_number_eq_one_iff.mpr $ by convert is_principal_ideal_ring.of_surjective
  (rat.ring_of_integers_equiv.symm : ℤ →+* ring_of_integers ℚ)
  (rat.ring_of_integers_equiv.symm.surjective)

end rat


/-

Change the below line to

import week_2.kb_solutions.Part_A_groups_solutions

(once the solutions are posted) if you want to get rid of the warning
-/

import week_2.Part_A_groups

/-!

## Subgroups

We define the structure `subgroup G`, whose terms are subgroups of `G`.
A subgroup of `G` is implemented as a subset of `G` closed under
`1`, `*` and `⁻¹`.

-/

namespace xena

/-- A subgroup of a group G is a subset containing 1
and closed under multiplication and inverse. -/
structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

/-

At this point, here's what we have.

A term `H` of type `subgroup G`, written `H : subgroup G`, is a
*quadruple*. To give a term `H : subgroup G` is to give the following four things:
1) `H.carrier` (a subset of `G`),
2) `H.one_mem'` (a proof that `1 ∈ H.carrier`),
3) `H.mul_mem'` (a proof that `H` is closed under multiplication)
4) `H.inv_mem'` (a proof that `H` is closed under inverses).

Note in particular that Lean, being super-pedantic, *distinguishes* between
the subgroup `H` and the subset `H.carrier`. One is a subgroup, one is
a subset. When we get going we will start by setting up some infrastructure
so that this difference will be hard to notice.

Note also that if `x` is in the subgroup `H` of `H` then the _type_ of `x` is still `G`,
and `x ∈ carrier` is a Proposition. Note also that `x : carrier` doesn't
make sense (`carrier` is a term, not a type, rather counterintuitively).

-/

namespace subgroup

open xena.group

-- let G be a group and let H and K be subgroups
variables {G : Type} [group G] (H J K : subgroup G)

/-
This `h ∈ H.carrier` notation kind of stinks. I don't want to write `H.carrier`
everywhere, because I want to be able to identify the subgroup `H` with
its underlying subset `H.carrier`. Note that these things are not _equal_,
firstly because `H` contains the proof that `H.carrier` is a subgroup, and
secondly because these terms have different types! `H` has type `subgroup G`
and `H.carrier` has type `set G`. Let's start by sorting this out.
-/

-- If `x : G` and `H : subgroup G` then let's define the notation
-- `x ∈ H` to mean `x ∈ H.carrier`
instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

-- Let's also define a "coercion", a.k.a. an "invisible map"
-- from subgroups of `G` to subsets of `G`, sending `H` to `H.carrier`.
-- The map is not completely invisible -- it's a little ↑. So
-- if you see `↑H` in the future, it means the subset `H.carrier` by definition.
instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

-- `λ` is just computer science notation for ↦ (mapsto); so
-- `λ H, H.carrier` is the function `H ↦ H.carrier`.

-- Let's check we have this working, and also tell the simplifier that we
-- would rather talk about `g ∈ H` than any other way of saying it.

/-- `g` is in the underlying subset of `H` iff `g ∈ H`. -/
@[simp] lemma mem_carrier {g : G} : g ∈ H.carrier ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

/-- `g` is in `H` considered as a subset of `G`, iff `g` is in `H` considered
as subgroup of `G`. -/
@[simp] lemma mem_coe {g : G} : g ∈ (↑H : set G) ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

-- Now let's define theorems without the `'`s in, which use this
-- more natural notation

/-- A subgroup contains the group's 1. -/
theorem one_mem : (1 : G) ∈ H :=
begin
  apply H.one_mem',
end

/-- A subgroup is closed under multiplication. -/
theorem mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H :=
begin
  -- what do you think?
  sorry
end

/-- A subgroup is closed under inverse -/
theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H :=
begin
  -- what do you think?
  sorry
end

/-

So here are the three theorems which you need to remember about subgroups.
Say `H : subgroup G`. Then:

`H.one_mem : (1 : G) ∈ H`
`H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H`
`H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H`

These now look like the way a mathematician would write things.

Now let's start to prove basic theorems about subgroups (or, as a the computer
scientists would say, make a basic _interface_ or _API_ for subgroups),
using this sensible notation.

Here's an example; let's prove `x ∈ H ↔ x⁻¹ ∈ H`. Let's put the more
complicated expression on the left hand side of the `↔` though, because then
we can make it a `simp` lemma.
-/

-- Remember that `xena.group.inv_inv x` is the statement that `x⁻¹⁻¹ = x`

@[simp] theorem inv_mem_iff {x : G} : x⁻¹ ∈ H ↔ x ∈ H :=
begin
  sorry,
end

-- We could prove a bunch more theorems here. Let's just do one more.
-- Let's show that if x and xy are in H then so is y.

theorem mem_of_mem_mul_mem {x y : G} (hx : x ∈ H) (hxy : x * y ∈ H) : y ∈ H :=
begin
  sorry,
end

/-
Subgroups are extensional objects (like most things in mathematics):
two subgroups are equal if they have the same underlying subset,
and also if they have the same underlying elements.
Let's prove variants of this triviality now. The first one is rather
un-mathematical: it takes a subgroup apart into its pieces. I'll see if
you can do the other two!
-/

/-- Two subgroups are equal if the underlying subsets are equal. -/
theorem ext' {H K : subgroup G} (h : H.carrier = K.carrier) : H = K :=
begin
  -- first take H and K apart
  cases H, -- H now broken up into its underlying 3-tuple.
  cases K,
  -- and now it must be obvious, so let's see if the simplifier can do it.
  simp * at *, -- it can!
end

-- here's a variant. You can prove it using `ext'`.

/-- Two subgroups are equal if and only if the underlying subsets are equal. -/
theorem ext'_iff {H K : subgroup G} :
  H.carrier = K.carrier ↔ H = K :=
begin
  sorry,
end

-- to do this next one, first apply the `ext'` theorem we just proved,
-- and then use the `ext` tactic (which works on sets)

/-- Two subgroups are equal if they have the same elements. -/
@[ext] theorem ext {H K : subgroup G} (h : ∀ x, x ∈ H ↔ x ∈ K) : H = K :=
begin
  sorry,
end

/-
We tagged that theorem with `ext`, so now the `ext` tactic works on subgroups
too: if you ever have a goal of proving that two subgroups are equal, you can
use the `ext` tactic to reduce to showing that they have the same elements.
-/

/-

## The lattice structure on subgroups

Subgroups of a group form what is known as a *lattice*.
This is a partially ordered set with a sensible notion of
max and min. We partially order subgroups by saying `H ≤ K` if
`H.carrier ⊆ K.carrier`. Subgroups even have a good notion of an infinite
Sup and Inf (the Inf of a bunch of subgroups is just their intersection;
their Sup is the subgroup generated by their union).

This combinatorial structure (a partially ordered set with good
finite and infinite notions of Sup and Inf) is called a "complete lattice",
and Lean has this structure inbuilt into it. We will construct
a complete lattice structure on `subgroup G`.

We start by defining a relation ≤ on the type of subgroups of a group.
We say H ≤ K iff H.carrier ⊆ K.carrier .
-/

/-- If `H` and `K` are subgroups of `G`, we write `H ≤ K` to
  mean `H.carrier ⊆ K.carrier` -/
instance : has_le (subgroup G) := ⟨λ H K, H.carrier ⊆ K.carrier⟩

-- useful to restate the definition so we can `rw` it
lemma le_def : H ≤ K ↔ H.carrier ⊆ K.carrier :=
begin
  -- true by definition
  refl
end

-- another useful variant
lemma le_iff : H ≤ K ↔ ∀ g, g ∈ H → g ∈ K :=
begin
  -- true by definition
  refl,
end

-- Now let's check the axioms for a partial order.
-- These are not hard, they just reduce immediately to the
-- fact that ⊆ is a partial order
@[refl] lemma le_refl : H ≤ H :=
begin
  rw le_def,
  -- Lean knows ⊆ is reflexive so the sneaky `refl` which Lean tries after `rw`
  -- has closed the goal!
end

lemma le_antisymm : H ≤ K → K ≤ H → H = K :=
begin
  rw [le_def, le_def, ← ext'_iff],
  -- now this is antisymmetry of ⊆, which Lean knows
  exact set.subset.antisymm,
end

@[trans] lemma le_trans : H ≤ J → J ≤ K → H ≤ K :=
begin
  rw [le_def, le_def, le_def],
  -- now this is transitivity of ⊆, which Lean knows
  exact set.subset.trans,
end

-- We've made `subgroup G` into a partial order!
instance : partial_order (subgroup G) :=
{ le := (≤),
  le_refl := le_refl,
  le_antisymm := le_antisymm,
  le_trans := le_trans }

/-

### intersections

Let's prove that the intersection of two subgroups is a subgroup. In Lean
this is a definition: given two subgroups, we define a new subgroup whose
underlying subset is the intersection of the subsets, and then prove
the axioms.
-/

/-- The intersection of two subgroups is also a subgroup -/
def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier, -- the carrier is the intersection
  one_mem' :=
  begin
    -- recall that x ∈ Y ∩ Z is _by definition_ x ∈ Y ∧ x ∈ Z, so you can `split` this.
    sorry,
  end,
  mul_mem' :=
  begin
    sorry,
  end,
  inv_mem' :=
  begin
    sorry,
  end }

-- Notation for `inf` in computer science circles is ⊓ .

instance : has_inf (subgroup G) := ⟨inf⟩

/-- The underlying set of the inf of two subgroups is just their intersection -/
lemma inf_def (H K : subgroup G) : (H ⊓ K : set G) = (H : set G) ∩ K :=
begin
  -- true by definition
  refl
end

/-

## Subgroup generated by a subset.

To do the sup of two subgroups is harder, because we don't just take
the union, we need to then look at the subgroup generated by this union
(e.g. the union of the x and y axes in ℝ² is not a subgroup). So we need
to have a machine to spit out the subgroup of `G` generated by a subset `S : set G`.

There are two completely different ways to do this. The first is a "top-down"
approach. We could define the subgroup generated by `S` to be the intersection of
all the subgroups of `G` that contain `S`. The second is a "bottom-up" approach.
We could define the subgroup generated by `S` "by induction" (or more precisely
by recursion), saying that `S` is in the subgroup, 1 is in the subgroup,
the product of two things in the subgroup is in the subgroup, the
inverse of something in the subgroup is in the subgroup, and that's it.
Both methods come out rather nicely in Lean. Let's do the first one.

We are going to be using a bunch of theorems about "bounded intersections",
a.k.a. `set.bInter`. We will soon get tired of writing `set.blah` so let's
`open set` so that we can skip it.

-/

open set

/-

Here is the API for `set.bInter` (or `bInter`, as we can now call it):

Notation: `⋂` (type with `\I`)

If `X : set (subgroup G)`, i.e. if `X` is a set of subgroups of `G`, then

`⋂ K ∈ X, (K : set G)` means "take the intersection of the underlying subsets".

-- mem_bInter_iff says you're in the intersection iff you're in
-- all the things you're intersecting. Very useful for rewriting.
`mem_bInter_iff : (g ∈ ⋂ (K ∈ S), f K) ↔ (∀ K, K ∈ s → g ∈ f K)`

-- mem_bInter is just the one way implication. Very useful for `apply`ing.
`mem_bInter : (∀ K, K ∈ s → g ∈ f K) → (g ∈ ⋂ (K ∈ S), f K)`

-/
/-
We will consider the closure of a set as the intersect of all subgroups
containing the set
-/

/-- The Inf of a set of subgroups of G is their intersection. -/
def Inf (X : set (subgroup G)) : subgroup G :=
{ carrier := ⋂ K ∈ X, (K : set G), -- carrier is the intersection of the underlying sets
  one_mem' := begin
    sorry,
  end,
  mul_mem' := begin
    sorry,
  end,
  inv_mem' := begin
    sorry,
  end,
}

/-- The *closure* of a subset `S` of `G` is the `Inf` of the subgroups of `G`
  which contain `S`. -/
def closure (S : set G) : subgroup G := Inf {H : subgroup G | S ⊆ H}

-- we can restate mem_bInter_iff using our new "closure" language:
lemma mem_closure_iff {S : set G} {x : G} :
  x ∈ closure S ↔ ∀ H : subgroup G, S ⊆ H → x ∈ H := mem_bInter_iff

/-
There is an underlying abstraction here, which you may not know about.
A "closure operator" in mathematics

https://en.wikipedia.org/wiki/Closure_operator

is something mapping subsets of a set X to subsets of X, and satisfying three
axioms:

1) `subset_closure : S ⊆ closure S`
2) `closure_mono : (S ⊆ T) → (closure S ⊆ closure T)`
3) `closure_closure : closure (closure S) = closure S`

It works for closure in topological spaces, and it works here too.
It also works for algebraic closures of fields, and there are several
other places in mathematics where it shows up. This idea, of "abstracting"
and axiomatising a phenomenon which shows up in more than one place,
is really key in Lean.

Let's prove these three lemmas in the case where `X = G` and `closure S`
is the subgroup generated by `S`.

Here are some things you might find helpful.

Remember
`mem_coe : g ∈ ↑H ↔ g ∈ H`
`mem_carrier : g ∈ H.carrier ↔ g ∈ H`

There's
`mem_closure_iff : x ∈ closure S ↔ ∀ (H : subgroup G), S ⊆ ↑H → x ∈ H`
(`closure S` is a subgroup so you might need to use `mem_coe` or `mem_carrier` first)

For subsets there's
`subset.trans : X ⊆ Y → Y ⊆ Z → X ⊆ Z`

You might find `le_antisymm : H ≤ K → K ≤ H → H = K` from above useful
-/

/-
Reminder: X ⊆ Y means `∀ g, g ∈ X → g ∈ Y` and it's definitional,
so you can just start this with `intro g`.
-/
lemma subset_closure (S : set G) : S ⊆ ↑(closure S) :=
begin
  sorry,
end

-- It's useful to know `subset.trans : X ⊆ Y → Y ⊆ Z → X ⊆ Z`
lemma closure_mono {S T : set G} (hST : S ⊆ T) : closure S ≤ closure T :=
begin
  sorry,
end

-- not one of the axioms, but sometimes handy
lemma closure_le (S : set G) (H : subgroup G) : closure S ≤ H ↔ S ⊆ ↑H :=
begin
  sorry,
end

-- You can start this one by applying `le_antisymm`,
lemma closure_closure (S : set G) : closure S = closure (closure S) :=
begin
  sorry,
end

-- This shows that every subgroup is the closure of something, namely its
-- underlying subset.
lemma closure_self {H : subgroup G} : closure ↑H = H :=
begin
  sorry,
end

/-
Recall the second proposed construction of the subgroup closure of a subset `S`;
it is the smallest subgroup `H` of `G` such that `S ⊆ H` and which contains
`1` and is closed under `*` and `⁻¹`. This inductive constuction (which we
did not make) comes with a so-called "recursor": if we have a true/false
statement `p g` attached to each element `g` of G with the following properties:

1) `p s` is true for all `s ∈ S`,
2) `p 1` is true,
3) If `p x` and `p y` then `p (x * y)`,
4) If `p x` then `p x⁻¹`

Then `p` is true on all of `closure S`.

If we had made an inductive definition of `closure S` then this would have been true
by definition! We used another definition, so we will have to prove it
ourselves.
-/

/-- An induction principle for closures. -/
lemma closure_induction {p : G → Prop} {S : set G}
  (HS : ∀ x ∈ S, p x)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹) :
  -- conclusion after colon
  ∀ x, x ∈ closure S → p x :=
begin
  -- the subset of G where `p` is true is a subgroup. Let's call it H
  let H : subgroup G :=
  { carrier := p,
    one_mem' := H1,
    mul_mem' := Hmul,
    inv_mem' := Hinv },
  -- The goal is just that closure S ≤ H, by definition.
  change closure S ≤ H,
  -- Our hypothesis HS is just that S ⊆ ↑H, by definition
  change S ⊆ ↑H at HS,
  -- I think you can take it from here!
  sorry,
end

/-
Finally we prove that the `closure` and `coe` maps form a `galois_insertion`.
This is another abstraction, it generalises `galois_connection`, which is
something that shows up all over the place (algebraic geometry, Galois theory etc).
See

https://en.wikipedia.org/wiki/Galois_connection

A partial order can be considered as a category, with Hom(A,B) having
one element if A ≤ B and no elements otherwise. A Galois connection between
two partial orders is just a pair of adjoint functors between the categories.
Adjointness in our case is `S ⊆ ↑H ↔ closure S ≤ H`.

The reason it's an insertion and not just a connection is that if you start
with a subgroup, take the underlying subset, and then look at the subgroup
generated by that set, you get back to where you started. So it's like one
of the adjoint functors being a forgetful functor.
-/

def gi : galois_insertion (closure : set G → subgroup G) (coe : subgroup G → set G) :=
{ choice := λ S _, closure S,
  gc := closure_le,
  le_l_u := λ H, subset_closure (H : set G),
  choice_eq := λ _ _, rfl }

/-

One use of this abstraction is that now we can pull back the complete
lattice structure on `set G` to get a complete lattice structure on `subgroup G`.
-/

instance : complete_lattice (subgroup G) :=
{.. galois_insertion.lift_complete_lattice gi}

/-

We just proved loads of lemmas about Infs and Sups of subgroups automatically,
and have access to a ton more because the `complete_lattice` structure in
Lean has a big API. See for example

https://leanprover-community.github.io/mathlib_docs/order/complete_lattice.html#complete_lattice

All those theorems are now true for subgroups. None are particularly hard to prove,
but the point is that we don't now have to prove any of them ourselves.
-/
end subgroup

end xena

/-

Further work: `bot` and `top` (would have to explain the
API for `singleton` and `univ`)

-/