/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot
-/

import tactic.apply_fun
import data.set.pairwise
import topology.uniform_space.basic
import topology.separation

/-!
# Hausdorff properties of uniform spaces. Separation quotient.

This file studies uniform spaces whose underlying topological spaces are separated
(also known as Hausdorff or T₂).
This turns out to be equivalent to asking that the intersection of all entourages
is the diagonal only. This condition actually implies the stronger separation property
that the space is regular (T₃), hence those conditions are equivalent for topologies coming from
a uniform structure.

More generally, the intersection `𝓢 X` of all entourages of `X`, which has type `set (X × X)` is an
equivalence relation on `X`. Points which are equivalent under the relation are basically
undistinguishable from the point of view of the uniform structure. For instance any uniformly
continuous function will send equivalent points to the same value.

The quotient `separation_quotient X` of `X` by `𝓢 X` has a natural uniform structure which is
separated, and satisfies a universal property: every uniformly continuous function
from `X` to a separated uniform space uniquely factors through `separation_quotient X`.
As usual, this allows to turn `separation_quotient` into a functor (but we don't use the
category theory library in this file).

These notions admit relative versions, one can ask that `s : set X` is separated, this
is equivalent to asking that the uniform structure induced on `s` is separated.

## Main definitions

* `separation_relation X : set (X × X)`: the separation relation
* `separated_space X`: a predicate class asserting that `X` is separated
* `is_separated s`: a predicate asserting that `s : set X` is separated
* `separation_quotient X`: the maximal separated quotient of `X`.
* `separation_quotient.lift f`: factors a map `f : X → Y` through the separation quotient of `X`.
* `separation_quotient.map f`: turns a map `f : X → Y` into a map between the separation quotients
  of `X` and `Y`.

## Main results

* `separated_iff_t2`: the equivalence between being separated and being Hausdorff for uniform
  spaces.
* `separation_quotient.uniform_continuous_lift`: factoring a uniformly continuous map through the
  separation quotient gives a uniformly continuous map.
* `separation_quotient.uniform_continuous_map`: maps induced between separation quotients are
  uniformly continuous.

## Notations

Localized in `uniformity`, we have the notation `𝓢 X` for the separation relation
on a uniform space `X`,

## Implementation notes

The separation setoid `separation_setoid` is not declared as a global instance.
It is made a local instance while building the theory of `separation_quotient`.
The factored map `separation_quotient.lift f` is defined without imposing any condition on
`f`, but returns junk if `f` is not uniformly continuous (constant junk hence it is always
uniformly continuous).

-/

open filter topological_space set classical function uniform_space
open_locale classical topological_space uniformity filter
noncomputable theory
set_option eqn_compiler.zeta true

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}
variables [uniform_space α] [uniform_space β] [uniform_space γ]

/-!
### Separated uniform spaces
-/

/-- The separation relation is the intersection of all entourages.
  Two points which are related by the separation relation are "indistinguishable"
  according to the uniform structure. -/
protected def separation_rel (α : Type u) [u : uniform_space α] :=
⋂₀ (𝓤 α).sets

localized "notation `𝓢` := separation_rel" in uniformity

lemma separated_equiv : equivalence (λx y, (x, y) ∈ 𝓢 α) :=
⟨assume x, assume s, refl_mem_uniformity,
  assume x y, assume h (s : set (α×α)) hs,
    have preimage prod.swap s ∈ 𝓤 α,
      from symm_le_uniformity hs,
    h _ this,
  assume x y z (hxy : (x, y) ∈ 𝓢 α) (hyz : (y, z) ∈ 𝓢 α)
      s (hs : s ∈ 𝓤 α),
    let ⟨t, ht, (h_ts : comp_rel t t ⊆ s)⟩ := comp_mem_uniformity_sets hs in
    h_ts $ show (x, z) ∈ comp_rel t t,
      from ⟨y, hxy t ht, hyz t ht⟩⟩

/-- A uniform space is separated if its separation relation is trivial (each point
is related only to itself). -/
class separated_space (α : Type u) [uniform_space α] : Prop := (out : 𝓢 α = id_rel)

theorem separated_space_iff {α : Type u} [uniform_space α] :
  separated_space α ↔ 𝓢 α = id_rel :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem separated_def {α : Type u} [uniform_space α] :
  separated_space α ↔ ∀ x y, (∀ r ∈ 𝓤 α, (x, y) ∈ r) → x = y :=
by simp [separated_space_iff, id_rel_subset.2 separated_equiv.1, subset.antisymm_iff];
   simp [subset_def, separation_rel]

theorem separated_def' {α : Type u} [uniform_space α] :
  separated_space α ↔ ∀ x y, x ≠ y → ∃ r ∈ 𝓤 α, (x, y) ∉ r :=
separated_def.trans $ forall_congr $ λ x, forall_congr $ λ y,
by rw ← not_imp_not; simp [not_forall]

lemma eq_of_uniformity {α : Type*} [uniform_space α] [separated_space α] {x y : α}
  (h : ∀ {V}, V ∈ 𝓤 α → (x, y) ∈ V) : x = y :=
separated_def.mp ‹separated_space α› x y (λ _, h)

lemma eq_of_uniformity_basis {α : Type*} [uniform_space α] [separated_space α] {ι : Type*}
  {p : ι → Prop} {s : ι → set (α × α)} (hs : (𝓤 α).has_basis p s) {x y : α}
  (h : ∀ {i}, p i → (x, y) ∈ s i) : x = y :=
eq_of_uniformity (λ V V_in, let ⟨i, hi, H⟩ := hs.mem_iff.mp V_in in H (h hi))

lemma eq_of_forall_symmetric {α : Type*} [uniform_space α] [separated_space α] {x y : α}
  (h : ∀ {V}, V ∈ 𝓤 α → symmetric_rel V → (x, y) ∈ V) : x = y :=
eq_of_uniformity_basis has_basis_symmetric (by simpa [and_imp] using λ _, h)

lemma id_rel_sub_separation_relation (α : Type*) [uniform_space α] : id_rel ⊆ 𝓢 α :=
begin
  unfold separation_rel,
  rw id_rel_subset,
  intros x,
  suffices : ∀ t ∈ 𝓤 α, (x, x) ∈ t, by simpa only [refl_mem_uniformity],
  exact λ t, refl_mem_uniformity,
end

lemma separation_rel_comap  {f : α → β}
  (h : ‹uniform_space α› = uniform_space.comap f ‹uniform_space β›) :
  𝓢 α = (prod.map f f) ⁻¹' 𝓢 β :=
begin
  dsimp [separation_rel],
  simp_rw [uniformity_comap h, (filter.comap_has_basis (prod.map f f) (𝓤 β)).sInter_sets,
      ← preimage_Inter, sInter_eq_bInter],
  refl,
end

protected lemma filter.has_basis.separation_rel {ι : Sort*} {p : ι → Prop} {s : ι → set (α × α)}
  (h : has_basis (𝓤 α) p s) :
  𝓢 α = ⋂ i (hi : p i), s i :=
by { unfold separation_rel, rw h.sInter_sets }

lemma separation_rel_eq_inter_closure : 𝓢 α = ⋂₀ (closure '' (𝓤 α).sets) :=
by simp [uniformity_has_basis_closure.separation_rel]

lemma is_closed_separation_rel : is_closed (𝓢 α) :=
begin
  rw separation_rel_eq_inter_closure,
  apply is_closed_sInter,
  rintros _ ⟨t, t_in, rfl⟩,
  exact is_closed_closure,
end

lemma separated_iff_t2 : separated_space α ↔ t2_space α :=
begin
  classical,
  split ; introI h,
  { rw [t2_iff_is_closed_diagonal, ← show 𝓢 α = diagonal α, from h.1],
    exact is_closed_separation_rel },
  { rw separated_def',
    intros x y hxy,
    rcases t2_separation hxy with ⟨u, v, uo, vo, hx, hy, h⟩,
    rcases is_open_iff_ball_subset.1 uo x hx with ⟨r, hrU, hr⟩,
    exact ⟨r, hrU, λ H, disjoint_iff.2 h ⟨hr H, hy⟩⟩ }
end

