import data.real.basic
import data.set

namespace my_closure

universes u
variables {α : Type u}
variables P Q Q' : α  Prop

local notation `|`x`|` := abs x

def is_adherent (x : ℝ) (X : set ℝ) : Prop :=
∀ ε > 0, ∃y ∈ X, |x - y| < ε

def closure(X : set ℝ) : set ℝ :=
{x : ℝ | is_adherent x X }

lemma closure_inter_subset_inter_closure (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
begin
  intros a ha,
  split; {
  intros ε hε,
  rcases ha ε hε with ⟨xy, hxy, h₁⟩,
  use xy,
  cases hxy,
  split;
  assumption,
  }
end

lemma closure_inter_subset_inter_closure' (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
begin
  intros a ha,
  split;
  intros ε hε;
  rcases ha ε hε with ⟨xy, hxy, h₁⟩;
  use xy;
  cases hxy;
  split;
  assumption,
end

lemma universal_impl_distrib  {a : α} :
(∀ a, P a → Q a ∧ Q' a) ↔ (∀ a, P a → Q a) ∧ (∀ a, P a → Q' a) :=
iff.intro
  (assume hl,
    and.intro
    (assume a, assume p,
      and.elim_left (hl a p))
    (assume a, assume p,
      and.elim_right (hl a p)))
  (assume hr,
    assume a, assume p,
    and.intro
      (and.elim_left hr a p)
      (and.elim_right hr a p)
    )

lemma closure_inter_subset_inter_closure'' (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
begin
    intros a ha,
    rw universal_impl_distrib,
end

lemma closure_inter_subset_inter_closure''' (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
begin
  intros a ha,
  split,
  {
  intros ε hε,
  rcases ha ε hε with ⟨xy, hxy, h₁⟩,
  use xy,
  exact ⟨hxy.left, h₁⟩,
  },
  {
    intros ε hε,
    rcases ha ε hε with ⟨xy, hxy, h₁⟩,
    use xy,
    exact ⟨hxy.right, h₁⟩,
  }
end

end my_closure


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

/-!
# Midpoint of a segment for characteristic zero

We collect lemmas that require that the underlying ring has characteristic zero.

## Tags

midpoint
-/

open affine_map affine_equiv

lemma line_map_inv_two {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
  line_map a b (2⁻¹:R) = midpoint R a b :=
rfl

lemma line_map_one_half {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
  line_map a b (1/2:R) = midpoint R a b :=
by rw [one_div, line_map_inv_two]

lemma homothety_inv_of_two {R : Type*} {V P : Type*} [comm_ring R] [invertible (2:R)]
  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
  homothety a (⅟2:R) b = midpoint R a b :=
rfl

lemma homothety_inv_two {k : Type*} {V P : Type*} [field k] [char_zero k]
  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
  homothety a (2⁻¹:k) b = midpoint k a b :=
rfl

lemma homothety_one_half {k : Type*} {V P : Type*} [field k] [char_zero k]
  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
  homothety a (1/2:k) b = midpoint k a b :=
by rw [one_div, homothety_inv_two]

@[simp] lemma pi_midpoint_apply {k ι : Type*} {V : Π i : ι, Type*} {P : Π i : ι, Type*} [field k]
  [invertible (2:k)] [Π i, add_comm_group (V i)] [Π i, module k (V i)]
  [Π i, add_torsor (V i) (P i)] (f g : Π i, P i) (i : ι) :
  midpoint k f g i = midpoint k (f i) (g i) := rfl


import subgroup.lagrange
import subgroup.definitions
import data.nat.modeq -- added by Giulia
import data.nat.prime  -- added by Giulia
open set classical function

open_locale classical

noncomputable theory

namespace mygroup

/-- A left action of some group `G` on some `S` is a function with type
  `to_fun : G → S → S` such that for all `s : S`, `to_fun 1 s = 1` and for all
  `g, h : G`, `s : S`, `to_fun g (to_fun h s) = to_fun (g * h) s` -/
structure laction (G : Type) [group G] (S : Type) :=
(to_fun    : G → S → S) (map_one' : ∀ s : S, to_fun 1 s = s)
(map_assoc' : ∀ g h : G, ∀ s : S, to_fun g (to_fun h s) = to_fun (g * h) s)

variables {G S : Type} [group G]
variables {μ : laction G S}

notation g ` •[`:70 μ `] `:0 s:70 := μ.to_fun g s
local notation g ` • `:70  s:70  := μ.to_fun g s

namespace laction

@[ext] lemma ext (μ1 μ2 : laction G S)
  (h : ∀ (g : G) (s : S), μ1.to_fun g s = μ2.to_fun g s) :
μ1 = μ2 :=
begin
  cases μ1, cases μ2, simp * at *,
  ext g s, apply h,
end

-- APIs for left actions

@[simp] lemma map_one (μ : laction G S) (s : S) : (1 •[μ] s) = s := μ.map_one' _

lemma map_assoc (g h : G) (s : S) : g • (h • s) = g * h • s :=
  μ.map_assoc' _ _ _

-- The user should prove these two lemmas below

lemma laction_mul_inv_cancel {g h : G} {s : S} :
  g • s = h • s ↔ s = (g⁻¹ * h) • s :=
begin
  split; intro hgh,
    { conv_lhs { rw ←map_one μ s },
      rw [←(group.mul_right_inv g⁻¹), ←map_assoc,
          ←map_assoc, ←hgh, group.inv_inv] },
    { conv_lhs { rw [hgh, map_assoc, ←group.mul_assoc,
                     group.mul_right_inv, group.one_mul] } }
end

lemma laction_mul_inv {g : G} {s t : S} : g • s = t ↔ s = g⁻¹ • t :=
begin
  split; intro h,
    rw [←h, map_assoc, group.mul_left_inv, map_one],
    rw [h, map_assoc, group.mul_right_inv, map_one]
end

end laction

/-- The orbit of some element of `s : S` is the image of the left action at `s` -/
def orbit (μ : laction G S) (s : S) : set S :=
  { m : S | ∃ g : G, m = g •[μ] s }

local notation `💫`:70 s:70 := orbit μ s

namespace laction

@[simp]
lemma orbit_def {s : S} : 💫 s = { m : S | ∃ g : G, m = g • s } := rfl

@[simp]
lemma mem_orbit {s t : S} : t ∈ 💫 s ↔ ∃ g : G, t = g • s :=
by rw [orbit_def, mem_set_of_eq]

/-- An element of `G` is in its own orbit -/
lemma mem_orbit_refl (s : S) : s ∈ 💫 s := ⟨1, (map_one μ s).symm⟩

/-- If `s₁ : S` is in `s₂ : S`'s orbit, then `s₂` is in `s₁`'s orbit -/
lemma mem_orbit_symm {s₁ s₂ : S} (h : s₁ ∈ 💫 s₂) : s₂ ∈ 💫 s₁ :=
let ⟨g, hg⟩ := h in ⟨g⁻¹, by rw [hg, map_assoc, group.mul_left_inv, map_one]⟩

/-- If s₁ ∈ [s₂] and s₂ ∈ [s₃] then s₁ ∈ [s₃] -/
lemma mem_orbit_trans {s₁ s₂ s₃ : S}
  (hs₁ : s₁ ∈ 💫 s₂) (hs₂ : s₂ ∈ 💫 s₃) : s₁ ∈ 💫 s₃ :=
begin
  cases hs₁ with g₁ hg₁,
  cases hs₂ with g₂ hg₂,
  refine ⟨g₁ * g₂, _⟩,
  rw [hg₁, hg₂, map_assoc]
end

/-- If two elements of `S` are in the same orbit then they are in eachothers orbit-/
lemma in_orbit_of_in_same_orbit {s₁ s₂ s₃ : S}
  (hs₁ : s₁ ∈ 💫 s₃) (hs₂ : s₂ ∈ 💫 s₃) : s₁ ∈ 💫 s₂ :=
begin
  cases hs₁ with g₁ hg₁,
  cases hs₂ with g₂ hg₂,
  refine ⟨g₁ * g₂⁻¹, _⟩,
  rw [hg₁, hg₂, map_assoc, group.mul_assoc, group.mul_left_inv, group.mul_one]
end

lemma in_orbit_of_inv' {s₁ s₂ : S} {g : G} (h : s₁ = g • s₂) :
  s₂ = g⁻¹ • s₁ := by rw [h, map_assoc, group.mul_left_inv, map_one]

lemma eq_orbit {s₀ s₁ : S} (t : S)
  (hs₁ : t ∈ 💫 s₀) (hs₂ : t ∈ 💫 s₁) : 💫 s₀ = 💫 s₁ :=
begin
  cases hs₁ with g₁ hg₁,
  cases hs₂ with g₂ hg₂,
  ext, split; rintro ⟨g, rfl⟩,
    { rw [hg₁, laction_mul_inv, map_assoc] at hg₂,
      rw [mem_orbit, hg₂, map_assoc],
      exact ⟨g * (g₁⁻¹ * g₂), rfl⟩ },
    { rw [hg₂, laction_mul_inv, map_assoc] at hg₁,
      rw [mem_orbit, hg₁, map_assoc],
      exact ⟨g * (g₂⁻¹ * g₁), rfl⟩ }
end

end laction

/-- The stabilizer of `s : S` is the subgroup which elements fixes `s` under the
  left laction -/
def stabilizer (μ : laction G S) (s : S) : subgroup G :=
{ carrier := { g : G | (g •[μ] s) = s },
  one_mem' := laction.map_one μ _,
  mul_mem' := λ _ _ hg hh,
    by { rw mem_set_of_eq at *, rw [←laction.map_assoc, hh, hg] },
  inv_mem' := λ x hx,
    begin
      rw mem_set_of_eq at *,
      conv_lhs { rw ←hx },
      rw [laction.map_assoc, group.mul_left_inv _, μ.2]
    end }

/-- Two subgroups `H K` of group `G` are conjugates if and only if there exist
  some `g : G`, `g⁻¹ H g = K` -/
def is_conjugate (H K : subgroup G) :=
  ∃ g : G, { c | ∃ h ∈ H, c = g⁻¹ * h * g } = K

@[simp] lemma subgroup.coe_mul (H : subgroup G) (a b : G) (ha : a ∈ H) (hb : b ∈ H) :
  ((((⟨a, ha⟩ : H) * ⟨b, hb⟩) : H) : G) = a * b := rfl

--  The normalizer of a subset of G is a subgroup of G
def normalizer (A : set G) : subgroup G :=
{ carrier := {g : G | ∀ n, n ∈ A ↔ g * n * g⁻¹ ∈ A},
  one_mem' :=
    begin
      intro a,
      rw [group.one_mul, group.one_inv, group.mul_one],
    end,
  mul_mem' :=
    begin
      intros x y hx hy a,
      dsimp at *,
      rw hy,
      rw hx,
      simp [group.mul_assoc],
    end,
  inv_mem' :=
    begin
      intros x hx a,
      dsimp at *,
      rw hx (x⁻¹ * a * x⁻¹⁻¹),
      simp [group.mul_assoc],
    end,
  }

namespace laction

@[simp]
lemma mem_stabilizer (s : S) (g : G) : g ∈ stabilizer μ s ↔ g • s = s := iff.rfl

/-- If `H` is the conjugate of `K`, then `K` is the conjugate of `H` -/
lemma is_conjugate_comm {H K : subgroup G} (h : is_conjugate H K) :
  is_conjugate K H :=
begin
  cases h with g hg, refine ⟨g⁻¹, _⟩,
  ext, split; intro hx,
    { rcases hx with ⟨h, hh₀, hh₁⟩,
      change h ∈ (K : set G) at hh₀,
      rw ←hg at hh₀,
      rcases hh₀ with ⟨k, hk₀, hk₁⟩,
      rw [hh₁, hk₁], simpa [group.mul_assoc] },
    { rw mem_set_of_eq,
      refine ⟨g⁻¹ * x * g, _, by simp [group.mul_assoc]⟩,
      show g⁻¹ * x * g ∈ (K : set G),
      rw ←hg, exact ⟨x, hx, rfl⟩ }
end

/-- If two elements are in the same orbit, then their stabilizers are conjugates -/
theorem conjugate_stabilizer_of_in_same_orbit {s₁ s₂ s₃ : S}
  (hs₁ : s₁ ∈ 💫 s₃) (hs₂ : s₂ ∈ 💫 s₃) :
  is_conjugate (stabilizer μ s₁) (stabilizer μ s₂) :=
begin
  cases in_orbit_of_in_same_orbit hs₁ hs₂ with g hg,
  refine ⟨g, _⟩,
  ext, split; intro hx,
    { show x ∈ stabilizer μ s₂,
      rcases hx with ⟨h, hh₀, hh₁⟩,
      rw [mem_stabilizer, hh₁, ←map_assoc, ←map_assoc, ←hg,
         (show h • s₁ = s₁, by exact hh₀), hg, map_assoc,
         group.mul_left_inv, map_one] },
    { change x ∈ stabilizer μ s₂ at hx,
      refine ⟨g * x * g⁻¹, (mem_stabilizer _ _).2 _, _⟩,
      rw [←map_assoc, ←(in_orbit_of_inv' hg),
          ←map_assoc, (mem_stabilizer _ _).1 hx, hg], by simp [group.mul_assoc] }
end

private structure extract_struct {μ : laction G S} {a : S} (s : orbit μ a) :=
(val : G) (prop : s.1 = μ.to_fun val a)

@[reducible] private def extract {μ : laction G S} {a : S} (s : orbit μ a) :
  extract_struct s := ⟨some s.2, some_spec s.2⟩

@[reducible] private def aux_map (μ : laction G S) (a : S) :
  orbit μ a → { s | ∃ h : G, s = h ⋆ stabilizer μ a } :=
λ s, ⟨(extract s).1 ⋆ stabilizer μ a, (extract s).1, rfl⟩

private lemma aux_map_biject {a : S} : bijective $ aux_map μ a :=
begin
  split,
    { rintro ⟨x, hx⟩ ⟨y, hy⟩ hxy,
      rw [subtype.mk.inj_eq, lagrange.lcoset_eq] at hxy,
      change ((extract ⟨y, hy⟩).val)⁻¹ * (extract ⟨x, hx⟩).val ∈
        { g : G | g • a = a } at hxy,
      rw [mem_set_of_eq, ←μ.3, ←(extract ⟨x, hx⟩).2,
        @laction_mul_inv _ _ _ μ _ x a, group.inv_inv, ←(extract ⟨y, hy⟩).2] at hxy,
      simp only [hxy] },
    { rintro ⟨_, g, hg⟩, refine ⟨⟨g • a, g, rfl⟩, _⟩,
      rw [subtype.mk.inj_eq, hg, lagrange.lcoset_eq],
      show g⁻¹ * (extract ⟨μ.to_fun g a, _⟩).val ∈ { g : G | g • a = a },
      rw [mem_set_of_eq, ←μ.3, ←(extract ⟨μ.to_fun g a, _⟩).2,
        μ.3, group.mul_left_inv, μ.2] }
end

-- With this function defined, we see that the cardinality of orbit s equals
-- the number of left cosets of stabilizer s

lemma card_orbit_eq_num_lcoset {a : S} :
  fincard (orbit μ a) = fincard { s | ∃ h : G, s = h ⋆ stabilizer μ a } :=
fincard.of_equiv (equiv.of_bijective _ aux_map_biject)

/-- Orbit-Stabilizer : The cardinality of a finite group `G` given a laction `μ`
on some `S` equals the cardinality of the orbit of `s` multiplied by the
cardinality of the stabilizer of `s` for any `s : S` -/
theorem orbit_stabilizer [h: fintype G] {a : S} (μ : laction G S) :
  fincard G = fincard (orbit μ a) * fincard (stabilizer μ a) :=
by rw [card_orbit_eq_num_lcoset, mul_comm]; exact lagrange.lagrange

/-! # fixed points -/

end laction

def fixed_points (μ : laction G S) : set S := {s : S | ∀ g : G, g •[μ] s = s }

@[simp] lemma mem_fixed_points_iff (s : S) :
  s ∈ fixed_points μ ↔ ∀ (g : G) , g • s = s := iff.rfl

lemma mem_fixed_points_iff_stabilizer_univ (s : S) :
  s ∈ fixed_points μ ↔ stabilizer μ s = ⊤ :=
begin
  rw mem_fixed_points_iff,
  rw subgroup.eq_top_iff',
  apply forall_congr,
  intro a, refl
end

--Want to show that if s is in the set of fixed points of μ, then the orbit of s contains only s.#check
lemma orbit_eq_singleton {s : S} {μ : laction G S} (h : s ∈ fixed_points μ) :
  orbit μ s = {s} :=
begin
  ext x,
  simp * at *,
end

lemma mem_fixed_points {s : S} {μ : laction G S} (h : orbit μ s = {s}) :
  s ∈ fixed_points μ :=
begin
  intros k,
  apply mem_singleton_iff.1,
  rw ←h,
  use k
end

lemma orbit_eq_singleton_iff {s : S} {μ : laction G S} :
  orbit μ s = {s} ↔ s ∈ fixed_points μ := ⟨mem_fixed_points, orbit_eq_singleton⟩

--The following lemma is based on the one by the same name in the library,
-- I believe it is needed to prove card_set_eq_card_fixed_points_sum_card_orbits
lemma mem_fixed_points_iff_card_orbit_eq_one {s : S} {μ : laction G S}:
  s ∈ fixed_points μ ↔ fincard (orbit μ s) = 1 :=
begin
  rw ←orbit_eq_singleton_iff,
  split; intro h,
    { simp [h] },
    { rw eq_singleton_iff_unique_mem,
      refine ⟨laction.mem_orbit_refl _, λ y hy, _⟩,
      rcases fincard.card_eq_one_iff_singleton.1 h with ⟨x, hx⟩,
      rw hx at hy,
      rw [mem_singleton_iff.1 hy, ←mem_singleton_iff, ←hx],
      exact laction.mem_orbit_refl _ }
end

/-
S : Type
~ : equiv reln on S
Common in maths departments to let Q = set of equiv classes

Map cl : S -> Q, sends s to cl(s) = {t : t ~ s}

What key properties do Q and S -> Q have?

Key one is the "universal property"

  If g : S -> T
  and if g has the following property : it's constant on equiv classes
  i.e. s1 ~ s2 -> g(s1) = g(s2) (*)

  then there's a map g-bar from Q to T "induced by g"

    Definition of g-bar: let q ∈ Q be an equiv class
    q ⊆ S and is nonempty
    choose s ∈ q <- MADE A CHOICE
    define g-bar(q) := g(s)
    What if I'd instead chosen s' ∈ q, s' ≠ s?
    Then g(s)=g(s') by our assumption (*)
    hence g-bar(q) doesn't depend on choice of s

   Hence "g-bar is well-defined"

Furthermore, S --(g)--> T
             |       /\
             |      /
            (cl)  (g-bar)
             |    /
             \/  /
             Q -/

/-

             g = g-bar ∘ cl

That's a property that cl has

Conversely, if I have φ : Q -> T then I can compose with cl and
get a map φ-tilde = φ ∘ cl : S -> T and I claim that if s1 and s2 are in S with s1 ~ s2
then φ-tilde (s1) = φ-tilde (s2) (i.e. φ-tilde satisfies (*) above)

So now we have two maps between the following sets:

1) {g : S → T | if s1 ~ s2 then g(s1) = g(s2) }
2) {φ : Q → T}

Map from 1 to 2 sends g to g-bar
Map from 2 to 1 sends φ to φ-tilde = φ ∘ cl

Easy to check that these are inverse bijections

In particular, we have cl : S → Q and composing with cl
gives us a bijection from {Q → T} to {g : S → T | g satisfies (*)}

Turns out that this characterises Q, the set of equiv classes, up to unique isomorphism
and hence this bijection property can be used as a "definition of Q" in some sense

In particular, Q doesn't _have_ to be equivalence classes!

Given S and an equiv reln, I now think of Q not as the set of equiv classes
but as any set at all with a surjection from S satisfying this property.

Annoyingly, my mental model of g-bar is "going downwards" but in Lean they
call it quotient.lift

equiv reln on S
Q = quotient = type of equiv classes

-/

-- should now prove that for G acting on S, size of S = sum
-- of size of orbits.

/-- Orbits of an action -/
def orbits (μ : laction G S) := setoid.classes
  {r := λ (x y : S), x ∈ orbit μ y,
   iseqv := ⟨laction.mem_orbit_refl,
            λ x y, laction.mem_orbit_symm,
            λ x y z, laction.mem_orbit_trans⟩}

lemma orbit_mem_orbits (s : S) : orbit μ s ∈ orbits μ := ⟨s, rfl⟩

lemma orbit_unique {x : S} {s : set S} (hs : s ∈ orbits μ) :
  x ∈ s ↔ orbit μ x = s :=
begin
  unfold orbits at hs,
  change s ∈ {s | ∃ y, s = {x | x ∈ orbit μ y}} at hs,
  rcases hs with ⟨y, rfl⟩,
  split; intro hx,
    { change x ∈ orbit μ y at hx,
      exact laction.eq_orbit x (laction.mem_orbit_refl _) hx },
    { change orbit μ x = orbit μ y at hx,
      rw ←hx, exact laction.mem_orbit_refl _ }
end

lemma sum_card_orbits [fintype S] : ∑' o in (orbits μ), fincard o = fincard S :=
(fincard.card_eq_finsum_partition (setoid.is_partition_classes _)).symm

/-
def orbits_not_singleton (μ : laction G S): set (orbits μ) := {o : orbits μ | fincard o > 1}

--Should I rewrite the fixed points as a collection of singletons?
def singleton_orbits  (μ : laction G S) : set (orbits μ) := {o : orbits μ | fincard o = 1}
--It probably makes more sense to write it as the following lemma, though fixed_points is a subset of S
-- and {o : orbits μ | fincard o = 1} is a subset of orbits  ↥

lemma fixed_points_singletons [fintype S] (μ : laction G S) :
  ↥(fixed_points μ) = (singleton_orbits μ ) :=
begin
 unfold fixed_points,
 unfold singleton_orbits,
 sorry
end

--The issue here is that types are different
lemma foo [fintype S] (μ : laction G S):
orbits μ = (orbits_not_singleton μ) ∪ singleton_orbits μ  := sorry
-/

lemma dumb {n : ℕ} (hn : n ≤ 1) : n = 0 ∨ n = 1 :=
begin
  induction n, finish,
  rw nat.succ_le_iff at hn,
  change _ < 1 + 0 at hn,
  rw nat.lt_one_add_iff at hn,
  rw nat.le_zero_iff at hn,
  right, rw hn,
end

lemma card_orbits_eq_one [fintype S] {s : set S}
  (hs₀ : s ∈ orbits μ) (hs₁ : fincard s ≤ 1) : fincard s = 1 :=
begin
  cases dumb hs₁,
    { change s ∈ {s | ∃ y, s = {x | x ∈ orbit μ y}} at hs₀,
      rcases hs₀ with ⟨x, hx⟩,
      change s = orbit μ x at hx,
      rw fincard.card_eq_zero_iff at h,
      exfalso,
      apply not_mem_empty x,
      rw [←h, hx],
      exact laction.mem_orbit_refl x },
    { assumption }
end

def map_singleton (μ : laction G S) : (fixed_points μ) →
  ({o ∈ orbits μ | fincard o ≤ 1} : set (set S)) :=
λ s, ⟨orbit μ s, orbit_mem_orbits _,
  let ⟨_, hs⟩ := s in le_of_eq (mem_fixed_points_iff_card_orbit_eq_one.1 hs)⟩

@[simp] lemma map_singleton_def (s : S) (hs : s ∈ fixed_points μ) :
  (map_singleton μ ⟨s, hs⟩ : set S) = {s} :=
begin
  suffices : {m : S | ∃ (g : G), m = g • s} = {s},
    simpa [map_singleton],
  finish,
end

lemma bijective_map_singleton [fintype S] (μ : laction G S) :
  function.bijective (map_singleton μ) :=
begin
  split,
    { rintros ⟨x, hx⟩ ⟨y, hy⟩ hxy, congr,
      rw ←singleton_eq_singleton_iff,
      iterate 2 { rw ←map_singleton_def _ }, rw hxy },
    { rintros ⟨y, hy₀, hy₁⟩,
      rcases fincard.card_eq_one_iff_singleton.1
        (card_orbits_eq_one hy₀ hy₁) with ⟨x, rfl⟩,
      refine ⟨⟨x, _⟩, _⟩,
        { rw ←orbit_eq_singleton_iff,
          exact (orbit_unique hy₀).1 (mem_singleton _) },
        { suffices : {m : S | ∃ (g : G), m = g • x} = {x},
            simpa [map_singleton],
          suffices : x ∈ fixed_points μ,
            finish,
          rw ←orbit_eq_singleton_iff,
          exact (orbit_unique hy₀).1 (mem_singleton _) } }
end

lemma card_fixed_points [fintype S] : fincard (fixed_points μ) =
  let p := λ s : set S, fincard s ≤ 1 in
  ∑' o in { o ∈ orbits μ | p o }, fincard o :=
begin
  dsimp only,
  rw @finsum_const_nat (set S) (by apply_instance) _ 1 _,
    { rw mul_one,
      exact fincard.of_equiv (equiv.of_bijective _ $ bijective_map_singleton μ) },
    { exact λ x ⟨hx₀, hx₁⟩, card_orbits_eq_one hx₀ hx₁ },
end

lemma card_set_eq_card_fixed_points_sum_card_orbits [fintype S] (μ : laction G S):
  fincard S = fincard (fixed_points μ)
             + let p := λ s : set S, fincard s ≤ 1 in
             ∑' o in { o ∈ (orbits μ) | ¬ p o }, fincard o :=
begin
  rw [card_fixed_points, fincard.finsum_in_filter],
  exact sum_card_orbits.symm
end

--I don't think this is needed anymore
lemma pow_prime_eq_one_or_dvd_prime {p d n : ℕ} (hp: p.prime) (hd: d = p^n) :
  d = 1 ∨ p ∣ d :=
begin
  cases n,
  left, rw hd, refl,
  right, simp [hd, nat.succ_eq_add_one, nat.pow_succ]
end

-- Are these names okay? Should I leave these lemmas here?
lemma card_orbit_div_pow_p [fintype S] [fintype G] (μ : laction G S)
  (p : ℕ) (hp : p.prime) (n : ℕ) (hG : fincard G = p ^ n):
  ∀ s : S, fincard'( orbit μ s ) ∣ p^n :=
begin
  intro s, rw ← hG,
    use (fincard (stabilizer μ s)),
    rw laction.orbit_stabilizer,
end

lemma card_orbit_eq_one_or_dvd_p [fintype S] [fintype G] (μ : laction G S)
  (p : ℕ) (hp : p.prime) (n : ℕ) (hG : fincard G = p ^ n) :
  ∀ (s : S), fincard (orbit μ s) = 1 ∨ p ∣ fincard (orbit μ s) :=
begin
  intro s,
  cases (card_orbit_div_pow_p μ p hp n hG) s with _ _,
  have h1: fincard ↥(orbit μ s) ∣ p^n,
    { use w, exact h },
  rw nat.dvd_prime_pow hp at h1,
  rcases h1 with ⟨a, _, ha⟩,
  rw ha,
  cases a with _ _,
    { rw nat.pow_zero,
      left, refl },
    { right,
      rw nat.pow_succ,
      use p^a, rw mul_comm }
end

lemma card_set_congr_card_fixed_points_mod_prime [fintype S] [fintype G]
  (μ : laction G S) (p : ℕ) (hp : p.prime) (n : ℕ) (hG : fincard G = p ^ n) :
  fincard S ≡ fincard (fixed_points μ) [MOD p] :=
begin
  have claim : ∀ s : S, fincard'( orbit μ s ) ∣ p^n ,
    { exact card_orbit_div_pow_p μ p hp n hG },
  rw card_set_eq_card_fixed_points_sum_card_orbits μ,
  dsimp,
  refine nat.modeq.modeq_of_dvd _,
  suffices: ↑p ∣ ↑∑' (o : set S) in
    ({o ∈ orbits μ | 1 < fincard o} : set (set S)), fincard ↥o,
    { simpa [sub_eq_add_neg] },
  norm_cast,
  apply fincard.finsum_divisible_by,
  have: ∀ (s : S), fincard (orbit μ s) = 1 ∨ p ∣ fincard (orbit μ s),
    { exact card_orbit_eq_one_or_dvd_p μ p hp n hG },
  rintro x h,
  cases h with hl hr,
  cases hl with s hs,
  change x = orbit μ s at hs,
  rw hs,
  cases this s,
  rw [hs, h] at hr,
  linarith,
  assumption
end

--Given a subset H of a group G, its conjugate is also a subgroup of G
def conjugate_subgroup [group G] (g : G) (H : subgroup G) :  subgroup G :=
{ carrier := { k| ∃ h ∈ H, k = g * h * g⁻¹ },
  one_mem' :=
    begin
      use (1 : G),
      split,
      apply H.one_mem',
      rw [group.mul_one, group.mul_right_inv],
    end,
  mul_mem' :=
    begin
      rintros x y ⟨s, hs, h1⟩ ⟨t, ht, h2⟩,
      use s * t,
      split,
      apply H.mul_mem' hs ht,
      rw [h1, h2],
      simp [group.mul_assoc],
    end  ,
  inv_mem' :=
    begin
      dsimp,
      rintros x ⟨s, hs, hx⟩,
      use s⁻¹,
      split,
      apply H.inv_mem' hs,
      apply group.inv_eq_of_mul_eq_one,
      rw hx,
      simp [group.mul_assoc],
    end }

lemma conjugate_is_conjugate (g : G) (H : subgroup G) : is_conjugate H (conjugate_subgroup g H) :=
begin
  use g⁻¹,
  rw group.inv_inv,
  ext x,
  apply exists_congr,
  simp [conjugate_subgroup],
end

lemma mul_equiv_of_is_conjugate {H K : subgroup G} (e : is_conjugate H K) :
 H ≃* K :=
let ⟨g, hg⟩ := classical.indefinite_description _ e in
begin
  dsimp at hg,
  rw ext_iff at hg,
  change ∀ x : G, (∃ (h : G), _) ↔ x ∈ K at hg,
exact { to_fun := λ h, ⟨g⁻¹ * h * g, show _ ∈ K, begin rw ←hg, use [h.1, h.2], refl end⟩,
  inv_fun := λ k, ⟨g*k.1*g⁻¹, begin show _ ∈ H, cases k with k hk,
    have hk2 := (hg k).2 hk,
    rcases hk2 with ⟨t, h1, h2⟩,
    convert h1,
    subst h2,
    simp [group.mul_assoc],
  end⟩,
  left_inv := begin
    rintro ⟨h, hh⟩,
    simp [group.mul_assoc]
  end,
  right_inv := begin
    rintro ⟨h, hh⟩,
    simp [group.mul_assoc]
  end,
  map_mul' := begin
    rintro ⟨a, ha⟩ ⟨b, hb⟩,
    ext,
    simp [group.mul_assoc]
  end} end

def conjugation_action [group G]: laction G (subgroup G) :=
{ to_fun := λ (g : G) (H : subgroup G), conjugate_subgroup g H,
  map_one' :=
    begin
      intro H,
      unfold conjugate_subgroup,
      norm_num,
      ext, split,
      repeat { intro hx, exact hx },
    end  ,
  map_assoc' :=
    begin
      intros s t H,
      ext, split,
      unfold conjugate_subgroup,
        {intro hx,
        rcases hx with ⟨h, ⟨⟨k, ⟨j, hj⟩⟩, h2⟩⟩,
        rw hj at h2,
        suffices: x = s * t * k * (t⁻¹ * s⁻¹),
         tidy,                                  --should tidy be non terminal?
        rw [← group.mul_assoc, h2, group.mul_assoc],
        apply group.mul_eq_of_eq_inv_mul,
        symmetry,
        iterate 4 {rw ← group.mul_assoc},
        rw [group.mul_left_inv, group.one_mul] },
      { intro hx,
        rcases hx with ⟨h, ⟨hh, hj⟩⟩,
        suffices: x ∈ conjugate_subgroup s (conjugate_subgroup t H),
          tidy,                                  --should tidy be non terminal?
        rw [← group.mul_assoc, ← group.mul_assoc, group.mul_assoc],
        assumption },
    end }

lemma mem_normalizer_iff [group G] {H : subgroup G} (x : G):
  x ∈ normalizer H.carrier ↔ ∀ k : G, k ∈ H ↔ x * k * x⁻¹ ∈ H := by refl

end mygroup


-- f es creciente syss ∀ x y, x < y → f x ≤ f y
-- ============================================

import data.real.basic

variable (f : ℝ → ℝ)

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    creciente : (ℝ → ℝ) → Prop
-- tal que (creciente f) espresa que f es creciente.
-- ----------------------------------------------------

def creciente (f : ℝ → ℝ) : Prop :=
∀ {x₁ x₂}, x₁ ≤ x₂ → f x₁ ≤ f x₂

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que f es creciente syss
-- ∀ x y, x < y → f x ≤ f y
-- ----------------------------------------------------

-- 1ª demostración
example :
  creciente f ↔ ∀ {x y}, x < y → f x ≤ f y :=
begin
  unfold creciente,
  split,
  { intros hf x y hxy,
    apply hf,
    -- by library_search
    exact le_of_lt hxy, },
  { intros h x y hxy,
    have h1: x = y ∨ x < y,
      apply eq_or_lt_of_le hxy,
    cases h1 with h2 h3,
    { rw h2, },
    { apply h,
      exact h3, }},
end

-- 2ª demostración
example :
  creciente f ↔ ∀ {x y}, x < y → f x ≤ f y :=
begin
  split,
  { intros hf x y hxy,
    apply hf,
    exact le_of_lt hxy, },
  { intros h x y hxy,
    have h1: x = y ∨ x < y,
      apply eq_or_lt_of_le hxy,
    cases h1 with h2 h3,
    { rw h2, },
    { apply h,
      exact h3, }},
end

-- 3ª demostración
example :
  creciente f ↔ ∀ {x y}, x < y → f x ≤ f y :=
begin
  split,
  { intros hf x y hxy,
    apply hf,
    linarith, },
  { intros h x y hxy,
    cases (eq_or_lt_of_le hxy) with h2 h3,
    { rw h2, },
    { exact h h3, }},
end


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import deprecated.subring
import algebra.group_with_zero.power
/-

# Unbundled subfields

This file introduces the predicate `is_subfield` on `S : set F` where `F` is a field.
This is *not* the preferred way to do subfields in Lean 3: in general `S : subfield F`
works more smoothly.

## Main definitions

`is_subfield (S : set F)` : the predicate that `S` is the underlying set of a subfield
of the field `F`. Note that the bundled variant `subfield F` is preferred to this approach.

## Tags

is_subfield
-/
variables {F : Type*} [field F] (S : set F)

structure is_subfield extends is_subring S : Prop :=
(inv_mem : ∀ {x : F}, x ∈ S → x⁻¹ ∈ S)

lemma is_subfield.div_mem {S : set F} (hS : is_subfield S) {x y : F} (hx : x ∈ S) (hy : y ∈ S) :
  x / y ∈ S :=
by { rw div_eq_mul_inv, exact hS.to_is_subring.to_is_submonoid.mul_mem hx (hS.inv_mem hy) }

lemma is_subfield.pow_mem {a : F} {n : ℤ} {s : set F} (hs : is_subfield s) (h : a ∈ s) :
  a ^ n ∈ s :=
begin
  cases n,
  { rw zpow_of_nat, exact hs.to_is_subring.to_is_submonoid.pow_mem h },
  { rw zpow_neg_succ_of_nat, exact hs.inv_mem (hs.to_is_subring.to_is_submonoid.pow_mem h) },
end

lemma univ.is_subfield : is_subfield (@set.univ F) :=
{ inv_mem := by intros; trivial,
  ..univ.is_submonoid,
  ..is_add_subgroup.univ_add_subgroup }

lemma preimage.is_subfield {K : Type*} [field K]
  (f : F →+* K) {s : set K} (hs : is_subfield s) : is_subfield (f ⁻¹' s) :=
{ inv_mem := λ a (ha : f a ∈ s), show f a⁻¹ ∈ s,
    by { rw [f.map_inv],
         exact hs.inv_mem ha },
  ..f.is_subring_preimage hs.to_is_subring }

lemma image.is_subfield {K : Type*} [field K]
  (f : F →+* K) {s : set F} (hs : is_subfield s) : is_subfield (f '' s) :=
{ inv_mem := λ a ⟨x, xmem, ha⟩, ⟨x⁻¹, hs.inv_mem xmem, ha ▸ f.map_inv _⟩,
  ..f.is_subring_image hs.to_is_subring }

lemma range.is_subfield {K : Type*} [field K]
  (f : F →+* K) : is_subfield (set.range f) :=
by { rw ← set.image_univ, apply image.is_subfield _ univ.is_subfield }

namespace field

/-- `field.closure s` is the minimal subfield that includes `s`. -/
def closure : set F :=
{ x | ∃ y ∈ ring.closure S, ∃ z ∈ ring.closure S, y / z = x }

variables {S}

theorem ring_closure_subset : ring.closure S ⊆ closure S :=
λ x hx, ⟨x, hx, 1, ring.closure.is_subring.to_is_submonoid.one_mem, div_one x⟩

lemma closure.is_submonoid : is_submonoid (closure S) :=
{ mul_mem := by rintros _  _ ⟨p, hp, q, hq, hq0, rfl⟩ ⟨r, hr, s, hs, hs0, rfl⟩;
    exact ⟨p * r,
          is_submonoid.mul_mem ring.closure.is_subring.to_is_submonoid hp hr,
          q * s,
          is_submonoid.mul_mem ring.closure.is_subring.to_is_submonoid hq hs,
          (div_mul_div _ _ _ _).symm⟩,
  one_mem := ring_closure_subset $ is_submonoid.one_mem ring.closure.is_subring.to_is_submonoid }

lemma closure.is_subfield : is_subfield (closure S) :=
have h0 : (0:F) ∈ closure S, from ring_closure_subset $
  ring.closure.is_subring.to_is_add_subgroup.to_is_add_submonoid.zero_mem,
{ add_mem := begin
    intros a b ha hb,
    rcases (id ha) with ⟨p, hp, q, hq, rfl⟩,
    rcases (id hb) with ⟨r, hr, s, hs, rfl⟩,
    classical, by_cases hq0 : q = 0, by simp [hb, hq0], by_cases hs0 : s = 0, by simp [ha, hs0],
    exact ⟨p * s + q * r, is_add_submonoid.add_mem
      ring.closure.is_subring.to_is_add_subgroup.to_is_add_submonoid
      (ring.closure.is_subring.to_is_submonoid.mul_mem hp hs)
      (ring.closure.is_subring.to_is_submonoid.mul_mem hq hr), q * s,
        ring.closure.is_subring.to_is_submonoid.mul_mem hq hs,
      (div_add_div p r hq0 hs0).symm⟩
  end,
  zero_mem := h0,
  neg_mem := begin
    rintros _ ⟨p, hp, q, hq, rfl⟩,
    exact ⟨-p, ring.closure.is_subring.to_is_add_subgroup.neg_mem hp, q, hq, neg_div q p⟩
  end,
  inv_mem := begin
    rintros _ ⟨p, hp, q, hq, rfl⟩,
    exact ⟨q, hq, p, hp, inv_div.symm⟩
  end,
  ..closure.is_submonoid }

theorem mem_closure {a : F} (ha : a ∈ S) : a ∈ closure S :=
ring_closure_subset $ ring.mem_closure ha

theorem subset_closure : S ⊆ closure S :=
λ _, mem_closure

theorem closure_subset {T : set F} (hT : is_subfield T) (H : S ⊆ T) : closure S ⊆ T :=
by rintros _ ⟨p, hp, q, hq, hq0, rfl⟩; exact hT.div_mem (ring.closure_subset hT.to_is_subring H hp)
  (ring.closure_subset hT.to_is_subring H hq)

theorem closure_subset_iff {s t : set F} (ht : is_subfield t) : closure s ⊆ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, closure_subset ht⟩

theorem closure_mono {s t : set F} (H : s ⊆ t) : closure s ⊆ closure t :=
closure_subset closure.is_subfield $ set.subset.trans H subset_closure

end field

lemma is_subfield_Union_of_directed {ι : Type*} [hι : nonempty ι]
  {s : ι → set F} (hs : ∀ i, is_subfield (s i))
  (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
  is_subfield (⋃i, s i) :=
{ inv_mem := λ x hx, let ⟨i, hi⟩ := set.mem_Union.1 hx in
    set.mem_Union.2 ⟨i, (hs i).inv_mem hi⟩,
  to_is_subring := is_subring_Union_of_directed (λ i, (hs i).to_is_subring) directed }

lemma is_subfield.inter {S₁ S₂ : set F} (hS₁ : is_subfield S₁) (hS₂ : is_subfield S₂) :
  is_subfield (S₁ ∩ S₂) :=
{ inv_mem := λ x hx, ⟨hS₁.inv_mem hx.1, hS₂.inv_mem hx.2⟩,
  ..is_subring.inter hS₁.to_is_subring hS₂.to_is_subring }

lemma is_subfield.Inter {ι : Sort*} {S : ι → set F} (h : ∀ y : ι, is_subfield (S y)) :
  is_subfield (set.Inter S) :=
{ inv_mem := λ x hx, set.mem_Inter.2 $ λ y, (h y).inv_mem $ set.mem_Inter.1 hx y,
  ..is_subring.Inter (λ y, (h y).to_is_subring) }


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

! This file was ported from Lean 3 source module model_theory.graph
! leanprover-community/mathlib commit e56b8fea84d60fe434632b9d3b829ee685fb0c8f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.ModelTheory.Satisfiability
import Mathbin.Combinatorics.SimpleGraph.Basic

/-!
# First-Ordered Structures in Graph Theory
This file defines first-order languages, structures, and theories in graph theory.

## Main Definitions
* `first_order.language.graph` is the language consisting of a single relation representing
adjacency.
* `simple_graph.Structure` is the first-order structure corresponding to a given simple graph.
* `first_order.language.Theory.simple_graph` is the theory of simple graphs.
* `first_order.language.simple_graph_of_structure` gives the simple graph corresponding to a model
of the theory of simple graphs.

-/

universe u v w w'

namespace FirstOrder

namespace Language

open FirstOrder

open Structure

variable {L : Language.{u, v}} {α : Type w} {V : Type w'} {n : ℕ}

/-! ### Simple Graphs -/

/-- The language consisting of a single relation representing adjacency. -/
protected def graph : Language :=
  Language.mk₂ Empty Empty Empty Empty Unit
#align first_order.language.graph FirstOrder.Language.graph

/-- The symbol representing the adjacency relation. -/
def adj : Language.graph.Relations 2 :=
  Unit.unit
#align first_order.language.adj FirstOrder.Language.adj

/-- Any simple graph can be thought of as a structure in the language of graphs. -/
def SimpleGraph.structure (G : SimpleGraph V) : Language.graph.Structure V :=
  Structure.mk₂ Empty.elim Empty.elim Empty.elim Empty.elim fun _ => G.Adj
#align simple_graph.Structure SimpleGraph.structure

namespace Graph

instance : IsRelational Language.graph :=
  Language.isRelational_mk₂

instance : Subsingleton (Language.graph.Relations n) :=
  Language.subsingleton_mk₂_relations

end Graph

/-- The theory of simple graphs. -/
protected def Theory.simpleGraph : Language.graph.Theory :=
  {adj.Irreflexive, adj.Symmetric}
#align first_order.language.Theory.simple_graph FirstOrder.Language.Theory.simpleGraph

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem Theory.simpleGraph_model_iff [Language.graph.Structure V] :
    V ⊨ Theory.simpleGraph ↔
      (Irreflexive fun x y : V => RelMap adj ![x, y]) ∧
        Symmetric fun x y : V => RelMap adj ![x, y] :=
  by simp [Theory.simple_graph]
#align first_order.language.Theory.simple_graph_model_iff FirstOrder.Language.Theory.simpleGraph_model_iff

instance simpleGraph_model (G : SimpleGraph V) : @Theory.Model _ V G.Structure Theory.simpleGraph :=
  by
  simp only [Theory.simple_graph_model_iff, rel_map_apply₂]
  exact ⟨G.loopless, G.symm⟩
#align first_order.language.simple_graph_model FirstOrder.Language.simpleGraph_model

variable (V)

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Any model of the theory of simple graphs represents a simple graph. -/
@[simps]
def simpleGraphOfStructure [Language.graph.Structure V] [V ⊨ Theory.simpleGraph] : SimpleGraph V
    where
  Adj x y := RelMap adj ![x, y]
  symm :=
    Relations.realize_symmetric.1
      (Theory.realize_sentence_of_mem Theory.simpleGraph
        (Set.mem_insert_of_mem _ (Set.mem_singleton _)))
  loopless :=
    Relations.realize_irreflexive.1
      (Theory.realize_sentence_of_mem Theory.simpleGraph (Set.mem_insert _ _))
#align first_order.language.simple_graph_of_structure FirstOrder.Language.simpleGraphOfStructure

variable {V}

@[simp]
theorem SimpleGraph.simpleGraphOfStructure (G : SimpleGraph V) :
    @simpleGraphOfStructure V G.Structure _ = G :=
  by
  ext
  rfl
#align simple_graph.simple_graph_of_structure SimpleGraph.simpleGraphOfStructure

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem structure_simpleGraphOfStructure [S : Language.graph.Structure V] [V ⊨ Theory.simpleGraph] :
    (simpleGraphOfStructure V).Structure = S :=
  by
  ext (n f xs)
  · exact (is_relational.empty_functions n).elim f
  · ext (n r xs)
    rw [iff_eq_eq]
    cases n
    · exact r.elim
    · cases n
      · exact r.elim
      · cases n
        · cases r
          change rel_map adj ![xs 0, xs 1] = _
          refine' congr rfl (funext _)
          simp [Fin.forall_fin_two]
        · exact r.elim
#align first_order.language.Structure_simple_graph_of_structure FirstOrder.Language.structure_simpleGraphOfStructure

theorem Theory.simpleGraph_isSatisfiable : Theory.IsSatisfiable Theory.simpleGraph :=
  ⟨@Theory.ModelCat.of _ _ Unit (SimpleGraph.structure ⊥) _ _⟩
#align first_order.language.Theory.simple_graph_is_satisfiable FirstOrder.Language.Theory.simpleGraph_isSatisfiable

end Language

end FirstOrder