/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import topology.compact_open
import topology.uniform_space.uniform_convergence

/-!
# Compact convergence (uniform convergence on compact sets)

Given a topological space `α` and a uniform space `β` (e.g., a metric space or a topological group),
the space of continuous maps `C(α, β)` carries a natural uniform space structure. We define this
uniform space structure in this file and also prove the following properties of the topology it
induces on `C(α, β)`:

 1. Given a sequence of continuous functions `Fₙ : α → β` together with some continuous `f : α → β`,
    then `Fₙ` converges to `f` as a sequence in `C(α, β)` iff `Fₙ` converges to `f` uniformly on
    each compact subset `K` of `α`.
 2. Given `Fₙ` and `f` as above and suppose `α` is locally compact, then `Fₙ` converges to `f` iff
    `Fₙ` converges to `f` locally uniformly.
 3. The topology coincides with the compact-open topology.

Property 1 is essentially true by definition, 2 follows from basic results about uniform
convergence, but 3 requires a little work and uses the Lebesgue number lemma.

## The uniform space structure

Given subsets `K ⊆ α` and `V ⊆ β × β`, let `E(K, V) ⊆ C(α, β) × C(α, β)` be the set of pairs of
continuous functions `α → β` which are `V`-close on `K`:
$$
  E(K, V) = \{ (f, g) | ∀ (x ∈ K), (f x, g x) ∈ V \}.
$$
Fixing some `f ∈ C(α, β)`, let `N(K, V, f) ⊆ C(α, β)` be the set of continuous functions `α → β`
which are `V`-close to `f` on `K`:
$$
  N(K, V, f) = \{ g | ∀ (x ∈ K), (f x, g x) ∈ V \}.
$$
Using this notation we can describe the uniform space structure and the topology it induces.
Specifically:
 *  A subset `X ⊆ C(α, β) × C(α, β)` is an entourage for the uniform space structure on `C(α, β)`
    iff there exists a compact `K` and entourage `V` such that `E(K, V) ⊆ X`.
 *  A subset `Y ⊆ C(α, β)` is a neighbourhood of `f` iff there exists a compact `K` and entourage
    `V` such that `N(K, V, f) ⊆ Y`.

The topology on `C(α, β)` thus has a natural subbasis (the compact-open subbasis) and a natural
neighbourhood basis (the compact-convergence neighbourhood basis).

## Main definitions / results

 * `compact_open_eq_compact_convergence`: the compact-open topology is equal to the
   compact-convergence topology.
 * `compact_convergence_uniform_space`: the uniform space structure on `C(α, β)`.
 * `mem_compact_convergence_entourage_iff`: a characterisation of the entourages of `C(α, β)`.
 * `tendsto_iff_forall_compact_tendsto_uniformly_on`: a sequence of functions `Fₙ` in `C(α, β)`
   converges to some `f` iff `Fₙ` converges to `f` uniformly on each compact subset `K` of `α`.
 * `tendsto_iff_tendsto_locally_uniformly`: on a locally compact space, a sequence of functions
   `Fₙ` in `C(α, β)` converges to some `f` iff `Fₙ` converges to `f` locally uniformly.
 * `tendsto_iff_tendsto_uniformly`: on a compact space, a sequence of functions `Fₙ` in `C(α, β)`
   converges to some `f` iff `Fₙ` converges to `f` uniformly.

## Implementation details

We use the forgetful inheritance pattern (see Note [forgetful inheritance]) to make the topology
of the uniform space structure on `C(α, β)` definitionally equal to the compact-open topology.

## TODO

 * When `β` is a metric space, there is natural basis for the compact-convergence topology
   parameterised by triples `(K, ε, f)` for a real number `ε > 0`.
 * When `α` is compact and `β` is a metric space, the compact-convergence topology (and thus also
   the compact-open topology) is metrisable.
 * Results about uniformly continuous functions `γ → C(α, β)` and uniform limits of sequences
   `ι → γ → C(α, β)`.
-/

universes u₁ u₂ u₃

open_locale filter uniformity topological_space
open uniform_space set filter

variables {α : Type u₁} {β : Type u₂} [topological_space α] [uniform_space β]
variables (K : set α) (V : set (β × β)) (f : C(α, β))

namespace continuous_map

/-- Given `K ⊆ α`, `V ⊆ β × β`, and `f : C(α, β)`, we define `compact_conv_nhd K V f` to be the set
of `g : C(α, β)` that are `V`-close to `f` on `K`. -/
def compact_conv_nhd : set C(α, β) := { g | ∀ (x ∈ K), (f x, g x) ∈ V }

variables {K V}

lemma self_mem_compact_conv_nhd (hV : V ∈ 𝓤 β) : f ∈ compact_conv_nhd K V f :=
λ x hx, refl_mem_uniformity hV