@[priority 100] -- see Note [lower instance priority]
instance separated_regular [separated_space α] : regular_space α :=
{ t0 := by { haveI := separated_iff_t2.mp ‹_›, exact t1_space.t0_space.t0 },
  regular := λs a hs ha,
    have sᶜ ∈ 𝓝 a,
      from is_open.mem_nhds hs.is_open_compl ha,
    have {p : α × α | p.1 = a → p.2 ∈ sᶜ} ∈ 𝓤 α,
      from mem_nhds_uniformity_iff_right.mp this,
    let ⟨d, hd, h⟩ := comp_mem_uniformity_sets this in
    let e := {y:α| (a, y) ∈ d} in
    have hae : a ∈ closure e, from subset_closure $ refl_mem_uniformity hd,
    have set.prod (closure e) (closure e) ⊆ comp_rel d (comp_rel (set.prod e e) d),
    begin
      rw [←closure_prod_eq, closure_eq_inter_uniformity],
      change (⨅d' ∈ 𝓤 α, _) ≤ comp_rel d (comp_rel _ d),
      exact (infi_le_of_le d $ infi_le_of_le hd $ le_refl _)
    end,
    have e_subset : closure e ⊆ sᶜ,
      from assume a' ha',
        let ⟨x, (hx : (a, x) ∈ d), y, ⟨hx₁, hx₂⟩, (hy : (y, _) ∈ d)⟩ := @this ⟨a, a'⟩ ⟨hae, ha'⟩ in
        have (a, a') ∈ comp_rel d d, from ⟨y, hx₂, hy⟩,
        h this rfl,
    have closure e ∈ 𝓝 a, from (𝓝 a).sets_of_superset (mem_nhds_left a hd) subset_closure,
    have 𝓝 a ⊓ 𝓟 (closure e)ᶜ = ⊥,
      from (is_compl_principal (closure e)).inf_right_eq_bot_iff.2 (le_principal_iff.2 this),
    ⟨(closure e)ᶜ, is_closed_closure.is_open_compl, assume x h₁ h₂, @e_subset x h₂ h₁, this⟩,
    ..@t2_space.t1_space _ _ (separated_iff_t2.mp ‹_›) }

lemma is_closed_of_spaced_out [separated_space α] {V₀ : set (α × α)} (V₀_in : V₀ ∈ 𝓤 α)
  {s : set α} (hs : s.pairwise (λ x y, (x, y) ∉ V₀)) : is_closed s :=
begin
  rcases comp_symm_mem_uniformity_sets V₀_in with ⟨V₁, V₁_in, V₁_symm, h_comp⟩,
  apply is_closed_of_closure_subset,
  intros x hx,
  rw mem_closure_iff_ball at hx,
  rcases hx V₁_in with ⟨y, hy, hy'⟩,
  suffices : x = y, by rwa this,
  apply eq_of_forall_symmetric,
  intros V V_in V_symm,
  rcases hx (inter_mem V₁_in V_in) with ⟨z, hz, hz'⟩,
  obtain rfl : z = y,
  { by_contra hzy,
    exact hs z hz' y hy' hzy (h_comp $ mem_comp_of_mem_ball V₁_symm
      (ball_inter_left x _ _ hz) hy) },
  exact ball_inter_right x _ _ hz
end

lemma is_closed_range_of_spaced_out {ι} [separated_space α] {V₀ : set (α × α)} (V₀_in : V₀ ∈ 𝓤 α)
  {f : ι → α} (hf : pairwise (λ x y, (f x, f y) ∉ V₀)) : is_closed (range f) :=
is_closed_of_spaced_out V₀_in $
  by { rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ h, exact hf x y (mt (congr_arg f) h) }

/-!
### Separated sets
-/

/-- A set `s` in a uniform space `α` is separated if the separation relation `𝓢 α`
induces the trivial relation on `s`. -/
def is_separated (s : set α) : Prop := ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y

lemma is_separated_def (s : set α) : is_separated s ↔ ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y :=
iff.rfl

lemma is_separated_def' (s : set α) : is_separated s ↔ (s.prod s) ∩ 𝓢 α ⊆ id_rel :=
begin
  rw is_separated_def,
  split,
  { rintros h ⟨x, y⟩ ⟨⟨x_in, y_in⟩, H⟩,
    simp [h x y x_in y_in H] },
  { intros h x y x_in y_in xy_in,
    rw ← mem_id_rel,
    exact h ⟨mk_mem_prod x_in y_in, xy_in⟩ }
end

lemma is_separated.mono {s t : set α} (hs : is_separated s) (hts : t ⊆ s) : is_separated t :=
λ x y hx hy, hs x y (hts hx) (hts hy)

lemma univ_separated_iff : is_separated (univ : set α) ↔ separated_space α :=
begin
  simp only [is_separated, mem_univ, true_implies_iff, separated_space_iff],
  split,
  { intro h,
    exact subset.antisymm (λ ⟨x, y⟩ xy_in, h x y xy_in) (id_rel_sub_separation_relation α), },
  { intros h x y xy_in,
    rwa h at xy_in },
end

lemma is_separated_of_separated_space [separated_space α] (s : set α) : is_separated s :=
begin
  rw [is_separated, separated_space.out],
  tauto,
end

lemma is_separated_iff_induced {s : set α} : is_separated s ↔ separated_space s :=
begin
  rw separated_space_iff,
  change _ ↔ 𝓢 {x // x ∈ s} = _,
  rw [separation_rel_comap rfl, is_separated_def'],
  split; intro h,
  { ext ⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩,
    suffices : (x, y) ∈ 𝓢 α ↔ x = y, by simpa only [mem_id_rel],
    refine ⟨λ H, h ⟨mk_mem_prod x_in y_in, H⟩, _⟩,
    rintro rfl,
    exact id_rel_sub_separation_relation α rfl },
  { rintros ⟨x, y⟩ ⟨⟨x_in, y_in⟩, hS⟩,
    have A : (⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩ : ↥s × ↥s) ∈ prod.map (coe : s → α) (coe : s → α) ⁻¹' 𝓢 α,
      from hS,
    simpa using h.subset A }
end

lemma eq_of_uniformity_inf_nhds_of_is_separated {s : set α} (hs : is_separated s) :
  ∀ {x y : α}, x ∈ s → y ∈ s → cluster_pt (x, y) (𝓤 α) → x = y :=
begin
  intros x y x_in y_in H,
  have : ∀ V ∈ 𝓤 α, (x, y) ∈ closure V,
  { intros V V_in,
    rw mem_closure_iff_cluster_pt,
    have : 𝓤 α ≤ 𝓟 V, by rwa le_principal_iff,
    exact H.mono this },
  apply hs x y x_in y_in,
  simpa [separation_rel_eq_inter_closure],
end

lemma eq_of_uniformity_inf_nhds [separated_space α] :
  ∀ {x y : α}, cluster_pt (x, y) (𝓤 α) → x = y :=
begin
  have : is_separated (univ : set α),
  { rw univ_separated_iff,
    assumption },
  introv,
  simpa using eq_of_uniformity_inf_nhds_of_is_separated this,
end

/-!
### Separation quotient
-/
namespace uniform_space

/-- The separation relation of a uniform space seen as a setoid. -/
def separation_setoid (α : Type u) [uniform_space α] : setoid α :=
⟨λx y, (x, y) ∈ 𝓢 α, separated_equiv⟩

local attribute [instance] separation_setoid

instance separation_setoid.uniform_space {α : Type u} [u : uniform_space α] :
  uniform_space (quotient (separation_setoid α)) :=
{ to_topological_space := u.to_topological_space.coinduced (λx, ⟦x⟧),
  uniformity := map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) u.uniformity,
  refl := le_trans (by simp [quotient.exists_rep]) (filter.map_mono refl_le_uniformity),
  symm := tendsto_map' $
    by simp [prod.swap, (∘)]; exact tendsto_map.comp tendsto_swap_uniformity,
  comp := calc (map (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) u.uniformity).lift' (λs, comp_rel s s) =
          u.uniformity.lift' ((λs, comp_rel s s) ∘ image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧))) :
      map_lift'_eq2 $ monotone_comp_rel monotone_id monotone_id
    ... ≤ u.uniformity.lift' (image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) ∘
            (λs:set (α×α), comp_rel s (comp_rel s s))) :
      lift'_mono' $ assume s hs ⟨a, b⟩ ⟨c, ⟨⟨a₁, a₂⟩, ha, a_eq⟩, ⟨⟨b₁, b₂⟩, hb, b_eq⟩⟩,
      begin
        simp at a_eq,
        simp at b_eq,
        have h : ⟦a₂⟧ = ⟦b₁⟧, { rw [a_eq.right, b_eq.left] },
        have h : (a₂, b₁) ∈ 𝓢 α := quotient.exact h,
        simp [function.comp, set.image, comp_rel, and.comm, and.left_comm, and.assoc],
        exact ⟨a₁, a_eq.left, b₂, b_eq.right, a₂, ha, b₁, h s hs, hb⟩
      end
    ... = map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧))
            (u.uniformity.lift' (λs:set (α×α), comp_rel s (comp_rel s s))) :
      by rw [map_lift'_eq];
        exact monotone_comp_rel monotone_id (monotone_comp_rel monotone_id monotone_id)
    ... ≤ map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) u.uniformity :
      map_mono comp_le_uniformity3,
  is_open_uniformity := assume s,
    have ∀a, ⟦a⟧ ∈ s →
        ({p:α×α | p.1 = a → ⟦p.2⟧ ∈ s} ∈ 𝓤 α ↔
          {p:α×α | p.1 ≈ a → ⟦p.2⟧ ∈ s} ∈ 𝓤 α),
      from assume a ha,
      ⟨assume h,
        let ⟨t, ht, hts⟩ := comp_mem_uniformity_sets h in
        have hts : ∀{a₁ a₂}, (a, a₁) ∈ t → (a₁, a₂) ∈ t → ⟦a₂⟧ ∈ s,
          from assume a₁ a₂ ha₁ ha₂, @hts (a, a₂) ⟨a₁, ha₁, ha₂⟩ rfl,
        have ht' : ∀{a₁ a₂}, a₁ ≈ a₂ → (a₁, a₂) ∈ t,
          from assume a₁ a₂ h, sInter_subset_of_mem ht h,
        u.uniformity.sets_of_superset ht $ assume ⟨a₁, a₂⟩ h₁ h₂, hts (ht' $ setoid.symm h₂) h₁,
        assume h, u.uniformity.sets_of_superset h $ by simp {contextual := tt}⟩,
    begin
      simp [topological_space.coinduced, u.is_open_uniformity, uniformity, forall_quotient_iff],
      exact ⟨λh a ha, (this a ha).mp $ h a ha, λh a ha, (this a ha).mpr $ h a ha⟩
    end }

lemma uniformity_quotient :
  𝓤 (quotient (separation_setoid α)) = (𝓤 α).map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) :=
rfl

lemma uniform_continuous_quotient_mk :
  uniform_continuous (quotient.mk : α → quotient (separation_setoid α)) :=
le_refl _

lemma uniform_continuous_quotient {f : quotient (separation_setoid α) → β}
  (hf : uniform_continuous (λx, f ⟦x⟧)) : uniform_continuous f :=
hf

lemma uniform_continuous_quotient_lift
  {f : α → β} {h : ∀a b, (a, b) ∈ 𝓢 α → f a = f b}
  (hf : uniform_continuous f) : uniform_continuous (λa, quotient.lift f h a) :=
uniform_continuous_quotient hf

lemma uniform_continuous_quotient_lift₂
  {f : α → β → γ} {h : ∀a c b d, (a, b) ∈ 𝓢 α → (c, d) ∈ 𝓢 β → f a c = f b d}
  (hf : uniform_continuous (λp:α×β, f p.1 p.2)) :
  uniform_continuous (λp:_×_, quotient.lift₂ f h p.1 p.2) :=
begin
  rw [uniform_continuous, uniformity_prod_eq_prod, uniformity_quotient, uniformity_quotient,
    filter.prod_map_map_eq, filter.tendsto_map'_iff, filter.tendsto_map'_iff],
  rwa [uniform_continuous, uniformity_prod_eq_prod, filter.tendsto_map'_iff] at hf
end

lemma comap_quotient_le_uniformity :
  (𝓤 $ quotient $ separation_setoid α).comap (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) ≤ (𝓤 α) :=
assume t' ht',
let ⟨t, ht, tt_t'⟩ := comp_mem_uniformity_sets ht' in
let ⟨s, hs, ss_t⟩ := comp_mem_uniformity_sets ht in
⟨(λp:α×α, (⟦p.1⟧, ⟦p.2⟧)) '' s,
  (𝓤 α).sets_of_superset hs $ assume x hx, ⟨x, hx, rfl⟩,
  assume ⟨a₁, a₂⟩ ⟨⟨b₁, b₂⟩, hb, ab_eq⟩,
  have ⟦b₁⟧ = ⟦a₁⟧ ∧ ⟦b₂⟧ = ⟦a₂⟧, from prod.mk.inj ab_eq,
  have b₁ ≈ a₁ ∧ b₂ ≈ a₂, from and.imp quotient.exact quotient.exact this,
  have ab₁ : (a₁, b₁) ∈ t, from (setoid.symm this.left) t ht,
  have ba₂ : (b₂, a₂) ∈ s, from this.right s hs,
  tt_t' ⟨b₁, show ((a₁, a₂).1, b₁) ∈ t, from ab₁,
    ss_t ⟨b₂, show ((b₁, a₂).1, b₂) ∈ s, from hb, ba₂⟩⟩⟩

lemma comap_quotient_eq_uniformity :
  (𝓤 $ quotient $ separation_setoid α).comap (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) = 𝓤 α :=
le_antisymm comap_quotient_le_uniformity le_comap_map

instance separated_separation : separated_space (quotient (separation_setoid α)) :=
⟨set.ext $ assume ⟨a, b⟩, quotient.induction_on₂ a b $ assume a b,
  ⟨assume h,
    have a ≈ b, from assume s hs,
      have s ∈ (𝓤 $ quotient $ separation_setoid α).comap (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)),
        from comap_quotient_le_uniformity hs,
      let ⟨t, ht, hts⟩ := this in
      hts begin dsimp [preimage], exact h t ht end,
    show ⟦a⟧ = ⟦b⟧, from quotient.sound this,

  assume heq : ⟦a⟧ = ⟦b⟧, assume h hs,
  heq ▸ refl_mem_uniformity hs⟩⟩

lemma separated_of_uniform_continuous {f : α → β} {x y : α}
  (H : uniform_continuous f) (h : x ≈ y) : f x ≈ f y :=
assume _ h', h _ (H h')

lemma eq_of_separated_of_uniform_continuous [separated_space β] {f : α → β} {x y : α}
  (H : uniform_continuous f) (h : x ≈ y) : f x = f y :=
separated_def.1 (by apply_instance) _ _ $ separated_of_uniform_continuous H h

lemma _root_.is_separated.eq_of_uniform_continuous {f : α → β} {x y : α} {s : set β}
  (hs : is_separated s) (hxs : f x ∈ s) (hys : f y ∈ s) (H : uniform_continuous f) (h : x ≈ y) :
  f x = f y :=
(is_separated_def _).mp hs _ _ hxs hys $ λ _ h', h _ (H h')

/-- The maximal separated quotient of a uniform space `α`. -/
def separation_quotient (α : Type*) [uniform_space α] := quotient (separation_setoid α)

namespace separation_quotient
instance : uniform_space (separation_quotient α) := by dunfold separation_quotient ; apply_instance
instance : separated_space (separation_quotient α) :=
  by dunfold separation_quotient ; apply_instance
instance [inhabited α] : inhabited (separation_quotient α) :=
by unfold separation_quotient; apply_instance

/-- Factoring functions to a separated space through the separation quotient. -/
def lift [separated_space β] (f : α → β) : (separation_quotient α → β) :=
if h : uniform_continuous f then
  quotient.lift f (λ x y, eq_of_separated_of_uniform_continuous h)
else
  λ x, f (nonempty.some ⟨x.out⟩)

lemma lift_mk [separated_space β] {f : α → β} (h : uniform_continuous f) (a : α) :
  lift f ⟦a⟧ = f a :=
by rw [lift, dif_pos h]; refl

lemma uniform_continuous_lift [separated_space β] (f : α → β) : uniform_continuous (lift f) :=
begin
  by_cases hf : uniform_continuous f,
  { rw [lift, dif_pos hf], exact uniform_continuous_quotient_lift hf },
  { rw [lift, dif_neg hf], exact uniform_continuous_of_const (assume a b, rfl) }
end

/-- The separation quotient functor acting on functions. -/
def map (f : α → β) : separation_quotient α → separation_quotient β :=
lift (quotient.mk ∘ f)

lemma map_mk {f : α → β} (h : uniform_continuous f) (a : α) : map f ⟦a⟧ = ⟦f a⟧ :=
by rw [map, lift_mk (uniform_continuous_quotient_mk.comp h)]

lemma uniform_continuous_map (f : α → β) : uniform_continuous (map f) :=
uniform_continuous_lift (quotient.mk ∘ f)

lemma map_unique {f : α → β} (hf : uniform_continuous f)
  {g : separation_quotient α → separation_quotient β}
  (comm : quotient.mk ∘ f = g ∘ quotient.mk) : map f = g :=
by ext ⟨a⟩;
calc map f ⟦a⟧ = ⟦f a⟧ : map_mk hf a
  ... = g ⟦a⟧ : congr_fun comm a

lemma map_id : map (@id α) = id :=
map_unique uniform_continuous_id rfl

lemma map_comp {f : α → β} {g : β → γ} (hf : uniform_continuous f) (hg : uniform_continuous g) :
  map g ∘ map f = map (g ∘ f) :=
(map_unique (hg.comp hf) $ by simp only [(∘), map_mk, hf, hg]).symm

end separation_quotient

lemma separation_prod {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) ≈ (a₂, b₂) ↔ a₁ ≈ a₂ ∧ b₁ ≈ b₂ :=
begin
  split,
  { assume h,
    exact ⟨separated_of_uniform_continuous uniform_continuous_fst h,
           separated_of_uniform_continuous uniform_continuous_snd h⟩ },
  { rintros ⟨eqv_α, eqv_β⟩ r r_in,
    rw uniformity_prod at r_in,
    rcases r_in with ⟨t_α, ⟨r_α, r_α_in, h_α⟩, t_β, ⟨r_β, r_β_in, h_β⟩, rfl⟩,
    let p_α := λ(p : (α × β) × (α × β)), (p.1.1, p.2.1),
    let p_β := λ(p : (α × β) × (α × β)), (p.1.2, p.2.2),
    have key_α : p_α ((a₁, b₁), (a₂, b₂)) ∈ r_α, { simp [p_α, eqv_α r_α r_α_in] },
    have key_β : p_β ((a₁, b₁), (a₂, b₂)) ∈ r_β, { simp [p_β, eqv_β r_β r_β_in] },
    exact ⟨h_α key_α, h_β key_β⟩ },
end

instance separated.prod [separated_space α] [separated_space β] : separated_space (α × β) :=
separated_def.2 $ assume x y H, prod.ext
  (eq_of_separated_of_uniform_continuous uniform_continuous_fst H)
  (eq_of_separated_of_uniform_continuous uniform_continuous_snd H)

lemma _root_.is_separated.prod {s : set α} {t : set β} (hs : is_separated s) (ht : is_separated t) :
  is_separated (s.prod t) :=
(is_separated_def _).mpr $ assume x y hx hy H, prod.ext
  (hs.eq_of_uniform_continuous hx.1 hy.1 uniform_continuous_fst H)
  (ht.eq_of_uniform_continuous hx.2 hy.2 uniform_continuous_snd H)

end uniform_space


import for_mathlib
import data.list.basic

/------- Definitions -------/

def restrict {χ : Type*} (q : χ → χ → Prop) (s : finset χ) : χ → χ → Prop :=
λ a b, q a b ∧ a ∈ s ∧ b ∈ s

instance {α β: Type*} (s : finset α) (Q : β → α → α → Prop)
  [decidable_eq α] [∀ b, decidable_rel (Q b)] :
  ∀ b, decidable_rel (restrict (Q b) s) :=
begin
  intro b,
  unfold restrict,
  apply_instance,
end

def cyclical {χ : Type*} (q : χ → χ → Prop) : Prop :=
∃ x, relation.trans_gen q x x

def is_cycle' {χ : Type*} (P : χ → χ → Prop) (c : list χ) :=
  ∃ (e : c ≠ list.nil), list.chain P (c.last e) c

def cyclical' {χ : Type*} (q : χ → χ → Prop) : Prop :=
∃ l, is_cycle' q l

def acyclical' {χ : Type*} (q : χ → χ → Prop) : Prop :=
∀ l, ¬ is_cycle' q l

def acyclical_in' {χ : Type*} (q : χ → χ → Prop) (s : finset χ): Prop :=
∀ l : list χ, (∀ x ∈ l, x ∈ s) → ¬ is_cycle' q l