@[mono] lemma compact_conv_nhd_mono {V' : set (β × β)} (hV' : V' ⊆ V) :
  compact_conv_nhd K V' f ⊆ compact_conv_nhd K V f :=
λ x hx a ha, hV' (hx a ha)

lemma compact_conv_nhd_mem_comp {g₁ g₂ : C(α, β)} {V' : set (β × β)}
  (hg₁ : g₁ ∈ compact_conv_nhd K V f) (hg₂ : g₂ ∈ compact_conv_nhd K V' g₁) :
  g₂ ∈ compact_conv_nhd K (V ○ V') f :=
λ x hx, ⟨g₁ x, hg₁ x hx, hg₂ x hx⟩

/-- A key property of `compact_conv_nhd`. It allows us to apply
`topological_space.nhds_mk_of_nhds_filter_basis` below. -/
lemma compact_conv_nhd_nhd_basis (hV : V ∈ 𝓤 β) :
  ∃ (V' ∈ 𝓤 β), V' ⊆ V ∧ ∀ (g ∈ compact_conv_nhd K V' f),
    compact_conv_nhd K V' g ⊆ compact_conv_nhd K V f :=
begin
  obtain ⟨V', h₁, h₂⟩ := comp_mem_uniformity_sets hV,
  exact ⟨V', h₁, subset.trans (subset_comp_self_of_mem_uniformity h₁) h₂, λ g hg g' hg',
    compact_conv_nhd_mono f h₂ (compact_conv_nhd_mem_comp f hg hg')⟩,
end

lemma compact_conv_nhd_subset_inter (K₁ K₂ : set α) (V₁ V₂ : set (β × β)) :
  compact_conv_nhd (K₁ ∪ K₂) (V₁ ∩ V₂) f ⊆
  compact_conv_nhd K₁ V₁ f ∩ compact_conv_nhd K₂ V₂ f :=
λ g hg, ⟨λ x hx, mem_of_mem_inter_left (hg x (mem_union_left K₂ hx)),
         λ x hx, mem_of_mem_inter_right (hg x (mem_union_right K₁ hx))⟩

lemma compact_conv_nhd_compact_entourage_nonempty :
  { KV : set α × set (β × β) | is_compact KV.1 ∧ KV.2 ∈ 𝓤 β }.nonempty :=
⟨⟨∅, univ⟩, is_compact_empty, filter.univ_mem⟩

lemma compact_conv_nhd_filter_is_basis : filter.is_basis
  (λ (KV : set α × set (β × β)), is_compact KV.1 ∧ KV.2 ∈ 𝓤 β)
  (λ KV, compact_conv_nhd KV.1 KV.2 f) :=
{ nonempty := compact_conv_nhd_compact_entourage_nonempty,
  inter    :=
    begin
      rintros ⟨K₁, V₁⟩ ⟨K₂, V₂⟩ ⟨hK₁, hV₁⟩ ⟨hK₂, hV₂⟩,
      exact ⟨⟨K₁ ∪ K₂, V₁ ∩ V₂⟩, ⟨hK₁.union hK₂, filter.inter_mem hV₁ hV₂⟩,
        compact_conv_nhd_subset_inter f K₁ K₂ V₁ V₂⟩,
    end, }

/-- A filter basis for the neighbourhood filter of a point in the compact-convergence topology. -/
def compact_convergence_filter_basis (f : C(α, β)) : filter_basis C(α, β) :=
(compact_conv_nhd_filter_is_basis f).filter_basis

lemma mem_compact_convergence_nhd_filter (Y : set C(α, β)) :
  Y ∈ (compact_convergence_filter_basis f).filter ↔
  ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β), compact_conv_nhd K V f ⊆ Y :=
begin
  split,
  { rintros ⟨X, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hY⟩,
    exact ⟨K, V, hK, hV, hY⟩, },
  { rintros ⟨K, V, hK, hV, hY⟩,
    exact ⟨compact_conv_nhd K V f, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hY⟩, },
end

/-- The compact-convergence topology. In fact, see `compact_open_eq_compact_convergence` this is
the same as the compact-open topology. This definition is thus an auxiliary convenience definition
and is unlikely to be of direct use. -/
def compact_convergence_topology : topological_space C(α, β) :=
topological_space.mk_of_nhds $ λ f, (compact_convergence_filter_basis f).filter

lemma nhds_compact_convergence :
  @nhds _ compact_convergence_topology f = (compact_convergence_filter_basis f).filter :=
begin
  rw topological_space.nhds_mk_of_nhds_filter_basis;
  rintros g - ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩,
  { exact self_mem_compact_conv_nhd g hV, },
  { obtain ⟨V', hV', h₁, h₂⟩ := compact_conv_nhd_nhd_basis g hV,
    exact ⟨compact_conv_nhd K V' g, ⟨⟨K, V'⟩, ⟨hK, hV'⟩, rfl⟩, compact_conv_nhd_mono g h₁,
      λ g' hg', ⟨compact_conv_nhd K V' g', ⟨⟨K, V'⟩, ⟨hK, hV'⟩, rfl⟩, h₂ g' hg'⟩⟩, },
end

lemma has_basis_nhds_compact_convergence :
  has_basis (@nhds _ compact_convergence_topology f)
  (λ (p : set α × set (β × β)), is_compact p.1 ∧ p.2 ∈ 𝓤 β) (λ p, compact_conv_nhd p.1 p.2 f) :=
(nhds_compact_convergence f).symm ▸ (compact_conv_nhd_filter_is_basis f).has_basis

/-- This is an auxiliary lemma and is unlikely to be of direct use outside of this file. See
`tendsto_iff_forall_compact_tendsto_uniformly_on` below for the useful version where the topology
is picked up via typeclass inference. -/
lemma tendsto_iff_forall_compact_tendsto_uniformly_on'
  {ι : Type u₃} {p : filter ι} {F : ι → C(α, β)} :
  filter.tendsto F p (@nhds _ compact_convergence_topology f) ↔
  ∀ K, is_compact K → tendsto_uniformly_on (λ i a, F i a) f p K :=
begin
  simp only [(has_basis_nhds_compact_convergence f).tendsto_right_iff, tendsto_uniformly_on,
    and_imp, prod.forall],
  refine forall_congr (λ K, _),
  rw forall_swap,
  exact forall₃_congr (λ hK V hV, iff.rfl),
end

/-- Any point of `compact_open.gen K U` is also an interior point wrt the topology of compact
convergence.

The topology of compact convergence is thus at least as fine as the compact-open topology. -/
lemma compact_conv_nhd_subset_compact_open (hK : is_compact K) {U : set β} (hU : is_open U)
  (hf : f ∈ compact_open.gen K U) :
  ∃ (V ∈ 𝓤 β), is_open V ∧ compact_conv_nhd K V f ⊆ compact_open.gen K U :=
begin
  obtain ⟨V, hV₁, hV₂, hV₃⟩ := lebesgue_number_of_compact_open (hK.image f.continuous) hU hf,
  refine ⟨V, hV₁, hV₂, _⟩,
  rintros g hg - ⟨x, hx, rfl⟩,
  exact hV₃ (f x) ⟨x, hx, rfl⟩ (hg x hx),
end

/-- The point `f` in `compact_conv_nhd K V f` is also an interior point wrt the compact-open
topology.

Since `compact_conv_nhd K V f` are a neighbourhood basis at `f` for each `f`, it follows that
the compact-open topology is at least as fine as the topology of compact convergence. -/
lemma Inter_compact_open_gen_subset_compact_conv_nhd (hK : is_compact K) (hV : V ∈ 𝓤 β) :
  ∃ (ι : Sort (u₁ + 1)) [fintype ι]
  (C : ι → set α) (hC : ∀ i, is_compact (C i))
  (U : ι → set β) (hU : ∀ i, is_open (U i)),
  (f ∈ ⋂ i, compact_open.gen (C i) (U i)) ∧
  (⋂ i, compact_open.gen (C i) (U i)) ⊆ compact_conv_nhd K V f :=
begin
  obtain ⟨W, hW₁, hW₄, hW₂, hW₃⟩ := comp_open_symm_mem_uniformity_sets hV,
  obtain ⟨Z, hZ₁, hZ₄, hZ₂, hZ₃⟩ := comp_open_symm_mem_uniformity_sets hW₁,
  let U : α → set α := λ x, f⁻¹' (ball (f x) Z),
  have hU : ∀ x, is_open (U x) := λ x, f.continuous.is_open_preimage _ (is_open_ball _ hZ₄),
  have hUK : K ⊆ ⋃ (x : K), U (x : K),
  { intros x hx,
    simp only [exists_prop, mem_Union, Union_coe_set, mem_preimage],
    exact ⟨(⟨x, hx⟩ : K), by simp [hx, mem_ball_self (f x) hZ₁]⟩, },
  obtain ⟨t, ht⟩ := hK.elim_finite_subcover _ (λ (x : K), hU x.val) hUK,
  let C : t → set α := λ i, K ∩ closure (U ((i : K) : α)),
  have hC : K ⊆ ⋃ i, C i,
  { rw [← K.inter_Union, subset_inter_iff],
    refine ⟨subset.rfl, ht.trans _⟩,
    simp only [set_coe.forall, subtype.coe_mk, Union_subset_iff],
    exact λ x hx₁ hx₂, subset_Union_of_subset (⟨_, hx₂⟩ : t) (by simp [subset_closure]) },
  have hfC : ∀ (i : t), C i ⊆ f ⁻¹' ball (f ((i : K) : α)) W,
  { simp only [← image_subset_iff, ← mem_preimage],
    rintros ⟨⟨x, hx₁⟩, hx₂⟩,
    have hZW : closure (ball (f x) Z) ⊆ ball (f x) W,
    { intros y hy,
      obtain ⟨z, hz₁, hz₂⟩ := uniform_space.mem_closure_iff_ball.mp hy hZ₁,
      exact ball_mono hZ₃ _ (mem_ball_comp hz₂ ((mem_ball_symmetry hZ₂).mp hz₁)), },
    calc f '' (K ∩ closure (U x)) ⊆ f '' (closure (U x)) : image_subset _ (inter_subset_right _ _)
                              ... ⊆ closure (f '' (U x)) : f.continuous.continuous_on.image_closure
                              ... ⊆ closure (ball (f x) Z) : by { apply closure_mono, simp, }
                              ... ⊆ ball (f x) W : hZW, },
  refine ⟨t, t.fintype_coe_sort, C,
          λ i, hK.inter_right is_closed_closure,
          λ i, ball (f ((i : K) : α)) W,
          λ i, is_open_ball _ hW₄,
          by simp [compact_open.gen, hfC],
          λ g hg x hx, hW₃ (mem_comp_rel.mpr _)⟩,
  simp only [mem_Inter, compact_open.gen, mem_set_of_eq, image_subset_iff] at hg,
  obtain ⟨y, hy⟩ := mem_Union.mp (hC hx),
  exact ⟨f y, (mem_ball_symmetry hW₂).mp (hfC y hy), mem_preimage.mp (hg y hy)⟩,
end

/-- The compact-open topology is equal to the compact-convergence topology. -/
lemma compact_open_eq_compact_convergence :
  continuous_map.compact_open = (compact_convergence_topology : topological_space C(α, β)) :=
begin
  rw [compact_convergence_topology, continuous_map.compact_open],
  refine le_antisymm _ _,
  { refine λ X hX, is_open_iff_forall_mem_open.mpr (λ f hf, _),
    have hXf : X ∈ (compact_convergence_filter_basis f).filter,
    { rw ← nhds_compact_convergence,
      exact @is_open.mem_nhds C(α, β) compact_convergence_topology _ _ hX hf, },
    obtain ⟨-, ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩, hXf⟩ := hXf,
    obtain ⟨ι, hι, C, hC, U, hU, h₁, h₂⟩ := Inter_compact_open_gen_subset_compact_conv_nhd f hK hV,
    haveI := hι,
    exact ⟨⋂ i, compact_open.gen (C i) (U i), h₂.trans hXf,
      is_open_Inter (λ i, continuous_map.is_open_gen (hC i) (hU i)), h₁⟩, },
  { simp only [le_generate_from_iff_subset_is_open, and_imp, exists_prop, forall_exists_index,
      set_of_subset_set_of],
    rintros - K hK U hU rfl f hf,
    obtain ⟨V, hV, hV', hVf⟩ := compact_conv_nhd_subset_compact_open f hK hU hf,
    exact filter.mem_of_superset (filter_basis.mem_filter_of_mem _ ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩) hVf, },
end

/-- The filter on `C(α, β) × C(α, β)` which underlies the uniform space structure on `C(α, β)`. -/
def compact_convergence_uniformity : filter (C(α, β) × C(α, β)) :=
⨅ KV ∈ { KV : set α × set (β × β) | is_compact KV.1 ∧ KV.2 ∈ 𝓤 β },
𝓟 { fg : C(α, β) × C(α, β) | ∀ (x : α), x ∈ KV.1 → (fg.1 x, fg.2 x) ∈ KV.2 }

/-- An intermediate lemma. Usually `mem_compact_convergence_entourage_iff` is more useful. -/
lemma mem_compact_convergence_uniformity (X : set (C(α, β) × C(α, β))) :
  X ∈ @compact_convergence_uniformity α β _ _ ↔
  ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β),
    { fg : C(α, β) × C(α, β) | ∀ x ∈ K, (fg.1 x, fg.2 x) ∈ V } ⊆ X :=
begin
  rw [compact_convergence_uniformity,
    (filter.has_basis_binfi_principal _ compact_conv_nhd_compact_entourage_nonempty).mem_iff],
  { simp only [exists_prop, prod.forall, set_of_subset_set_of, mem_set_of_eq, prod.exists],
    exact exists₂_congr (λ K V, by tauto) },
  { rintros ⟨K₁, V₁⟩ ⟨hK₁, hV₁⟩ ⟨K₂, V₂⟩ ⟨hK₂, hV₂⟩,
    refine ⟨⟨K₁ ∪ K₂, V₁ ∩ V₂⟩, ⟨hK₁.union hK₂, filter.inter_mem hV₁ hV₂⟩, _⟩,
    simp only [le_eq_subset, prod.forall, set_of_subset_set_of, ge_iff_le, order.preimage,
      ← forall_and_distrib, mem_inter_eq, mem_union_eq],
    exact λ f g, forall_imp (λ x, by tauto!), },
end

/-- Note that we ensure the induced topology is definitionally the compact-open topology. -/
instance compact_convergence_uniform_space : uniform_space C(α, β) :=
{ uniformity := compact_convergence_uniformity,
  refl :=
    begin
      simp only [compact_convergence_uniformity, and_imp, filter.le_principal_iff, prod.forall,
        filter.mem_principal, mem_set_of_eq, le_infi_iff, id_rel_subset],
      exact λ K V hK hV f x hx, refl_mem_uniformity hV,
    end,
  symm :=
    begin
      simp only [compact_convergence_uniformity, and_imp, prod.forall, mem_set_of_eq, prod.fst_swap,
        filter.tendsto_principal, prod.snd_swap, filter.tendsto_infi],
      intros K V hK hV,
      obtain ⟨V', hV', hsymm, hsub⟩ := symm_of_uniformity hV,
      let X := { fg : C(α, β) × C(α, β) | ∀ (x : α), x ∈ K → (fg.1 x, fg.2 x) ∈ V' },
      have hX : X ∈ compact_convergence_uniformity :=
        (mem_compact_convergence_uniformity X).mpr ⟨K, V', hK, hV', by simp⟩,
      exact filter.eventually_of_mem hX (λ fg hfg x hx, hsub (hsymm _ _ (hfg x hx))),
    end,
  comp := λ X hX,
    begin
      obtain ⟨K, V, hK, hV, hX⟩ := (mem_compact_convergence_uniformity X).mp hX,
      obtain ⟨V', hV', hcomp⟩ := comp_mem_uniformity_sets hV,
      let h := λ (s : set (C(α, β) × C(α, β))), s ○ s,
      suffices : h {fg : C(α, β) × C(α, β) | ∀ (x ∈ K), (fg.1 x, fg.2 x) ∈ V'} ∈
                 compact_convergence_uniformity.lift' h,
      { apply filter.mem_of_superset this,
        rintros ⟨f, g⟩ ⟨z, hz₁, hz₂⟩,
        refine hX (λ x hx, hcomp _),
        exact ⟨z x, hz₁ x hx, hz₂ x hx⟩, },
      apply filter.mem_lift',
      exact (mem_compact_convergence_uniformity _).mpr ⟨K, V', hK, hV', subset.refl _⟩,
    end,
  is_open_uniformity :=
    begin
      rw compact_open_eq_compact_convergence,
      refine λ Y, forall₂_congr (λ f hf, _),
      simp only [mem_compact_convergence_nhd_filter, mem_compact_convergence_uniformity,
        prod.forall, set_of_subset_set_of, compact_conv_nhd],
      refine exists₄_congr (λ K V hK hV, ⟨_, λ hY g hg, hY f g hg rfl⟩),
      rintros hY g₁ g₂ hg₁ rfl,
      exact hY hg₁,
    end }

lemma mem_compact_convergence_entourage_iff (X : set (C(α, β) × C(α, β))) :
  X ∈ 𝓤 C(α, β) ↔ ∃ (K : set α) (V : set (β × β)) (hK : is_compact K) (hV : V ∈ 𝓤 β),
    { fg : C(α, β) × C(α, β) | ∀ x ∈ K, (fg.1 x, fg.2 x) ∈ V } ⊆ X :=
mem_compact_convergence_uniformity X

lemma has_basis_compact_convergence_uniformity :
  has_basis (𝓤 C(α, β)) (λ p : set α × set (β × β), is_compact p.1 ∧ p.2 ∈ 𝓤 β)
            (λ p, { fg : C(α, β) × C(α, β) | ∀ x ∈ p.1, (fg.1 x, fg.2 x) ∈ p.2 }) :=
⟨λ t, by { simp only [mem_compact_convergence_entourage_iff, prod.exists], tauto, }⟩

variables {ι : Type u₃} {p : filter ι} {F : ι → C(α, β)} {f}

lemma tendsto_iff_forall_compact_tendsto_uniformly_on :
  tendsto F p (𝓝 f) ↔ ∀ K, is_compact K → tendsto_uniformly_on (λ i a, F i a) f p K :=
by rw [compact_open_eq_compact_convergence, tendsto_iff_forall_compact_tendsto_uniformly_on']

/-- Locally uniform convergence implies convergence in the compact-open topology. -/
lemma tendsto_of_tendsto_locally_uniformly
  (h : tendsto_locally_uniformly (λ i a, F i a) f p) : tendsto F p (𝓝 f) :=
begin
  rw tendsto_iff_forall_compact_tendsto_uniformly_on,
  intros K hK,
  rw ← tendsto_locally_uniformly_on_iff_tendsto_uniformly_on_of_compact hK,
  exact h.tendsto_locally_uniformly_on,
end

/-- If every point has a compact neighbourhood, then convergence in the compact-open topology
implies locally uniform convergence.

See also `tendsto_iff_tendsto_locally_uniformly`, especially for T2 spaces. -/
lemma tendsto_locally_uniformly_of_tendsto
  (hα : ∀ x : α, ∃ n, is_compact n ∧ n ∈ 𝓝 x) (h : tendsto F p (𝓝 f)) :
  tendsto_locally_uniformly (λ i a, F i a) f p :=
begin
  rw tendsto_iff_forall_compact_tendsto_uniformly_on at h,
  intros V hV x,
  obtain ⟨n, hn₁, hn₂⟩ := hα x,
  exact ⟨n, hn₂, h n hn₁ V hV⟩,
end

/-- Convergence in the compact-open topology is the same as locally uniform convergence on a locally
compact space.

For non-T2 spaces, the assumption `locally_compact_space α` is stronger than we need and in fact
the `←` direction is true unconditionally. See `tendsto_locally_uniformly_of_tendsto` and
`tendsto_of_tendsto_locally_uniformly` for versions requiring weaker hypotheses. -/
lemma tendsto_iff_tendsto_locally_uniformly [locally_compact_space α] :
  tendsto F p (𝓝 f) ↔ tendsto_locally_uniformly (λ i a, F i a) f p :=
⟨tendsto_locally_uniformly_of_tendsto exists_compact_mem_nhds, tendsto_of_tendsto_locally_uniformly⟩

section compact_domain

variables [compact_space α]

lemma has_basis_compact_convergence_uniformity_of_compact :
  has_basis (𝓤 C(α, β)) (λ V : set (β × β), V ∈ 𝓤 β)
            (λ V, { fg : C(α, β) × C(α, β) | ∀ x, (fg.1 x, fg.2 x) ∈ V }) :=
has_basis_compact_convergence_uniformity.to_has_basis
  (λ p hp, ⟨p.2, hp.2, λ fg hfg x hx, hfg x⟩)
  (λ V hV, ⟨⟨univ, V⟩, ⟨compact_univ, hV⟩, λ fg hfg x, hfg x (mem_univ x)⟩)

/-- Convergence in the compact-open topology is the same as uniform convergence for sequences of
continuous functions on a compact space. -/
lemma tendsto_iff_tendsto_uniformly :
  tendsto F p (𝓝 f) ↔ tendsto_uniformly (λ i a, F i a) f p :=
begin
  rw [tendsto_iff_forall_compact_tendsto_uniformly_on, ← tendsto_uniformly_on_univ],
  exact ⟨λ h, h univ compact_univ, λ h K hK, h.mono (subset_univ K)⟩,
end

end compact_domain

end continuous_map


open classical

variables (α : Type) (p q : α → Prop)
variable r : Prop

-- Exercise 1
example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  iff.intro
    (assume h : ∀ x, p x ∧ q x,
      and.intro
        (assume x,
          (h x).left)
        (assume x,
          (h x).right))
    (assume h : (∀ x, p x) ∧ (∀ x, q x),
      assume x,
      show p x ∧ q x, from
      and.intro
        (h.left x)
        (h.right x))
example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  assume hi : ∀ x, p x → q x,
  assume hp : ∀ x, p x,
  assume x,
  have hp : p x, from hp x,
  (hi x) hp
example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  assume h : (∀ x, p x) ∨ (∀ x, q x),
  h.elim
    (assume hp : ∀ x, p x,
      assume x,
      or.inl (hp x))
    (assume hq : ∀ x, q x,
      assume x,
      or.inr (hq x))

-- Exercise 2
example : α → ((∀ x : α, r) ↔ r) :=
  assume hα,
  iff.intro
    (assume h : ∀ x : α, r,
      h hα)
    (assume hr : r,
      assume x : α,
      hr)
example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  iff.intro
    (assume h : (∀ x, p x ∨ r),
      by_cases
        (assume hr : r,
          or.inr hr)
        (assume hnr : ¬r,
          have hfpx : ∀ x, p x, from (
            assume x,
            have ho : p x ∨ r, from h x,
            have hpx : p x, from
              ((h x).elim
                (assume hpx : p x,
                  hpx)
                (assume hr : r,
                  absurd hr hnr)),
            hpx),
          or.inl hfpx))
    (assume h : (∀ x, p x) ∨ r,
      h.elim
        (assume hf : ∀ x, p x,
          assume x,
          show p x ∨ r, from or.inl (hf x))
        (assume hr : r,
          assume x,
          show p x ∨ r, from or.inr hr))
example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  iff.intro
    (assume h : ∀ x, r → p x,
      assume hr : r,
      assume x,
      (h x) hr)
    (assume h : r → ∀ x, p x,
      assume x,
      assume hr : r,
      (h hr) x)
-- Exercise 3
variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
  have hab : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
  have hnsbb : ¬ shaves barber barber, from (
    assume hsbb : shaves barber barber,
    absurd hsbb (hab.elim_left hsbb)
  ),
  absurd (hab.elim_right hnsbb) hnsbb
-- Exercise 4
namespace hidden
  def divides (m n : ℕ) : Prop := ∃ k, m * k = n

  instance : has_dvd nat := ⟨divides⟩

  def even (n : ℕ) : Prop := 2 ∣ n

  section
    variables m n : ℕ

    def prime (n : ℕ) : Prop := ∀ r : ℕ, (r ∣ n) → (r = 1 ∨ r = n)

    def infinitely_many_primes : Prop := ∀ n : ℕ, ∃ q : ℕ, q > n ∧ prime q

    def Fermat_prime (n : ℕ) : Prop := prime n ∧ ∃ k : ℕ, n = 2 ^ (2 ^ k)

    def infinitely_many_Fermat_primes : Prop := ∀ n : ℕ, ∃ q : ℕ, q > n ∧ Fermat_prime q

    def goldbach_conjecture : Prop := ∀ k : ℕ, even k → ∃ (m n : ℕ), prime m ∧ prime n ∧ k = m + n

    def Goldbach's_weak_conjecture : Prop := ∀ k : ℕ, k > 5 ∧ ¬(even k) → ∃ (l m n : ℕ), prime l ∧ prime m ∧ prime n ∧ k = l + m + n

    def Fermat's_last_theorem : Prop := ¬ (∃ (a b c n : ℕ), a > 0 ∧ b > 0 ∧ c > 0 ∧ n > 2 ∧ a^n + b^n = c^n)
  end
end hidden
-- Exercise 5
-- see existential_quantifier.lean
-- Exercise 6
variables (real : Type) [ordered_ring real]
variables (log exp : real → real)

variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
  calc
    log(x * y) = log(exp (log x) * exp (log y)) : by rw [←eq.symm (exp_log_eq hx), ←eq.symm (exp_log_eq hy)]
           ... = log(exp (log x + log y))       : by rw [exp_add (log x) (log y)]
           ... = log x + log y                  : by rw [log_exp_eq]

-- Exercise 7
example (x : ℤ) : x * 0 = 0 :=
  calc
    x * 0 = x * (1 - 1)   : by rw sub_self
      ... = x * 1 - x * 1 : by rw mul_sub
      ... = x - x         : by rw mul_one   -- Could be skipped
      ... = 0             : by rw sub_self


import game.limits.L01defs
import game.limits.seq_limSeqSub

open real

namespace xena -- hide

notation `|` x `|` := abs x -- hide

/-
Use previous results to obtain the limit of a product in the general case.
Work in progress.
-/

/- Lemma
If $\lim_{n \to \infty} a_n = \alpha$ and $\lim_{n \to \infty} b_n = \beta$, then
$\lim_{n \to \infty} (a_n * b_n) = \alpha * \beta$
-/
lemma lim_prod (a : ℕ → ℝ) (b : ℕ → ℝ) (α β : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, (a n) * (b n) ) (α * β) :=
begin
    have Ha := lim_seq_sub_const a α α ha,
    rw [sub_self α] at Ha,
    have Hb := lim_seq_sub_const b β β hb,
    rw [sub_self β] at Hb,
    have G := lim_zero_prod (λ n, a n - α) (λ n, b n - β) Ha Hb,
    --g1 and g2 are unnecessary
    have g1 := lim_times_const a α β ha,
    have g2 := lim_times_const b β α hb,
    -- becomes ugly, need to improve notation
    have G1 := lim_linear (λ (n : ℕ),
        (λ (n : ℕ), a n - α) n * (λ (n : ℕ), b n - β) n) a 0 α 1 β G ha,
    have h1 : (1:ℝ) * 0 + β * α = β * α , norm_num,
    rw h1 at G1,
    have G2 := lim_linear (λ (n : ℕ),
        1 * (λ (n : ℕ), (λ (n : ℕ), a n - α) n * (λ (n : ℕ), b n - β) n) n + β * a n) b
        (β * α) β 1 α G1 hb,
    -- to get rid of these non-terminal `simp`
    simp at G2,
    have h2 : β * α + α * β = 2 * α * β,
        rw mul_comm β α, norm_num,
        have h21 := mul_two (α * β), rw ← h21,
        rw mul_assoc α β 2, rw mul_comm β _, rw ← mul_assoc,
        rw mul_comm α 2,
    rw h2 at G2,
    have G3 := lim_seq_sub_const
        (λ (n : ℕ), (a n - α) * (b n - β) + (β * a n + α * b n)) (2 * α * β) (α * β) _,
    simp at G3,
    have h3 : 2 * α * β - α * β = α * β,
        have h31 : (2:ℝ) * α * β - α * β = (2:ℝ) * α * β + (-1:ℝ) * α * β, ring,
        --rw ← add_mul (2:ℝ) (-1:ℝ) (α * β) at h31,
        rw h31, norm_cast, norm_num, ring,
    rw h3 at G3,
    intros ε hε,
    have G4 := G3 ε hε, cases G4 with N hN,
    use N,
    intros n hn,
    have G5 := hN n hn,
    simp at G5, simp,
    have h4 : (a n - α) * (b n - β) = (a n) * (b n) - α * (b n) - β * (a n) + α * β, ring,
    rw h4 at G5,
    have h5 : a n * b n - α * b n - β * a n + α * β + (β * a n + α * b n) - α * β - α * β =
        a n * b n - α * β, ring,
    rw h5 at G5, exact G5, convert G2, ext, ring, done
end

end xena -- hide


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

-- Natural numbers

-- TODO:
-- shorten the pow theorems
-- work through the sporadic confused comments
-- clean everything up a bit, re naming and formatting
-- try to re-use theorems more

-- stops name conflicts
namespace hidden

inductive mynat
| zero : mynat
| succ (n : mynat) : mynat

namespace mynat

-- this instance stuff is pure voodoo but it seems to make the
-- notation work
instance: has_zero mynat := ⟨zero⟩
instance: has_one mynat := ⟨succ zero⟩

def add: mynat → mynat → mynat
| m 0        := m
| m (succ n) := succ (add m n)

instance: has_add mynat := ⟨add⟩

def mul: mynat → mynat → mynat
| m 0        := 0
| m (succ n) := m + mul m n

instance: has_mul mynat := ⟨mul⟩

-- a ^ b should be number of functions from a b-set to an a-set. fight
-- me
def pow: mynat → mynat → mynat
| m 0        := 1
| m (succ n) := m * pow m n

instance: has_pow mynat mynat := ⟨pow⟩

variables {m n k : mynat}

-- ADDITION

-- I'm simping liberally for future reasons
@[simp] theorem add_zero (m : mynat): m + 0 = m := rfl

@[simp]
theorem add_succ (m n : mynat): m + succ n = succ (m + n) := rfl

-- so for some reason all the old code breaks with the new operator
-- instances, so I have to go and replace zero with 0 wherever I used
-- induction. How fix???
@[simp] theorem zz: zero = 0 := rfl

@[simp]
theorem zero_add: ∀ m : mynat, 0 + m = m
| zero     := rfl
| (succ m) := by rw [add_succ, zero_add]

@[simp]
theorem succ_add: ∀ m n : mynat, succ m + n = succ (m + n)
| m zero     := rfl
| m (succ n) := by rw [add_succ, add_succ, succ_add]

theorem add_assoc: ∀ m n k : mynat, (m + n) + k = m + (n + k)
| m n zero     := rfl
| m n (succ k) := by rw [add_succ, add_succ, add_succ, add_assoc]

instance add_is_assoc: is_associative mynat add :=
⟨assume a b c, add_assoc a b c⟩

theorem add_comm: ∀ m n : mynat, m + n = n + m
| m zero     := by rw [zz, add_zero, zero_add]
| m (succ n) := by rw [add_succ, succ_add, add_comm]

instance add_is_comm: is_commutative mynat add :=
⟨assume a b, add_comm a b⟩

@[simp] theorem add_one_succ: m + 1 = succ m := rfl

theorem succ_inj: succ m = succ n → m = n :=
succ.inj

@[simp]
theorem one_eq_succ_zero: succ 0 = 1 := rfl

theorem zero_ne_one : (0:  mynat) ≠ 1 :=
begin
  assume h,
  from mynat.no_confusion h,
end

theorem add_cancel: ∀ {m}, m + n = m + k → n = k
| zero     := by simp; cc
| (succ m) := assume h, by {
  rw [succ_add, succ_add] at h,
  from @add_cancel m (succ_inj h)
}

theorem add_cancel_right: m + n = k + n → m = k :=
begin
  repeat {rw add_comm _ n},
  from add_cancel,
end

-- In the case where nothing is being added on LHS
theorem add_cancel_to_zero: m = m + k → k = 0 :=
begin
  assume hmmk,
  -- use conv to just add zero to the left m
  conv at hmmk { to_lhs, rw ←add_zero m, },
  from add_cancel hmmk.symm,
end

-- again, this is magical cases
theorem succ_ne_zero: succ m ≠ 0 :=
begin
  assume h,
  cases h,
end

theorem nzero_iff_succ: m ≠ 0 ↔ ∃ n, m = succ n :=
begin
  split; assume h, {
    cases m,
      contradiction,
    existsi m,
    refl,
  }, {
    cases h with n h,
    rw h,
    from succ_ne_zero,
  },
end

theorem add_integral: ∀ {m n : mynat}, m + n = 0 → m = 0
| zero     _ := by simp
| (succ m) n :=
begin
  rw succ_add,
  assume h,
  from false.elim (succ_ne_zero h),
end

-- DECIDABILITY

instance: decidable_eq mynat :=
begin
  intros m n,
  induction m with m hm generalizing n, {
    cases n, {
      from is_true rfl,
    }, {
      from is_false succ_ne_zero.symm,
    },
  }, {
    induction n with n hn generalizing m, {
      from is_false succ_ne_zero,
    }, {
      cases (hm n) with hmnen hmeqn, {
        apply is_false,
        assume hsmsn,
        from hmnen (succ_inj hsmsn),
      }, {
        rw hmeqn,
        from is_true rfl,
      },
    },
  },
end

-- MULTIPLICATION

@[simp] theorem mul_zero (m : mynat): m * 0 = 0 := rfl

@[simp]
theorem mul_succ (m n : mynat): m * (succ n) = m + (m * n) := rfl

@[simp] theorem mul_one (m : mynat) : m * 1 = m := rfl

@[simp]
theorem zero_mul: ∀ m : mynat, 0 * m = 0
| zero     := by rw [zz, mul_zero]
| (succ m) := by rw [mul_succ, zero_mul, add_zero]

@[simp]
theorem one_mul: ∀ m : mynat, 1 * m = m
| zero     := by rw [zz, mul_zero]
| (succ m) := by rw [mul_succ, one_mul, add_comm, add_one_succ]

@[simp]
theorem succ_mul: ∀ m n : mynat, (succ m) * n = m * n + n
| m zero     := by rw [zz, mul_zero, mul_zero, add_zero]
| m (succ n) := by conv {
  congr,
    rw [mul_succ, succ_mul, ←add_assoc, ←add_comm (m*n), add_assoc],
  skip,
    rw [mul_succ, add_comm m, add_assoc, add_succ, ←succ_add],
}

@[simp]
theorem mul_add: ∀ m n k : mynat, m * (n + k) = m * n + m * k
| zero     n k := by repeat { rw zz <|> rw zero_mul <|> rw zero_add }
| (succ m) n k := by repeat { rw succ_mul <|> rw mul_add }; ac_refl

theorem mul_assoc: ∀ m n k: mynat, (m * n) * k = m * (n * k)
| m n zero     := by rw [zz, mul_zero, mul_zero, mul_zero]
| m n (succ k) := by rw [mul_succ, mul_succ, mul_add, mul_assoc]

instance mul_is_assoc: is_associative mynat mul :=
⟨assume a b c, mul_assoc a b c⟩

theorem mul_comm: ∀ m n : mynat, m * n = n * m
| m zero     := by rw [zz, mul_zero, zero_mul]
| m (succ n) := by rw [mul_succ, succ_mul, mul_comm, add_comm]

instance mul_is_comm: is_commutative mynat mul :=
⟨assume a b, mul_comm a b⟩

@[simp]
theorem add_mul (m n k : mynat) : (m + n) * k = m * k + n * k :=
by rw [mul_comm (m + n), mul_comm m, mul_comm n, mul_add]

theorem mul_integral: ∀ {m n : mynat}, m ≠ 0 → m * n = 0 → n = 0
| m zero     := by simp
| m (succ n) :=
begin
  assume hmne0 hmn0,
  rw mul_succ at hmn0,
  from false.elim (hmne0 (add_integral hmn0)),
end

theorem mul_integral_symmetric: m * n = 0 → m = 0 ∨ n = 0 :=
begin
  cases m, {
    assume _, left, from rfl,
  }, {
    assume hsmn0,
    right,
    from mul_integral succ_ne_zero hsmn0,
  },
end

theorem mul_cancel: m ≠ 0 → m * n = m * k → n = k :=
begin
  induction n with n hn generalizing m k; assume hmn0 heq, {
    simp at heq,
    symmetry,
    from mul_integral hmn0 heq.symm,
  }, {
    cases k, {
      exfalso,
      rw [zz, mul_zero] at heq,
      from succ_ne_zero (mul_integral hmn0 heq),
    }, {
      rw [mul_succ, mul_succ] at heq,
      rw hn hmn0 (add_cancel heq),
    },
  },
end

theorem mul_cancel_to_one: m ≠ 0 → m = m * k → k = 1 :=
begin
  assume hmn0 hmmk,
  rw [←mul_one m, mul_assoc, one_mul] at hmmk,
  rw mul_cancel hmn0 hmmk,
end

-- POWERS

-- do I really have to spell out mynat like this? yuck
@[simp] theorem pow_zero (m : mynat) : m ^ (0: mynat) = 1 := rfl

@[simp]
theorem pow_succ (m n : mynat) : m ^ (succ n) = m * (m ^ n) := rfl

theorem zero_pow: ∀ {m : mynat}, m ≠ 0 → (0: mynat) ^ m = 0
| zero     := assume h, by contradiction
| (succ m) := assume h, by simp

@[simp]
theorem pow_one: n ^ (1: mynat) = n := rfl

@[simp]
theorem one_pow: ∀ {n : mynat}, (1: mynat) ^ n = 1
| zero     := rfl
| (succ n) := by rw [pow_succ, one_mul, one_pow]

@[simp]
theorem pow_add (m n : mynat) : ∀ k, m ^ (n + k) = (m ^ n) * (m ^ k)
| zero := by simp
| (succ k) := by simp [pow_add]; ac_refl

@[simp]
theorem pow_mul (m n : mynat): ∀ k, (m ^ n) ^ k = m ^ (n * k)
| zero := by rw [zz, pow_zero, mul_zero, pow_zero]
| (succ k) := by rw [pow_succ, mul_succ, pow_add, pow_mul]

@[simp]
theorem mul_pow (m n : mynat): ∀ k : mynat, (m * n) ^ k = m ^ k * n ^ k
| zero := by simp
| (succ k) := by rw [pow_succ, pow_succ, pow_succ, mul_pow]; ac_refl

end mynat

end hidden


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

import data.polynomial.eval
import ring_theory.ideal.quotient

/-!
# modular equivalence for submodule
-/

open submodule

variables {R : Type*} [ring R]
variables {M : Type*} [add_comm_group M] [module R M] (U U₁ U₂ : submodule R M)
variables {x x₁ x₂ y y₁ y₂ z z₁ z₂ : M}
variables {N : Type*} [add_comm_group N] [module R N] (V V₁ V₂ : submodule R N)

/-- A predicate saying two elements of a module are equivalent modulo a submodule. -/
def smodeq (x y : M) : Prop :=
(submodule.quotient.mk x : M ⧸ U) = submodule.quotient.mk y

notation x ` ≡ `:50 y ` [SMOD `:50 N `]`:0 := smodeq N x y

variables {U U₁ U₂}

protected lemma smodeq.def : x ≡ y [SMOD U] ↔
  (submodule.quotient.mk x : M ⧸ U) = submodule.quotient.mk y := iff.rfl

namespace smodeq

lemma sub_mem : x ≡ y [SMOD U] ↔ x - y ∈ U :=
by rw [smodeq.def, submodule.quotient.eq]

@[simp] theorem top : x ≡ y [SMOD (⊤ : submodule R M)] :=
(submodule.quotient.eq ⊤).2 mem_top

@[simp] theorem bot : x ≡ y [SMOD (⊥ : submodule R M)] ↔ x = y :=
by rw [smodeq.def, submodule.quotient.eq, mem_bot, sub_eq_zero]

@[mono] theorem mono (HU : U₁ ≤ U₂) (hxy : x ≡ y [SMOD U₁]) : x ≡ y [SMOD U₂] :=
(submodule.quotient.eq U₂).2 $ HU $ (submodule.quotient.eq U₁).1 hxy

@[refl] theorem refl : x ≡ x [SMOD U] := eq.refl _

@[symm] theorem symm (hxy : x ≡ y [SMOD U]) : y ≡ x [SMOD U] := hxy.symm

@[trans] theorem trans (hxy : x ≡ y [SMOD U]) (hyz : y ≡ z [SMOD U]) : x ≡ z [SMOD U] :=
hxy.trans hyz

theorem add (hxy₁ : x₁ ≡ y₁ [SMOD U]) (hxy₂ : x₂ ≡ y₂ [SMOD U]) : x₁ + x₂ ≡ y₁ + y₂ [SMOD U] :=
by { rw smodeq.def at hxy₁ hxy₂ ⊢, simp_rw [quotient.mk_add, hxy₁, hxy₂] }

theorem smul (hxy : x ≡ y [SMOD U]) (c : R) : c • x ≡ c • y [SMOD U] :=
by { rw smodeq.def at hxy ⊢, simp_rw [quotient.mk_smul, hxy] }

theorem zero : x ≡ 0 [SMOD U] ↔ x ∈ U :=
by rw [smodeq.def, submodule.quotient.eq, sub_zero]

theorem map (hxy : x ≡ y [SMOD U]) (f : M →ₗ[R] N) : f x ≡ f y [SMOD U.map f] :=
(submodule.quotient.eq _).2 $ f.map_sub x y ▸ mem_map_of_mem $ (submodule.quotient.eq _).1 hxy

theorem comap {f : M →ₗ[R] N} (hxy : f x ≡ f y [SMOD V]) : x ≡ y [SMOD V.comap f] :=
(submodule.quotient.eq _).2 $ show f (x - y) ∈ V,
from (f.map_sub x y).symm ▸ (submodule.quotient.eq _).1 hxy

lemma eval {R : Type*} [comm_ring R] {I : ideal R} {x y : R} (h : x ≡ y [SMOD I])
  (f : polynomial R) : f.eval x ≡ f.eval y [SMOD I] :=
begin
  rw [smodeq.def] at h ⊢,
  show ideal.quotient.mk I (f.eval x) = ideal.quotient.mk I (f.eval y),
  change ideal.quotient.mk I x = ideal.quotient.mk I y at h,
  rw [← polynomial.eval₂_at_apply, ← polynomial.eval₂_at_apply, h],
end

end smodeq


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

import algebra.polynomial.group_ring_action
import deprecated.subfield
import field_theory.normal
import field_theory.separable
import field_theory.tower
import linear_algebra.matrix
import ring_theory.polynomial

/-!
# Fixed field under a group action.

This is the basis of the Fundamental Theorem of Galois Theory.
Given a (finite) group `G` that acts on a field `F`, we define `fixed_points G F`,
the subfield consisting of elements of `F` fixed_points by every element of `G`.

This subfield is then normal and separable, and in addition (TODO) if `G` acts faithfully on `F`
then `finrank (fixed_points G F) F = fintype.card G`.

## Main Definitions

- `fixed_points G F`, the subfield consisting of elements of `F` fixed_points by every element of
`G`, where `G` is a group that acts on `F`.

-/

noncomputable theory
open_locale classical big_operators
open mul_action finset finite_dimensional

universes u v w

variables (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] (g : G)

instance fixed_by.is_subfield : is_subfield (fixed_by G F g) :=
{ zero_mem := smul_zero g,
  add_mem := λ x y hx hy, (smul_add g x y).trans $ congr_arg2 _ hx hy,
  neg_mem := λ x hx, (smul_neg g x).trans $ congr_arg _ hx,
  one_mem := smul_one g,
  mul_mem := λ x y hx hy, (smul_mul' g x y).trans $ congr_arg2 _ hx hy,
  inv_mem := λ x hx, (smul_inv F g x).trans $ congr_arg _ hx }

namespace fixed_points

instance : is_subfield (fixed_points G F) :=
by convert @is_subfield.Inter F _ G (fixed_by G F) _; rw fixed_eq_Inter_fixed_by

instance : is_invariant_subring G (fixed_points G F) :=
{ smul_mem := λ g x hx g', by rw [hx, hx] }

@[simp] theorem smul (g : G) (x : fixed_points G F) : g • x = x :=
subtype.eq $ x.2 g

-- Why is this so slow?
@[simp] theorem smul_polynomial (g : G) (p : polynomial (fixed_points G F)) : g • p = p :=
polynomial.induction_on p
  (λ x, by rw [polynomial.smul_C, smul])
  (λ p q ihp ihq, by rw [smul_add, ihp, ihq])
  (λ n x ih, by rw [smul_mul', polynomial.smul_C, smul, smul_pow, polynomial.smul_X])

instance : algebra (fixed_points G F) F :=
algebra.of_is_subring _

theorem coe_algebra_map :
  algebra_map (fixed_points G F) F = is_subring.subtype (fixed_points G F) :=
rfl

lemma linear_independent_smul_of_linear_independent {s : finset F} :
  linear_independent (fixed_points G F) (λ i : (↑s : set F), (i : F)) →
  linear_independent F (λ i : (↑s : set F), mul_action.to_fun G F i) :=
begin
  refine finset.induction_on s (λ _, linear_independent_empty_type $ λ ⟨x⟩, x.2)
    (λ a s has ih hs, _),
  rw coe_insert at hs ⊢,
  rw linear_independent_insert (mt mem_coe.1 has) at hs,
  rw linear_independent_insert' (mt mem_coe.1 has), refine ⟨ih hs.1, λ ha, _⟩,
  rw finsupp.mem_span_iff_total at ha, rcases ha with ⟨l, hl, hla⟩,
  rw [finsupp.total_apply_of_mem_supported F hl] at hla,
  suffices : ∀ i ∈ s, l i ∈ fixed_points G F,
  { replace hla := (sum_apply _ _ (λ i, l i • to_fun G F i)).symm.trans (congr_fun hla 1),
    simp_rw [pi.smul_apply, to_fun_apply, one_smul] at hla,
    refine hs.2 (hla ▸ submodule.sum_mem _ (λ c hcs, _)),
    change (⟨l c, this c hcs⟩ : fixed_points G F) • c ∈ _,
    exact submodule.smul_mem _ _ (submodule.subset_span $ mem_coe.2 hcs) },
  intros i his g,
  refine eq_of_sub_eq_zero (linear_independent_iff'.1 (ih hs.1) s.attach (λ i, g • l i - l i) _
    ⟨i, his⟩ (mem_attach _ _) : _),
  refine (@sum_attach _ _ s _ (λ i, (g • l i - l i) • (to_fun G F) i)).trans _, ext g', dsimp only,
  conv_lhs { rw sum_apply, congr, skip, funext, rw [pi.smul_apply, sub_smul, smul_eq_mul] },
  rw [sum_sub_distrib, pi.zero_apply, sub_eq_zero],
  conv_lhs { congr, skip, funext,
    rw [to_fun_apply, ← mul_inv_cancel_left g g', mul_smul, ← smul_mul', ← to_fun_apply _ x] },
  show ∑ x in s, g • (λ y, l y • to_fun G F y) x (g⁻¹ * g') =
    ∑ x in s, (λ y, l y • to_fun G F y) x g',
  rw [← smul_sum, ← sum_apply _ _ (λ y, l y • to_fun G F y),
      ← sum_apply _ _ (λ y, l y • to_fun G F y)], dsimp only,
  rw [hla, to_fun_apply, to_fun_apply, smul_smul, mul_inv_cancel_left]
end

variables [fintype G] (x : F)

/-- `minpoly G F x` is the minimal polynomial of `(x : F)` over `fixed_points G F`. -/
def minpoly : polynomial (fixed_points G F) :=
(prod_X_sub_smul G F x).to_subring _ $ λ c hc g,
let ⟨hc0, n, hn⟩ := finsupp.mem_frange.1 hc in hn ▸ prod_X_sub_smul.coeff G F x g n

namespace minpoly

theorem eval₂ :
  polynomial.eval₂ (is_subring.subtype $ fixed_points G F) x (minpoly G F x) = 0 :=
begin
  rw [← prod_X_sub_smul.eval G F x, polynomial.eval₂_eq_eval_map],
  simp [minpoly],
end

theorem ne_one :
  minpoly G F x ≠ (1 : polynomial (fixed_points G F)) :=
λ H, have _ := eval₂ G F x,
(one_ne_zero : (1 : F) ≠ 0) $ by rwa [H, polynomial.eval₂_one] at this

theorem of_eval₂ (f : polynomial (fixed_points G F))
  (hf : polynomial.eval₂ (is_subring.subtype $ fixed_points G F) x f = 0) :
  minpoly G F x ∣ f :=
begin
  rw [← polynomial.map_dvd_map' (is_subring.subtype $ fixed_points G F),
      minpoly, polynomial.map_to_subring, prod_X_sub_smul],
  refine fintype.prod_dvd_of_coprime
    (polynomial.pairwise_coprime_X_sub $ mul_action.injective_of_quotient_stabilizer G x)
    (λ y, quotient_group.induction_on y $ λ g, _),
  rw [polynomial.dvd_iff_is_root, polynomial.is_root.def, mul_action.of_quotient_stabilizer_mk,
      polynomial.eval_smul', ← is_invariant_subring.coe_subtype_hom' G (fixed_points G F),
      ← mul_semiring_action_hom.coe_polynomial, ← mul_semiring_action_hom.map_smul,
      smul_polynomial, mul_semiring_action_hom.coe_polynomial,
      is_invariant_subring.coe_subtype_hom', polynomial.eval_map, hf, smul_zero]
end

/- Why is this so slow? -/
theorem irreducible_aux (f g : polynomial (fixed_points G F))
  (hf : f.monic) (hg : g.monic) (hfg : f * g = minpoly G F x) :
  f = 1 ∨ g = 1 :=
begin
  have hf2 : f ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_right _ _ },
  have hg2 : g ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_left _ _ },
  have := eval₂ G F x,
  rw [← hfg, polynomial.eval₂_mul, mul_eq_zero] at this,
  cases this,
  { right,
    have hf3 : f = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hf (monic G F x)
        (associated_of_dvd_dvd hf2 $ @of_eval₂ G _ F _ _ _  x f this) },
    rwa [← mul_one (minpoly G F x), hf3,
        mul_right_inj' (monic G F x).ne_zero] at hfg },
  { left,
    have hg3 : g = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hg (monic G F x)
        (associated_of_dvd_dvd hg2 $ @of_eval₂ G _ F _ _ _  x g this) },
    rwa [← one_mul (minpoly G F x), hg3,
        mul_left_inj' (monic G F x).ne_zero] at hfg }
end

theorem irreducible : irreducible (minpoly G F x) :=
(polynomial.irreducible_of_monic (monic G F x) (ne_one G F x)).2 (irreducible_aux G F x)

end minpoly

theorem is_integral : is_integral (fixed_points G F) x :=
⟨minpoly G F x, minpoly.monic G F x, minpoly.eval₂ G F x⟩

theorem minpoly_eq_minpoly :
  minpoly G F x = _root_.minpoly (fixed_points G F) x :=
minpoly.unique' (minpoly.irreducible G F x)
  (minpoly.eval₂ G F x) (minpoly.monic G F x)

instance normal : normal (fixed_points G F) F :=
⟨λ x, is_integral G F x, λ x, (polynomial.splits_id_iff_splits _).1 $
by { rw [← minpoly_eq_minpoly, minpoly,
    coe_algebra_map, polynomial.map_to_subring, prod_X_sub_smul],
  exact polynomial.splits_prod _ (λ _ _, polynomial.splits_X_sub_C _) }⟩

instance separable : is_separable (fixed_points G F) F :=
⟨λ x, is_integral G F x,
 λ x, by {
  rw [← minpoly_eq_minpoly, ← polynomial.separable_map (is_subring.subtype (fixed_points G F)),
    minpoly, polynomial.map_to_subring],
  exact polynomial.separable_prod_X_sub_C_iff.2 (injective_of_quotient_stabilizer G x) }⟩

lemma dim_le_card : module.rank (fixed_points G F) F ≤ fintype.card G :=
begin
  refine dim_le (λ s hs, cardinal.nat_cast_le.1 _),
  rw [← @dim_fun' F G, ← cardinal.lift_nat_cast.{v (max u v)},
    cardinal.finset_card, ← cardinal.lift_id (module.rank F (G → F))],
  exact linear_independent_le_dim'.{_ _ _ (max u v)}
    (linear_independent_smul_of_linear_independent G F hs)
end

instance : finite_dimensional (fixed_points G F) F :=
finite_dimensional.finite_dimensional_iff_dim_lt_omega.2 $
lt_of_le_of_lt (dim_le_card G F) (cardinal.nat_lt_omega _)

lemma finrank_le_card : finrank (fixed_points G F) F ≤ fintype.card G :=
by exact_mod_cast trans_rel_right (≤) (finrank_eq_dim _ _) (dim_le_card G F)

end fixed_points

lemma linear_independent_to_linear_map (R : Type u) (A : Type v) (B : Type w)
  [comm_semiring R] [integral_domain A] [algebra R A] [integral_domain B] [algebra R B] :
  linear_independent B (alg_hom.to_linear_map : (A →ₐ[R] B) → (A →ₗ[R] B)) :=
have linear_independent B (linear_map.lto_fun R A B ∘ alg_hom.to_linear_map),
from ((linear_independent_monoid_hom A B).comp
  (coe : (A →ₐ[R] B) → (A →* B))
  (λ f g hfg, alg_hom.ext $ monoid_hom.ext_iff.1 hfg) : _),
this.of_comp _

lemma cardinal_mk_alg_hom (K : Type u) (V : Type v) (W : Type w)
  [field K] [field V] [algebra K V] [finite_dimensional K V]
            [field W] [algebra K W] [finite_dimensional K W] :
  cardinal.mk (V →ₐ[K] W) ≤ finrank W (V →ₗ[K] W) :=
cardinal_mk_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V W

noncomputable instance alg_hom.fintype (K : Type u) (V : Type v) (W : Type w)
  [field K] [field V] [algebra K V] [finite_dimensional K V]
            [field W] [algebra K W] [finite_dimensional K W] :
  fintype (V →ₐ[K] W) :=
classical.choice $ cardinal.lt_omega_iff_fintype.1 $
lt_of_le_of_lt (cardinal_mk_alg_hom K V W) (cardinal.nat_lt_omega _)

noncomputable instance alg_equiv.fintype (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype (V ≃ₐ[K] V) :=
fintype.of_equiv (V →ₐ[K] V) (alg_equiv_equiv_alg_hom K V).symm

lemma finrank_alg_hom (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype.card (V →ₐ[K] V) ≤ finrank V (V →ₗ[K] V) :=
fintype_card_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V V

namespace fixed_points
/-- Embedding produced from a faithful action. -/
@[simps apply {fully_applied := ff}]
def to_alg_hom (G : Type u) (F : Type v) [group G] [field F]
  [faithful_mul_semiring_action G F] : G ↪ (F →ₐ[fixed_points G F] F) :=
{ to_fun := λ g, { commutes' := λ x, x.2 g,
    .. mul_semiring_action.to_semiring_hom G F g },
  inj' := λ g₁ g₂ hg, to_semiring_hom_injective G F $ ring_hom.ext $ λ x, alg_hom.ext_iff.1 hg x, }

lemma to_alg_hom_apply_apply {G : Type u} {F : Type v} [group G] [field F]
  [faithful_mul_semiring_action G F] (g : G) (x : F) :
  to_alg_hom G F g x = g • x :=
rfl

theorem finrank_eq_card (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [faithful_mul_semiring_action G F] :
  finrank (fixed_points G F) F = fintype.card G :=
le_antisymm (fixed_points.finrank_le_card G F) $
calc  fintype.card G
    ≤ fintype.card (F →ₐ[fixed_points G F] F) : fintype.card_le_of_injective _ (to_alg_hom G F).2
... ≤ finrank F (F →ₗ[fixed_points G F] F) : finrank_alg_hom (fixed_points G F) F
... = finrank (fixed_points G F) F : finrank_linear_map' _ _ _

theorem to_alg_hom_bijective (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [faithful_mul_semiring_action G F] :
  function.bijective (to_alg_hom G F) :=
begin
  rw fintype.bijective_iff_injective_and_card,
  split,
  { exact (to_alg_hom G F).injective },
  { apply le_antisymm,
    { exact fintype.card_le_of_injective _ (to_alg_hom G F).injective },
    { rw ← finrank_eq_card G F,
      exact has_le.le.trans_eq (finrank_alg_hom _ F) (finrank_linear_map' _ _ _) } },
end

/-- Bijection between G and algebra homomorphisms that fix the fixed points -/
def to_alg_hom_equiv (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [faithful_mul_semiring_action G F] : G ≃ (F →ₐ[fixed_points G F] F) :=
function.embedding.equiv_of_surjective (to_alg_hom G F) (to_alg_hom_bijective G F).2

end fixed_points


import fibonacci_world.induction -- hide

/-
## The Fibonacci key lemma

Below is the definition of the Fibonacci sequence. Notice that we specify
what is $F_0$, what is $F_1$ and then we use a recurrence to define $F_{n+2}$.
-/

def Fib : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n + 2) := Fib n + Fib (n+1)

/-
It is useful to have the first few values available, as well as a rule
to rewrite the recurrence. The proofs of the following lemmas are `by definition`,
this is what `rfl` means at the end of the lines.
-/
@[simp] -- hide
lemma Fib0 : Fib 0 = 0 := rfl
@[simp] -- hide
lemma Fib1 : Fib 1 = 1 := rfl
@[simp] -- hide
lemma Fib2 : Fib 2 = 1 := rfl
@[simp] -- hide
lemma Fib_def (n : ℕ) : Fib (n+2) = Fib n + Fib (n+1) := rfl

/-
Armed with these tools, prove this important lemma on Fibonacci numbers. Remember
the `induction'` lemma that you just proved!
-/

@[simp] -- hide
/- Lemma :
For all $k$ and $n$, we have $F_{n+k+1} = F_k F_n + F_{k+1} F_{n+1}$.
-/
lemma Fib_general (n k : ℕ) : Fib (n + k + 1) = (Fib k) * (Fib n) + (Fib (k+1)) * (Fib (n+1)) :=
begin
  apply induction' k,
  {
  intros k h0 h1,
  rw show n+(k+2)+1 = (n+k+1)+2, by ring,
  rw Fib_def,
  rw show n + k + 1 + 1 = n + (k+1) + 1, by ring,
  -- simp [h0, h1], ring -- works
  rw h0,
  rw h1,
  rw Fib_def,
  rw Fib_def,
  rw Fib_def,
  ring,
  },
  { -- simp works
    rw Fib0,
    rw Fib1,
    ring,
  },
  { -- simp works
    rw Fib1,
    rw Fib2,
    rw Fib_def,
    ring,
  },

end


import data.int.basic
import data.rat.basic
import data.real.basic
import float.reduce
import tactic

-- Float structure before quotiening. Basic operations.

structure float_raw := (m : ℤ) (e : ℤ)

namespace float_raw

def reduce (x : float_raw) : float_raw :=
let m := if x.m < 0 then int.to_nat (-x.m) else int.to_nat x.m in
let res := reduce_float_raw_aux ⟨m, x.e⟩ in
{ m := if x.m < 0 then -res.1 else res.1, e := res.2 }

def neg (x : float_raw) : float_raw :=
⟨-x.m, x.e⟩

def add (x y : float_raw) : float_raw :=
if x.e ≤ y.e
then ⟨x.m + y.m * 2 ^ int.to_nat (y.e - x.e), x.e⟩
else ⟨y.m + x.m * 2 ^ int.to_nat (x.e - y.e), y.e⟩

def mul (x y : float_raw) : float_raw :=
⟨x.m * y.m, x.e + y.e⟩

end float_raw

-- Transforming floats to rational numbers.

@[reducible] def to_rat : float_raw → ℚ := λ x, x.m * 2 ^ x.e

-- Some tactics to make the proofs shorter.

namespace tactic
namespace interactive

-- TODO: Move
lemma pow_rat_cast (x : ℤ) {y : ℤ} (hy : 0 ≤ y) : ((x ^ int.to_nat y) : ℚ) = (x : ℚ) ^ (y : ℤ) :=
begin
  lift y to ℕ using hy, rw [int.to_nat_coe_nat], norm_num,
end

open tactic
open interactive (parse)
open interactive.types
open lean.parser (ident)

meta def apply_pow_rat_cast (h : parse ident) : tactic unit := do
  e ← get_local h,
  t ← infer_type e,
  r ← match t with
  | `(%%a ≤ %%b) := tactic.to_expr ``(pow_rat_cast 2 (sub_nonneg.2 %%e))
  | `(¬(%%a ≤ %%b)) := tactic.to_expr ``(pow_rat_cast 2 (sub_nonneg.2 (le_of_not_le %%e)))
  | _ := failed
  end,
  rewrite_target r {md := semireducible}

meta def simplify_neg : tactic unit := do
  `[simp only [float_raw.neg] at *;
    try { simp only [has_equiv.equiv, setoid.r, R, to_rat] };
    try { dsimp }; push_cast]

meta def simplify_add : tactic unit := do
  `[simp only [float_raw.add] at *, split_ifs;
    try { simp only [has_equiv.equiv, setoid.r, R, to_rat] };
    try { dsimp }; push_cast]

meta def simplify_mul : tactic unit := do
  `[simp only [float_raw.mul] at *;
    try { simp only [has_equiv.equiv, setoid.r, R, to_rat] };
    try { dsimp }; push_cast]

end interactive
end tactic

-- Properties of `to_rat`.

namespace to_rat

lemma reduce (x : float_raw)
: to_rat x = to_rat (float_raw.reduce x) :=
begin
  unfold float_raw.reduce,
  by_cases (x.m < 0); split_ifs,
  { simp [to_rat], dsimp, push_cast, rw [←neg_one_mul, mul_assoc],
    rw ←(reduce_float_raw_aux_to_rat (-x.m).to_nat x.e),
    have hrw := int.to_nat_of_nonneg (le_of_lt (neg_pos.2 h)),
    replace hrw := congr_arg (coe : ℤ → ℚ) hrw, push_cast at hrw,
    rw hrw, ring, },
  { simp [to_rat], dsimp,
    rw ←(reduce_float_raw_aux_to_rat (x.m).to_nat x.e),
    have hrw := int.to_nat_of_nonneg (le_of_not_lt h),
    replace hrw := congr_arg (coe : ℤ → ℚ) hrw, push_cast at hrw,
    rw hrw,  }
end

lemma neg {x y : float_raw} (h : to_rat x = to_rat y)
: to_rat (float_raw.neg x) = to_rat (float_raw.neg y) :=
begin
  simp [float_raw.neg, to_rat] at *, dsimp,
  iterate 2 { rw [int.cast_neg, ←neg_mul_eq_neg_mul], }, rw h,
end

lemma add {x y x' y' : float_raw} (h : to_rat x = to_rat y) (h' : to_rat x' = to_rat y')
: to_rat (float_raw.add x x') = to_rat (float_raw.add y y') :=
begin
  simp [float_raw.add, to_rat] at *, split_ifs; push_cast;
  iterate 2 { rw [add_mul], };
  apply_pow_rat_cast h_1; apply_pow_rat_cast h_2;
  iterate 2 { erw [mul_assoc, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0)], }; simp,
  { rw [h, h']; ring, },
  { rw [h, ←h']; ring, },
  { rw [←h, h']; ring, },
  { rw [←h, ←h']; ring, },
end

lemma mul {x y x' y' : float_raw} (h : to_rat x = to_rat y) (h' : to_rat x' = to_rat y')
: to_rat (float_raw.mul x x') = to_rat (float_raw.mul y y') :=
begin
  simp [float_raw.mul, to_rat] at *, dsimp,
  simp only [fpow_add (by norm_num : (2 : ℚ) ≠ 0)], push_cast,
  calc ↑(x.m) * ↑(x'.m) * ((2 : ℚ) ^ x.e * (2 : ℚ) ^ x'.e)
      = (↑(x.m) * 2 ^ x.e) * (↑(x'.m) * 2 ^ x'.e) : by ring
  ... = (↑(y.m) * 2 ^ y.e) * (↑(y'.m) * 2 ^ y'.e) : by rw [h, h']
  ... = ↑(y.m) * ↑(y'.m) * (2 ^ y.e * 2 ^ y'.e) : by ring,
end

end to_rat

-- Define `float` as `float_raw` modulo `to_rat`.

@[reducible] private def R (x y : float_raw) : Prop := to_rat x = to_rat y
private lemma R.reflexive : reflexive R := λ x, by unfold R; exact eq.refl
private lemma R.symmetric : symmetric R := λ x y, by unfold R; exact eq.symm
private lemma R.transitive : transitive R := λ x y z, by unfold R; exact eq.trans
private lemma R.equivalence : equivalence R := ⟨R.reflexive, R.symmetric, R.transitive⟩

instance float_raw.setoid : setoid float_raw := ⟨R, R.equivalence⟩

def float : Type* := quotient float_raw.setoid

notation `𝔽` := float

namespace float

def mk (m e : ℤ) : 𝔽 := quot.mk R ⟨m, e⟩

def of_int (n : ℤ) : float := mk n 0

@[reducible] def eval : 𝔽 → ℚ := quot.lift to_rat (λ a b h, h)

meta def repr : 𝔽 → string :=
λ x, let x' := quot.unquot x in int.repr x'.m ++ "," ++ int.repr x'.e

meta instance : has_repr 𝔽 := ⟨float.repr⟩
meta instance : has_to_string 𝔽 := ⟨float.repr⟩
meta instance : has_to_format 𝔽 := ⟨coe ∘ float.repr⟩

-- `float` is a linearly ordered commutative ring.

instance : has_zero float := ⟨mk 0 0⟩
instance : has_one float := ⟨mk 1 0⟩
instance : inhabited float := ⟨0⟩

@[simp] lemma mk_zero (e : ℤ) : mk 0 e = 0 :=
begin
  apply quotient.sound, show to_rat _ = _, simp [to_rat],
end

@[simp] lemma eval_zero : eval 0 = 0 :=
begin
  show to_rat _ = _, simp only [to_rat], dsimp, rw zero_mul,
end

/-- Negation of floats. -/
def neg : 𝔽 → 𝔽 :=
quotient.lift (λ x, ⟦float_raw.neg x⟧) (λ a b h, quotient.sound $ to_rat.neg h)

instance : has_neg 𝔽 := ⟨neg⟩

@[simp] lemma neg_def {m e : ℤ}
: - mk m e = mk (-m) e :=
begin
  simp [mk], apply quotient.sound, show to_rat _ = _, simp [to_rat, float_raw.neg],
end

/-- Addition of floats. -/
def add : 𝔽 → 𝔽 → 𝔽 :=
quotient.lift₂ (λ x y, ⟦float_raw.add x y⟧) (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound $ to_rat.add h₁ h₂)

instance : has_add 𝔽 := ⟨add⟩

@[simp] lemma add_def {m₁ m₂ e₁ e₂ : ℤ}
: (mk m₁ e₁) + (mk m₂ e₂) =
  if e₁ ≤ e₂
  then mk (m₁ + m₂ * 2 ^ int.to_nat (e₂ - e₁)) e₁
  else mk (m₂ + m₁ * 2 ^ int.to_nat (e₁ - e₂)) e₂ :=
begin
  split_ifs, all_goals {
    simp [mk], apply quotient.sound,
    show to_rat _ = _, simp [to_rat, float_raw.add],
    split_ifs, refl, },
end

/-- Multiplication of floats. -/
def mul : 𝔽 → 𝔽 → 𝔽 :=
quotient.lift₂ (λ x y, ⟦float_raw.mul x y⟧) (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound $ to_rat.mul h₁ h₂)

instance : has_mul 𝔽 := ⟨mul⟩

@[simp] lemma mul_def {m₁ m₂ e₁ e₂ : ℤ}
: (mk m₁ e₁) * (mk m₂ e₂) = mk (m₁ * m₂) (e₁ + e₂) :=
begin
  simp [mk], apply quotient.sound, show to_rat _ = _, simp [to_rat, float_raw.mul],
end

-- Lemmas to prove that 𝔽 is a `comm_ring`.

variables (x y z : 𝔽)

protected lemma add_zero : x + 0 = x :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_add; apply_pow_rat_cast h; simp)

protected lemma zero_add : 0 + x = x :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_add; apply_pow_rat_cast h; simp)

protected lemma add_comm : x + y = y + x :=
quotient.induction_on₂ x y (λ a b, quotient.sound $
begin
  simplify_add; apply_pow_rat_cast h; apply_pow_rat_cast h_1;
  simp [add_mul, mul_assoc, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0), add_comm],
end)

protected lemma add_assoc : x + y + z = x + (y + z) :=
quotient.induction_on₃ x y z (λ a b c, quotient.sound $
begin
  simplify_add; apply_pow_rat_cast h; apply_pow_rat_cast h_1; try { apply_pow_rat_cast h_2, };
  simp [add_mul, mul_assoc, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0), add_comm, add_assoc]; ring,
end)

protected lemma add_left_neg : -x + x = 0 :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_add; simplify_neg; simp)

protected lemma mul_zero : x * 0 = 0 :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_mul; simp)

protected lemma zero_mul : 0 * x = 0 :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_mul; simp)

protected lemma mul_one : x * 1 = x :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_mul; simp)

protected lemma one_mul : 1 * x = x :=
quotient.induction_on x (λ a, quotient.sound $ by simplify_mul; simp)

protected lemma mul_comm : x * y = y * x :=
quotient.induction_on₂ x y (λ a b, quotient.sound $
begin
  simplify_mul, simp [fpow_add (by norm_num : (2 : ℚ) ≠ 0)], ring,
end)

protected lemma mul_assoc : x * y * z = x * (y * z) :=
quotient.induction_on₃ x y z (λ a b c, quotient.sound $
begin
  simplify_mul, simp [fpow_add (by norm_num : (2 : ℚ) ≠ 0)], ring,
end)

protected lemma left_distrib : x * (y + z) = (x * y) + (x * z) :=
quotient.induction_on₃ x y z (λ a b c, quotient.sound $
begin
  simplify_mul; simplify_add; apply_pow_rat_cast h; apply_pow_rat_cast h_1;
  simp [add_mul, mul_add, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0)]; ring!,
  { left, ring, },
  { replace h_1 := (add_le_add_iff_left a.e).1 (le_of_not_le h_1),
    simp [le_antisymm h h_1], left, ring, },
  { replace h_1 := (add_le_add_iff_left a.e).1 h_1,
    simp [le_antisymm (le_of_not_le h) h_1], left, ring, },
  { left, ring, },
end)

protected lemma right_distrib : (x + y) * z = (x * z) + (y * z) :=
quotient.induction_on₃ x y z (λ a b c, quotient.sound $
begin
  simplify_mul; simplify_add; apply_pow_rat_cast h; apply_pow_rat_cast h_1;
  simp [add_mul, mul_add, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0)]; ring!,
  { left, ring, },
  { replace h_1 := (add_le_add_iff_right c.e).1 (le_of_not_le h_1),
    simp [le_antisymm h h_1], left, ring, },
  { replace h_1 := (add_le_add_iff_right c.e).1 h_1,
    simp [le_antisymm (le_of_not_le h) h_1], left, ring, },
  { left, ring, },
end)

instance : comm_ring 𝔽 := {
  zero := 0,
  one := 1,
  neg := float.neg,
  add := float.add,
  mul := float.mul,
  add_zero := float.add_zero,
  zero_add := float.zero_add,
  add_comm := float.add_comm,
  add_assoc := float.add_assoc,
  add_left_neg := float.add_left_neg,
  mul_one := float.mul_one,
  one_mul := float.one_mul,
  mul_comm := float.mul_comm,
  mul_assoc := float.mul_assoc,
  left_distrib := float.left_distrib,
  right_distrib := float.right_distrib,
}

-- Lemmas to prove that 𝔽 is a `linear_ordered_comm_ring`.

@[simp] lemma eval_mk {m e : ℤ} : eval (mk m e) = m * 2 ^ e := rfl

@[simp] lemma eval_neg (x : 𝔽) : eval (-x) = -(eval x) :=
begin
  apply quotient.induction_on x, intros a, show to_rat _ = -to_rat _,
  simplify_neg, simp [eval, to_rat],
end

@[simp] lemma eval_add (x y : 𝔽) : eval (x + y) = (eval x) + (eval y) :=
begin
  apply quotient.induction_on₂ x y, intros a b, show to_rat _ = to_rat _ + to_rat _,
  simplify_add; apply_pow_rat_cast h;
  simp [add_mul, mul_assoc, ←fpow_add (by norm_num : (2 : ℚ) ≠ 0)], ring,
end

@[simp] lemma eval_mul (x y : 𝔽) : eval (x * y) = (eval x) * (eval y) :=
begin
  apply quotient.induction_on₂ x y, intros a b, show to_rat _ = to_rat _ * to_rat _,
  simplify_mul, simp [fpow_add (by norm_num : (2 : ℚ) ≠ 0)], ring,
end

@[simp] lemma eval_sub (x y : 𝔽) : eval (x - y) = (eval x) - (eval y) :=
begin
  show eval (x + (-y)) = (eval x) + (-(eval y)),
  rw [eval_add x (-y), eval_neg y],
end

/-- Comparison of floats. -/
def le : 𝔽 → 𝔽 → Prop := λ x y, eval x ≤ eval y
def lt : 𝔽 → 𝔽 → Prop := λ x y, eval x < eval y

instance : has_le 𝔽 := ⟨le⟩
instance : has_lt 𝔽 := ⟨lt⟩

protected lemma le_refl : x ≤ x :=
quotient.induction_on x (λ a, rat.le_refl _)

protected lemma le_trans : x ≤ y → y ≤ z → x ≤ z :=
quotient.induction_on₃ x y z (λ a b c h1 h2, rat.le_trans h1 h2)

protected lemma le_antisymm : x ≤ y → y ≤ x → x = y :=
quotient.induction_on₂ x y (λ a b h1 h2, by apply quotient.sound; exact (rat.le_antisymm h1 h2))

protected lemma add_le_add_left : x ≤ y → ∀ (c : 𝔽), c + x ≤ c + y :=
begin
  apply quotient.induction_on₂ x y, intros a b h z,
  apply quotient.induction_on z, intros c,
  show eval _ ≤ eval _, simp only [eval_add],
  exact (rat.add_le_add_left.2 h),
end

protected lemma zero_le_one : (0 : 𝔽) ≤ 1 :=
begin
  show to_rat _ ≤ to_rat _, simp [to_rat], push_cast, simp, linarith,
end

protected lemma mul_pos : 0 < x → 0 < y → 0 < x * y :=
begin
  apply quotient.induction_on₂ x y, intros a b h1 h2,
  show _ < eval _, simp only [eval_mul],
  exact (mul_pos h1 h2),
end

protected lemma le_total : x ≤ y ∨ y ≤ x :=
begin
  apply quotient.induction_on₂ x y, intros a b, exact (rat.le_total _ _),
end

-- protected lemma decidable_le : decidable (x ≤ y) :=
-- rat.decidable_le (eval x) (eval y)

instance decidable_le : decidable_rel ((≤) : 𝔽 → 𝔽 → Prop) :=
λ a b, rat.decidable_le (eval a) (eval b)

protected lemma exists_pair_ne : ∃ (x y : 𝔽), x ≠ y :=
begin
  use [⟦⟨0, 0⟩⟧, ⟦⟨1, 0⟩⟧], simp, show ¬(to_rat _ = to_rat _),
  intros hc, simp [to_rat] at hc, exact hc,
end

instance : linear_ordered_comm_ring 𝔽 := {
  le := float.le,
  le_refl := float.le_refl,
  le_trans := float.le_trans,
  le_antisymm := float.le_antisymm,
  add_le_add_left := float.add_le_add_left,
  zero_le_one := float.zero_le_one,
  mul_pos := float.mul_pos,
  le_total := float.le_total,
  decidable_le := float.decidable_le,
  exists_pair_ne := float.exists_pair_ne,
  ..float.comm_ring
}

end float


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

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

/-!
# Set family operations

This file defines a few binary operations on `finset α` for use in set family combinatorics.

## Main declarations

* `s ⊻ t`: Finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`.
* `s ⊼ t`: Finset of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`.
* `finset.disj_sups s t`: Finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t` and `a`
  and `b` are disjoint.

## Notation

We define the following notation in locale `finset_family`:
* `s ⊻ t`
* `s ⊼ t`
* `s ○ t` for `finset.disj_sups s t`

## References

[B. Bollobás, *Combinatorics*][bollobas1986]
-/

open Function

open SetFamily

variable {α : Type _} [DecidableEq α]

namespace Finset

section Sups

variable [SemilatticeSup α] (s s₁ s₂ t t₁ t₂ u v : Finset α)

/-- `s ⊻ t` is the finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`. -/
protected def hasSups : HasSups (Finset α) :=
  ⟨image₂ (· ⊔ ·)⟩
#align finset.has_sups Finset.hasSups

scoped[FinsetFamily] attribute [instance] Finset.hasSups

variable {s t} {a b c : α}

@[simp]
theorem mem_sups : c ∈ s ⊻ t ↔ ∃ a ∈ s, ∃ b ∈ t, a ⊔ b = c := by simp [(· ⊻ ·)]
#align finset.mem_sups Finset.mem_sups

variable (s t)

@[simp, norm_cast]
theorem coe_sups : (↑(s ⊻ t) : Set α) = s ⊻ t :=
  coe_image₂ _ _ _
#align finset.coe_sups Finset.coe_sups

theorem card_sups_le : (s ⊻ t).card ≤ s.card * t.card :=
  card_image₂_le _ _ _
#align finset.card_sups_le Finset.card_sups_le

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem card_sups_iff :
    (s ⊻ t).card = s.card * t.card ↔ (s ×ˢ t : Set (α × α)).InjOn fun x => x.1 ⊔ x.2 :=
  card_image₂_iff
#align finset.card_sups_iff Finset.card_sups_iff

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

theorem sup_mem_sups : a ∈ s → b ∈ t → a ⊔ b ∈ s ⊻ t :=
  mem_image₂_of_mem
#align finset.sup_mem_sups Finset.sup_mem_sups

theorem sups_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊻ t₁ ⊆ s₂ ⊻ t₂ :=
  image₂_subset
#align finset.sups_subset Finset.sups_subset

theorem sups_subset_left : t₁ ⊆ t₂ → s ⊻ t₁ ⊆ s ⊻ t₂ :=
  image₂_subset_left
#align finset.sups_subset_left Finset.sups_subset_left

theorem sups_subset_right : s₁ ⊆ s₂ → s₁ ⊻ t ⊆ s₂ ⊻ t :=
  image₂_subset_right
#align finset.sups_subset_right Finset.sups_subset_right

theorem image_subset_sups_left : b ∈ t → (s.image fun a => a ⊔ b) ⊆ s ⊻ t :=
  image_subset_image₂_left
#align finset.image_subset_sups_left Finset.image_subset_sups_left

theorem image_subset_sups_right : a ∈ s → t.image ((· ⊔ ·) a) ⊆ s ⊻ t :=
  image_subset_image₂_right
#align finset.image_subset_sups_right Finset.image_subset_sups_right

theorem forall_sups_iff {p : α → Prop} : (∀ c ∈ s ⊻ t, p c) ↔ ∀ a ∈ s, ∀ b ∈ t, p (a ⊔ b) :=
  forall_image₂_iff
#align finset.forall_sups_iff Finset.forall_sups_iff

@[simp]
theorem sups_subset_iff : s ⊻ t ⊆ u ↔ ∀ a ∈ s, ∀ b ∈ t, a ⊔ b ∈ u :=
  image₂_subset_iff
#align finset.sups_subset_iff Finset.sups_subset_iff

@[simp]
theorem sups_nonempty : (s ⊻ t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image₂_nonempty_iff
#align finset.sups_nonempty Finset.sups_nonempty

protected theorem Nonempty.sups : s.Nonempty → t.Nonempty → (s ⊻ t).Nonempty :=
  Nonempty.image₂
#align finset.nonempty.sups Finset.Nonempty.sups

theorem Nonempty.of_sups_left : (s ⊻ t).Nonempty → s.Nonempty :=
  Nonempty.of_image₂_left
#align finset.nonempty.of_sups_left Finset.Nonempty.of_sups_left

theorem Nonempty.of_sups_right : (s ⊻ t).Nonempty → t.Nonempty :=
  Nonempty.of_image₂_right
#align finset.nonempty.of_sups_right Finset.Nonempty.of_sups_right

@[simp]
theorem empty_sups : ∅ ⊻ t = ∅ :=
  image₂_empty_left
#align finset.empty_sups Finset.empty_sups

@[simp]
theorem sups_empty : s ⊻ ∅ = ∅ :=
  image₂_empty_right
#align finset.sups_empty Finset.sups_empty

@[simp]
theorem sups_eq_empty : s ⊻ t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image₂_eq_empty_iff
#align finset.sups_eq_empty Finset.sups_eq_empty

@[simp]
theorem singleton_sups : {a} ⊻ t = t.image fun b => a ⊔ b :=
  image₂_singleton_left
#align finset.singleton_sups Finset.singleton_sups

@[simp]
theorem sups_singleton : s ⊻ {b} = s.image fun a => a ⊔ b :=
  image₂_singleton_right
#align finset.sups_singleton Finset.sups_singleton

theorem singleton_sups_singleton : ({a} ⊻ {b} : Finset α) = {a ⊔ b} :=
  image₂_singleton
#align finset.singleton_sups_singleton Finset.singleton_sups_singleton

theorem sups_union_left : (s₁ ∪ s₂) ⊻ t = s₁ ⊻ t ∪ s₂ ⊻ t :=
  image₂_union_left
#align finset.sups_union_left Finset.sups_union_left

theorem sups_union_right : s ⊻ (t₁ ∪ t₂) = s ⊻ t₁ ∪ s ⊻ t₂ :=
  image₂_union_right
#align finset.sups_union_right Finset.sups_union_right

theorem sups_inter_subset_left : (s₁ ∩ s₂) ⊻ t ⊆ s₁ ⊻ t ∩ s₂ ⊻ t :=
  image₂_inter_subset_left
#align finset.sups_inter_subset_left Finset.sups_inter_subset_left

theorem sups_inter_subset_right : s ⊻ (t₁ ∩ t₂) ⊆ s ⊻ t₁ ∩ s ⊻ t₂ :=
  image₂_inter_subset_right
#align finset.sups_inter_subset_right Finset.sups_inter_subset_right

theorem subset_sups {s t : Set α} :
    ↑u ⊆ s ⊻ t → ∃ s' t' : Finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' ⊻ t' :=
  subset_image₂
#align finset.subset_sups Finset.subset_sups

variable (s t u v)

theorem bunionᵢ_image_sup_left : (s.bunionᵢ fun a => t.image <| (· ⊔ ·) a) = s ⊻ t :=
  bunionᵢ_image_left
#align finset.bUnion_image_sup_left Finset.bunionᵢ_image_sup_left

theorem bunionᵢ_image_sup_right : (t.bunionᵢ fun b => s.image fun a => a ⊔ b) = s ⊻ t :=
  bunionᵢ_image_right
#align finset.bUnion_image_sup_right Finset.bunionᵢ_image_sup_right

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem image_sup_product (s t : Finset α) : (s ×ˢ t).image (uncurry (· ⊔ ·)) = s ⊻ t :=
  image_uncurry_product _ _ _
#align finset.image_sup_product Finset.image_sup_product

theorem sups_assoc : s ⊻ t ⊻ u = s ⊻ (t ⊻ u) :=
  image₂_assoc fun _ _ _ => sup_assoc
#align finset.sups_assoc Finset.sups_assoc

theorem sups_comm : s ⊻ t = t ⊻ s :=
  image₂_comm fun _ _ => sup_comm
#align finset.sups_comm Finset.sups_comm

theorem sups_left_comm : s ⊻ (t ⊻ u) = t ⊻ (s ⊻ u) :=
  image₂_left_comm sup_left_comm
#align finset.sups_left_comm Finset.sups_left_comm

theorem sups_right_comm : s ⊻ t ⊻ u = s ⊻ u ⊻ t :=
  image₂_right_comm sup_right_comm
#align finset.sups_right_comm Finset.sups_right_comm

theorem sups_sups_sups_comm : s ⊻ t ⊻ (u ⊻ v) = s ⊻ u ⊻ (t ⊻ v) :=
  image₂_image₂_image₂_comm sup_sup_sup_comm
#align finset.sups_sups_sups_comm Finset.sups_sups_sups_comm

end Sups

section Infs

variable [SemilatticeInf α] (s s₁ s₂ t t₁ t₂ u v : Finset α)

/-- `s ⊼ t` is the finset of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`. -/
protected def hasInfs : HasInfs (Finset α) :=
  ⟨image₂ (· ⊓ ·)⟩
#align finset.has_infs Finset.hasInfs

scoped[FinsetFamily] attribute [instance] Finset.hasInfs

variable {s t} {a b c : α}

@[simp]
theorem mem_infs : c ∈ s ⊼ t ↔ ∃ a ∈ s, ∃ b ∈ t, a ⊓ b = c := by simp [(· ⊼ ·)]
#align finset.mem_infs Finset.mem_infs

variable (s t)

@[simp, norm_cast]
theorem coe_infs : (↑(s ⊼ t) : Set α) = s ⊼ t :=
  coe_image₂ _ _ _
#align finset.coe_infs Finset.coe_infs

theorem card_infs_le : (s ⊼ t).card ≤ s.card * t.card :=
  card_image₂_le _ _ _
#align finset.card_infs_le Finset.card_infs_le

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem card_infs_iff :
    (s ⊼ t).card = s.card * t.card ↔ (s ×ˢ t : Set (α × α)).InjOn fun x => x.1 ⊓ x.2 :=
  card_image₂_iff
#align finset.card_infs_iff Finset.card_infs_iff

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

theorem inf_mem_infs : a ∈ s → b ∈ t → a ⊓ b ∈ s ⊼ t :=
  mem_image₂_of_mem
#align finset.inf_mem_infs Finset.inf_mem_infs

theorem infs_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊼ t₁ ⊆ s₂ ⊼ t₂ :=
  image₂_subset
#align finset.infs_subset Finset.infs_subset

theorem infs_subset_left : t₁ ⊆ t₂ → s ⊼ t₁ ⊆ s ⊼ t₂ :=
  image₂_subset_left
#align finset.infs_subset_left Finset.infs_subset_left

theorem infs_subset_right : s₁ ⊆ s₂ → s₁ ⊼ t ⊆ s₂ ⊼ t :=
  image₂_subset_right
#align finset.infs_subset_right Finset.infs_subset_right

theorem image_subset_infs_left : b ∈ t → (s.image fun a => a ⊓ b) ⊆ s ⊼ t :=
  image_subset_image₂_left
#align finset.image_subset_infs_left Finset.image_subset_infs_left

theorem image_subset_infs_right : a ∈ s → t.image ((· ⊓ ·) a) ⊆ s ⊼ t :=
  image_subset_image₂_right
#align finset.image_subset_infs_right Finset.image_subset_infs_right

theorem forall_infs_iff {p : α → Prop} : (∀ c ∈ s ⊼ t, p c) ↔ ∀ a ∈ s, ∀ b ∈ t, p (a ⊓ b) :=
  forall_image₂_iff
#align finset.forall_infs_iff Finset.forall_infs_iff

@[simp]
theorem infs_subset_iff : s ⊼ t ⊆ u ↔ ∀ a ∈ s, ∀ b ∈ t, a ⊓ b ∈ u :=
  image₂_subset_iff
#align finset.infs_subset_iff Finset.infs_subset_iff

@[simp]
theorem infs_nonempty : (s ⊼ t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  image₂_nonempty_iff
#align finset.infs_nonempty Finset.infs_nonempty

protected theorem Nonempty.infs : s.Nonempty → t.Nonempty → (s ⊼ t).Nonempty :=
  Nonempty.image₂
#align finset.nonempty.infs Finset.Nonempty.infs

theorem Nonempty.of_infs_left : (s ⊼ t).Nonempty → s.Nonempty :=
  Nonempty.of_image₂_left
#align finset.nonempty.of_infs_left Finset.Nonempty.of_infs_left

theorem Nonempty.of_infs_right : (s ⊼ t).Nonempty → t.Nonempty :=
  Nonempty.of_image₂_right
#align finset.nonempty.of_infs_right Finset.Nonempty.of_infs_right

@[simp]
theorem empty_infs : ∅ ⊼ t = ∅ :=
  image₂_empty_left
#align finset.empty_infs Finset.empty_infs

@[simp]
theorem infs_empty : s ⊼ ∅ = ∅ :=
  image₂_empty_right
#align finset.infs_empty Finset.infs_empty

@[simp]
theorem infs_eq_empty : s ⊼ t = ∅ ↔ s = ∅ ∨ t = ∅ :=
  image₂_eq_empty_iff
#align finset.infs_eq_empty Finset.infs_eq_empty

@[simp]
theorem singleton_infs : {a} ⊼ t = t.image fun b => a ⊓ b :=
  image₂_singleton_left
#align finset.singleton_infs Finset.singleton_infs

@[simp]
theorem infs_singleton : s ⊼ {b} = s.image fun a => a ⊓ b :=
  image₂_singleton_right
#align finset.infs_singleton Finset.infs_singleton

theorem singleton_infs_singleton : ({a} ⊼ {b} : Finset α) = {a ⊓ b} :=
  image₂_singleton
#align finset.singleton_infs_singleton Finset.singleton_infs_singleton

theorem infs_union_left : (s₁ ∪ s₂) ⊼ t = s₁ ⊼ t ∪ s₂ ⊼ t :=
  image₂_union_left
#align finset.infs_union_left Finset.infs_union_left

theorem infs_union_right : s ⊼ (t₁ ∪ t₂) = s ⊼ t₁ ∪ s ⊼ t₂ :=
  image₂_union_right
#align finset.infs_union_right Finset.infs_union_right

theorem infs_inter_subset_left : (s₁ ∩ s₂) ⊼ t ⊆ s₁ ⊼ t ∩ s₂ ⊼ t :=
  image₂_inter_subset_left
#align finset.infs_inter_subset_left Finset.infs_inter_subset_left

theorem infs_inter_subset_right : s ⊼ (t₁ ∩ t₂) ⊆ s ⊼ t₁ ∩ s ⊼ t₂ :=
  image₂_inter_subset_right
#align finset.infs_inter_subset_right Finset.infs_inter_subset_right

theorem subset_infs {s t : Set α} :
    ↑u ⊆ s ⊼ t → ∃ s' t' : Finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' ⊼ t' :=
  subset_image₂
#align finset.subset_infs Finset.subset_infs

variable (s t u v)

theorem bunionᵢ_image_inf_left : (s.bunionᵢ fun a => t.image <| (· ⊓ ·) a) = s ⊼ t :=
  bunionᵢ_image_left
#align finset.bUnion_image_inf_left Finset.bunionᵢ_image_inf_left

theorem bunionᵢ_image_inf_right : (t.bunionᵢ fun b => s.image fun a => a ⊓ b) = s ⊼ t :=
  bunionᵢ_image_right
#align finset.bUnion_image_inf_right Finset.bunionᵢ_image_inf_right

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem image_inf_product (s t : Finset α) : (s ×ˢ t).image (uncurry (· ⊓ ·)) = s ⊼ t :=
  image_uncurry_product _ _ _
#align finset.image_inf_product Finset.image_inf_product

theorem infs_assoc : s ⊼ t ⊼ u = s ⊼ (t ⊼ u) :=
  image₂_assoc fun _ _ _ => inf_assoc
#align finset.infs_assoc Finset.infs_assoc

theorem infs_comm : s ⊼ t = t ⊼ s :=
  image₂_comm fun _ _ => inf_comm
#align finset.infs_comm Finset.infs_comm

theorem infs_left_comm : s ⊼ (t ⊼ u) = t ⊼ (s ⊼ u) :=
  image₂_left_comm inf_left_comm
#align finset.infs_left_comm Finset.infs_left_comm

theorem infs_right_comm : s ⊼ t ⊼ u = s ⊼ u ⊼ t :=
  image₂_right_comm inf_right_comm
#align finset.infs_right_comm Finset.infs_right_comm

theorem infs_infs_infs_comm : s ⊼ t ⊼ (u ⊼ v) = s ⊼ u ⊼ (t ⊼ v) :=
  image₂_image₂_image₂_comm inf_inf_inf_comm
#align finset.infs_infs_infs_comm Finset.infs_infs_infs_comm

end Infs

open FinsetFamily

section DistribLattice

variable [DistribLattice α] (s t u : Finset α)

theorem sups_infs_subset_left : s ⊻ t ⊼ u ⊆ (s ⊻ t) ⊼ (s ⊻ u) :=
  image₂_distrib_subset_left fun _ _ _ => sup_inf_left
#align finset.sups_infs_subset_left Finset.sups_infs_subset_left

theorem sups_infs_subset_right : t ⊼ u ⊻ s ⊆ (t ⊻ s) ⊼ (u ⊻ s) :=
  image₂_distrib_subset_right fun _ _ _ => sup_inf_right
#align finset.sups_infs_subset_right Finset.sups_infs_subset_right

theorem infs_sups_subset_left : s ⊼ (t ⊻ u) ⊆ s ⊼ t ⊻ s ⊼ u :=
  image₂_distrib_subset_left fun _ _ _ => inf_sup_left
#align finset.infs_sups_subset_left Finset.infs_sups_subset_left

theorem infs_sups_subset_right : (t ⊻ u) ⊼ s ⊆ t ⊼ s ⊻ u ⊼ s :=
  image₂_distrib_subset_right fun _ _ _ => inf_sup_right
#align finset.infs_sups_subset_right Finset.infs_sups_subset_right

end DistribLattice

section DisjSups

variable [SemilatticeSup α] [OrderBot α] [@DecidableRel α Disjoint] (s s₁ s₂ t t₁ t₂ u : Finset α)

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t` and `a` and `b` are disjoint.
-/
def disjSups : Finset α :=
  ((s ×ˢ t).filterₓ fun ab : α × α => Disjoint ab.1 ab.2).image fun ab => ab.1 ⊔ ab.2
#align finset.disj_sups Finset.disjSups

-- mathport name: finset.disj_sups
scoped[FinsetFamily] infixl:74 " ○ " => Finset.disjSups

variable {s t u} {a b c : α}

@[simp]
theorem mem_disjSups : c ∈ s ○ t ↔ ∃ a ∈ s, ∃ b ∈ t, Disjoint a b ∧ a ⊔ b = c := by
  simp [disj_sups, and_assoc']
#align finset.mem_disj_sups Finset.mem_disjSups

theorem disjSups_subset_sups : s ○ t ⊆ s ⊻ t :=
  by
  simp_rw [subset_iff, mem_sups, mem_disj_sups]
  exact fun c ⟨a, b, ha, hb, h, hc⟩ => ⟨a, b, ha, hb, hc⟩
#align finset.disj_sups_subset_sups Finset.disjSups_subset_sups

variable (s t)

theorem card_disjSups_le : (s ○ t).card ≤ s.card * t.card :=
  (card_le_of_subset disjSups_subset_sups).trans <| card_sups_le _ _
#align finset.card_disj_sups_le Finset.card_disjSups_le

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

theorem disjSups_subset (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ○ t₁ ⊆ s₂ ○ t₂ :=
  image_subset_image <| filter_subset_filter _ <| product_subset_product hs ht
#align finset.disj_sups_subset Finset.disjSups_subset

theorem disjSups_subset_left (ht : t₁ ⊆ t₂) : s ○ t₁ ⊆ s ○ t₂ :=
  disjSups_subset Subset.rfl ht
#align finset.disj_sups_subset_left Finset.disjSups_subset_left

theorem disjSups_subset_right (hs : s₁ ⊆ s₂) : s₁ ○ t ⊆ s₂ ○ t :=
  disjSups_subset hs Subset.rfl
#align finset.disj_sups_subset_right Finset.disjSups_subset_right

theorem forall_disjSups_iff {p : α → Prop} :
    (∀ c ∈ s ○ t, p c) ↔ ∀ a ∈ s, ∀ b ∈ t, Disjoint a b → p (a ⊔ b) :=
  by
  simp_rw [mem_disj_sups]
  refine' ⟨fun h a ha b hb hab => h _ ⟨_, ha, _, hb, hab, rfl⟩, _⟩
  rintro h _ ⟨a, ha, b, hb, hab, rfl⟩
  exact h _ ha _ hb hab
#align finset.forall_disj_sups_iff Finset.forall_disjSups_iff

@[simp]
theorem disjSups_subset_iff : s ○ t ⊆ u ↔ ∀ a ∈ s, ∀ b ∈ t, Disjoint a b → a ⊔ b ∈ u :=
  forall_disjSups_iff
#align finset.disj_sups_subset_iff Finset.disjSups_subset_iff

theorem Nonempty.of_disjSups_left : (s ○ t).Nonempty → s.Nonempty :=
  by
  simp_rw [Finset.Nonempty, mem_disj_sups]
  exact fun ⟨_, a, ha, _⟩ => ⟨a, ha⟩
#align finset.nonempty.of_disj_sups_left Finset.Nonempty.of_disjSups_left

theorem Nonempty.of_disjSups_right : (s ○ t).Nonempty → t.Nonempty :=
  by
  simp_rw [Finset.Nonempty, mem_disj_sups]
  exact fun ⟨_, _, _, b, hb, _⟩ => ⟨b, hb⟩
#align finset.nonempty.of_disj_sups_right Finset.Nonempty.of_disjSups_right

@[simp]
theorem disjSups_empty_left : ∅ ○ t = ∅ := by simp [disj_sups]
#align finset.disj_sups_empty_left Finset.disjSups_empty_left

@[simp]
theorem disjSups_empty_right : s ○ ∅ = ∅ := by simp [disj_sups]
#align finset.disj_sups_empty_right Finset.disjSups_empty_right

theorem disjSups_singleton : ({a} ○ {b} : Finset α) = if Disjoint a b then {a ⊔ b} else ∅ := by
  split_ifs <;> simp [disj_sups, filter_singleton, h]
#align finset.disj_sups_singleton Finset.disjSups_singleton

theorem disjSups_union_left : (s₁ ∪ s₂) ○ t = s₁ ○ t ∪ s₂ ○ t := by
  simp [disj_sups, filter_union, image_union]
#align finset.disj_sups_union_left Finset.disjSups_union_left

theorem disjSups_union_right : s ○ (t₁ ∪ t₂) = s ○ t₁ ∪ s ○ t₂ := by
  simp [disj_sups, filter_union, image_union]
#align finset.disj_sups_union_right Finset.disjSups_union_right

theorem disjSups_inter_subset_left : (s₁ ∩ s₂) ○ t ⊆ s₁ ○ t ∩ s₂ ○ t := by
  simpa only [disj_sups, inter_product, filter_inter_distrib] using image_inter_subset _ _ _
#align finset.disj_sups_inter_subset_left Finset.disjSups_inter_subset_left

theorem disjSups_inter_subset_right : s ○ (t₁ ∩ t₂) ⊆ s ○ t₁ ∩ s ○ t₂ := by
  simpa only [disj_sups, product_inter, filter_inter_distrib] using image_inter_subset _ _ _
#align finset.disj_sups_inter_subset_right Finset.disjSups_inter_subset_right

variable (s t)

theorem disjSups_comm : s ○ t = t ○ s := by
  ext
  rw [mem_disj_sups, exists₂_comm]
  simp [sup_comm, disjoint_comm]
#align finset.disj_sups_comm Finset.disjSups_comm

end DisjSups

open FinsetFamily

section DistribLattice

variable [DistribLattice α] [OrderBot α] [@DecidableRel α Disjoint] (s t u v : Finset α)

theorem disjSups_assoc : ∀ s t u : Finset α, s ○ t ○ u = s ○ (t ○ u) :=
  by
  refine' associative_of_commutative_of_le disj_sups_comm _
  simp only [le_eq_subset, disj_sups_subset_iff, mem_disj_sups]
  rintro s t u _ ⟨a, ha, b, hb, hab, rfl⟩ c hc habc
  rw [disjoint_sup_left] at habc
  exact ⟨a, ha, _, ⟨b, hb, c, hc, habc.2, rfl⟩, hab.sup_right habc.1, sup_assoc.symm⟩
#align finset.disj_sups_assoc Finset.disjSups_assoc

theorem disjSups_left_comm : s ○ (t ○ u) = t ○ (s ○ u) := by
  simp_rw [← disj_sups_assoc, disj_sups_comm s]
#align finset.disj_sups_left_comm Finset.disjSups_left_comm

theorem disjSups_right_comm : s ○ t ○ u = s ○ u ○ t := by simp_rw [disj_sups_assoc, disj_sups_comm]
#align finset.disj_sups_right_comm Finset.disjSups_right_comm

theorem disjSups_disjSups_disjSups_comm : s ○ t ○ (u ○ v) = s ○ u ○ (t ○ v) := by
  simp_rw [← disj_sups_assoc, disj_sups_right_comm]
#align finset.disj_sups_disj_sups_disj_sups_comm Finset.disjSups_disjSups_disjSups_comm

end DistribLattice

end Finset


variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from ⟨(and.right h), (and.left h)⟩)
  (assume h : q ∧ p,
    show p ∧ q, from ⟨(and.right h), (and.left h)⟩)

example : p ∨ q ↔ q ∨ p :=
iff.intro
  (assume h : p ∨ q,
    or.elim h
      (assume hp : p,
        show q ∨ p, from or.inr hp)
      (assume hq : q,
        show q ∨ p, from or.inl hq))
  (assume h : q ∨ p,
    or.elim h
      (assume hq : q,
        show p ∨ q, from or.inr hq)
      (assume hp : p,
        show p ∨ q, from or.inl hp))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro
    (assume h : (p ∧ q) ∧ r,
        have hpq : p ∧ q, from and.left h,
        show p ∧ (q ∧ r), from
            ⟨and.left hpq, ⟨and.right hpq, and.right h⟩⟩)
    (assume h : p ∧ (q ∧ r),
        have hqr : q ∧ r, from and.right h,
        show (p ∧ q) ∧ r, from
            ⟨⟨and.left h, and.left hqr⟩, and.right hqr⟩)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
    (assume h : (p ∨ q) ∨ r,
        show p ∨ (q ∨ r), from
        or.elim h
            (assume hpq : p ∨ q,
                or.elim hpq
                    (assume hp : p, or.inl hp)
                    (assume hq : q, or.inr (or.inl hq)))
            (assume hr : r,
                or.inr (or.inr hr)))
    (assume h : p ∨ (q ∨ r),
        show (p ∨ q) ∨ r, from
        or.elim h
            (assume hp : p, or.inl (or.inl hp))
            (assume hqr : q ∨ r,
                or.elim hqr
                    (assume hq : q, or.inl (or.inr hq))
                    (assume hr : r, or.inr hr)))

-- distributivity

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
    (assume h : p ∧ (q ∨ r),
        show (p ∧ q) ∨ (p ∧ r), from
        have hp : p, from and.left h,
        or.elim (and.right h)
            (assume hq : q, or.inl ⟨hp, hq⟩)
            (assume hr : r, or.inr ⟨hp, hr⟩))
    (assume h: (p ∧ q) ∨ (p ∧ r),
        show p ∧ (q ∨ r), from
        or.elim h
            (assume hpq : p ∧ q, ⟨and.left hpq, or.inl (and.right hpq)⟩)
            (assume hpr : p ∧ r, ⟨and.left hpr, or.inr (and.right hpr)⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
    (assume h : p ∨ (q ∧ r),
        show (p ∨ q) ∧ (p ∨ r), from
        or.elim h
            (assume hp : p, ⟨or.inl hp, or.inl hp⟩)
            (assume hqr : q ∧ r,
                have hq : q, from hqr.left,
                have hr : r, from hqr.right,
                ⟨or.inr hq, or.inr hr⟩))
    (assume h : (p ∨ q) ∧ (p ∨ r),
        show p ∨ (q ∧ r), from
        have hpq : p ∨ q, from h.left,
        have hpr : p ∨ r, from h.right,
        or.elim hpq
            (assume hp : p, or.inl hp)
            (assume hq : q,
                or.elim hpr
                    (assume hp : p, or.inl hp)
                    (assume hr : r, or.inr ⟨hq, hr⟩)))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
iff.intro
    (assume h : (p → (q → r)),
        show (p ∧ q → r), from
        assume hpq : p ∧ q,
            h hpq.left hpq.right)
    (assume h : (p ∧ q → r),
        show (p → (q → r)), from
        assume hp : p,
            assume hq : q,
                h ⟨hp, hq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro
    (assume h : ((p ∨ q) → r),
        show (p → r) ∧ (q → r), from
        and.intro
            (assume hp : p, h (or.inl hp))
            (assume hq : q, h (or.inr hq)))
    (assume h : (p → r) ∧ (q → r),
        show ((p ∨ q) → r), from
        assume hpq : p ∨ q,
            or.elim hpq
                (assume hp : p, h.left hp)
                (assume hq : q, h.right hq))

theorem dem1 : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro
    (assume h : ¬(p ∨ q),
        show ¬p ∧ ¬q, from
        and.intro
            (show ¬p, from
                (assume hp : p, h (or.inl hp)))
            (show ¬q, from
                (assume hq : q, h (or.inr hq))))
    (assume h : ¬p ∧ ¬q,
        show ¬(p ∨ q), from
        (assume hpq : p ∨ q,
            or.elim hpq
                (assume hp : p, absurd hp h.left)
                (assume hq : q, absurd hq h.right)))

theorem dem2 : ¬p ∨ ¬q → ¬(p ∧ q) :=
assume h : ¬p ∨ ¬q,
    show ¬(p ∧ q), from
    (assume hpq : p ∧ q,
        or.elim h
            (assume hnp : ¬p, absurd hpq.left hnp)
            (assume hnq : ¬q, absurd hpq.right hnq))

example : ¬(p ∧ ¬p) :=
show ¬(p ∧ ¬p), from
assume hpnp : p ∧ ¬p,
    absurd hpnp.left hpnp.right

example : p ∧ ¬q → ¬(p → q) :=
assume h : p ∧ ¬q,
    show ¬(p → q), from
    assume hnpiq : p → q,
        absurd (hnpiq h.left) h.right

example : ¬p → (p → q) :=
assume hnp : ¬p,
    show p → q, from
    assume hp : p,
        absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
assume h : (¬p ∨ q),
    show (p → q), from
    (assume hp : p,
        or.elim h
            (assume hnp : ¬p, absurd hp hnp)
            (assume hq : q, hq))

example : p ∨ false ↔ p :=
iff.intro
    (assume h : p ∨ false,
        show p, from
        or.elim h
            (assume hp : p, hp)
            false.elim)
    (assume hp : p,
        show p ∨ false, from
        or.inl hp)

example : p ∧ false ↔ false :=
iff.intro
    (assume h : p ∧ false,
        show false, from
        h.right)
    false.elim

-- with classical (because couldn't figure out how to do it without, for a while)
-- p ¬(p ↔ ¬p)
-- 1         1
-- 0         1
example : ¬(p ↔ ¬p) :=
assume hneg : p ↔ ¬p,
or.elim (classical.em p)
    (assume hp : p,
        absurd hp (hneg.mp hp))
    (assume hnp : ¬p,
        absurd (hneg.mpr hnp) hnp)

-- without classical
example : ¬(p ↔ ¬p) :=
assume h : p ↔ ¬p,
have hnp : ¬p, from
    (show p → false, from
        assume hp : p,
        absurd hp (h.mp hp)),
absurd (h.mpr hnp) hnp

example : (p → q) → (¬q → ¬p) :=
assume h : p → q,
show ¬q → ¬p, from -- (q → false) → (p → false)
    assume hnq : ¬q,
    show ¬p, from
    assume hp : p,
        absurd (h hp) hnq

-- these require classical reasoning
open classical

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume h : p → r ∨ s,
show (p → r) ∨ (p → s), from
or.elim (em p)
    (assume hp : p,
        have hrs : r ∨ s, from h hp,
        or.elim hrs
            (assume hr : r,
                show (p → r) ∨ (p → s), from
                suffices hpr : p → r, from or.inl hpr,
                show (p → r), from
                assume hp : p, hr)
            (assume hs : s,
                show (p → r) ∨ (p → s), from
                suffices hps : p → s, from or.inr hps,
                show (p → s), from
                assume hp : p, hs))
    (assume hnp : ¬p,
        show (p → r) ∨ (p → s), from
        suffices hpr : p → r, from or.inl hpr,
        show (p → r), from
        assume hp : p, absurd hp hnp)

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
assume h : ¬(p ∧ q),
show ¬p ∨ ¬q, from
or.elim (em p)
    (assume hp : p,
        or.elim (em q)
            (assume hq : q,
                show ¬p ∨ ¬q, from
                false.elim (h ⟨hp, hq⟩))
            or.inr)
    or.inl

example : ¬(p → q) → p ∧ ¬q :=
assume h : ¬(p → q),
show p ∧ ¬q, from
or.elim (em q)
    (assume hq : q,
        suffices hneg : p → q, from false.elim (h hneg),
        assume hp : p, hq)
    (assume hnq : ¬q,
        or.elim (em p)
            (assume hp : p, ⟨hp, hnq⟩)
            (assume hnp : ¬p,
                suffices hneg : p → q, from false.elim (h hneg),
                assume hp : p, absurd hp hnp))

-- p q ¬p ∨ q
-- 1 1      1
-- 1 0      0
-- 0 1      1
-- 0 0      1
example : (p → q) → (¬p ∨ q) :=
assume h : p → q,
show ¬p ∨ q, from
or.elim (em q)
    (assume hq : q,
        or.inr hq)
    (assume hnq : ¬q,
        show ¬p ∨ q, from
        or.elim (em p)
            (assume hp : p,
                absurd (h hp) hnq)
            (assume hnp : ¬p,
                or.inl hnp))

-- p q ¬q → ¬p p → q
-- 1 1       1     1
-- 1 0       0     0
-- 0 1       1     1
-- 0 0       1     1
example : (¬q → ¬p) → (p → q) :=
assume h : ¬q → ¬p,
show p → q, from
or.elim (em p)
    (assume hp : p,
        or.elim (em q)
            (assume hq : q,
                show p → q, from
                assume hp : p, hq)
            (assume hnq : ¬q,
                suffices hneg : ¬(¬q → ¬p), from absurd h hneg,
                absurd hp (h hnq)))
    (assume hnp : ¬p,
        assume hp : p, absurd hp hnp)

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
assume h1 : (p → q) → p,
show p, from
or.elim (em p)
    id
    (assume hnp : ¬p,
        have hpq : p → q, from (assume hp : p, absurd hp hnp),
        absurd (h1 hpq) hnp)


import algebra.euclidean_domain ring_theory.ideals
universes u v
variables {α : Type u} {β : Type v} [comm_ring α] {a b : α}
open set function
local attribute [instance] classical.prop_decidable

class is_principal_ideal {α : Type u} [comm_ring α] (S : set α) : Prop :=
(principal : ∃ a : α, S = {x | a ∣ x})

class principal_ideal_domain (α : Type*) extends integral_domain α :=
(principal : ∀ (S : set α) [is_ideal S], is_principal_ideal S)

namespace is_principal_ideal.to_is_ideal

protected lemma zero (S : set α) [is_principal_ideal S] : (0 : α) ∈ S :=
begin
  cases is_principal_ideal.principal S,
  rw[h],
  have H1 : w ∣ 0,
  { exact dvd_zero w },
  exact H1
end

protected lemma add {S : set α} [is_principal_ideal S] : ∀ {x y : α}, x ∈ S → y ∈ S → x + y ∈ S :=
begin
  intros,
  cases is_principal_ideal.principal S,
  rw[h],
  rw[h] at a_1,
  rw[h] at a,
  exact dvd_add a a_1,
end
protected lemma smul {S : set α} [is_principal_ideal S] : ∀ (c : α) {x : α}, x ∈ S → c • x ∈ S :=
begin
  intros,
  cases is_principal_ideal.principal S,
  rw[h],
  show c * x ∈ {x : α | w ∣ x},
  rw[h] at a,
  exact dvd_mul_of_dvd_right a c,
end
instance is_principal_ideal.to_is_ideal {α : Type u} [comm_ring α] (S : set α) [is_principal_ideal S] : is_ideal S :=
{ to_is_submodule :=
begin
split,
{ exact is_principal_ideal.to_is_ideal.zero S},
{ exact @is_principal_ideal.to_is_ideal.add _ _ _ _ },
{ exact @is_principal_ideal.to_is_ideal.smul _ _ _ _ },
end
}
end is_principal_ideal.to_is_ideal

instance euclidean_domain.to_principal_ideal_domain {α : Type u} [euclidean_domain α]
: principal_ideal_domain α :=
{ principal :=
  begin
    intros,
    resetI,
    split,
    have H1 : well_founded (euclidean_domain.r : α → α → Prop),
    { exact euclidean_domain.r_well_founded α },
    let L := set.diff S {x | x = 0},
    by_cases L ≠ ∅ ,
    { have H6 : well_founded.min H1 L h ∈ S,
        { have h : well_founded.min H1 L h ∈ L,
          { exact well_founded.min_mem H1 L h },
        simp[L] at h,
        unfold set.diff at h,
        exact h.1,
        },
      existsi well_founded.min H1 L h,
      have H4 : S ⊆ {x : α | well_founded.min H1 L h ∣ x},
      { intro x,
        intro,
        show well_founded.min H1 L h ∣ x,
        have H4 : (well_founded.min H1 L h) * euclidean_domain.quotient x (well_founded.min H1 L h)
        + euclidean_domain.remainder x (well_founded.min H1 L h) = x,
        { exact euclidean_domain.quotient_mul_add_remainder_eq x (well_founded.min H1 L h) },
        rw[add_comm] at H4,
        have H5 : euclidean_domain.remainder x (well_founded.min H1 L h) = x - well_founded.min H1 L h * euclidean_domain.quotient x (well_founded.min H1 L h),
        { rw[eq_add_neg_of_add_eq H4], refl },
        have H7 : well_founded.min H1 L h * euclidean_domain.quotient x (well_founded.min H1 L h) ∈ S,
        { exact is_ideal.mul_right H6 },
        have H8 : euclidean_domain.remainder x (well_founded.min H1 L h) ∈ S,
        { rw[H5], exact is_ideal.sub a H7 },
        by_cases h' :  euclidean_domain.remainder x (well_founded.min H1 L h) = 0,
        { rw[h'] at H4,
          simp at H4,
          exact dvd.intro (euclidean_domain.quotient x (well_founded.min H1 L h)) H4 },
        replace h' : euclidean_domain.remainder x (well_founded.min H1 L h) ≠ 0 := h',
        have H9 : euclidean_domain.remainder x (well_founded.min H1 L h) ∈ L,
        { simp[L],
          unfold set.diff,
          exact ⟨ H8,
          begin
            intro,
            have h : euclidean_domain.remainder x (well_founded.min H1 L h) = 0,
            { exact a_1},
            contradiction,
          end⟩ } ,
          have H10 : ¬  (well_founded.min H1 L h) = 0,
          { exact (well_founded.min_mem H1 L h).2 },
          replace H10 : well_founded.min H1 L h ≠  0 := H10,
          have H11 : euclidean_domain.r (euclidean_domain.remainder x (well_founded.min H1 L h)) (well_founded.min H1 L h),
          { exact euclidean_domain.remainder_lt x H10 },
          have H12 : ¬ euclidean_domain.r (euclidean_domain.remainder x (well_founded.min H1 L h)) (well_founded.min H1 L h),
          { exact well_founded.not_lt_min H1 L h H9 },
          contradiction },
       have H5 : {x : α | well_founded.min H1 L h ∣ x} ⊆ S,
       { intro x,
         intro,
         have H6 : ∃ c : α , x = c * well_founded.min H1 L h ,
         { exact exists_eq_mul_left_of_dvd a },
         cases H6,
         rw[H6_h],
         exact is_ideal.mul_left H6 },
        exact set.subset.antisymm H4 H5 },
    { simp at h,
      have h3 : S ≠ ∅ → L = ∅ → S = {x : α | x = 0},
      { simp [L, set.ext_iff, set.diff, iff_def, is_ideal.zero S] {contextual := tt},
      finish },
      have h4 : ∃ x, x ∈ S,
      { existsi (0 : α),
       exact is_ideal.zero S },
      have h5 : S ≠ ∅ ,
      { exact ne_empty_iff_exists_mem.2 h4} ,
      have h6 :  S = {x : α | x = 0},
      { exact h3 h5 h },
      existsi (0 : α),
      rw[h6],
      congr,
      funext,
      apply propext,
      split,
      { intro,
        rw[a]
      },
     intro,
     have h6 : ∃ a, x = 0 * a,
     {  exact exists_eq_mul_right_of_dvd a },
     cases h6,
     simp[h6_h],
    }

end

}
#check dvd.elim
--#check set.subset.antisymm
#check ne_empty_iff_exists_mem


import algebra.group.basic
import data.real.basic data.set.image
import combinatorics.simple_graph.basic data.matrix.basic combinatorics.pigeonhole data.finset.card data.finset.basic

/- Define latin square object-/
structure latin_square (n : ℕ) :=
(square : matrix (fin n) (fin n) (fin n))
(is_latin : ∀ i j k : fin n, square i j ≠ square i k ∧
                             square j i ≠ square k i)

def specify (α β γ : Type) (f : α → β → γ) (a : α) : β → γ := f a

-- example (n : ℕ) (s : latin_square n) (i : fin n) :
--   ∀ j : fin n, ∃ k : fin n, s.square j k = i :=

theorem all_entrys_appears (n : ℕ) (s : latin_square n) (i : fin n) :
  ∀ j : fin n, ∃ k : fin n, s.square j k = i :=
begin
  intro j,
  by_contra,
  push_neg at h,
  have square_j := specify (fin n) (fin n) (fin n) s.square j,
  have image_ssub_domain : (square_j '' set.univ) ⊂ set.univ,
  {
    rw set.ssubset_def,
    split,
    {
      rw set.subset_def,
      intro x,
      simp,
    },
    {
      rw set.subset_def,
      push_neg,
      use i,
      split,
      {
        simp,
      },
      {
        intro h1,
        -- hence there exist y st square j y = i
        rcases (set.mem_image square_j set.univ i).mp h1 with ⟨ x, xin_univ, hx ⟩,
        specialize h x,

      },
    },
  },
end