def margin {χ υ : Type*} (voters : finset υ) (Q : υ → χ → χ → Prop) (c c' : χ)
  [∀ v, decidable_rel (Q v)] : ℤ :=
(voters.filter (λ v, Q v c c')).card - (voters.filter (λ v, Q v c' c)).card

def margin_pos {χ υ : Type*} (voters : finset υ) (Q : υ → χ → χ → Prop)
  [∀ v, decidable_rel (Q v)] (c c' : χ) : Prop :=  0 < margin voters Q c c'

def defeats {χ υ : Type*} (voters : finset υ) (cands: finset χ) (Q : υ → χ → χ → Prop)
  [∀ v, decidable_rel (Q v)] [decidable_eq χ] (x y: χ) :=
margin_pos voters Q x y ∧ ¬ (∃ l : list χ, (∀ c ∈ l, c ∈ cands) ∧ x ∈ l ∧ y ∈ l ∧
    is_cycle' (λ a b, margin voters Q x y ≤ margin voters Q a b) l)

def is_undefeated {χ υ : Type*} (voters : finset υ) (cands: finset χ) (Q : υ → χ → χ → Prop)
  (x : χ) [∀ v, decidable_rel (Q v)] [decidable_eq χ] :=
  ∀ y ∈ cands, ¬ defeats voters cands Q y x

open_locale classical

lemma succ_pred {i : ℕ} (e : 0 < i) : i - 1 + 1 = i := by omega

lemma ineq5 (i n : ℕ) (e : i < n) (z: ¬i = n - 1) : i < n - 1 := by omega

lemma dominate_ineq3 {a b : ℕ} (e : 0 < b) : a < b - 1 → a + 1 < b := by omega

lemma is_cycle'_of_is_cycle'_restrict {χ : Type*} {P : χ → χ → Prop} {c : list χ}
  {s : finset χ} (h : is_cycle' (restrict P s) c) : is_cycle' P c :=
begin
  simp only [is_cycle', list.last, ne.def] at h ⊢,
  cases h with hc₁ hc₂,
  refine ⟨hc₁, list.chain.imp (λ a b hab, _) hc₂⟩,
  exact hab.1,
end

def length_cycle_pos {χ : Type*} {l : list χ} {P : χ → χ → Prop}
  (c : is_cycle' P l) : 0 < l.length :=
begin
    cases c with a b,
    exact list.length_pos_of_ne_nil a,
end

lemma dominates_of_cycle_index {χ : Type*} {P : χ → χ → Prop} {l : list χ}
  (hl : is_cycle' P l) (i : ℕ) (i_bound : i < l.length) :
  P (l.nth_le i i_bound) (l.nth_le ((i + 1) % l.length) (nat.mod_lt (i + 1) (length_cycle_pos hl))) :=
begin
    unfold is_cycle' at hl,
    cases hl with e c,
    rw list.chain_iff_nth_le at c,
    cases c with c_left c_right,
    by_cases z : i = l.length - 1,
        {simp_rw z, rw ←list.last_eq_nth_le l e,
        specialize c_left (list.length_pos_of_ne_nil e),
        simp_rw succ_pred (list.length_pos_of_ne_nil e),
        simp_rw nat.mod_self,
        exact c_left,},
    specialize c_right i,
    have i_bound2 := ineq5 i l.length i_bound z,
    specialize c_right i_bound2,
    have underflow : (i + 1) % l.length = (i + 1),
    rw nat.mod_eq_of_lt,
    exact dominate_ineq3 (list.length_pos_of_ne_nil e) i_bound2,
    simp_rw underflow,
    exact c_right,
end

lemma dominates_of_cycle  {χ : Type*} {l : list χ} {P : χ → χ → Prop}
  (hl : is_cycle' P l) : ∀ x ∈ l, ∃ y ∈ l, P x y :=
begin
    intros x x_in,
    let i := l.index_of x,
    have d := dominates_of_cycle_index hl,
    specialize d i,
    specialize d (list.index_of_lt_length.mpr x_in),
    use (l.nth_le ((i + 1) % l.length) ((i + 1).mod_lt (length_cycle_pos hl))),
    split,
    apply list.nth_le_mem,
    simp_rw list.index_of_nth_le at d,
    exact d,
end

lemma mem_of_is_cycle'_restrict {χ : Type*} {P : χ → χ → Prop} {l : list χ} {s : finset χ} {a : χ}
  (a_in : a ∈ l) (hl : is_cycle' (restrict P s) l) :
  a ∈ s :=
begin
  obtain ⟨b, b_in, hb⟩ := dominates_of_cycle hl a a_in,
  exact hb.2.1,
end

/- TODO: other side of the iff -/
lemma cyclical'_of_cyclical {χ : Type*} {q : χ → χ → Prop} (h : cyclical q) :
  cyclical' q :=
begin
  simp only [cyclical, cyclical', is_cycle'],
  cases h with x hx,
  obtain ⟨l, hl₁, hl₂, hl₃⟩ := exists_chain_of_relation_trans_gen hx,
  have l_last : l.last hl₁ = x := by rw ← hl₃;
    exact (list.last_cons (list.cons_ne_nil _ _) hl₁).symm,
  rw ← l_last at hl₂,
  exact ⟨l, hl₁, hl₂⟩,
end

lemma not_acyclical_in'_of_cyclical'_restrict {χ : Type*} {q : χ → χ → Prop} {s : finset χ}
  (h : cyclical' (restrict q s)) : ¬ acyclical_in' q s :=
begin
  rcases h with ⟨l, hl⟩,
  simp only [acyclical_in', exists_prop, not_not, not_forall],
  refine ⟨l, _, is_cycle'_of_is_cycle'_restrict hl⟩,
  intros x x_in,
  exact mem_of_is_cycle'_restrict x_in hl,
end

/- TODO: GOLF-/
lemma nonempty_ico {X : Type*} (c : list X) (e : 0 < c.length) : (finset.Ico 0 c.length).nonempty  :=
begin
    fconstructor,
    use 0,
    simp at *,
    omega,
end

lemma split_cycle_to_margin_cycle {χ υ : Type*}
  (voters : finset υ) (cands: finset χ) (Q : υ → χ → χ → Prop) (c : list χ) :
  is_cycle' (defeats voters cands Q) c → is_cycle' (margin_pos voters Q) c :=
begin
    intro chain,
    unfold is_cycle' at chain,
    cases chain with witness chain,
    use witness,
    refine list.chain_of_chain_map id _ _,
    exact (defeats voters cands Q),
    intros a b s,
    exact and.left s,
    simp,
    exact chain,
end

theorem defeat_acyclical_in' {χ υ : Type*} (voters : finset υ) (cands: finset χ) (Q : υ → χ → χ → Prop) :
  acyclical_in' (defeats voters cands Q) cands :=
begin
  rintros c hcs ⟨c_ne_nil, hc⟩,
  have ico_nonempty := nonempty_ico c (list.length_pos_of_ne_nil c_ne_nil),
  have margin_pos_cyc := split_cycle_to_margin_cycle voters cands Q c ⟨c_ne_nil, hc⟩,
  obtain ⟨mini_idx, bounds, mini_req⟩ :=
    finset.exists_min_image (finset.Ico 0 c.length) (λ x, (margin voters Q)
    (c.nth_le (x % c.length) (nat.mod_lt x (list.length_pos_of_ne_nil c_ne_nil)))
    (c.nth_le ((x+1) % c.length) (nat.mod_lt (x+1) (list.length_pos_of_ne_nil c_ne_nil))))
    ico_nonempty,
  simp only [nat.Ico_zero_eq_range, finset.mem_range] at bounds,
  let mini := (c.nth_le mini_idx bounds),
  have mini_mem := list.nth_le_mem c mini_idx bounds,
  obtain ⟨defeated, defeats⟩ :=
    dominates_of_cycle_index ⟨c_ne_nil, hc⟩ mini_idx bounds,
  simp only [nat.Ico_zero_eq_range, finset.mem_range] at mini_req,
  contrapose defeats,
  push_neg,
  refine ⟨c, hcs ,mini_mem, _, _⟩,
  { exact list.nth_le_mem c ((mini_idx + 1) % c.length)
      (nat.mod_lt (mini_idx + 1) (list.length_pos_of_ne_nil c_ne_nil)) },
  unfold is_cycle',
  use c_ne_nil,
  rw list.chain_iff_nth_le,
  split,
  { intro h,
    specialize mini_req (c.length - 1),
    have o : ∀ (n : ℕ), (0 < n) → n - 1 < n := by omega,
    { specialize mini_req (o c.length h),
      have cal : (c.length-1) % c.length = c.length-1,
      { apply nat.mod_eq_of_lt,
      exact o c.length h },
      simp_rw cal at mini_req,
      have cal : (c.length - 1 + 1) % c.length = 0,
      { rw succ_pred h,
        exact nat.mod_self c.length, },
      simp_rw cal at mini_req,
      rw ←list.last_eq_nth_le c c_ne_nil at mini_req,
      have test : (margin voters Q (c.nth_le (mini_idx % c.length) (mini_idx.mod_lt (list.length_pos_of_ne_nil c_ne_nil))) (c.nth_le ((mini_idx + 1) % c.length) ((mini_idx + 1).mod_lt (list.length_pos_of_ne_nil c_ne_nil))) ≤ margin voters Q (c.last c_ne_nil) (c.nth_le 0 (eq.rec ((c.length - 1 + 1).mod_lt (list.length_pos_of_ne_nil c_ne_nil)) cal))) = (margin voters Q (c.nth_le mini_idx bounds) (c.nth_le ((mini_idx + 1) % c.length) ((mini_idx + 1).mod_lt (length_cycle_pos ⟨c_ne_nil,hc⟩))) ≤ margin voters Q (c.last c_ne_nil) (c.nth_le 0 h)),
        { congr,
        exact nat.mod_eq_of_lt bounds, },
      rw ←test,
      exact mini_req } },
  { intros i h,
    specialize mini_req i,
    specialize mini_req (nat.lt_of_lt_pred h),
    simp_rw (nat.mod_eq_of_lt bounds) at mini_req,
    simp_rw (nat.mod_eq_of_lt (nat.lt_of_lt_pred h)) at mini_req,
    have o : ∀ i n, i < n - 1 → 0 < n → (i + 1) < n := by omega,
    simp_rw (nat.mod_eq_of_lt (o i c.length h (list.length_pos_of_ne_nil c_ne_nil))) at mini_req,
    exact mini_req },
end

lemma defeat_irreflexive {χ υ : Type*} (voters : finset υ) (cands: finset χ) (Q : υ → χ → χ → Prop) :
  irreflexive (defeats voters cands Q) :=
begin
    intros a ha,
    simp only [defeats, margin, lt_self_iff_false, sub_self, false_and, margin_pos] at ha,
    exact ha,
end

lemma not_margin_pos_of_reverse {χ υ : Type*} {voters : finset υ} {Q : υ → χ → χ → Prop} {a b : χ}
  (h : margin_pos voters Q a b) :  ¬ margin_pos voters Q b a :=
begin
  simp only [margin_pos, margin, sub_pos, not_lt, int.coe_nat_lt] at *,
  exact le_of_lt h,
end

lemma not_margin_pos_self {χ υ : Type*} (voters : finset υ) (Q : υ → χ → χ → Prop) (a : χ) :
  ¬ margin_pos voters Q a a :=
by simp only [margin_pos, margin, lt_self_iff_false, not_false_iff, sub_self]

lemma not_defeat_of_margin_pos {χ υ : Type*} {voters : finset υ} {Q : υ → χ → χ → Prop} {a b : χ}
  (cands : finset χ) (h : margin_pos voters Q a b) :
    ¬ defeats voters cands Q b a :=
begin
  simp only [defeats, not_and'] at ⊢ h,
  rintros -,
  exact not_margin_pos_of_reverse h,
end

lemma undefeated_erase {χ υ : Type*} {voters : finset υ} {cands: finset χ} {Q : υ → χ → χ → Prop}
  {a b : χ} (ha : is_undefeated voters (cands.erase b) Q a) (hb : ¬ defeats voters cands Q b a) :
  is_undefeated voters cands Q a :=
begin
  intros y y_in,
  by_cases hby : y = b, { rwa ← hby at hb, },
  simp only [is_undefeated, defeats, not_exists,
    and_imp, exists_prop, not_and, not_not, ne.def, finset.mem_erase, not_forall] at *,
  intro hya,
  obtain ⟨x, hx₁, hx₂ ⟩ := ha y hby y_in hya,
  exact ⟨x, λ c c_in, (hx₁ c c_in).2, hx₂⟩,
end


#print add_group
/-
structure add_group : Type u → Type u
fields:
add_group.add : Π {α : Type u} [c : add_group α], α → α → α
add_group.add_assoc : ∀ {α : Type u} [c : add_group α] (a b c_1 : α), a + b + c_1 = a + (b + c_1)
add_group.zero : Π (α : Type u) [c : add_group α], α
add_group.zero_add : ∀ {α : Type u} [c : add_group α] (a : α), 0 + a = a
add_group.add_zero : ∀ {α : Type u} [c : add_group α] (a : α), a + 0 = a
add_group.neg : Π {α : Type u} [c : add_group α], α → α
add_group.add_left_neg : ∀ {α : Type u} [c : add_group α] (a : α), -a + a = 0

-/

structure add_group' {G : Type}
[has_add G] [has_zero G] [has_neg G] :=
-- those lines mean
-- "we have a function + : G x G → G written λ a b, a + b"
-- "we have something called 0 : G"
-- "we have a map neg : G → G written λ a, -a"
(add_assoc : ∀ (a b c : G), a + b + c = a + (b + c))
(zero_add : ∀ (a : G), 0 + a = a)
(add_zero : ∀ (a : G), a + 0 = a)
(add_left_neg : ∀ (a : G), -a + a = 0)

#print has_add
#print has_zero
#print has_neg

variables {G : Type} [has_add G] [has_zero G] [has_neg G]
theorem add_group.add_zero'
(add_assoc : ∀ a b c : G, a + b + c = a + (b + c))
(zero : G)
(zero_add : ∀ a : G, 0 + a = a)
(neg : G → G)
(add_left_neg : ∀ a : G, -a + a = 0)
: ∀ a : G, a + 0 = a :=
begin
  have left_cancel : ∀ (a b c : G), a + b = a + c → b = c,
  { intros a b c Habac,
    exact calc b = 0 + b : (zero_add _).symm
    ...          = (-a + a) + b : by rw [←add_left_neg]
    ...          = -a + (a + b) : add_assoc _ _ _
    ...          = -a + (a + c) : by rw Habac
    ...          = (-a + a) + c : (add_assoc _ _ _).symm
    ...          = 0 + c : by rw add_left_neg
    ...          = c : zero_add _
  },
  -- a + 0 = a
  intro a,
  apply (left_cancel (-a) _ _),
  rw [←add_assoc,add_left_neg,zero_add],
end

#print group


/-
Copyright (c) 2018 Guy Leroy. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sangwoo Jo (aka Jason), Guy Leroy, Johannes Hölzl

Greatest common divisor (gcd) and least common multiple (lcm) for integers.

This sets up ℤ to be a GCD domain, and introduces rules about `int.gcd`, as well as `int.lcm`.
NOTE: If you add rules to this theory, check that the corresponding rules are available for
`gcd_domain`.
-/
import data.int.basic data.nat.prime

/- Extended Euclidean algorithm -/
namespace nat

def xgcd_aux : ℕ → ℤ → ℤ → ℕ → ℤ → ℤ → ℕ × ℤ × ℤ
| 0          s t r' s' t' := (r', s', t')
| r@(succ _) s t r' s' t' :=
  have r' % r < r, from mod_lt _ $ succ_pos _,
  let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t

@[simp] theorem xgcd_zero_left {s t r' s' t'} : xgcd_aux 0 s t r' s' t' = (r', s', t') :=
by simp [xgcd_aux]

@[simp] theorem xgcd_aux_rec {r s t r' s' t'} (h : 0 < r) : xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t :=
by cases r; [exact absurd h (lt_irrefl _), {simp only [xgcd_aux], refl}]

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd (x y : ℕ) : ℤ × ℤ := (xgcd_aux x 1 0 y 0 1).2

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a (x y : ℕ) : ℤ := (xgcd x y).1

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b (x y : ℕ) : ℤ := (xgcd x y).2

@[simp] theorem xgcd_aux_fst (x y) : ∀ s t s' t',
  (xgcd_aux x s t y s' t').1 = gcd x y :=
gcd.induction x y (by simp) (λ x y h IH s t s' t', by simp [h, IH]; rw ← gcd_rec)

theorem xgcd_aux_val (x y) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) :=
by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1]; cases xgcd_aux x 1 0 y 0 1; refl

theorem xgcd_val (x y) : xgcd x y = (gcd_a x y, gcd_b x y) :=
by unfold gcd_a gcd_b; cases xgcd x y; refl

section
parameters (a b : ℕ)

private def P : ℕ × ℤ × ℤ → Prop | (r, s, t) := (r : ℤ) = a * s + b * t

theorem xgcd_aux_P {r r'} : ∀ {s t s' t'}, P (r, s, t) → P (r', s', t') → P (xgcd_aux r s t r' s' t') :=
gcd.induction r r' (by simp) $ λ x y h IH s t s' t' p p', begin
  rw [xgcd_aux_rec h], refine IH _ p, dsimp [P] at *,
  rw [int.mod_def], generalize : (y / x : ℤ) = k,
  rw [p, p'], simp [mul_add, mul_comm, mul_left_comm]
end

theorem gcd_eq_gcd_ab : (gcd a b : ℤ) = a * gcd_a a b + b * gcd_b a b :=
by have := @xgcd_aux_P a b a b 1 0 0 1 (by simp [P]) (by simp [P]);
   rwa [xgcd_aux_val, xgcd_val] at this
end

end nat

namespace int

theorem nat_abs_div (a b : ℤ) (H : b ∣ a) : nat_abs (a / b) = (nat_abs a) / (nat_abs b) :=
begin
  cases (nat.eq_zero_or_pos (nat_abs b)),
  rw eq_zero_of_nat_abs_eq_zero h,
  simp,
  calc
  nat_abs (a / b) = nat_abs (a / b) * 1 : by rw mul_one
    ... = nat_abs (a / b) * (nat_abs b / nat_abs b) : by rw nat.div_self h
    ... = nat_abs (a / b) * nat_abs b / nat_abs b : by rw (nat.mul_div_assoc _ (dvd_refl _))
    ... = nat_abs (a / b * b) / nat_abs b : by rw (nat_abs_mul (a / b) b)
    ... = nat_abs a / nat_abs b : by rw int.div_mul_cancel H,
end

theorem nat_abs_dvd_abs_iff {i j : ℤ} : i.nat_abs ∣ j.nat_abs ↔ i ∣ j :=
⟨assume (H : i.nat_abs ∣ j.nat_abs), dvd_nat_abs.mp (nat_abs_dvd.mp (coe_nat_dvd.mpr H)),
assume H : (i ∣ j), coe_nat_dvd.mp (dvd_nat_abs.mpr (nat_abs_dvd.mpr H))⟩

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : nat.prime p) {m n : ℤ} {k l : ℕ}
      (hpm : ↑(p ^ k) ∣ m)
      (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k+l+1)) ∣ m*n) : ↑(p ^ (k+1)) ∣ m ∨ ↑(p ^ (l+1)) ∣ n :=
have hpm' : p ^ k ∣ m.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpm,
have hpn' : p ^ l ∣ n.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpn,
have hpmn' : (p ^ (k+l+1)) ∣ m.nat_abs*n.nat_abs,
  by rw ←int.nat_abs_mul; apply (int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpmn),
let hsd := nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn' in
hsd.elim
  (λ hsd1, or.inl begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd1 end)
  (λ hsd2, or.inr begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd2 end)

theorem dvd_of_mul_dvd_mul_left {i j k : ℤ} (k_non_zero : k ≠ 0) (H : k * i ∣ k * j) : i ∣ j :=
dvd.elim H (λl H1, by rw mul_assoc at H1; exact ⟨_, eq_of_mul_eq_mul_left k_non_zero H1⟩)

theorem dvd_of_mul_dvd_mul_right {i j k : ℤ} (k_non_zero : k ≠ 0) (H : i * k ∣ j * k) : i ∣ j :=
by rw [mul_comm i k, mul_comm j k] at H; exact dvd_of_mul_dvd_mul_left k_non_zero H

end int


import MyNat.Power
import MultiplicationWorld.Level2 -- mul_one
namespace MyNat
open MyNat

/-!
# Power World

## Level 4: `one_pow`

## Lemma
For all naturals `m`, `1 ^ m = 1`.
-/
lemma one_pow (m : MyNat) : (1 : MyNat) ^ m = 1 := by
  induction m with
  | zero =>
    rw [zero_is_0]
    rw [pow_zero]
  | succ m ih =>
    rw [pow_succ]
    rw [ih]
    rw [mul_one]

/-!
Next up [Level 5](./Level5.lean.md)
-/


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

Sums of finite geometric series
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_with_zero.power
import Mathlib.algebra.big_operators.order
import Mathlib.algebra.big_operators.ring
import Mathlib.algebra.big_operators.intervals
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i$. -/
def geom_series {α : Type u} [semiring α] (x : α) (n : ℕ) : α :=
  finset.sum (finset.range n) fun (i : ℕ) => x ^ i

theorem geom_series_def {α : Type u} [semiring α] (x : α) (n : ℕ) :
    geom_series x n = finset.sum (finset.range n) fun (i : ℕ) => x ^ i :=
  rfl

@[simp] theorem geom_series_zero {α : Type u} [semiring α] (x : α) : geom_series x 0 = 0 := rfl

@[simp] theorem geom_series_one {α : Type u} [semiring α] (x : α) : geom_series x 1 = 1 := sorry

@[simp] theorem op_geom_series {α : Type u} [ring α] (x : α) (n : ℕ) :
    opposite.op (geom_series x n) = geom_series (opposite.op x) n :=
  sorry

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i y^{n-1-i}$. -/
def geom_series₂ {α : Type u} [semiring α] (x : α) (y : α) (n : ℕ) : α :=
  finset.sum (finset.range n) fun (i : ℕ) => x ^ i * y ^ (n - 1 - i)

theorem geom_series₂_def {α : Type u} [semiring α] (x : α) (y : α) (n : ℕ) :
    geom_series₂ x y n = finset.sum (finset.range n) fun (i : ℕ) => x ^ i * y ^ (n - 1 - i) :=
  rfl

@[simp] theorem geom_series₂_zero {α : Type u} [semiring α] (x : α) (y : α) :
    geom_series₂ x y 0 = 0 :=
  rfl

@[simp] theorem geom_series₂_one {α : Type u} [semiring α] (x : α) (y : α) :
    geom_series₂ x y 1 = 1 :=
  sorry

@[simp] theorem geom_series₂_with_one {α : Type u} [semiring α] (x : α) (n : ℕ) :
    geom_series₂ x 1 n = geom_series x n :=
  sorry

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add {α : Type u} [semiring α] {x : α} {y : α}
    (h : commute x y) (n : ℕ) : geom_series₂ (x + y) y n * x + y ^ n = (x + y) ^ n :=
  sorry

theorem geom_series₂_self {α : Type u_1} [comm_ring α] (x : α) (n : ℕ) :
    geom_series₂ x x n = ↑n * x ^ (n - 1) :=
  sorry

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add {α : Type u} [comm_semiring α] (x : α) (y : α) (n : ℕ) :
    geom_series₂ (x + y) y n * x + y ^ n = (x + y) ^ n :=
  commute.geom_sum₂_mul_add (commute.all x y) n

theorem geom_sum_mul_add {α : Type u} [semiring α] (x : α) (n : ℕ) :
    geom_series (x + 1) n * x + 1 = (x + 1) ^ n :=
  eq.mp
    (Eq._oldrec (Eq.refl (geom_series₂ (x + 1) 1 n * x + 1 = (x + 1) ^ n))
      (geom_series₂_with_one (x + 1) n))
    (eq.mp (Eq._oldrec (Eq.refl (geom_series₂ (x + 1) 1 n * x + 1 ^ n = (x + 1) ^ n)) (one_pow n))
      (commute.geom_sum₂_mul_add (commute.one_right x) n))

theorem geom_sum₂_mul_comm {α : Type u} [ring α] {x : α} {y : α} (h : commute x y) (n : ℕ) :
    geom_series₂ x y n * (x - y) = x ^ n - y ^ n :=
  sorry

theorem geom_sum₂_mul {α : Type u} [comm_ring α] (x : α) (y : α) (n : ℕ) :
    geom_series₂ x y n * (x - y) = x ^ n - y ^ n :=
  geom_sum₂_mul_comm (commute.all x y) n

theorem geom_sum_mul {α : Type u} [ring α] (x : α) (n : ℕ) :
    geom_series x n * (x - 1) = x ^ n - 1 :=
  eq.mp
    (Eq._oldrec (Eq.refl (geom_series₂ x 1 n * (x - 1) = x ^ n - 1)) (geom_series₂_with_one x n))
    (eq.mp (Eq._oldrec (Eq.refl (geom_series₂ x 1 n * (x - 1) = x ^ n - 1 ^ n)) (one_pow n))
      (geom_sum₂_mul_comm (commute.one_right x) n))

theorem mul_geom_sum {α : Type u} [ring α] (x : α) (n : ℕ) :
    (x - 1) * geom_series x n = x ^ n - 1 :=
  sorry

theorem geom_sum_mul_neg {α : Type u} [ring α] (x : α) (n : ℕ) :
    geom_series x n * (1 - x) = 1 - x ^ n :=
  sorry

theorem mul_neg_geom_sum {α : Type u} [ring α] (x : α) (n : ℕ) :
    (1 - x) * geom_series x n = 1 - x ^ n :=
  sorry

theorem geom_sum {α : Type u} [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) :
    geom_series x n = (x ^ n - 1) / (x - 1) :=
  sorry

theorem geom_sum_Ico_mul {α : Type u} [ring α] (x : α) {m : ℕ} {n : ℕ} (hmn : m ≤ n) :
    (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) * (x - 1) = x ^ n - x ^ m :=
  sorry

theorem geom_sum_Ico_mul_neg {α : Type u} [ring α] (x : α) {m : ℕ} {n : ℕ} (hmn : m ≤ n) :
    (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) * (1 - x) = x ^ m - x ^ n :=
  sorry

theorem geom_sum_Ico {α : Type u} [division_ring α] {x : α} (hx : x ≠ 1) {m : ℕ} {n : ℕ}
    (hmn : m ≤ n) :
    (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) = (x ^ n - x ^ m) / (x - 1) :=
  sorry

theorem geom_sum_inv {α : Type u} [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
    geom_series (x⁻¹) n = x - 1⁻¹ * (x - x⁻¹ ^ n * x) :=
  sorry

theorem ring_hom.map_geom_series {α : Type u} {β : Type u_1} [semiring α] [semiring β] (x : α)
    (n : ℕ) (f : α →+* β) : coe_fn f (geom_series x n) = geom_series (coe_fn f x) n :=
  sorry

theorem ring_hom.map_geom_series₂ {α : Type u} {β : Type u_1} [semiring α] [semiring β] (x : α)
    (y : α) (n : ℕ) (f : α →+* β) :
    coe_fn f (geom_series₂ x y n) = geom_series₂ (coe_fn f x) (coe_fn f y) n :=
  sorry

end Mathlib


/-
Copyright (c) 2017 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis
-/

import mathematica
import tactic.norm_num
import data.real.pi
open expr tactic int

/-!
The examples in this file show how we can use Mathematica to solve polynomial equations
and then verify the results in Lean using the tactic `norm_num`,
which simplifies numeral arithmetic.
-/

/-!
Auxiliary functions about lists.
-/

meta def pexpr_of_list_expr : list expr → pexpr
| [] := ``([])
| (h::t) := ``(%%h::%%(pexpr_of_list_expr t) : list _)

meta def expr_of_list_expr : list expr → tactic expr :=
to_expr ∘ pexpr_of_list_expr

meta def dest_list_fst (e : expr) : tactic expr :=
do _::k::_ ← match_app_of e `list.cons, return k

meta def expr_list_of_list_expr : expr → tactic (list expr)
| (app (app (app (const `list.cons _) _) h) t) :=
do t' ← expr_list_of_list_expr t,
   return $ h :: t'
| (app (const `list.nil _) _) := return []
| _ := failed

meta def mk_local_lambdas : expr → tactic (list expr × expr)
| (expr.lam n bi d b) := do
  p ← mk_local' n bi d,
  (ps, r) ← mk_local_lambdas (expr.instantiate_var b p),
  return ((p :: ps), r)
| e := return ([], e)

meta def exists_to_lambda : expr → expr
| (app (app (const `Exists _) _) (lam nm bi tp bod)) := lam nm bi tp (exists_to_lambda bod)
| a := a

/--
This tactic tries to prove a goal of the form `∃ x1 ... xn, _` by asking Mathematica to produce
values `x1 ... xn`. Given these values, it tries to close the goal by calling `norm_num`.
-/
meta def find_sols : tactic unit :=
do lamd ← exists_to_lambda <$> target,
   (lcls, bod) ← mk_local_lambdas lamd,
   lcls' ← expr_of_list_expr lcls,
   sol ← mathematica.run_command_on_2_using
      (λ s t, "Solve[ " ++ s ++ "// LeanForm // Activate, " ++  t ++" // LeanForm // Activate, Reals] // LUnrule")
        bod lcls' "poly.m",
   tp ← infer_type lcls.head,
   intes ← to_expr ``(%%sol : list (list %%tp)) >>= dest_list_fst >>= expr_list_of_list_expr,
   intes.mmap' existsi,
   `[norm_num]

lemma e1 : ∃ x y : ℤ, x*x*x-y=0 ∧ y-8=0 := by find_sols

lemma e2 : ∃ r : ℝ, r+r = 3 := by find_sols

-- no new axioms were added to the environment.
#print axioms


-- 4.2 Equality

#check eq
#check eq.refl
#check eq.symm
#check eq.trans

universe u

#check @eq
#check @eq.refl.{u}
#check @eq.symm.{u}
#check @eq.trans.{u}

variables (α : Type*) (a b c d: α)
variables (hab : a = b) (hcb : c = b) (hcd : c = d)

example : a = d :=
have hbc : b = c, from eq.symm hcb,
have hac : a = c, from eq.trans hab hbc,
show a = d,
from eq.trans hac hcd

example : a = d :=
eq.trans (eq.trans hab (eq.symm hcb)) hcd

example : a = d := (hab.trans hcb.symm).trans hcd

variable β : Type*

example (f : α → β) (a : α) : (λ x, f x) a = f a := eq.refl _
example (a : α) (b : α) : (a, b).1 = a := eq.refl _
example : 2 + 3 = 5 := eq.refl _

example (f : α → β) (a : α) : (λ x, f x) a = f a := rfl
example (a : α) (b : α) : (a, b).1 = a := rfl
example : 2 + 3 = 5 := rfl


-- ----------------------------------------------------
-- Ejercicio. Demostrar
--    ((∀x, P x) ∧ (∀x, Q x)) ↔ (∀x, P x ∧ Q x)
-- ----------------------------------------------------

import tactic

variable  (U : Type)
variables (P Q : U → Prop)

-- 1ª demostración
example :
  ((∀x, P x) ∧ (∀x, Q x)) ↔ (∀x, P x ∧ Q x) :=
begin
  split,
  { rintros ⟨h1, h2⟩ a,
    exact ⟨h1 a, h2 a⟩, },
  { intro h3,
    split,
    { intro a,
      exact (h3 a).left, },
    { intro a,
      exact (h3 a).right, }},
end

github-repos/lean/jaalonso-Logica_con_Lean/Logica_con_Lean-beb6765c6ff3c05590a03f45722eda0c815a25cd/src/2_LPO/Ejercicios/((∀x, P x) ∧ (∀x, Q x)) ⟷ (∀x, P x ∧ Q x).lean


import data.finset.basic
import data.fintype.card
import data.nat.basic

import algebra.big_operators.basic

open_locale big_operators

/-!
# IMO 2018 Q3

An anti-Pascal triangle is an equilateral triangular array of numbers such that,
except for the numbers in the bottom row, each number is the absolute value
of the difference of the two numbers immediately below it. For example,
the following array is an anti-Pascal triangle with four rows
which contains every integer from 1 to 10:

                  4
                2   6
              5   7   1
            8   3  10   9

Does there exist an anti-Pascal triangle with 2018 rows which contains every
integer from 1 to 1 + 2 + ... + 2018?

# Solution
No.

-/

structure coords := mk ::
(row : ℕ) (col : ℕ)

def left_child (c : coords) : coords :=
⟨c.row.succ, c.col⟩

lemma left_child_row (c : coords) : (left_child c).row = c.row.succ := rfl
lemma left_child_col (c : coords) : (left_child c).col = c.col := rfl

def right_child (c : coords) : coords :=
⟨c.row.succ, c.col.succ⟩

lemma right_child_row (c : coords) : (right_child c).row = c.row.succ := rfl
lemma right_child_col (c : coords) : (right_child c).col = c.col.succ := rfl

/--
antipascal triangle with n rows
-/
structure antipascal_triangle (n : ℕ) := mk ::
  (v : coords → ℕ)
  (antipascal : ∀ x : coords,
                   x.row.succ < n →
                   x.col ≤ x.row →
                   v x + v (left_child x) = v (right_child x) ∨
                   v x + v (right_child x) = v (left_child x))

/--
  Given an antipascal triangle and a point c in it, construct the subtriangle
  rooted at c.
-/
def subtriangle
   {n : ℕ}
   (t : antipascal_triangle n)
   (c : coords)
   (hcr : c.row < n)
   (hcc : c.col ≤ c.row) : antipascal_triangle (n - c.row) :=
{
  v := (λ x, t.v ⟨x.row + c.row, x.col + c.col⟩),
  antipascal :=
    begin
      intros x hxr hxc,
      have hh : x.row.succ + c.row < n := lt_tsub_iff_right.mp hxr,
      rw [nat.succ_add] at hh,
      have := t.antipascal ⟨x.row + c.row, x.col + c.col⟩ hh (add_le_add hxc hcc),
      cases this with hl hr,
      { left,
        rw[left_child, right_child] at hl,
        rw[left_child, nat.succ_add, right_child, nat.succ_add, nat.succ_add],
        exact hl },
      { right,
        rw[left_child, right_child] at hr,
        rw[left_child, nat.succ_add, right_child, nat.succ_add, nat.succ_add],
        exact hr },
    end
}

structure a_and_b := mk ::
(a : coords) (b : coords)

def a_and_b_seqs {n : ℕ} (t : antipascal_triangle n) : ℕ → a_and_b
| 0 := ⟨⟨0,0⟩, ⟨0,0⟩⟩
| (nat.succ m) :=
  let b := (a_and_b_seqs m).b
  in if t.v b + t.v (left_child b) = t.v (right_child b)
     then ⟨left_child b, right_child b⟩
     else ⟨right_child b, left_child b⟩

lemma a_and_b_invariant {n : ℕ} (t : antipascal_triangle n) (m : ℕ) :
  (let b := (a_and_b_seqs t m).b in
   ((a_and_b_seqs t m.succ) = ⟨left_child b, right_child b⟩ ∧
    (b.row.succ < n → b.col ≤ b.row → t.v b + t.v (left_child b) = t.v (right_child b))) ∨
    ((a_and_b_seqs t m.succ) = ⟨right_child b, left_child b⟩) ∧
     (b.row.succ < n → b.col ≤ b.row → t.v b + t.v (right_child b) = t.v (left_child b))) :=
begin
  cases classical.em (t.v (a_and_b_seqs t m).b +
                     t.v (left_child (a_and_b_seqs t m).b) =
                     t.v (right_child (a_and_b_seqs t m).b)) with hl hr,
  { simp only [a_and_b_seqs, left_child, right_child],
    finish },
  { simp only [a_and_b_seqs, left_child, right_child, hr],
    right,
    split,
    { finish },
    { intros h1 h2,
      have := t.antipascal (a_and_b_seqs t m).b h1 h2,
      finish },
  },
end

lemma a_and_b_row_is_m {n : ℕ} (t : antipascal_triangle n) (m : ℕ) :
    (a_and_b_seqs t m).a.row = m ∧ (a_and_b_seqs t m).b.row = m :=
begin
  induction m with m' ih,
  { simp[a_and_b_seqs] },
  cases ih with ih1 ih2,
  cases a_and_b_invariant t m' with hl hr,
  { simp[hl,left_child, right_child, ih2] },
  { simp[hr,left_child, right_child, ih2] }
end

lemma a_and_b_within_triangle {n : ℕ} (t : antipascal_triangle n) (m : ℕ) (hm : m < n) :
  (a_and_b_seqs t m).a.col ≤ (a_and_b_seqs t m).a.row ∧
  (a_and_b_seqs t m).b.col ≤ (a_and_b_seqs t m).b.row :=
begin
  induction m with m' ih,
  { simp[a_and_b_seqs] },
  { obtain ⟨iha,ihb⟩ := ih (nat.lt_of_succ_lt hm),
    cases (a_and_b_invariant t m') with hl hr,
    { rw[hl.1],
      rw[left_child_col, left_child_row, right_child_col, right_child_row],
      split,
      { exact nat.le_succ_of_le ihb },
      { exact nat.succ_le_succ ihb } },
    { rw[hr.1],
      rw[left_child_col, left_child_row, right_child_col, right_child_row],
      split,
      { exact nat.succ_le_succ ihb },
      { exact nat.le_succ_of_le ihb }} }
end

lemma sum_of_a {n : ℕ} (t : antipascal_triangle n) (m : ℕ) (hm : m < n) :
  (∑i in finset.range m.succ, t.v (a_and_b_seqs t i).a) = t.v (a_and_b_seqs t m).b :=
begin
  induction m with m' ih,
  { simp only [nat.nat_zero_eq_zero, finset.sum_singleton, finset.range_one, a_and_b_seqs] },
  rw [finset.sum_range_succ, ih (nat.lt_of_succ_lt hm)],
  obtain ⟨hra, hrb⟩ := a_and_b_row_is_m t m',
  obtain ⟨haw, hbw⟩ := a_and_b_within_triangle t m' (nat.lt_of_succ_lt hm),
  cases a_and_b_invariant t m' with hl hr,
  { finish },
  { finish },
end

def has_downward_path_to (c1 c2 : coords) : Prop :=
 ∃ (rd cd : ℕ), cd ≤ rd ∧ c2 = ⟨c1.row + rd, c1.col + cd⟩

lemma downward_path_trans
   {c1 c2 c3 : coords}
   (h12 : has_downward_path_to c1 c2)
   (h23 : has_downward_path_to c2 c3) :
   has_downward_path_to c1 c3 :=
begin
  obtain ⟨rd1, cd1, hle1, hs1⟩ := h12,
  obtain ⟨rd2, cd2, hle2, hs2⟩ := h23,
  use rd1 + rd2,
  use cd1 + cd2,
  split,
  { exact add_le_add hle1 hle2 },
  { rw [hs1] at hs2,
    rw [hs2],
    rw[add_assoc, add_assoc] }
end

lemma downward_path_left_child (c : coords) : has_downward_path_to c (left_child c) :=
 ⟨1, 0, by simp[left_child]⟩

lemma downward_path_right_child (c : coords) : has_downward_path_to c (right_child c) :=
 ⟨1, 1, by simp[right_child]⟩

lemma a_and_b_have_path_from_origin
            {n : ℕ}
            (t : antipascal_triangle n)
            (i : ℕ) :
            has_downward_path_to ⟨0,0⟩ (a_and_b_seqs t i).a ∧
            has_downward_path_to ⟨0,0⟩ (a_and_b_seqs t i).b :=
begin
  induction i with i' ih,
  { split,
    { use 0, use 0, simp[a_and_b_seqs] },
    { use 0, use 0, simp[a_and_b_seqs] }},
  { cases ih with iha ihb,
    cases a_and_b_invariant t i' with hl hr,
    { rw[hl.1],
      dsimp,
      split,
      { exact downward_path_trans ihb (downward_path_left_child _) },
      { exact downward_path_trans ihb (downward_path_right_child _) },},
    { rw[hr.1],
      dsimp,
      split,
      { exact downward_path_trans ihb (downward_path_right_child _) },
      { exact downward_path_trans ihb (downward_path_left_child _) }},
  },
end

/--
 Given an antipascal triangle t with height n greater than 2, there exists a subtriangle
 of height at least (n - 1) / 2 that contains none of the elements of `a_and_b_seqs t`.
-/
lemma exists_disjoint_subtriangle
  {n : ℕ}
  (t : antipascal_triangle n)
  (hn : 2 < n) :
  ∃ (c : coords)
    (hcr : (n - 1) / 2 ≤ n - c.row )
    (hcc : c.col ≤ c.row),
    (∀ ii : ℕ, ii < n → ((¬ has_downward_path_to c (a_and_b_seqs t ii).a) ∧
                         (¬ has_downward_path_to c (a_and_b_seqs t ii).b))) :=
begin
  -- look at columns of (a_and_b_seqs t (n-1))
  -- if they are both less than ~ n/2, then choose ⟨n - (n-1)/2, 0⟩,
  -- else choose ⟨n-(n-1)/2, n-(n-1)/2⟩.
  sorry
end

def triangle (n : ℕ) := finset.sigma (finset.range n) (λ i, finset.range (i + 1))

lemma mem_triangle_iff (n r c : ℕ) : sigma.mk r c ∈ triangle n ↔ r < n ∧ c ≤ r :=
begin
  rw [triangle, finset.mem_sigma, finset.mem_range, finset.mem_range],
  dsimp,
  split,
  { intro h,
    cases h with hl hr,
    exact ⟨hl, nat.lt_succ_iff.mp hr⟩ },
  { intro h,
    cases h with hl hr,
    exact ⟨hl, nat.lt_succ_iff.mpr hr⟩ }
end

lemma triangle_card (n : ℕ) : (triangle n).card = (∑ i in finset.range n, (i + 1)) :=
begin
  rw[triangle],
  cases n,
  { simp },
  { rw [finset.sum_range_succ, finset.card_sigma, finset.sum_range_succ],
    rw [finset.card_range],
    congr,
    funext,
    exact finset.card_range _ }
end

lemma triangle_fintype_card (n : ℕ) : fintype.card (triangle n) = (∑ i in finset.range n, (i + 1)) :=
by rw [fintype.card_coe, triangle_card]

lemma antipascal_injective
        (n : ℕ)
        (t : antipascal_triangle n)
        (h_contains_all : ∀ m ≤ (∑(i:ℕ) in finset.range n, (i + 1)),
         ∃ r < n, ∃ c ≤ r, t.v ⟨r,c⟩ = m) :
        ∀ r1 c1 r2 c2 : ℕ,
            ((r1 < n ∧ c1 ≤ r1) ∧ (r2 < n ∧ c2 ≤ r2)
             ∧ t.v ⟨r1, c1⟩ = t.v ⟨r2, c2⟩) → (r1 = r2 ∧ c1 = c2) :=
begin
  intros r1 c1 r2 c2 h,
--  let f : ↥(triangle n) → {j // j ≤ (∑(i:ℕ) in finset.range n, (i + 1))} :=
--          (λ ⟨x, hxt⟩, let y := t.v ⟨x.1, x.2⟩ in ⟨y, sorry⟩),

  let g : finset.range (∑(i:ℕ) in finset.range n, (i + 1)) → ↥(triangle n) :=
          λ xx, by { have hca := h_contains_all xx.val (finset.mem_range_le xx.prop),
                         let r' := classical.some hca,
                         have rr' := classical.some_spec hca,
                         have hr' := classical.some rr',
                         have prc' := classical.some_spec rr',
                         let c' := classical.some prc',
                         have rc' := classical.some_spec prc',
                         have hc' := classical.some rc',
                         exact ⟨⟨r', c'⟩, (mem_triangle_iff n r' c').mpr ⟨hr', hc'⟩⟩ },

  have : function.injective g,
  { intros a1 a2 hg,
    have : t.v ⟨(g a1).val.1, (g a1).val.2⟩ = a1,
    { sorry, },
    sorry },

  sorry
end

theorem imo2018_q3 (t : antipascal_triangle 2018)
  (h_contains_all : ∀ n ≤ (∑(i:ℕ) in finset.range 2018, (i + 1)),
    ∃ r < 2018, ∃ c ≤ r, t.v ⟨r,c⟩ = n) :
  false :=
begin
sorry
end


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

Integer power operation on fields.
-/

import algebra.group_power tactic.wlog

universe u

section field_power
open int nat
variables {α : Type u} [division_ring α]

@[simp] lemma zero_gpow : ∀ z : ℕ, z ≠ 0 → (0 : α)^z = 0
| 0 h := absurd rfl h
| (k+1) h := zero_mul _

def fpow (a : α) : ℤ → α
| (of_nat n) := a ^ n
| -[1+n] := 1/(a ^ (n+1))

instance : has_pow α ℤ := ⟨fpow⟩

@[simp] lemma fpow_of_nat (a : α) (n : ℕ) : a ^ (n : ℤ) = a ^ n := rfl

lemma fpow_neg_succ_of_nat (a : α) (n : ℕ) : a ^ (-[1+ n]) = 1 / (a ^ (n + 1)) := rfl

lemma unit_pow {a : α} (ha : a ≠ 0) : ∀ n : ℕ, a ^ n = ↑((units.mk0 a ha)^n)
| 0 := units.coe_one.symm
| (k+1) := by simp only [_root_.pow_succ, units.coe_mul, units.mk0_val]; rw unit_pow

lemma fpow_eq_gpow {a : α} (h : a ≠ 0) : ∀ (z : ℤ), a ^ z = ↑(gpow (units.mk0 a h) z)
| (of_nat k) := unit_pow _ _
| -[1+k] := by rw [fpow_neg_succ_of_nat, gpow, one_div_eq_inv, units.inv_eq_inv, unit_pow]

lemma fpow_inv (a : α) : a ^ (-1 : ℤ) = a⁻¹ :=
show 1*(a*1)⁻¹ = a⁻¹, by rw [one_mul, mul_one]

lemma fpow_ne_zero_of_ne_zero {a : α} (ha : a ≠ 0) : ∀ (z : ℤ), a ^ z ≠ 0
| (of_nat n) := pow_ne_zero _ ha
| -[1+n] := one_div_ne_zero $ pow_ne_zero _ ha

@[simp] lemma fpow_zero {a : α} : a ^ (0 : ℤ) = 1 :=
pow_zero a

lemma fpow_add {a : α} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 + z2) = a ^ z1 * a ^ z2 :=
begin simp only [fpow_eq_gpow ha], rw ← units.coe_mul, congr, apply gpow_add end

@[simp] lemma one_fpow : ∀(i : ℤ), (1 : α) ^ i = 1
| (int.of_nat n) := _root_.one_pow n
| -[1+n]         := show 1/(1 ^ (n+1) : α) = 1, by simp

@[simp] lemma fpow_one (a : α) : a^(1:ℤ) = a :=
pow_one a

end field_power

namespace is_field_hom

lemma map_fpow {α β : Type*} [discrete_field α] [discrete_field β] (f : α → β) [is_field_hom f]
  (a : α) : ∀ (n : ℤ), f (a ^ n) = f a ^ n
| (n : ℕ) := is_semiring_hom.map_pow f a n
| -[1+ n] := by simp [fpow_neg_succ_of_nat, is_semiring_hom.map_pow f, is_field_hom.map_inv f]

end is_field_hom

section discrete_field_power
open int
variables {α : Type u} [discrete_field α]

lemma zero_fpow : ∀ z : ℤ, z ≠ 0 → (0 : α) ^ z = 0
| (of_nat n) h := zero_gpow _ $ by rintro rfl; exact h rfl
| -[1+n] h := show 1/(0*0^n)=(0:α), by rw [zero_mul, one_div_zero]

lemma fpow_neg (a : α) : ∀ n : ℤ, a ^ (-n) = 1 / a ^ n
| (0) := by simp
| (of_nat (n+1)) := rfl
| -[1+n] := show fpow a (n+1) = 1 / (1 / fpow a (n+1)), by rw one_div_one_div

lemma fpow_sub {a : α} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 :=
by rw [sub_eq_add_neg, fpow_add ha, fpow_neg, ←div_eq_mul_one_div]

lemma fpow_mul (a : α) (i j : ℤ) : a ^ (i * j) = (a ^ i) ^ j :=
begin
  by_cases a = 0,
  { subst h,
    have : ¬ i = 0 → ¬ j = 0 → ¬ i * j = 0, begin rw [mul_eq_zero, not_or_distrib], exact and.intro end,
    by_cases hi : i = 0; by_cases hj : j = 0;
      simp [hi, hj, zero_fpow i, zero_fpow j, zero_fpow _ (this _ _), one_fpow] },
  rw [fpow_eq_gpow h, fpow_eq_gpow h, fpow_eq_gpow (units.ne_zero _), units.mk0_coe],
  fapply congr_arg coe _, -- TODO: uh oh
  exact gpow_mul (units.mk0 a h) i j
end

lemma mul_fpow (a b : α) : ∀(i : ℤ), (a * b) ^ i = (a ^ i) * (b ^ i)
| (int.of_nat n) := _root_.mul_pow a b n
| -[1+n] :=
  by rw [fpow_neg_succ_of_nat, fpow_neg_succ_of_nat, fpow_neg_succ_of_nat,
      mul_pow, div_mul_div, one_mul]

end discrete_field_power

section ordered_field_power
open int

variables {α : Type u} [discrete_linear_ordered_field α]

lemma fpow_nonneg_of_nonneg {a : α} (ha : a ≥ 0) : ∀ (z : ℤ), a ^ z ≥ 0
| (of_nat n) := pow_nonneg ha _
| -[1+n] := div_nonneg' zero_le_one $ pow_nonneg ha _

lemma fpow_pos_of_pos {a : α} (ha : a > 0) : ∀ (z : ℤ), a ^ z > 0
| (of_nat n) := pow_pos ha _
| -[1+n] := div_pos zero_lt_one $ pow_pos ha _

lemma fpow_le_of_le {x : α} (hx : 1 ≤ x) {a b : ℤ} (h : a ≤ b) : x ^ a ≤ x ^ b :=
begin
  induction a with a a; induction b with b b,
  { simp only [fpow_of_nat, of_nat_eq_coe],
    apply pow_le_pow hx,
    apply le_of_coe_nat_le_coe_nat h },
  { apply absurd h,
    apply not_le_of_gt,
    exact lt_of_lt_of_le (neg_succ_lt_zero _) (of_nat_nonneg _) },
  { simp only [fpow_neg_succ_of_nat, one_div_eq_inv],
    apply le_trans (inv_le_one _); apply one_le_pow_of_one_le hx },
  { simp only [fpow_neg_succ_of_nat],
    apply (one_div_le_one_div _ _).2,
    { apply pow_le_pow hx,
      have : -(↑(a+1) : ℤ) ≤ -(↑(b+1) : ℤ), from h,
      have h' := le_of_neg_le_neg this,
      apply le_of_coe_nat_le_coe_nat h' },
    repeat { apply pow_pos (lt_of_lt_of_le zero_lt_one hx) } }
end

lemma pow_le_max_of_min_le {x : α} (hx : x ≥ 1) {a b c : ℤ} (h : min a b ≤ c) :
      x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) :=
begin
  wlog hle : a ≤ b,
  have hnle : -b ≤ -a, from neg_le_neg hle,
  have hfle : x ^ (-b) ≤ x ^ (-a), from fpow_le_of_le hx hnle,
  have : x ^ (-c) ≤ x ^ (-a),
  { apply fpow_le_of_le hx,
    simpa only [min_eq_left hle, neg_le_neg_iff] using h },
  simpa only [max_eq_left hfle]
end

lemma fpow_le_one_of_nonpos {p : α} (hp : p ≥ 1) {z : ℤ} (hz : z ≤ 0) : p ^ z ≤ 1 :=
calc p ^ z ≤ p ^ 0 : fpow_le_of_le hp hz
          ... = 1        : by simp

lemma fpow_ge_one_of_nonneg {p : α} (hp : p ≥ 1) {z : ℤ} (hz : z ≥ 0) : p ^ z ≥ 1 :=
calc p ^ z ≥ p ^ 0 : fpow_le_of_le hp hz
          ... = 1        : by simp

end ordered_field_power

lemma one_lt_pow {α} [linear_ordered_semiring α] {p : α} (hp : p > 1) : ∀ {n : ℕ}, 1 ≤ n → 1 < p ^ n
| 1 h := by simp; assumption
| (k+2) h :=
  begin
    rw ←one_mul (1 : α),
    apply mul_lt_mul,
    { assumption },
    { apply le_of_lt, simpa using one_lt_pow (nat.le_add_left 1 k)},
    { apply zero_lt_one },
    { apply le_of_lt (lt_trans zero_lt_one hp) }
  end

lemma one_lt_fpow {α}  [discrete_linear_ordered_field α] {p : α} (hp : p > 1) :
  ∀ z : ℤ, z > 0 → 1 < p ^ z
| (int.of_nat n) h := one_lt_pow hp (nat.succ_le_of_lt (int.lt_of_coe_nat_lt_coe_nat h))


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.basic
import data.nat.order.basic
import algebra.order.ring.defs

/- Turn off trace messages so they don't pollute the test build: -/
set_option trace.silence_library_search true

example {a b : ℕ} (h : b > 0) (w : a ≥ 1) : b ≤ a * b :=
by library_search -- exact (le_mul_iff_one_le_left h).mpr w


import analysis.topology.topological_space
import analysis.topology.continuity
import data.set.basic
import logic.basic
import Topology.Material.connected_spaces
import analysis.real
--import Topology.Material.Path_Homotopy

open set filter lattice classical
local attribute [instance] prop_decidable

universe u
variables {α : Type u} {β : Type u}

-- Definition 12.1 TODO: Work out why this breaks??
theorem connected_if_nexists_cts [topological_space α] :
¬ (∃ f : α → bool, continuous f ∧ function.surjective f) → connected_space α :=
  by {intro h, simp at h, exact cts_to_discrete_to_connected h}

-- Definition 12.2
def is_partition [topological_space α] (A B : set α) : Prop :=
is_open A ∧ is_open B ∧ A ∪ B = univ ∧ A ∩ B = ∅ ∧ A ≠ ∅ ∧ B ≠ ∅

-- Proposition 12.3
theorem connected_def_no_partition [connected_space α] :
¬(∃ A B : set α, is_partition A B) :=
begin
  intros hc, unfold is_partition at hc,
  have h1 : ∀ U V : set α, is_open U ∧ is_open V → ¬(U ∪ V = univ ∧ U ∩ V = ∅ ∧ U ≠ ∅ ∧ V ≠ ∅),
    exact connected_def_no_open_separation,
    show false, by exact exists.elim hc
      (assume A a, by exact exists.elim a
        (assume B b, by exact absurd b.2.2 (h1 A B (and.intro b.1 b.2.1)))),
end

theorem no_partition_to_connected [topological_space α] :
¬(∃ A B : set α, is_partition A B) → connected_space α :=
begin
  intro H, simp at H, unfold is_partition at H,
  have h1 : ∀ (x y : set α), is_open x ∧ is_open y →
  ¬ (x ∪ y = univ ∧ x ∩ y = ∅ ∧ x ≠ ∅ ∧ y ≠ ∅),
    {intros x y a1, have a2 := H x y,
    rw [not_and_distrib,not_and_distrib,or_iff_not_imp_left,not_not] at a2,
    have a3 := a2 a1.1, rw [or_iff_not_imp_left,not_not] at a3, by exact a3 a1.2},
  by exact no_open_separation_to_connected h1,
end

-- Corollary 12.4

-- Example 12.5 (a)
theorem discrete_space_admits_partition [discrete_space α] {x y : α} (H : x ≠ y) :
∃ U V : set α, is_partition U V :=
begin
  unfold is_partition,
  have h1 : ∀ s : set α, s ∩ -s = ∅, {intro x, simp},
  have h2 : ∀ s : set α, s ∪ -s = univ, {intro x, simp},
  have h3 : ∀ s : set α, is_open s, {intro s, exact discrete_space.discreteness s},
  have h4 : (singleton x) ∩ -(singleton x) = ∅, {exact h1 (singleton x)},
  have h5 : (singleton x) ∪ -(singleton x) = univ, {exact h2 (singleton x)},
  have h6 : is_open (singleton x), {exact h3 (singleton x)},
  have h7 : is_open (-(singleton x)), {exact h3 (-(singleton x))},
  have h8 : (singleton x) ≠ ∅ := ne_empty_iff_exists_mem.mpr (exists.intro x (mem_singleton x)),
  have h9 : y ∈ (-(singleton x)),
        {have b1 : y ∉ (singleton x), {by_contradiction hc, rw [mem_singleton_iff] at hc,
        rw [eq_comm] at hc, exact absurd hc H}, exact (mem_compl_iff _ _ ).mpr b1},
  have h10 : -(singleton x) ≠ ∅ := ne_empty_iff_exists_mem.mpr (exists.intro y h9),
  have h11 : is_open (singleton x) ∧ is_open (-(singleton x)) ∧ (singleton x) ∪ -(singleton x) = univ ∧
  (singleton x) ∩ -(singleton x) = ∅ ∧ (singleton x) ≠ ∅ ∧ -(singleton x) ≠ ∅ := ⟨h6,h7,h5,h4,h8,h10⟩,
  by exact exists.intro (singleton x) (by exact exists.intro (-(singleton x)) (h11)),
end

-- Example 12.5 (b)
theorem indiscrete_space_admits_no_partition [indiscrete_space α] :
¬(∃ A B : set α, is_partition A B) :=
begin
  simp, intros A B hc, unfold is_partition at hc,
  show false, from absurd hc.1 (indiscrete_space.indiscreteness A),
end

-- Proposition 12.7

def interval (a b : ℝ) : set ℝ := {x : ℝ | a ≤ x ∧ x ≤ b}

lemma le_lt_trans {x y z : ℝ} (h1 : x ≤ y) (h2 : y < z) : x < z :=
begin
  have H : x ≤ z := le_trans h1 (lt_iff_le_and_ne.mp h2).1,
    {by_contradiction g1, simp at g1,
      have g2 := le_antisymm H g1, rw g2 at h1,
      exact absurd h2 (not_lt.mpr h1)},
end

lemma lt_le_trans {x y z : ℝ} (h1 : x < y) (h2 : y ≤ z) : x < z :=
begin
  have H : x ≤ z := le_trans (lt_iff_le_and_ne.mp h1).1 h2,
    {by_contradiction g1, simp at g1,
      have g2 := le_antisymm H g1, rw g2 at h1,
      exact absurd h1 (not_lt.mpr h2)},
end

theorem interval_iff {a b : ℝ} (S : set ℝ): S = interval a b ↔
∀ x y z : ℝ, x ∈ S ∧ y ∈ S ∧ (x < z) ∧ (z < y) → z ∈ S :=
begin
  apply iff.intro,
    intros hS x y z h1, rw interval at hS,
    by_contradiction hz, rw hS at hz, simp at hz,
    have g1 := h1.1, have g2 := h1.2.1,
    rw hS at g1 g2, simp at g2 g1,
    have g3 := h1.2.2.1, have g4 := h1.2.2.2,
    have t1 : a < z := le_lt_trans g1.1 g3,
    have t2 : z < b := lt_le_trans g4 g2.2,
    have t3 : b < z := (hz (le_of_lt t1)),
    by exact absurd t3 (not_lt_of_lt t2),

  by sorry

end

-- Theorem 12.8
-- Example 12.9
-- Theorem 12.10
-- Proposition 12.11

/-
theorem [connected_space α] [topological_space β] {f : α → β}
(hf : continuous f) (hs : function.surjective f) :
is_connected (f '' univ) := sorry

theorem [connected_space α] [topological_space β] {f : α → β} (hf : continuous f) :
is_connected (f '' univ) :=
begin
  rw is_connected, intros U V H1 HC, rw is_open_in_subspace at H1, by sorry
end
-/

-- Corollary 12.12
-- Corollary 12.13
-- Corollary 12.14
-- Corollary 12.15
-- Proposition 12.16
-- Corollary 12.17

-- Theorem 12.18

theorem prod_connected_if_connected [connected_space α] [connected_space β]
: connected_space (α × β) := sorry

theorem left_connected_if_prod_connected [connected_space (α × β)]
: connected_space α := sorry

theorem right_connected_if_prod_connected [connected_space (α × β)]
: connected_space β := sorry

-- Proposition 12.19
theorem subset_closure_connected [topological_space α] {A B : set α}
(hc : is_connected A) (hs1 : A ⊆ B) (hs2 : B ⊆ closure A) : is_connected B :=
sorry

-- Definition 12.20
-- Definition 12.21
-- Example 12.22 (a)
-- Example 12.22 (b)
-- Proposition 12.23
-- Lemma 12.24
-- Proposition 12.25