/-
Copyright (c) 2018 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow, Patrick Massot, Yury Kudryashov
-/
import topology.subset_properties
import topology.metric_space.basic

/-!
# Sequences in topological spaces

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

In this file we define sequences in topological spaces and show how they are related to
filters and the topology.

## Main definitions

### Set operation
* `seq_closure s`: sequential closure of a set, the set of limits of sequences of points of `s`;

### Predicates

* `is_seq_closed s`: predicate saying that a set is sequentially closed, i.e., `seq_closure s ⊆ s`;
* `seq_continuous f`: predicate saying that a function is sequentially continuous, i.e.,
  for any sequence `u : ℕ → X` that converges to a point `x`, the sequence `f ∘ u` converges to
  `f x`;
* `is_seq_compact s`: predicate saying that a set is sequentially compact, i.e., every sequence
  taking values in `s` has a converging subsequence.

### Type classes

* `frechet_urysohn_space X`: a typeclass saying that a topological space is a *Fréchet-Urysohn
  space*, i.e., the sequential closure of any set is equal to its closure.
* `sequential_space X`: a typeclass saying that a topological space is a *sequential space*, i.e.,
  any sequentially closed set in this space is closed. This condition is weaker than being a
  Fréchet-Urysohn space.
* `seq_compact_space X`: a typeclass saying that a topological space is sequentially compact, i.e.,
  every sequence in `X` has a converging subsequence.

## Main results

* `seq_closure_subset_closure`: closure of a set includes its sequential closure;
* `is_closed.is_seq_closed`: a closed set is sequentially closed;
* `is_seq_closed.seq_closure_eq`: sequential closure of a sequentially closed set `s` is equal
  to `s`;
* `seq_closure_eq_closure`: in a Fréchet-Urysohn space, the sequential closure of a set is equal to
  its closure;
* `tendsto_nhds_iff_seq_tendsto`, `frechet_urysohn_space.of_seq_tendsto_imp_tendsto`: a topological
  space is a Fréchet-Urysohn space if and only if sequential convergence implies convergence;
* `topological_space.first_countable_topology.frechet_urysohn_space`: every topological space with
  first countable topology is a Fréchet-Urysohn space;
* `frechet_urysohn_space.to_sequential_space`: every Fréchet-Urysohn space is a sequential space;
* `is_seq_compact.is_compact`: a sequentially compact set in a uniform space with countably
  generated uniformity is compact.

## Tags

sequentially closed, sequentially compact, sequential space
-/

open set function filter topological_space
open_locale topology filter

variables {X Y : Type*}

/-! ### Sequential closures, sequential continuity, and sequential spaces. -/
section topological_space
variables [topological_space X] [topological_space Y]

/-- The sequential closure of a set `s : set X` in a topological space `X` is the set of all `a : X`
which arise as limit of sequences in `s`. Note that the sequential closure of a set is not
guaranteed to be sequentially closed. -/
def seq_closure (s : set X) : set X :=
{a | ∃ x : ℕ → X, (∀ n : ℕ, x n ∈ s) ∧ tendsto x at_top (𝓝 a)}

lemma subset_seq_closure {s : set X} : s ⊆ seq_closure s :=
λ p hp, ⟨const ℕ p, λ _, hp, tendsto_const_nhds⟩

/-- The sequential closure of a set is contained in the closure of that set.
The converse is not true. -/
lemma seq_closure_subset_closure {s : set X} : seq_closure s ⊆ closure s :=
λ p ⟨x, xM, xp⟩, mem_closure_of_tendsto xp (univ_mem' xM)

/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`, the
limit belongs to `s` as well. Note that the sequential closure of a set is not guaranteed to be
sequentially closed. -/
def is_seq_closed (s : set X) : Prop :=
∀ ⦃x : ℕ → X⦄ ⦃p : X⦄, (∀ n, x n ∈ s) → tendsto x at_top (𝓝 p) → p ∈ s

/-- The sequential closure of a sequentially closed set is the set itself. -/
lemma is_seq_closed.seq_closure_eq {s : set X} (hs : is_seq_closed s) :
  seq_closure s = s :=
subset.antisymm (λ p ⟨x, hx, hp⟩, hs hx hp) subset_seq_closure

/-- If a set is equal to its sequential closure, then it is sequentially closed. -/
lemma is_seq_closed_of_seq_closure_eq {s : set X} (hs : seq_closure s = s) :
  is_seq_closed s :=
λ x p hxs hxp, hs ▸ ⟨x, hxs, hxp⟩

/-- A set is sequentially closed iff it is equal to its sequential closure. -/
lemma is_seq_closed_iff {s : set X} :
  is_seq_closed s ↔ seq_closure s = s :=
⟨is_seq_closed.seq_closure_eq, is_seq_closed_of_seq_closure_eq⟩

/-- A set is sequentially closed if it is closed. -/
protected lemma is_closed.is_seq_closed {s : set X} (hc : is_closed s) : is_seq_closed s :=
λ u x hu hx, hc.mem_of_tendsto hx (eventually_of_forall hu)

/-- A topological space is called a *Fréchet-Urysohn space*, if the sequential closure of any set
is equal to its closure. Since one of the inclusions is trivial, we require only the non-trivial one
in the definition. -/
class frechet_urysohn_space (X : Type*) [topological_space X] : Prop :=
(closure_subset_seq_closure : ∀ s : set X, closure s ⊆ seq_closure s)

lemma seq_closure_eq_closure [frechet_urysohn_space X] (s : set X) :
  seq_closure s = closure s :=
seq_closure_subset_closure.antisymm $ frechet_urysohn_space.closure_subset_seq_closure s

/-- In a Fréchet-Urysohn space, a point belongs to the closure of a set iff it is a limit
of a sequence taking values in this set. -/
lemma mem_closure_iff_seq_limit [frechet_urysohn_space X] {s : set X} {a : X} :
  a ∈ closure s ↔ ∃ x : ℕ → X, (∀ n : ℕ, x n ∈ s) ∧ tendsto x at_top (𝓝 a) :=
by { rw [← seq_closure_eq_closure], refl }

/-- If the domain of a function `f : α → β` is a Fréchet-Urysohn space, then convergence
is equivalent to sequential convergence. See also `filter.tendsto_iff_seq_tendsto` for a version
that works for any pair of filters assuming that the filter in the domain is countably generated.

This property is equivalent to the definition of `frechet_urysohn_space`, see
`frechet_urysohn_space.of_seq_tendsto_imp_tendsto`. -/
lemma tendsto_nhds_iff_seq_tendsto [frechet_urysohn_space X] {f : X → Y} {a : X} {b : Y} :
  tendsto f (𝓝 a) (𝓝 b) ↔ ∀ u : ℕ → X, tendsto u at_top (𝓝 a) → tendsto (f ∘ u) at_top (𝓝 b) :=
begin
  refine ⟨λ hf u hu, hf.comp hu,
    λ h, ((nhds_basis_closeds _).tendsto_iff (nhds_basis_closeds _)).2 _⟩,
  rintro s ⟨hbs, hsc⟩,
  refine ⟨closure (f ⁻¹' s), ⟨mt _ hbs, is_closed_closure⟩, λ x, mt $ λ hx, subset_closure hx⟩,
  rw [← seq_closure_eq_closure],
  rintro ⟨u, hus, hu⟩,
  exact hsc.mem_of_tendsto (h u hu) (eventually_of_forall hus)
end

/-- An alternative construction for `frechet_urysohn_space`: if sequential convergence implies
convergence, then the space is a Fréchet-Urysohn space. -/
lemma frechet_urysohn_space.of_seq_tendsto_imp_tendsto
  (h : ∀ (f : X → Prop) (a : X),
    (∀ u : ℕ → X, tendsto u at_top (𝓝 a) → tendsto (f ∘ u) at_top (𝓝 (f a))) → continuous_at f a) :
  frechet_urysohn_space X :=
begin
  refine ⟨λ s x hcx, _⟩,
  specialize h (∉ s) x,
  by_cases hx : x ∈ s, { exact subset_seq_closure hx },
  simp_rw [(∘), continuous_at, hx, not_false_iff, nhds_true, tendsto_pure, eq_true_iff,
    ← mem_compl_iff, eventually_mem_set, ← mem_interior_iff_mem_nhds, interior_compl] at h,
  rw [mem_compl_iff, imp_not_comm] at h,
  simp only [not_forall, not_eventually, mem_compl_iff, not_not] at h,
  rcases h hcx with ⟨u, hux, hus⟩,
  rcases extraction_of_frequently_at_top hus with ⟨φ, φ_mono, hφ⟩,
  exact ⟨u ∘ φ, hφ, hux.comp φ_mono.tendsto_at_top⟩
end

/-- Every first-countable space is a Fréchet-Urysohn space. -/
@[priority 100] -- see Note [lower instance priority]
instance topological_space.first_countable_topology.frechet_urysohn_space
  [first_countable_topology X] : frechet_urysohn_space X :=
frechet_urysohn_space.of_seq_tendsto_imp_tendsto $ λ f a, tendsto_iff_seq_tendsto.2

/-- A topological space is said to be a *sequential space* if any sequentially closed set in this
space is closed. This condition is weaker than being a Fréchet-Urysohn space. -/
class sequential_space (X : Type*) [topological_space X] : Prop :=
(is_closed_of_seq : ∀ s : set X, is_seq_closed s → is_closed s)

/-- Every Fréchet-Urysohn space is a sequential space. -/
@[priority 100] -- see Note [lower instance priority]
instance frechet_urysohn_space.to_sequential_space [frechet_urysohn_space X] :
  sequential_space X :=
⟨λ s hs, by rw [← closure_eq_iff_is_closed, ← seq_closure_eq_closure, hs.seq_closure_eq]⟩

/-- In a sequential space, a sequentially closed set is closed. -/
protected lemma is_seq_closed.is_closed [sequential_space X] {s : set X} (hs : is_seq_closed s) :
  is_closed s :=
sequential_space.is_closed_of_seq s hs

/-- In a sequential space, a set is closed iff it's sequentially closed. -/
lemma is_seq_closed_iff_is_closed [sequential_space X] {M : set X} :
  is_seq_closed M ↔ is_closed M :=
⟨is_seq_closed.is_closed, is_closed.is_seq_closed⟩

/-- A function between topological spaces is sequentially continuous if it commutes with limit of
 convergent sequences. -/
def seq_continuous (f : X → Y) : Prop :=
∀ ⦃x : ℕ → X⦄ ⦃p : X⦄, tendsto x at_top (𝓝 p) → tendsto (f ∘ x) at_top (𝓝 (f p))

/-- The preimage of a sequentially closed set under a sequentially continuous map is sequentially
closed. -/
lemma is_seq_closed.preimage {f : X → Y} {s : set Y} (hs : is_seq_closed s)
  (hf : seq_continuous f) :
  is_seq_closed (f ⁻¹' s) :=
λ x p hx hp, hs hx (hf hp)

/- A continuous function is sequentially continuous. -/
protected lemma continuous.seq_continuous {f : X → Y} (hf : continuous f) :
  seq_continuous f :=
λ x p hx, (hf.tendsto p).comp hx

/-- A sequentially continuous function defined on a sequential space is continuous. -/
protected lemma seq_continuous.continuous [sequential_space X] {f : X → Y} (hf : seq_continuous f) :
  continuous f :=
continuous_iff_is_closed.mpr $ λ s hs, (hs.is_seq_closed.preimage hf).is_closed

/-- If the domain of a function is a sequential space, then continuity of this function is
equivalent to its sequential continuity. -/
lemma continuous_iff_seq_continuous [sequential_space X] {f : X → Y} :
  continuous f ↔ seq_continuous f :=
⟨continuous.seq_continuous, seq_continuous.continuous⟩

lemma quotient_map.sequential_space [sequential_space X] {f : X → Y} (hf : quotient_map f) :
  sequential_space Y :=
⟨λ s hs, hf.is_closed_preimage.mp $ (hs.preimage $ hf.continuous.seq_continuous).is_closed⟩

/-- The quotient of a sequential space is a sequential space. -/
instance [sequential_space X] {s : setoid X} : sequential_space (quotient s) :=
quotient_map_quot_mk.sequential_space

end topological_space

section seq_compact
open topological_space topological_space.first_countable_topology
variables [topological_space X]

/-- A set `s` is sequentially compact if every sequence taking values in `s` has a
converging subsequence. -/
def is_seq_compact (s : set X) :=
∀ ⦃x : ℕ → X⦄, (∀ n, x n ∈ s) → ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a)

/-- A space `X` is sequentially compact if every sequence in `X` has a
converging subsequence. -/
@[mk_iff] class seq_compact_space (X : Type*) [topological_space X] : Prop :=
(seq_compact_univ : is_seq_compact (univ : set X))

export seq_compact_space (seq_compact_univ)

lemma is_seq_compact.subseq_of_frequently_in {s : set X} (hs : is_seq_compact s) {x : ℕ → X}
  (hx : ∃ᶠ n in at_top, x n ∈ s) :
  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
let ⟨ψ, hψ, huψ⟩ := extraction_of_frequently_at_top hx, ⟨a, a_in, φ, hφ, h⟩ := hs huψ in
⟨a, a_in, ψ ∘ φ, hψ.comp hφ, h⟩

lemma seq_compact_space.tendsto_subseq [seq_compact_space X] (x : ℕ → X) :
  ∃ a (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
let ⟨a, _, φ, mono, h⟩ := seq_compact_univ (λ n, mem_univ (x n)) in ⟨a, φ, mono, h⟩

section first_countable_topology
variables [first_countable_topology X]
open topological_space.first_countable_topology

protected lemma is_compact.is_seq_compact {s : set X} (hs : is_compact s) : is_seq_compact s :=
λ x x_in, let ⟨a, a_in, ha⟩ := hs (tendsto_principal.mpr (eventually_of_forall x_in))
in ⟨a, a_in, tendsto_subseq ha⟩

lemma is_compact.tendsto_subseq' {s : set X} {x : ℕ → X} (hs : is_compact s)
  (hx : ∃ᶠ n in at_top, x n ∈ s) :
  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
hs.is_seq_compact.subseq_of_frequently_in hx

lemma is_compact.tendsto_subseq {s : set X} {x : ℕ → X} (hs : is_compact s) (hx : ∀ n, x n ∈ s) :
  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
hs.is_seq_compact hx

@[priority 100] -- see Note [lower instance priority]
instance first_countable_topology.seq_compact_of_compact [compact_space X] : seq_compact_space X :=
⟨is_compact_univ.is_seq_compact⟩

lemma compact_space.tendsto_subseq [compact_space X] (x : ℕ → X) :
  ∃ a (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
seq_compact_space.tendsto_subseq x

end first_countable_topology
end seq_compact

section uniform_space_seq_compact

open_locale uniformity
open uniform_space prod

variables [uniform_space X] {s : set X}

lemma is_seq_compact.exists_tendsto_of_frequently_mem (hs : is_seq_compact s) {u : ℕ → X}
  (hu : ∃ᶠ n in at_top, u n ∈ s) (huc : cauchy_seq u) :
  ∃ x ∈ s, tendsto u at_top (𝓝 x) :=
let ⟨x, hxs, φ, φ_mono, hx⟩ := hs.subseq_of_frequently_in hu
in ⟨x, hxs, tendsto_nhds_of_cauchy_seq_of_subseq huc φ_mono.tendsto_at_top hx⟩

lemma is_seq_compact.exists_tendsto (hs : is_seq_compact s) {u : ℕ → X} (hu : ∀ n, u n ∈ s)
  (huc : cauchy_seq u) : ∃ x ∈ s, tendsto u at_top (𝓝 x) :=
hs.exists_tendsto_of_frequently_mem (frequently_of_forall hu) huc

/-- A sequentially compact set in a uniform space is totally bounded. -/
protected lemma is_seq_compact.totally_bounded (h : is_seq_compact s) : totally_bounded s :=
begin
  intros V V_in,
  unfold is_seq_compact at h,
  contrapose! h,
  obtain ⟨u, u_in, hu⟩ : ∃ u : ℕ → X, (∀ n, u n ∈ s) ∧ ∀ n m, m < n → u m ∉ ball (u n) V,
  { simp only [not_subset, mem_Union₂, not_exists, exists_prop] at h,
    simpa only [forall_and_distrib, ball_image_iff, not_and] using seq_of_forall_finite_exists h },
  refine ⟨u, u_in, λ x x_in φ hφ huφ, _⟩,
  obtain ⟨N, hN⟩ : ∃ N, ∀ p q, p ≥ N → q ≥ N → (u (φ p), u (φ q)) ∈ V,
    from huφ.cauchy_seq.mem_entourage V_in,
  exact hu (φ $ N + 1) (φ N) (hφ $ lt_add_one N) (hN (N + 1) N N.le_succ le_rfl)
end

variables [is_countably_generated (𝓤 X)]

/-- A sequentially compact set in a uniform set with countably generated uniformity filter
is complete. -/
protected lemma is_seq_compact.is_complete (hs : is_seq_compact s) : is_complete s :=
begin
  intros l hl hls,
  haveI := hl.1,
  rcases exists_antitone_basis (𝓤 X) with ⟨V, hV⟩,
  choose W hW hWV using λ n, comp_mem_uniformity_sets (hV.mem n),
  have hWV' : ∀ n, W n ⊆ V n, from λ n ⟨x, y⟩ hx, @hWV n (x, y) ⟨x, refl_mem_uniformity $ hW _, hx⟩,
  obtain ⟨t, ht_anti, htl, htW, hts⟩ : ∃ t : ℕ → set X, antitone t ∧ (∀ n, t n ∈ l) ∧
    (∀ n, t n ×ˢ t n ⊆ W n) ∧ (∀ n, t n ⊆ s),
  { have : ∀ n, ∃ t ∈ l, t ×ˢ t ⊆ W n ∧ t ⊆ s,
    { rw [le_principal_iff] at hls,
      have : ∀ n, W n ∩ s ×ˢ s ∈ l ×ᶠ l := λ n, inter_mem (hl.2 (hW n)) (prod_mem_prod hls hls),
      simpa only [l.basis_sets.prod_self.mem_iff, true_implies_iff, subset_inter_iff,
        prod_self_subset_prod_self, and.assoc] using this },
    choose t htl htW hts,
    have : ∀ n, (⋂ k ≤ n, t k) ⊆ t n, from λ n, Inter₂_subset _ le_rfl,
    exact ⟨λ n, ⋂ k ≤ n, t k, λ m n h, bInter_subset_bInter_left (λ k (hk : k ≤ m), hk.trans h),
      λ n, (bInter_mem (finite_le_nat n)).2 (λ k hk, htl k),
      λ n, (prod_mono (this n) (this n)).trans (htW n), λ n, (this n).trans (hts n)⟩ },
  choose u hu using λ n, filter.nonempty_of_mem (htl n),
  have huc : cauchy_seq u := hV.to_has_basis.cauchy_seq_iff.2
    (λ N hN, ⟨N, λ m hm n hn, hWV' _ $ @htW N (_, _) ⟨ht_anti hm (hu _), (ht_anti hn (hu _))⟩⟩),
  rcases hs.exists_tendsto (λ n, hts n (hu n)) huc with ⟨x, hxs, hx⟩,
  refine ⟨x, hxs, (nhds_basis_uniformity' hV.to_has_basis).ge_iff.2 $ λ N hN, _⟩,
  obtain ⟨n, hNn, hn⟩ : ∃ n, N ≤ n ∧ u n ∈ ball x (W N),
    from ((eventually_ge_at_top N).and (hx $ ball_mem_nhds x (hW N))).exists,
  refine mem_of_superset (htl n) (λ y hy, hWV N ⟨u n, _, htW N ⟨_, _⟩⟩),
  exacts [hn, ht_anti hNn (hu n), ht_anti hNn hy]
end

/-- If `𝓤 β` is countably generated, then any sequentially compact set is compact. -/
protected lemma is_seq_compact.is_compact (hs : is_seq_compact s) : is_compact s :=
is_compact_iff_totally_bounded_is_complete.2 ⟨hs.totally_bounded, hs.is_complete⟩

/-- A version of Bolzano-Weistrass: in a uniform space with countably generated uniformity filter
(e.g., in a metric space), a set is compact if and only if it is sequentially compact. -/
protected lemma uniform_space.is_compact_iff_is_seq_compact : is_compact s ↔ is_seq_compact s :=
⟨λ H, H.is_seq_compact, λ H, H.is_compact⟩

lemma uniform_space.compact_space_iff_seq_compact_space : compact_space X ↔ seq_compact_space X :=
by simp only [← is_compact_univ_iff, seq_compact_space_iff,
  uniform_space.is_compact_iff_is_seq_compact]

end uniform_space_seq_compact

section metric_seq_compact

variables [pseudo_metric_space X]
open metric

lemma seq_compact.lebesgue_number_lemma_of_metric {ι : Sort*} {c : ι → set X}
  {s : set X} (hs : is_seq_compact s) (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
  ∃ δ > 0, ∀ a ∈ s, ∃ i, ball a δ ⊆ c i :=
lebesgue_number_lemma_of_metric hs.is_compact hc₁ hc₂

variables [proper_space X] {s : set X}

/-- A version of **Bolzano-Weistrass**: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. This version assumes only
that the sequence is frequently in some bounded set. -/
lemma tendsto_subseq_of_frequently_bounded (hs : bounded s)
  {x : ℕ → X} (hx : ∃ᶠ n in at_top, x n ∈ s) :
  ∃ a ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
have hcs : is_seq_compact (closure s), from hs.is_compact_closure.is_seq_compact,
have hu' : ∃ᶠ n in at_top, x n ∈ closure s, from hx.mono (λ n hn, subset_closure hn),
hcs.subseq_of_frequently_in hu'

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. -/
lemma tendsto_subseq_of_bounded (hs : bounded s) {x : ℕ → X} (hx : ∀ n, x n ∈ s) :
  ∃ a ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
tendsto_subseq_of_frequently_bounded hs $ frequently_of_forall hx

end metric_seq_compact


import tactic
import data.nat.modeq

noncomputable theory
open_locale classical

-- Let p be an odd prime.

variables {p : ℕ} [fact p.prime]

-- A group of p campers sit around a circle,
-- and are labeled with the integers 1,2,...,p in clockwise order.
-- The camper with label 1 yells out the number 1.
-- The camper sitting next to this camper in clockwise order yells out 2.
-- The camper two spots in clockwise order from the camper who yelled out 2 yells out 3.
-- This process continues: the camper seated n spots (in clockwise order) from the camper who yelled out n must yell out n+1.
-- A camper gets a cookie anytime she or he yells out a number.

lemma arithmetic1 (a b : ℕ) (hb : 1 < b) : a % b < b := sorry

structure camper_state (campers : Type*) :=
(head : campers)
(count : ℕ)
(cookies : campers → ℕ)

def initial_state : camper_state (fin p) :=
begin
  refine {head := _, count := 0, cookies := λ x, 0},
  refine ⟨1, _⟩, apply nat.prime.one_lt, assumption,
end

def update : camper_state (fin p) → camper_state (fin p) :=
begin
  intro s,
  refine {head := _,
  count := s.count + 1,
  cookies := λ x, if x = s.head then s.cookies x + 1 else s.cookies x
  },
  refine ⟨ (s.head + s.count) % p, _ ⟩,
  apply arithmetic1, refine nat.prime.one_lt _inst_1,
end

def seq_state : ℕ → camper_state (fin p)
| 0 := initial_state
| (n+1) := update (seq_state n)

-- Show that there is a camper who never gets a cookie.
def sad_camper (a : fin p) : Prop := ∀ n, (seq_state n).cookies a = 0 :=

theorem exists_sad_camper : ∃ a : fin p, sad_camper a :=
  sorry

-- Of the campers who do get cookies, is there one who at some point has at least ten more cookies than the others?

def max_cookie_camper (a : fin p) : Prop :=
∀ n, ∀ b ≠ a, 10 < (seq_state n).cookies a - (seq_state n).cookies b

-- prove the following statement or its negation
theorem exists_max_cookie_camper : ∃ a : fin p, max_cookie_camper a :=
  sorry

-- Of the campers who do get cookies, is there one who at some point has at least ten fewer cookies than the others?

def min_cookie_camper (a : fin p) : Prop :=
∀ n, ∀ b ≠ a, sad_camper b ∨ 10 < (seq_state n).cookies b - (seq_state n).cookies a

-- prove the following statement or its negation
theorem exists_min_cookie_camper : ∃ a : fin p, min_cookie_camper a :=
  sorry


import lecture01
import data.complex.basic
import data.equiv.fintype
import data.int.order
import tactic.norm_swap

namespace e222

namespace group

variables {n : ℕ}

example : GLₙ n ℝ = units (matrix (fin n) (fin n) ℝ) := rfl
example : GLₙ n ℂ = units (matrix (fin n) (fin n) ℂ) := rfl
example : GLₙ n ℚ = units (matrix (fin n) (fin n) ℚ) := rfl

variables {G : Type*} [group G] (a b c : G)

example : a ᵍ* (b ᵍ* c) = a ᵍ* b ᵍ* c := group.mul_assoc _ _ _
example : ᵍ1 ᵍ* a = a ∧ a ᵍ* ᵍ1 = a := ⟨group.one_mul _, group.mul_one _⟩
example : a ᵍ* aᵍ⁻¹ = ᵍ1 ∧ aᵍ⁻¹ ᵍ* a = ᵍ1 := ⟨group.mul_inv _, group.inv_mul _⟩

-- Matrices that are invertible form a group under matrix multiplication
noncomputable instance {K n' : Type*} [comm_ring K] [fintype n'] [decidable_eq n'] :
  group (units (matrix n' n' K)) :=
{ op := (*),
  assoc' := λ _ _ _, units.ext $
    by simp only [units.coe_mul, matrix.mul_eq_mul, ←matrix.mul_assoc],
  e := 1,
  op_e' := λ _, units.ext $ by
    by simp only [units.coe_mul, units.coe_one, matrix.mul_eq_mul, matrix.mul_one],
  e_op' := λ _, units.ext $ by
    by simp only [units.coe_mul, units.coe_one, matrix.mul_eq_mul, matrix.one_mul],
  inv := λ a, ⟨a⁻¹, a,
    by rw [matrix.mul_eq_mul, matrix.nonsing_inv_mul _
           ((matrix.is_unit_iff_is_unit_det _).mp a.is_unit)],
    by rw [matrix.mul_eq_mul, matrix.mul_nonsing_inv _
           ((matrix.is_unit_iff_is_unit_det _).mp a.is_unit)]⟩,
  inv_op' := λ x, units.ext $ by
    rw [units.coe_mul, units.coe_mk, units.coe_one,
        matrix.mul_eq_mul, matrix.nonsing_inv_mul _
        ((matrix.is_unit_iff_is_unit_det _).mp x.is_unit)],
  op_inv' := λ x, units.ext $ by
    rw [units.coe_mul, units.coe_mk, units.coe_one,
        matrix.mul_eq_mul, matrix.mul_nonsing_inv _
        ((matrix.is_unit_iff_is_unit_det _).mp x.is_unit)] }

-- Transfer the group instance to our notation
noncomputable instance (n : ℕ) (K : Type*) [comm_ring K] : group (GLₙ n K) :=
by apply_instance

lemma GLₙ.group.e_def {K : Type*} [comm_ring K] : (GLₙ.group n K).e = 1 := rfl
lemma GLₙ.group.op_def {K : Type*} [comm_ring K] : (GLₙ.group n K).op = (*) := rfl
lemma GLₙ.group.inv_coe {K : Type*} [comm_ring K] (M : GLₙ n K) :
  (↑(Mᵍ⁻¹ : GLₙ n K) : matrix (fin n) (fin n) K) = (↑M : matrix _ _ _)⁻¹ := rfl

-- Our own notation
notation `Sym ` T := T ≃ T
notation `Aut ` T := T ≃ T

-- The prototypical (ur) example of a group is the symmetries of T
-- defined so that `(f * g)(x) = f(g(x))`
instance (T : Type*) : group (Sym T) :=
{ op := λ f g, g.trans f,
  assoc' := λ _ _ _, equiv.trans_assoc _ _ _,
  e := equiv.refl _,
  op_e' := equiv.trans_refl,
  e_op' := equiv.refl_trans,
  inv := equiv.symm,
  inv_op' := equiv.self_trans_symm,
  op_inv' := equiv.symm_trans_self }

-- helper lemmas to associate symmetry multiplication with application
@[simp] lemma mul_apply {T : Type*} (f g : Sym T) (x : T) :
  (f ᵍ* g) x = f (g x) := rfl

lemma equiv.group.op_def (T : Type*) : (equiv.group T).op = (*) := rfl
lemma equiv.group.e_def (T : Type*) : (equiv.group T).e = 1 := rfl
lemma equiv.group.inv_def {T : Type*} (x : Sym T) : xᵍ⁻¹ = x⁻¹ := rfl

-- Definition of subgroup, similar to the mathlib construction
@[ext] structure subgroup (G : Type*) [group G] :=
-- subset
(carrier : set G)
-- contains identity
(mem_e : ᵍ1 ∈ carrier)
-- closed under multiplication
(mem_op : ∀ ⦃x : G⦄ (hx : x ∈ carrier) ⦃y : G⦄ (hy : y ∈ carrier), x ᵍ* y ∈ carrier)
-- closed under inverses
(mem_inv : ∀ ⦃x : G⦄ (hx : x ∈ carrier), xᵍ⁻¹ ∈ carrier)

-- Notational shortcut
instance : has_mem G (subgroup G) := ⟨λ g H, g ∈ H.carrier⟩

-- Normalization to express membership using the notational shortcut
@[simp] lemma subgroup.mem_iff {g : G} {H : subgroup G} : g ∈ H.carrier ↔ g ∈ H := iff.rfl

-- Two subgroups are equal iff they are equal on all elements (extensionality)
lemma subgroup.ext_iff' {G : Type*} [group G] {H H' : subgroup G} :
  H = H' ↔ (∀ (g : G), g ∈ H ↔ g ∈ H') :=
begin
  split,
  { intro H,
    rw H,
    exact λ _, iff.rfl },
  { intro h,
    ext,
    simp only [h, subgroup.mem_iff] },
end

@[simp] lemma mul_left_inj (x : G) {y z : G} :
  x ᵍ* y = x ᵍ* z ↔ y = z :=
⟨λ h, by simpa [mul_assoc] using congr_arg (λ t, xᵍ⁻¹ ᵍ* t) h, λ h, h ▸ rfl⟩

@[simp] lemma mul_right_inj (y : G) {x z : G} :
  x ᵍ* y = z ᵍ* y ↔ x = z :=
⟨λ h, by simpa [←mul_assoc] using congr_arg (λ t, t ᵍ* yᵍ⁻¹) h, λ h, h ▸ rfl⟩

@[simp] lemma inv_inv (g : G) :
  gᵍ⁻¹ᵍ⁻¹ = g :=
begin
  rw [←mul_left_inj gᵍ⁻¹, mul_inv, inv_mul]
end

@[simp] lemma subgroup.mem_inv_iff {x : G} {H : subgroup G} :
  xᵍ⁻¹ ∈ H ↔ x ∈ H :=
begin
  refine ⟨λ h, _, λ h, H.mem_inv h⟩,
  rw ←inv_inv x,
  exact H.mem_inv h
end

-- GLₙ(ℝ) as a subgroup of Sym(ℝ^n)
example {n : ℕ} : subgroup (Sym (fin n → ℝ)) :=
{ carrier := {f | is_linear_map ℝ f}, -- we know that GLₙ(ℝ) is the set of linear maps
  mem_e := by { simp only [equiv.perm.coe_one, set.mem_set_of_eq,
    show (ᵍ1 : Sym (fin n → ℝ)) = 1, from rfl],
    exact ⟨by simp, by simp⟩ },
  mem_op := by { simp_rw [set.mem_set_of_eq],
    intros f hf g hg,
    refine ⟨λ x y, _, λ r x, _⟩,
    { simp only [mul_apply, hg.map_add, hf.map_add] },
    { simp only [mul_apply, hg.map_smul, hf.map_smul] } },
  mem_inv := by { simp_rw [set.mem_set_of_eq],
      -- show (equiv.group (fin n → ℝ)).inv = equiv.symm, from rfl],
    intros f hf,
    refine ⟨λ x y, _, λ r x, _⟩;
    { apply f.injective,
      simp only [hf.map_add, hf.map_smul, ←mul_apply, equiv.group.op_def,
        mul_inv, equiv.group.e_def, equiv.perm.coe_one, id.def] } } }

-- order of Sₙ is n!
example {n : ℕ} : fintype.card (Sₙ n) = nat.factorial n :=
begin
  rw [fintype.card_perm, fintype.card_fin]
end

-- S₁ is solely the identity
-- we can rely on mathlib to enumerate the elements for us
-- using a brute-force computation, invoked by `dec_trivial`
-- because it is decidable to check equality of finite perms,
-- by checking on all the elements
example : (finset.univ : finset Sₙ 1) = {1} := dec_trivial

example : (finset.univ : finset Sₙ 2) = {1, equiv.swap 0 1} := dec_trivial

-- TODO: use cycle notation
example : (finset.univ : finset Sₙ 3) =
  {1, equiv.swap 0 1, equiv.swap 0 2, equiv.swap 1 2,
    equiv.of_bijective ![1, 2, 0] dec_trivial, equiv.of_bijective ![2, 0, 1] dec_trivial} :=
  dec_trivial

-- TODO: #8258
@[simps apply symm_apply]
def fin_as_subtype {n m : ℕ} (h : n ≤ m) : fin n ≃o subtype (λ (i : fin m), (i : ℕ) < n) :=
{ to_fun := λ i, ⟨fin.cast_le h i, by simpa using i.is_lt⟩,
  inv_fun := λ i, ⟨i, i.prop⟩,
  left_inv := λ _, by simp,
  right_inv := λ _, by simp,
  map_rel_iff' := λ _ _, by simp }

-- TODO: #8259
def subgroup.Sk (k n : ℕ) (h : k ≤ n) : subgroup (Sₙ n) :=
{ carrier := set.range (λ f : Sₙ k, f.extend_domain (fin_as_subtype h).to_equiv),
  mem_e := by { simp only [set.mem_range], use 1,
    simp only [equiv.group.e_def, equiv.perm.extend_domain_one] },
  mem_op := by { simp only [forall_apply_eq_imp_iff', set.mem_range, forall_const,
    equiv.perm.extend_domain_mul, exists_imp_distrib, exists_apply_eq_apply, equiv.group.op_def] },
  mem_inv := by { simp only [forall_apply_eq_imp_iff', set.mem_range, forall_const,
    equiv.perm.extend_domain_inv, exists_imp_distrib, exists_apply_eq_apply, equiv.group.inv_def] } }

-- The group Sₙ is non-abelian for all 3 ≤ n
example {n : ℕ} (hn : 3 ≤ n) : ∃ (g h : Sₙ n), g ᵍ* h ≠ h ᵍ* g :=
begin
  obtain ⟨g, h, hgh⟩ : ∃ g h : Sₙ 3, g ᵍ* h ≠ h ᵍ* g,
  { use [equiv.swap 0 1, equiv.swap 0 2],
    intro H,
    have := equiv.congr_fun H 0,
    norm_num [equiv.group.op_def] at this },
  refine ⟨g.extend_domain (fin_as_subtype hn).to_equiv,
          h.extend_domain (fin_as_subtype hn).to_equiv, λ H, hgh _⟩,
  ext x,
  simpa [equiv.perm.extend_domain_mul, -rel_iso.coe_fn_to_equiv,
    equiv.perm.extend_domain_apply_image, ←subtype.ext_iff, ←fin.ext_iff] using
    congr_arg (λ (p : Sₙ n), p ((fin_as_subtype hn).to_equiv x)) H
end

-- Subgroup of GL₂(ℝ) which stabilizer the line `y = 0`
noncomputable example : subgroup (GLₙ 2 ℝ) :=
{ carrier := {A : GLₙ 2 ℝ | ∃ (a c d : ℝ), a * d ≠ 0 ∧ ![![a, c], ![0, d]] = (↑A : matrix _ _ _)},
  mem_e := by { simp only [units.coe_one, ne.def, set.mem_set_of_eq, mul_eq_zero, GLₙ.group.e_def],
  use [1, 0, 1],
  simp only [not_false_iff, one_ne_zero, or_self, true_and],
  ext i j,
  fin_cases i;
  fin_cases j;
  simp },
  mem_op := by { simp only [and_imp, ne.def, matrix.mul_eq_mul, set.mem_set_of_eq, mul_eq_zero,
    exists_imp_distrib, units.coe_mul, not_or_distrib, GLₙ.group.op_def],
    intros M a c d ha hd hM M' a' c' d' ha' hd' hM',
    use [a * a', a * c' + c * d', d * d'],
    simp [←hM, ←hM', ha, hd, ha', hd'] },
  mem_inv := by { simp only [not_or_distrib, and_imp, ne.def, set.mem_set_of_eq, exists_imp_distrib,
    mul_eq_zero],
    intros M a c d ha hd hM,
    suffices : (↑M : matrix _ _ _) * ![![a⁻¹, - c / (a * d)], ![0, d⁻¹]] = 1,
    { use [a⁻¹, - c / (a * d), d⁻¹],
      rw [matrix.mul_eq_mul] at this,
      simp [ha, hd, GLₙ.group.inv_coe, matrix.inv_eq_right_inv this] },
    rw ←hM,
    ext i j,
    fin_cases i;
    fin_cases j;
    { field_simp [ha, hd],
      try { ring } } } }

instance : group ℤ :=
{ op := (+),
  assoc' := λ _ _ _, (int.add_assoc _ _ _).symm,
  e := 0,
  op_e' := int.add_zero,
  e_op' := int.zero_add,
  inv := λ x, -x,
  inv_op' := int.add_left_neg,
  op_inv' := int.add_right_neg }

instance : abelian_group ℤ :=
{ comm := int.add_comm,
  ..int.group }

lemma int.group.op_def : int.group.op = (+) := rfl
lemma int.group.e_def : int.group.e = 0 := rfl
lemma int.group.inv_def (x : ℤ) : xᵍ⁻¹ = -x := rfl

def subgroup.int (b : ℤ) : subgroup ℤ :=
{ carrier := set.range ((*) b), -- left multiplication by b
  mem_e := by {
    simp only [set.mem_range, int.group.e_def],
    simp only [mul_eq_zero, exists_or_eq_right] },
  mem_op := by {
    simp only [set.mem_range, int.group.op_def],
    rintro _ ⟨m, rfl⟩ _ ⟨n, rfl⟩,
    use (m + n),
    simp only [mul_add] },
  mem_inv := by {
    simp only [set.mem_range, int.group.inv_def],
    rintro _ ⟨m, rfl⟩,
    use -m,
    simp only [mul_neg_eq_neg_mul_symm] } }

lemma subgroup.int.mem_iff {b x : ℤ} :
  x ∈ subgroup.int b ↔ ∃ (m : ℤ), b * m = x := iff.rfl

@[simp] lemma inv_one (G : Type*) [group G] : (ᵍ1 : G)ᵍ⁻¹ = ᵍ1 :=
by rw [←mul_left_inj ᵍ1, mul_inv, mul_one]

-- The largest trivial subgroup
def subgroup.top (G : Type*) [group G] : subgroup G :=
{ carrier := set.univ,
  mem_e := by simp only [set.mem_univ],
  mem_op := by simp only [set.mem_univ, implies_true_iff],
  mem_inv := by simp only [set.mem_univ, implies_true_iff] }

@[simp] lemma subgroup.mem_top {G : Type*} [group G] (g : G) :
  g ∈ subgroup.top G :=
set.mem_univ g

-- The smallest trivial subgroup
def subgroup.bot (G : Type*) [group G] : subgroup G :=
{ carrier := {ᵍ1},
  mem_e := by simp only [set.mem_singleton],
  mem_op := by simp only [mul_one, set.mem_singleton_iff, forall_eq],
  mem_inv := by simp only [set.mem_singleton_iff, forall_eq, inv_one] }

@[simp] lemma subgroup.mem_bot_iff {G : Type*} [group G] {g : G} :
  g ∈ subgroup.bot G ↔ g = ᵍ1 :=
set.mem_singleton_iff

-- The smallest subgroup of ℤ is the trivial one
lemma subgroup.int_zero : subgroup.int 0 = subgroup.bot ℤ :=
begin
  simp_rw [subgroup.ext_iff', subgroup.int.mem_iff],
  intro,
  simp only [eq_comm, exists_const, int.group.e_def, subgroup.mem_bot_iff, zero_mul]
end

-- The largest subgroup of ℤ is the (* 1) one
lemma subgroup.int_one : subgroup.int 1 = subgroup.top ℤ :=
begin
  simp_rw [subgroup.ext_iff', subgroup.int.mem_iff],
  intro,
  simp [forall_const, one_mul, subgroup.mem_top, iff_self, nonempty_of_inhabited,
    exists_apply_eq_apply]
end

-- Multiples are part of int subgroups, like powers. Proved by induction
lemma subgroup.mem_left_mul (H : subgroup ℤ) ⦃m : ℤ⦄ (hm : m ∈ H) (b : ℤ) :
  b * m ∈ H :=
begin
  induction b using int.induction_on with b IH b IH,
  { rw [int.zero_mul, ←int.group.e_def],
    exact H.mem_e },
  { rw [add_mul, int.one_mul, ←int.group.op_def],
    exact H.mem_op IH hm },
  { rw [sub_mul, int.one_mul, int.sub_eq_add_neg, ←int.group.op_def, ←int.group.inv_def],
    exact H.mem_op IH (H.mem_inv hm) }
end

-- There are no other subgroups of ℤ other than the ones defined by subgroup.int
example (H : subgroup ℤ) : ∃ (b : ℤ), H = subgroup.int b :=
begin
  -- case 1: H = {0}
  by_cases h : H = subgroup.int 0,
  { exact ⟨0, h⟩ },
  -- case 2: H ≠ {0}, so contains m ≠ 0
  obtain ⟨m, hm', hm⟩ : ∃ (m : ℤ) (hm : m ≠ 0), m ∈ H,
  { contrapose! h,
    ext,
    simp only [subgroup.int_zero, subgroup.mem_bot_iff, subgroup.mem_iff],
    split,
    { intro h',
      contrapose! h,
      refine ⟨x, _, h'⟩,
      rwa ←int.group.e_def },
    { intro h',
      simpa [h'] using H.mem_e } },
  set bs : set ℤ := {b : ℤ | b ∈ H ∧ 0 < b} with hbs,
  have bdd : bdd_below bs,
  { use 0,
    simp only [mem_lower_bounds, and_imp, set.mem_set_of_eq],
    intros x _ H,
    exact H.le },
  have hmem : Inf bs ∈ bs,
  { refine int.cInf_mem _ bdd,
    cases hm'.lt_or_lt with mneg mpos,
    { use -m,
      simp only [set.mem_set_of_eq],
      split,
      { rwa [←int.group.inv_def, subgroup.mem_inv_iff] },
      { rwa [right.neg_pos_iff] } },
    { use m,
      simp only [set.mem_set_of_eq],
      exact ⟨hm, mpos⟩ } },
  nth_rewrite_rhs 0 hbs at hmem,
  rw [set.mem_set_of_eq] at hmem,
  use Inf bs,
  simp_rw [subgroup.ext_iff', subgroup.int.mem_iff],
  intros g,
  split,
  -- Show that `bℤ ⊆ H`
  { intros hg,
    use g / Inf bs,
    refine int.mul_div_cancel' _,
    refine int.dvd_of_mod_eq_zero _,
    have modnonneg : 0 ≤ g % Inf bs := int.mod_nonneg _ hmem.right.ne',
    -- = int.mod_nonneg _ hlb.right.ne',
    have modlt : g % Inf bs < (Inf bs) := int.mod_lt_of_pos _ hmem.right,
    contrapose! modlt,
    refine cInf_le bdd _,
    rw ←int.mod_add_div g (Inf bs) at hg,
    suffices : (Inf bs) * (g / Inf bs) ∈ H,
    { nth_rewrite_rhs 0 hbs,
      rw set.mem_set_of_eq,
      refine ⟨_, lt_of_le_of_ne modnonneg modlt.symm⟩,
      convert H.mem_op hg (H.mem_inv this),
      rw [←int.group.op_def, ←group.assoc', mul_inv, mul_one] },
    rw int.mul_comm,
    exact H.mem_left_mul hmem.left _ },
  -- Show that `H ⊆ bℤ`
  { rintro ⟨m, rfl⟩,
    rw int.mul_comm,
    exact H.mem_left_mul hmem.left _ }
end

-- in mathlib, this is defined directly in the properties of
-- a group (via a monoid) to make definitional equality work better
instance {G : Type*} [group G] : has_pow G ℤ := ⟨λ g z,
  @zpow_rec _ ⟨ᵍ1⟩ ⟨(ᵍ*)⟩ ⟨λ x, xᵍ⁻¹⟩ z g⟩

lemma inv_mul_distrib (x y : G) :
  (x ᵍ* y)ᵍ⁻¹ = yᵍ⁻¹ ᵍ* xᵍ⁻¹ :=
by rw [←mul_left_inj (x ᵍ* y), mul_inv, mul_assoc, ←mul_assoc x y,
        mul_inv, mul_one, mul_inv]
lemma inv_eq_iff {x y : G} :
  xᵍ⁻¹ = y ↔ x = yᵍ⁻¹ :=
begin
  split;
  { rintro rfl,
    rw inv_inv }
end
@[simp] lemma inv_eq_inv_iff {x y : G} :
  xᵍ⁻¹ = yᵍ⁻¹ ↔ x = y :=
by rw [inv_eq_iff, inv_inv]

-- Ouw own theory of integer powers, basically recapitulating integer addition
@[simp] protected lemma gpow_zero {G : Type*} [group G] (g : G) :
  g ^ (0 : ℤ) = ᵍ1 := rfl
@[simp] protected lemma gpow_succ_coe {G : Type*} [group G] (g : G) (z : ℕ) :
  g ^ (z + 1 : ℤ) = g ᵍ* g ^ (z : ℤ)  := rfl
@[simp] protected lemma gpow_one {G : Type*} [group G] (g : G) :
  g ^ (1 : ℤ) = g :=
begin
  convert group.gpow_succ_coe g 0,
  simp only [group.gpow_zero, mul_one, int.coe_nat_zero]
end
@[simp] protected lemma gpow_two {G : Type*} [group G] (g : G) :
  g ^ (2 : ℤ) = g ᵍ* g :=
begin
  convert group.gpow_succ_coe g 1,
  simp only [int.coe_nat_zero, int.coe_nat_succ, group.gpow_one, zero_add]
end
@[simp] protected lemma gpow_succ_coe' {G : Type*} [group G] (g : G) (z : ℕ) :
  g ^ (z + 1 : ℤ) = g ^ (z : ℤ) ᵍ* g :=
begin
  induction z with z hz,
  { simp only [group.gpow_zero, one_mul, int.coe_nat_zero, group.gpow_one, zero_add] },
  { rw [int.coe_nat_succ, group.gpow_succ_coe, ←int.coe_nat_succ, group.gpow_succ_coe,
        int.coe_nat_succ, hz, group.assoc'] }
end
@[simp] protected lemma gpow_neg_coe {G : Type*} [group G] (g : G) (z : ℕ) :
  g ^ (-z : ℤ) = (g ^ (z : ℤ))ᵍ⁻¹ :=
by { cases z, simp only [group.gpow_zero, int.coe_nat_zero, inv_one, neg_zero], refl }
@[simp] protected lemma gpow_neg {G : Type*} [group G] (g : G) (z : ℤ) :
  g ^ -z = (g ^ z)ᵍ⁻¹ :=
begin
  cases z,
  { simp only [int.of_nat_eq_coe, group.gpow_neg_coe]},
  { rw [int.neg_succ_of_nat_eq, neg_neg, ←inv_inv (g ^ _)],
    refl }
end
@[simp] protected lemma gpow_succ {G : Type*} [group G] (g : G) (z : ℤ) :
  g ^ (z + 1) = g ᵍ* g ^ (z : ℤ) :=
begin
  induction z using int.induction_on with z hz z hz,
  { simp only [group.gpow_zero, mul_one, group.gpow_one, zero_add] },
  { rw [group.gpow_succ_coe, ←int.coe_nat_succ, group.gpow_succ_coe, int.coe_nat_succ, hz] },
  { rw [int.sub_add_cancel, int.sub_eq_add_neg, ←int.neg_add, group.gpow_neg, group.gpow_neg,
        ←mul_left_inj gᵍ⁻¹, ←inv_mul_distrib, ←group.gpow_succ_coe', group.assoc', inv_mul,
        one_mul] }
end
protected lemma gpow_succ' {G : Type*} [group G] (g : G) (z : ℤ) :
  g ^ (z + 1) = g ^ (z : ℤ) ᵍ* g :=
begin
  induction z using int.induction_on with z hz z hz,
  { simp only [group.gpow_zero, one_mul, group.gpow_one, zero_add] },
  { rw [group.gpow_succ_coe, ←int.coe_nat_succ, group.gpow_succ_coe, int.coe_nat_succ, hz,
    group.assoc'] },
  { rw [int.sub_add_cancel, int.sub_eq_add_neg, ←int.neg_add, group.gpow_neg, group.gpow_neg,
        ←mul_right_inj gᵍ⁻¹, ←inv_mul_distrib, ←group.gpow_succ_coe, ←group.assoc', mul_inv,
        mul_one] }
end
@[simp] protected lemma gpow_sub_one {G : Type*} [group G] (g : G) (z : ℤ) :
  g ^ (z - 1) = gᵍ⁻¹ ᵍ* g ^ (z : ℤ) :=
begin
  induction z using int.induction_on with z hz z hz,
  { simp },
  { rw [int.add_sub_cancel, group.gpow_succ, group.assoc', inv_mul, one_mul] },
  { rw [←inv_eq_inv_iff, ←group.gpow_neg, sub_sub, neg_sub, sub_neg_eq_add,
        inv_mul_distrib, ←group.gpow_neg, neg_sub, sub_neg_eq_add, inv_inv,
        ←group.gpow_succ', add_right_comm] }
end
protected lemma gpow_sub_one' {G : Type*} [group G] (g : G) (z : ℤ) :
  g ^ (z - 1) = g ^ (z : ℤ) ᵍ* gᵍ⁻¹ :=
by rw [←mul_right_inj g, ←group.assoc', inv_mul, mul_one, ←group.gpow_succ',
       int.sub_add_cancel]
protected lemma gpow_add {G : Type*} [group G] (g : G) (n m : ℤ) :
  g ^ (n + m) = g ^ n ᵍ* g ^ m :=
begin
  induction n using int.induction_on with n IH n IH generalizing m,
  { simp only [group.gpow_zero, one_mul, zero_add] },
  { rw [group.gpow_succ', ←group.assoc', ←group.gpow_succ,
        group.gpow_succ', add_right_comm, group.gpow_succ', group.assoc',
        IH] },
  { rw [group.gpow_sub_one', ←group.assoc', ←group.gpow_sub_one, ←IH,
        ←int.add_sub_assoc, add_comm, add_comm _ m, int.add_sub_assoc] },
end
protected lemma gpow_comm {G : Type*} [group G] (g : G) (n m : ℤ) :
  g ^ n ᵍ* g ^ m = g ^ m ᵍ* g ^ n :=
by rw [←group.gpow_add, ←group.gpow_add, add_comm]

-- The group generated by a single element
def subgroup.gpowers {G : Type*} [group G] (g : G) : subgroup G :=
{ carrier := set.range ((^) g : ℤ → G),
  mem_e := by { use 0, simp },
  mem_op := by { simp only [forall_apply_eq_imp_iff', set.mem_range, exists_imp_distrib],
    intros n m,
    use (n + m),
    exact group.gpow_add _ _ _ },
  mem_inv := by {
    simp only [forall_apply_eq_imp_iff', set.mem_range, exists_imp_distrib],
    intros n,
    use -n,
    exact group.gpow_neg _ _ } }

lemma subgroup.gpowers_mem_iff {G : Type*} [group G] {g x : G} :
  x ∈ subgroup.gpowers g ↔ ∃ (z : ℤ), g ^ z = x := iff.rfl

-- Take `τ ∈ S₃, ⟨τ⟩ = {e, τ⦄
example : (subgroup.gpowers (equiv.swap 0 1 : Sₙ 3)).carrier = {ᵍ1, equiv.swap 0 1} :=
begin
  ext x,
  simp only [set.mem_insert_iff, subgroup.mem_iff, set.mem_singleton_iff, subgroup.gpowers_mem_iff],
  split,
  { rintro ⟨z, rfl⟩,
    induction z using int.induction_on with z IH z IH,
    { simp },
    { cases IH with IH' IH'; -- rely on mathlib lemmas about powers of equiv.swap
      simp [IH', equiv.group.op_def, equiv.group.e_def] },
    { cases IH with IH' IH'; -- rely on mathlib lemmas about inverse of equiv.swap
      simp [IH', equiv.group.op_def, equiv.group.e_def, equiv.group.inv_def] } },
  { rintro (rfl|rfl),
    { use 0,
      simp only [group.gpow_zero] },
    { use 1,
      simp only [group.gpow_one] } }
end

-- in mathlib, defined as `order_of`
-- mathlib convention is to use 0 instead of infinity for junk values
def order {G : Type*} [group G] (g : G)
  -- we defer the proof of finiteness and the algorithm to calculate order
  [decidable (∃ (n : ℕ) (npos : 0 < n), g ^ (n : ℤ) = ᵍ1)]
  [decidable_pred (λ (n : ℕ), ∃ (npos : 0 < n), g ^ (n : ℤ) = ᵍ1)] : ℕ :=
if h : ∃ (n : ℕ) (npos : 0 < n), g ^ (n : ℤ) = ᵍ1 then nat.find h else 0

-- there are a lot of lemmas about `order_of` working properly
-- so we fake the presence of an algorithm by relying on classical math

open_locale classical

-- The order of `τ` is 2
example : order (equiv.swap 0 1 : Sₙ 3) = 2 :=
begin
  have key : (equiv.swap 0 1 : Sₙ 3) ^ (2 : ℤ) = ᵍ1,
  { simp [equiv.group.op_def, equiv.group.e_def] },
  rw [order, dif_pos, nat.find_eq_iff],
  { split,
    { simp [key] },
    { rintro (_|_|n) hn,
      { simp },
      { suffices : ∃ (x : fin 3), (equiv.swap 0 1 : Sₙ 3) x ≠ (ᵍ1 : Sₙ 3) x,
        { simpa [equiv.ext_iff] },
        use 0,
        simp [equiv.group.e_def] },
      { simpa [nat.succ_lt_succ_iff] using hn } } },
  { use 2,
    simp [key] }
end

lemma swap_mul {α : Type*} [decidable_eq α] ⦃x y z : α⦄
  (hxy : x ≠ y) (hyz : y ≠ z) (hzx : z ≠ x) :
  equiv.swap x y * equiv.swap y z = equiv.swap x z * equiv.swap x y :=
begin
  ext w,
  by_cases hx : w = x,
  { simpa [hx, equiv.swap_apply_of_ne_of_ne, hxy, hxy.symm, hyz.symm, hzx, hzx.symm] using
    (equiv.swap_apply_of_ne_of_ne hxy.symm hyz).symm },
  by_cases hy : w = y,
  { simp [hx, hy, equiv.swap_apply_of_ne_of_ne, hxy, hxy.symm, hyz.symm, hzx, hzx.symm] },
  by_cases hz : w = z,
  { simp [hx, hy, hz, equiv.swap_apply_of_ne_of_ne, hxy, hxy.symm, hyz.symm, hzx, hzx.symm] },
  { simp [hx, hy, hz, equiv.swap_apply_of_ne_of_ne, hxy, hxy.symm, hyz.symm, hzx, hzx.symm] }
end

-- The order of `σ` is 2
-- TODO: use cycle notation
example : order (equiv.swap 0 1 * equiv.swap 1 2 : Sₙ 3) = 3 :=
begin
  have key : (equiv.swap 0 1 * equiv.swap 1 2 : Sₙ 3) ^ (3 : ℤ) = ᵍ1,
  { ext i,
    fin_cases i;
    norm_num [bit1, equiv.group.e_def] },
  rw [order, dif_pos, nat.find_eq_iff],
  { split,
    { use zero_lt_three,
      exact key },
    { rintro (_|_|_|n) hn,
      { simp },
      { suffices : ∃ (x : fin 3), (equiv.swap 0 1 * equiv.swap 1 2 : Sₙ 3) x ≠ (ᵍ1 : Sₙ 3) x,
        { simpa [equiv.ext_iff] },
        use 0,
        norm_num [equiv.group.e_def] },
      { suffices : ∃ (x : fin 3),
          ((equiv.swap 0 1 * equiv.swap 1 2 : Sₙ 3) ^ (2 : ℤ)) x ≠ (ᵍ1 : Sₙ 3) x,
        { simpa [equiv.ext_iff] },
        use 0,
        norm_num [equiv.group.e_def] },
      { simpa [nat.succ_lt_succ_iff] using hn } } },
  { use 3,
    simp [key] }
end

end group

end e222


import data.real.basic
import tactic

open function real

namespace vilnius

example (X Y Z : Type) (f : X → Y) (g : Y → Z)
  (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  intro b,
  obtain ⟨c, hc⟩ := hg b,
  obtain ⟨a, ha⟩ := hf c,
  use a,
  rw ← hc,
  rw ← ha,
end

/- ### The λ notation:
In Lean (or in Type Theory, rather) the way to define a function is to use λ expressions: here, you should think that `λ = ∀`: so, the function
`λ x, 3*x ^ 2 + 1`
is nothing else that the function
`f(x)=3*x ^ 2 + 1` or `f : x ↦ 3*x ^ 2 + 1`.

As for usual functions, the name of the variable does not matter, so
`λ x, 3*x ^ 2 + 1` is the same as `λ w, 3*w ^ 2 + 1`

The tactic to get rid of a `λ` term is
* `simp only` (possibly: at h)
because it "evaluates a λ-term", transforming, for instance
`(λ x, 2 * x + 1) 3` into `2 * 3 + 1`.
-/

definition A : ℕ → ℕ := λ n, n + 1

example : injective A :=
begin
  intros a b h,
  rw A at h,
  simp only at h,
  rw ← nat.succ_eq_add_one at h,
  rw ← nat.succ_eq_add_one at h,
  rw nat.succ.inj_eq at h,
  exact h,
end

example : ¬ surjective A := --λ h, nat.add_one_ne_zero (h 0).some (h 0).some_spec
begin
  intro h,
  have := (h 0).some,
  obtain ⟨a, ha⟩ := h 0,
  exact nat.add_one_ne_zero a ha,
end

-- Recall the-
definition is_linear (f : ℝ → ℝ) : Prop := ∀ c x y, f (c * x + y) = c * f (x) + f(y)
--as well as
theorem linear_at_0 (f : ℝ → ℝ) (H : is_linear f) : f 0 = 0 := sorry

-- And now a new
definition is_linear' (f : ℝ → ℝ) : Prop :=
(∀ x y, f ( x + y) = f (x) + f (y)) ∧ (∀ c x, f (c * x) = c * f (x))

example (f : ℝ → ℝ) : is_linear f ↔ is_linear' f :=
begin
  split,
  { intro hf,
    split,
    intros x y,
    have h_1 := hf 1 x y,
    rw one_mul at h_1,
    rw one_mul at h_1,
    exact h_1,
    intros a x,
    have h_2 := hf a x 0,
    rw add_zero at h_2,--oh, here we need that f (0) = 0 if f is linear'!f_
    have f_zero : f ( 0 ) = 0,
    { specialize hf 1 0 0,
      rw one_mul at hf,
      rw one_mul at hf,
      rw add_zero at hf,
      apply self_eq_add_left.mp hf },
    rw f_zero at h_2,
    rw add_zero at h_2,
    exact h_2,
  },
  { intro hf,
    intros a x y,
    have h_1 := hf.1 (a * x) y,
    rw h_1,
    have h_2 := hf.2 a x,
    rw h_2, },
end

--Recall the
definition is_affine (f : ℝ → ℝ) : Prop := ∃ a, ∀ x y, f (y) - f(x) = a * (y - x)

-- together with the
theorem linear_add_cnst_of_affine (f : ℝ → ℝ) : is_affine f → (∃ a : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, a)) ∧ is_linear g) := sorry
-- as well as
theorem affine_of_linear_add_cnst (f : ℝ → ℝ) : (∃ b : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, b)) ∧ is_linear g) → is_affine f := sorry

-- that we proved in the lesson.

example (f : ℝ → ℝ) : is_affine f ↔ ∃ a : ℝ, ∃ g : ℝ → ℝ, (f = g + (λ x, a)) ∧ is_linear g := -- iff.intro (linear_add_cnst_of_affine _) (affine_of_linear_add_cnst _)
begin
  have h1 := linear_add_cnst_of_affine f,
  have h2 := affine_of_linear_add_cnst f,
  split,
  intro H,
  apply h1 H,
  intro H,
  apply h2 H,
end

end vilnius


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.nilpotent
import algebra.lie.centralizer

/-!
# Cartan subalgebras

Cartan subalgebras are one of the most important concepts in Lie theory. We define them here.
The standard example is the set of diagonal matrices in the Lie algebra of matrices.

## Main definitions

  * `lie_subalgebra.is_cartan_subalgebra`

## Tags

lie subalgebra, normalizer, idealizer, cartan subalgebra
-/

universes u v w w₁ w₂

variables {R : Type u} {L : Type v}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] (H : lie_subalgebra R L)

namespace lie_subalgebra

/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/
class is_cartan_subalgebra : Prop :=
(nilpotent        : lie_algebra.is_nilpotent R H)
(self_normalizing : H.normalizer = H)

instance [H.is_cartan_subalgebra] : lie_algebra.is_nilpotent R H := is_cartan_subalgebra.nilpotent

@[simp] lemma centralizer_eq_self_of_is_cartan_subalgebra
  (H : lie_subalgebra R L) [H.is_cartan_subalgebra] :
  H.to_lie_submodule.centralizer = H.to_lie_submodule :=
by rw [← lie_submodule.coe_to_submodule_eq_iff, coe_centralizer_eq_normalizer,
  is_cartan_subalgebra.self_normalizing, coe_to_lie_submodule]

end lie_subalgebra

@[simp] lemma lie_ideal.normalizer_eq_top {R : Type u} {L : Type v}
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) :
  (I : lie_subalgebra R L).normalizer = ⊤ :=
begin
  ext x,
  simpa only [lie_subalgebra.mem_normalizer_iff, lie_subalgebra.mem_top, iff_true]
    using λ y hy, I.lie_mem hy
end

open lie_ideal

/-- A nilpotent Lie algebra is its own Cartan subalgebra. -/
instance lie_algebra.top_is_cartan_subalgebra_of_nilpotent [lie_algebra.is_nilpotent R L] :
  lie_subalgebra.is_cartan_subalgebra (⊤ : lie_subalgebra R L) :=
{ nilpotent        := infer_instance,
  self_normalizing :=
    by { rw [← top_coe_lie_subalgebra, normalizer_eq_top, top_coe_lie_subalgebra], }, }


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.fin.tuple
import data.list.range
import group_theory.group_action.pi
import meta.univs

/-!
# Matrix and vector notation

This file defines notation for vectors and matrices. Given `a b c d : α`,
the notation allows us to write `![a, b, c, d] : fin 4 → α`.
Nesting vectors gives a matrix, so `![![a, b], ![c, d]] : fin 2 → fin 2 → α`.
Later we will define `matrix m n α` to be `m → n → α`, so the type of `![![a, b], ![c, d]]`
can be written as `matrix (fin 2) (fin 2) α`.

## Main definitions

* `vec_empty` is the empty vector (or `0` by `n` matrix) `![]`
* `vec_cons` prepends an entry to a vector, so `![a, b]` is `vec_cons a (vec_cons b vec_empty)`

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

The main new notation is `![a, b]`, which gets expanded to `vec_cons a (vec_cons b vec_empty)`.

## Examples

Examples of usage can be found in the `test/matrix.lean` file.
-/

namespace matrix

universe u
variables {α : Type u}

section matrix_notation

/-- `![]` is the vector with no entries. -/
def vec_empty : fin 0 → α :=
fin_zero_elim

/-- `vec_cons h t` prepends an entry `h` to a vector `t`.

The inverse functions are `vec_head` and `vec_tail`.
The notation `![a, b, ...]` expands to `vec_cons a (vec_cons b ...)`.
-/
def vec_cons {n : ℕ} (h : α) (t : fin n → α) : fin n.succ → α :=
fin.cons h t

notation `![` l:(foldr `, ` (h t, vec_cons h t) vec_empty `]`) := l

/-- `vec_head v` gives the first entry of the vector `v` -/
def vec_head {n : ℕ} (v : fin n.succ → α) : α :=
v 0

/-- `vec_tail v` gives a vector consisting of all entries of `v` except the first -/
def vec_tail {n : ℕ} (v : fin n.succ → α) : fin n → α :=
v ∘ fin.succ

variables {m n : ℕ}

/-- Use `![...]` notation for displaying a vector `fin n → α`, for example:

```
#eval ![1, 2] + ![3, 4] -- ![4, 6]
```
-/
instance _root_.pi_fin.has_repr [has_repr α] : has_repr (fin n → α) :=
{ repr := λ f, "![" ++ (string.intercalate ", " ((list.fin_range n).map (λ n, repr (f n)))) ++ "]" }

end matrix_notation

variables {m n o : ℕ} {m' n' o' : Type*}

lemma empty_eq (v : fin 0 → α) : v = ![] := subsingleton.elim _ _

section val

@[simp] lemma head_fin_const (a : α) : vec_head (λ (i : fin (n + 1)), a) = a := rfl

@[simp] lemma cons_val_zero (x : α) (u : fin m → α) : vec_cons x u 0 = x := rfl

lemma cons_val_zero' (h : 0 < m.succ) (x : α) (u : fin m → α) :
  vec_cons x u ⟨0, h⟩ = x :=
rfl

@[simp] lemma cons_val_succ (x : α) (u : fin m → α) (i : fin m) :
  vec_cons x u i.succ = u i :=
by simp [vec_cons]

@[simp] lemma cons_val_succ' {i : ℕ} (h : i.succ < m.succ) (x : α) (u : fin m → α) :
  vec_cons x u ⟨i.succ, h⟩ = u ⟨i, nat.lt_of_succ_lt_succ h⟩ :=
by simp only [vec_cons, fin.cons, fin.cases_succ']

@[simp] lemma head_cons (x : α) (u : fin m → α) :
  vec_head (vec_cons x u) = x :=
rfl

@[simp] lemma tail_cons (x : α) (u : fin m → α) :
  vec_tail (vec_cons x u) = u :=
by { ext, simp [vec_tail] }

@[simp] lemma empty_val' {n' : Type*} (j : n') :
  (λ i, (![] : fin 0 → n' → α) i j) = ![] :=
empty_eq _

@[simp] lemma cons_head_tail (u : fin m.succ → α) :
 vec_cons (vec_head u) (vec_tail u) = u :=
fin.cons_self_tail _

@[simp] lemma range_cons (x : α) (u : fin n → α) :
  set.range (vec_cons x u) = {x} ∪ set.range u :=
set.ext $ λ y, by simp [fin.exists_fin_succ, eq_comm]

@[simp]

@[simp] lemma vec_cons_const (a : α) : vec_cons a (λ k : fin n, a) = λ _, a :=
funext $ fin.forall_fin_succ.2 ⟨rfl, cons_val_succ _ _⟩

lemma vec_single_eq_const (a : α) : ![a] = λ _, a :=
funext $ unique.forall_iff.2 rfl

/-- `![a, b, ...] 1` is equal to `b`.

  The simplifier needs a special lemma for length `≥ 2`, in addition to
  `cons_val_succ`, because `1 : fin 1 = 0 : fin 1`.
-/
@[simp] lemma cons_val_one (x : α) (u : fin m.succ → α) :
  vec_cons x u 1 = vec_head u :=
by { rw [← fin.succ_zero_eq_one, cons_val_succ], refl }

@[simp] lemma cons_val_fin_one (x : α) (u : fin 0 → α) (i : fin 1) :
  vec_cons x u i = x :=
by { refine fin.forall_fin_one.2 _ i, refl }

lemma cons_fin_one (x : α) (u : fin 0 → α) : vec_cons x u = (λ _, x) :=
funext (cons_val_fin_one x u)

meta instance _root_.pi_fin.reflect [reflected_univ.{u}] [reflected _ α] [has_reflect α] :
  Π {n}, has_reflect (fin n → α)
| 0 v := (subsingleton.elim vec_empty v).rec
    ((by reflect_name : reflected _ (@vec_empty.{u})).subst `(α))
| (n + 1) v := (cons_head_tail v).rec $
    (by reflect_name : reflected _ @vec_cons.{u}).subst₄ `(α) `(n) `(_) (_root_.pi_fin.reflect _)

/-! ### Numeral (`bit0` and `bit1`) indices
The following definitions and `simp` lemmas are to allow any
numeral-indexed element of a vector given with matrix notation to
be extracted by `simp` (even when the numeral is larger than the
number of elements in the vector, which is taken modulo that number
of elements by virtue of the semantics of `bit0` and `bit1` and of
addition on `fin n`).
-/

@[simp] lemma empty_append (v : fin n → α) : fin.append (zero_add _).symm ![] v = v :=
by { ext, simp [fin.append] }

@[simp] lemma cons_append (ho : o + 1 = m + 1 + n) (x : α) (u : fin m → α) (v : fin n → α) :
  fin.append ho (vec_cons x u) v =
    vec_cons x (fin.append (by rwa [add_assoc, add_comm 1, ←add_assoc,
                                  add_right_cancel_iff] at ho) u v) :=
begin
  ext i,
  simp_rw [fin.append],
  split_ifs with h,
  { rcases i with ⟨⟨⟩ | i, hi⟩,
    { simp },
    { simp only [nat.succ_eq_add_one, add_lt_add_iff_right, fin.coe_mk] at h,
      simp [h] } },
  { rcases i with ⟨⟨⟩ | i, hi⟩,
    { simpa using h },
    { rw [not_lt, fin.coe_mk, nat.succ_eq_add_one, add_le_add_iff_right] at h,
      simp [h] } }
end

/-- `vec_alt0 v` gives a vector with half the length of `v`, with
only alternate elements (even-numbered). -/
def vec_alt0 (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
v ⟨(k : ℕ) + k, hm.symm ▸ add_lt_add k.property k.property⟩

/-- `vec_alt1 v` gives a vector with half the length of `v`, with
only alternate elements (odd-numbered). -/
def vec_alt1 (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
v ⟨(k : ℕ) + k + 1, hm.symm ▸ nat.add_succ_lt_add k.property k.property⟩

lemma vec_alt0_append (v : fin n → α) : vec_alt0 rfl (fin.append rfl v v) = v ∘ bit0 :=
begin
  ext i,
  simp_rw [function.comp, bit0, vec_alt0, fin.append],
  split_ifs with h; congr,
  { rw fin.coe_mk at h,
    simp only [fin.ext_iff, fin.coe_add, fin.coe_mk],
    exact (nat.mod_eq_of_lt h).symm },
  { rw [fin.coe_mk, not_lt] at h,
    simp only [fin.ext_iff, fin.coe_add, fin.coe_mk, nat.mod_eq_sub_mod h],
    refine (nat.mod_eq_of_lt _).symm,
    rw tsub_lt_iff_left h,
    exact add_lt_add i.property i.property }
end

lemma vec_alt1_append (v : fin (n + 1) → α) : vec_alt1 rfl (fin.append rfl v v) = v ∘ bit1 :=
begin
  ext i,
  simp_rw [function.comp, vec_alt1, fin.append],
  cases n,
  { simp, congr },
  { split_ifs with h; simp_rw [bit1, bit0]; congr,
    { simp only [fin.ext_iff, fin.coe_add, fin.coe_mk],
      rw fin.coe_mk at h,
      rw fin.coe_one,
      rw nat.mod_eq_of_lt (nat.lt_of_succ_lt h),
      rw nat.mod_eq_of_lt h },
    { rw [fin.coe_mk, not_lt] at h,
      simp only [fin.ext_iff, fin.coe_add, fin.coe_mk, nat.mod_add_mod, fin.coe_one,
                 nat.mod_eq_sub_mod h],
      refine (nat.mod_eq_of_lt _).symm,
      rw tsub_lt_iff_left h,
      exact nat.add_succ_lt_add i.property i.property } }
end

@[simp] lemma vec_head_vec_alt0 (hm : (m + 2) = (n + 1) + (n + 1)) (v : fin (m + 2) → α) :
  vec_head (vec_alt0 hm v) = v 0 := rfl

@[simp] lemma vec_head_vec_alt1 (hm : (m + 2) = (n + 1) + (n + 1)) (v : fin (m + 2) → α) :
  vec_head (vec_alt1 hm v) = v 1 :=
by simp [vec_head, vec_alt1]

@[simp] lemma cons_vec_bit0_eq_alt0 (x : α) (u : fin n → α) (i : fin (n + 1)) :
  vec_cons x u (bit0 i) = vec_alt0 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i :=
by rw vec_alt0_append

@[simp] lemma cons_vec_bit1_eq_alt1 (x : α) (u : fin n → α) (i : fin (n + 1)) :
  vec_cons x u (bit1 i) = vec_alt1 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i :=
by rw vec_alt1_append

@[simp] lemma cons_vec_alt0 (h : m + 1 + 1 = (n + 1) + (n + 1)) (x y : α) (u : fin m → α) :
  vec_alt0 h (vec_cons x (vec_cons y u)) = vec_cons x (vec_alt0
    (by rwa [add_assoc n, add_comm 1, ←add_assoc, ←add_assoc, add_right_cancel_iff,
             add_right_cancel_iff] at h) u) :=
begin
  ext i,
  simp_rw [vec_alt0],
  rcases i with ⟨⟨⟩ | i, hi⟩,
  { refl },
  { simp [vec_alt0, nat.add_succ, nat.succ_add] }
end

-- Although proved by simp, extracting element 8 of a five-element
-- vector does not work by simp unless this lemma is present.
@[simp] lemma empty_vec_alt0 (α) {h} : vec_alt0 h (![] : fin 0 → α) = ![] :=
by simp

@[simp] lemma cons_vec_alt1 (h : m + 1 + 1 = (n + 1) + (n + 1)) (x y : α) (u : fin m → α) :
  vec_alt1 h (vec_cons x (vec_cons y u)) = vec_cons y (vec_alt1
    (by rwa [add_assoc n, add_comm 1, ←add_assoc, ←add_assoc, add_right_cancel_iff,
             add_right_cancel_iff] at h) u) :=
begin
  ext i,
  simp_rw [vec_alt1],
  rcases i with ⟨⟨⟩ | i, hi⟩,
  { refl },
  { simp [vec_alt1, nat.add_succ, nat.succ_add] }
end

-- Although proved by simp, extracting element 9 of a five-element
-- vector does not work by simp unless this lemma is present.
@[simp] lemma empty_vec_alt1 (α) {h} : vec_alt1 h (![] : fin 0 → α) = ![] :=
by simp

end val

section smul

variables {M : Type*} [has_scalar M α]

@[simp] lemma smul_empty (x : M) (v : fin 0 → α) : x • v = ![] := empty_eq _

@[simp] lemma smul_cons (x : M) (y : α) (v : fin n → α) :
  x • vec_cons y v = vec_cons (x • y) (x • v) :=
by { ext i, refine fin.cases _ _ i; simp }

end smul

section add

variables [has_add α]

@[simp] lemma empty_add_empty (v w : fin 0 → α) : v + w = ![] := empty_eq _

@[simp] lemma cons_add (x : α) (v : fin n → α) (w : fin n.succ → α) :
  vec_cons x v + w = vec_cons (x + vec_head w) (v + vec_tail w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma add_cons (v : fin n.succ → α) (y : α) (w : fin n → α) :
  v + vec_cons y w = vec_cons (vec_head v + y) (vec_tail v + w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma cons_add_cons (x : α) (v : fin n → α) (y : α) (w : fin n → α) :
  vec_cons x v + vec_cons y w = vec_cons (x + y) (v + w) :=
by simp

@[simp] lemma head_add (a b : fin n.succ → α) : vec_head (a + b) = vec_head a + vec_head b := rfl

@[simp] lemma tail_add (a b : fin n.succ → α) : vec_tail (a + b) = vec_tail a + vec_tail b := rfl

end add

section sub

variables [has_sub α]

@[simp] lemma empty_sub_empty (v w : fin 0 → α) : v - w = ![] := empty_eq _

@[simp] lemma cons_sub (x : α) (v : fin n → α) (w : fin n.succ → α) :
  vec_cons x v - w = vec_cons (x - vec_head w) (v - vec_tail w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma sub_cons (v : fin n.succ → α) (y : α) (w : fin n → α) :
  v - vec_cons y w = vec_cons (vec_head v - y) (vec_tail v - w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma cons_sub_cons (x : α) (v : fin n → α) (y : α) (w : fin n → α) :
  vec_cons x v - vec_cons y w = vec_cons (x - y) (v - w) :=
by simp

@[simp] lemma head_sub (a b : fin n.succ → α) : vec_head (a - b) = vec_head a - vec_head b := rfl

@[simp] lemma tail_sub (a b : fin n.succ → α) : vec_tail (a - b) = vec_tail a - vec_tail b := rfl

end sub

section zero

variables [has_zero α]

@[simp] lemma zero_empty : (0 : fin 0 → α) = ![] :=
empty_eq _

@[simp] lemma cons_zero_zero : vec_cons (0 : α) (0 : fin n → α) = 0 :=
by { ext i j, refine fin.cases _ _ i, { refl }, simp }

@[simp] lemma head_zero : vec_head (0 : fin n.succ → α) = 0 := rfl

@[simp] lemma tail_zero : vec_tail (0 : fin n.succ → α) = 0 := rfl

@[simp] lemma cons_eq_zero_iff {v : fin n → α} {x : α} :
  vec_cons x v = 0 ↔ x = 0 ∧ v = 0 :=
⟨ λ h, ⟨ congr_fun h 0, by { convert congr_arg vec_tail h, simp } ⟩,
  λ ⟨hx, hv⟩, by simp [hx, hv] ⟩

open_locale classical

lemma cons_nonzero_iff {v : fin n → α} {x : α} :
  vec_cons x v ≠ 0 ↔ (x ≠ 0 ∨ v ≠ 0) :=
⟨ λ h, not_and_distrib.mp (h ∘ cons_eq_zero_iff.mpr),
  λ h, mt cons_eq_zero_iff.mp (not_and_distrib.mpr h) ⟩

end zero

section neg

variables [has_neg α]

@[simp] lemma neg_empty (v : fin 0 → α) : -v = ![] := empty_eq _

@[simp] lemma neg_cons (x : α) (v : fin n → α) :
  -(vec_cons x v) = vec_cons (-x) (-v) :=
by { ext i, refine fin.cases _ _ i; simp }

@[simp] lemma head_neg (a : fin n.succ → α) : vec_head (-a) = -vec_head a := rfl

@[simp] lemma tail_neg (a : fin n.succ → α) : vec_tail (-a) = -vec_tail a := rfl

end neg

end matrix


/-
modified from an old version of a comment by Junyan Xu on
https://leanprover-community.github.io/archive/stream/113489-new-members/topic/Generalization.20of.20map_diff.html
-/
import data.multiset.basic
open multiset
variables {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α → β)

lemma multiset.map_diff_subset (s₁ : multiset α) (s₂ : multiset α) :
  s₁.map f - s₂.map f ≤ (s₁ - s₂).map f :=
begin
  rw tsub_le_iff_right,
  rw le_iff_count,
  intro b,
  rw count_add,
  iterate 3 { rw count_map },
  rw ← card_add,
  apply card_le_of_le,
  rw ← filter_add,
  apply filter_le_filter,
  rw ← tsub_le_iff_right,
end

lemma list.map_diff_subset (l₁ : list α) (l₂ : list α) :
  (l₁.map f).diff (l₂.map f) ⊆ (l₁.diff l₂).map f :=
begin
  rw ← coe_subset,
  rw ← coe_sub,
  iterate 3 { rw ← coe_map },
  rw ← coe_sub,
  apply subset_of_le, apply multiset.map_diff_subset,
end


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Isometries of emetric and metric spaces
Authors: Sébastien Gouëzel
-/
import topology.metric_space.antilipschitz

/-!
# Isometries

We define isometries, i.e., maps between emetric spaces that preserve
the edistance (on metric spaces, these are exactly the maps that preserve distances),
and prove their basic properties. We also introduce isometric bijections.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `pseudo_metric_space` and we specialize to `metric_space` when needed.
-/

noncomputable theory

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

open function set
open_locale topological_space ennreal

/-- An isometry (also known as isometric embedding) is a map preserving the edistance
between pseudoemetric spaces, or equivalently the distance between pseudometric space.  -/
def isometry [pseudo_emetric_space α] [pseudo_emetric_space β] (f : α → β) : Prop :=
∀x1 x2 : α, edist (f x1) (f x2) = edist x1 x2

/-- On pseudometric spaces, a map is an isometry if and only if it preserves distances. -/
lemma isometry_emetric_iff_metric [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
  isometry f ↔ (∀x y, dist (f x) (f y) = dist x y) :=
⟨assume H x y, by simp [dist_edist, H x y],
assume H x y, by simp [edist_dist, H x y]⟩

/-- An isometry preserves edistances. -/
theorem isometry.edist_eq [pseudo_emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : edist (f x) (f y) = edist x y :=
hf x y

/-- An isometry preserves distances. -/
theorem isometry.dist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : dist (f x) (f y) = dist x y :=
by rw [dist_edist, dist_edist, hf]

/-- An isometry preserves non-negative distances. -/
theorem isometry.nndist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : nndist (f x) (f y) = nndist x y :=
subtype.ext $ hf.dist_eq x y

section pseudo_emetric_isometry

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {f : α → β} {x y z : α}  {s : set α}

lemma isometry.lipschitz (h : isometry f) : lipschitz_with 1 f :=
lipschitz_with.of_edist_le $ λ x y, le_of_eq (h x y)

lemma isometry.antilipschitz (h : isometry f) : antilipschitz_with 1 f :=
λ x y, by simp only [h x y, ennreal.coe_one, one_mul, le_refl]

/-- An isometry from an emetric space is injective -/
lemma isometry.injective {α : Type u} [emetric_space α] {f : α → β} (h : isometry f) :
  injective f := h.antilipschitz.injective

/-- Any map on a subsingleton is an isometry -/
theorem isometry_subsingleton [subsingleton α] : isometry f :=
λx y, by rw subsingleton.elim x y; simp

/-- The identity is an isometry -/
lemma isometry_id : isometry (id : α → α) :=
λx y, rfl

/-- The composition of isometries is an isometry -/
theorem isometry.comp {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) :
  isometry (g ∘ f) :=
assume x y, calc
  edist ((g ∘ f) x) ((g ∘ f) y) = edist (f x) (f y) : hg _ _
                            ... = edist x y : hf _ _

/-- An isometry from a metric space is a uniform inducing map -/
theorem isometry.uniform_inducing (hf : isometry f) :
  uniform_inducing f :=
hf.antilipschitz.uniform_inducing hf.lipschitz.uniform_continuous

lemma isometry.tendsto_nhds_iff {ι : Type*} {f : α → β}
  {g : ι → α} {a : filter ι} {b : α} (hf : isometry f) :
  filter.tendsto g a (𝓝 b) ↔ filter.tendsto (f ∘ g) a (𝓝 (f b)) :=
hf.uniform_inducing.inducing.tendsto_nhds_iff

/-- An isometry is continuous. -/
lemma isometry.continuous (hf : isometry f) : continuous f :=
hf.lipschitz.continuous

/-- The right inverse of an isometry is an isometry. -/
lemma isometry.right_inv {f : α → β} {g : β → α} (h : isometry f) (hg : right_inverse g f) :
  isometry g :=
λ x y, by rw [← h, hg _, hg _]

/-- Isometries preserve the diameter in pseudoemetric spaces. -/
lemma isometry.ediam_image (hf : isometry f) (s : set α) :
  emetric.diam (f '' s) = emetric.diam s :=
eq_of_forall_ge_iff $ λ d,
by simp only [emetric.diam_le_iff, ball_image_iff, hf.edist_eq]

lemma isometry.ediam_range (hf : isometry f) :
  emetric.diam (range f) = emetric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.ediam_image univ }

lemma isometry.maps_to_emetric_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
  maps_to f (emetric.ball x r) (emetric.ball (f x) r) :=
λ y hy, by rwa [emetric.mem_ball, hf]

lemma isometry.maps_to_emetric_closed_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
  maps_to f (emetric.closed_ball x r) (emetric.closed_ball (f x) r) :=
λ y hy, by rwa [emetric.mem_closed_ball, hf]

/-- The injection from a subtype is an isometry -/
lemma isometry_subtype_coe {s : set α} : isometry (coe : s → α) :=
λx y, rfl

lemma isometry.comp_continuous_on_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α}
  {s : set γ} :
  continuous_on (f ∘ g) s ↔ continuous_on g s :=
hf.uniform_inducing.inducing.continuous_on_iff.symm

lemma isometry.comp_continuous_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} :
  continuous (f ∘ g) ↔ continuous g :=
hf.uniform_inducing.inducing.continuous_iff.symm

end pseudo_emetric_isometry --section

section emetric_isometry
variables [emetric_space α]

/-- An isometry from a metric space is a uniform embedding -/
theorem isometry.uniform_embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  uniform_embedding f :=
hf.antilipschitz.uniform_embedding hf.lipschitz.uniform_continuous

/-- An isometry from a metric space is an embedding -/
theorem isometry.embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  embedding f :=
hf.uniform_embedding.embedding

/-- An isometry from a complete emetric space is a closed embedding -/
theorem isometry.closed_embedding [complete_space α] [emetric_space β]
  {f : α → β} (hf : isometry f) : closed_embedding f :=
hf.antilipschitz.closed_embedding hf.lipschitz.uniform_continuous

end emetric_isometry --section

namespace isometry

variables [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}

/-- An isometry preserves the diameter in pseudometric spaces. -/
lemma diam_image (hf : isometry f) (s : set α) : metric.diam (f '' s) = metric.diam s :=
by rw [metric.diam, metric.diam, hf.ediam_image]

lemma diam_range (hf : isometry f) : metric.diam (range f) = metric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.diam_image univ }

lemma maps_to_ball (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.ball x r) (metric.ball (f x) r) :=
λ y hy, by rwa [metric.mem_ball, hf.dist_eq]

lemma maps_to_sphere (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.sphere x r) (metric.sphere (f x) r) :=
λ y hy, by rwa [metric.mem_sphere, hf.dist_eq]

lemma maps_to_closed_ball (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.closed_ball x r) (metric.closed_ball (f x) r) :=
λ y hy, by rwa [metric.mem_closed_ball, hf.dist_eq]

end isometry

/-- A uniform embedding from a uniform space to a metric space is an isometry with respect to the
induced metric space structure on the source space. -/
lemma uniform_embedding.to_isometry {α β} [uniform_space α] [metric_space β] {f : α → β}
  (h : uniform_embedding f) :
  @isometry α β
    (@pseudo_metric_space.to_pseudo_emetric_space α
      (@metric_space.to_pseudo_metric_space α (h.comap_metric_space f)))
    (by apply_instance) f :=
begin
  apply isometry_emetric_iff_metric.2,
  assume x y,
  refl
end

/-- An embedding from a topological space to a metric space is an isometry with respect to the
induced metric space structure on the source space. -/
lemma embedding.to_isometry {α β} [topological_space α] [metric_space β] {f : α → β}
  (h : embedding f) :
  @isometry α β
    (@pseudo_metric_space.to_pseudo_emetric_space α
      (@metric_space.to_pseudo_metric_space α (h.comap_metric_space f)))
    (by apply_instance) f :=
begin
  apply isometry_emetric_iff_metric.2,
  assume x y,
  refl
end

/-- `α` and `β` are isometric if there is an isometric bijection between them. -/
@[nolint has_inhabited_instance] -- such a bijection need not exist
structure isometric (α : Type*) (β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
  extends α ≃ β :=
(isometry_to_fun  : isometry to_fun)

infix ` ≃ᵢ `:25 := isometric

namespace isometric

section pseudo_emetric_space
variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]

instance : has_coe_to_fun (α ≃ᵢ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

lemma coe_eq_to_equiv (h : α ≃ᵢ β) (a : α) : h a = h.to_equiv a := rfl

@[simp] lemma coe_to_equiv (h : α ≃ᵢ β) : ⇑h.to_equiv = h := rfl

protected lemma isometry (h : α ≃ᵢ β) : isometry h := h.isometry_to_fun

protected lemma bijective (h : α ≃ᵢ β) : bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ᵢ β) : injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ᵢ β) : surjective h := h.to_equiv.surjective

protected lemma edist_eq (h : α ≃ᵢ β) (x y : α) : edist (h x) (h y) = edist x y :=
h.isometry.edist_eq x y

protected lemma dist_eq {α β : Type*} [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)
  (x y : α) : dist (h x) (h y) = dist x y :=
h.isometry.dist_eq x y

protected lemma nndist_eq {α β : Type*} [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)
  (x y : α) : nndist (h x) (h y) = nndist x y :=
h.isometry.nndist_eq x y

protected lemma continuous (h : α ≃ᵢ β) : continuous h := h.isometry.continuous

@[simp] lemma ediam_image (h : α ≃ᵢ β) (s : set α) : emetric.diam (h '' s) = emetric.diam s :=
h.isometry.ediam_image s

lemma to_equiv_inj : ∀ ⦃h₁ h₂ : α ≃ᵢ β⦄, (h₁.to_equiv = h₂.to_equiv) → h₁ = h₂
| ⟨e₁, h₁⟩ ⟨e₂, h₂⟩ H := by { dsimp at H, subst e₁ }

@[ext] lemma ext ⦃h₁ h₂ : α ≃ᵢ β⦄ (H : ∀ x, h₁ x = h₂ x) : h₁ = h₂ :=
to_equiv_inj $ equiv.ext H

/-- Alternative constructor for isometric bijections,
taking as input an isometry, and a right inverse. -/
def mk' {α : Type u} [emetric_space α] (f : α → β) (g : β → α) (hfg : ∀ x, f (g x) = x)
  (hf : isometry f) : α ≃ᵢ β :=
{ to_fun := f,
  inv_fun := g,
  left_inv := λ x, hf.injective $ hfg _,
  right_inv := hfg,
  isometry_to_fun := hf }

/-- The identity isometry of a space. -/
protected def refl (α : Type*) [pseudo_emetric_space α] : α ≃ᵢ α :=
{ isometry_to_fun := isometry_id, .. equiv.refl α }

/-- The composition of two isometric isomorphisms, as an isometric isomorphism. -/
protected def trans (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) : α ≃ᵢ γ :=
{ isometry_to_fun  := h₂.isometry_to_fun.comp h₁.isometry_to_fun,
  .. equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : α) : h₁.trans h₂ x = h₂ (h₁ x) := rfl

/-- The inverse of an isometric isomorphism, as an isometric isomorphism. -/
protected def symm (h : α ≃ᵢ β) : β ≃ᵢ α :=
{ isometry_to_fun  := h.isometry.right_inv h.right_inv,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵢ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵢ β) : β → α := h.symm

initialize_simps_projections isometric
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply)

@[simp] lemma symm_symm (h : α ≃ᵢ β) : h.symm.symm = h := to_equiv_inj h.to_equiv.symm_symm

@[simp] lemma apply_symm_apply (h : α ≃ᵢ β) (y : β) : h (h.symm y) = y :=
h.to_equiv.apply_symm_apply y

@[simp] lemma symm_apply_apply (h : α ≃ᵢ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

lemma symm_apply_eq (h : α ≃ᵢ β) {x : α} {y : β} :
  h.symm y = x ↔ y = h x :=
h.to_equiv.symm_apply_eq

lemma eq_symm_apply (h : α ≃ᵢ β) {x : α} {y : β} :
  x = h.symm y ↔ h x = y :=
h.to_equiv.eq_symm_apply

lemma symm_comp_self (h : α ≃ᵢ β) : ⇑h.symm ∘ ⇑h = id :=
funext $ assume a, h.to_equiv.left_inv a

lemma self_comp_symm (h : α ≃ᵢ β) : ⇑h ∘ ⇑h.symm = id :=
funext $ assume a, h.to_equiv.right_inv a

@[simp] lemma range_eq_univ (h : α ≃ᵢ β) : range h = univ :=
h.to_equiv.range_eq_univ

lemma image_symm (h : α ≃ᵢ β) : image h.symm = preimage h :=
image_eq_preimage_of_inverse h.symm.to_equiv.left_inv h.symm.to_equiv.right_inv

lemma preimage_symm (h : α ≃ᵢ β) : preimage h.symm = image h :=
(image_eq_preimage_of_inverse h.to_equiv.left_inv h.to_equiv.right_inv).symm

@[simp] lemma symm_trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : γ) :
  (h₁.trans h₂).symm x = h₁.symm (h₂.symm x) := rfl

lemma ediam_univ (h : α ≃ᵢ β) : emetric.diam (univ : set α) = emetric.diam (univ : set β) :=
by rw [← h.range_eq_univ, h.isometry.ediam_range]

@[simp] lemma ediam_preimage (h : α ≃ᵢ β) (s : set β) : emetric.diam (h ⁻¹' s) = emetric.diam s :=
by rw [← image_symm, ediam_image]

@[simp] lemma preimage_emetric_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
  h ⁻¹' (emetric.ball x r) = emetric.ball (h.symm x) r :=
by { ext y, simp [← h.edist_eq] }

@[simp] lemma preimage_emetric_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
  h ⁻¹' (emetric.closed_ball x r) = emetric.closed_ball (h.symm x) r :=
by { ext y, simp [← h.edist_eq] }

@[simp] lemma image_emetric_ball (h : α ≃ᵢ β) (x : α) (r : ℝ≥0∞) :
  h '' (emetric.ball x r) = emetric.ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_emetric_ball, symm_symm]

@[simp] lemma image_emetric_closed_ball (h : α ≃ᵢ β) (x : α) (r : ℝ≥0∞) :
  h '' (emetric.closed_ball x r) = emetric.closed_ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_emetric_closed_ball, symm_symm]

/-- The (bundled) homeomorphism associated to an isometric isomorphism. -/
@[simps to_equiv] protected def to_homeomorph (h : α ≃ᵢ β) : α ≃ₜ β :=
{ continuous_to_fun  := h.continuous,
  continuous_inv_fun := h.symm.continuous,
  to_equiv := h.to_equiv }

@[simp] lemma coe_to_homeomorph (h : α ≃ᵢ β) : ⇑(h.to_homeomorph) = h := rfl

@[simp] lemma coe_to_homeomorph_symm (h : α ≃ᵢ β) : ⇑(h.to_homeomorph.symm) = h.symm := rfl

@[simp] lemma comp_continuous_on_iff {γ} [topological_space γ] (h : α ≃ᵢ β)
  {f : γ → α} {s : set γ} :
  continuous_on (h ∘ f) s ↔ continuous_on f s :=
h.to_homeomorph.comp_continuous_on_iff _ _

@[simp] lemma comp_continuous_iff {γ} [topological_space γ] (h : α ≃ᵢ β) {f : γ → α} :
  continuous (h ∘ f) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff

@[simp] lemma comp_continuous_iff' {γ} [topological_space γ] (h : α ≃ᵢ β) {f : β → γ} :
  continuous (f ∘ h) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff'

/-- The group of isometries. -/
instance : group (α ≃ᵢ α) :=
  { one := isometric.refl _,
    mul := λ e₁ e₂, e₂.trans e₁,
    inv := isometric.symm,
    mul_assoc := λ e₁ e₂ e₃, rfl,
    one_mul := λ e, ext $ λ _, rfl,
    mul_one := λ e, ext $ λ _, rfl,
    mul_left_inv := λ e, ext e.symm_apply_apply }

@[simp] lemma coe_one : ⇑(1 : α ≃ᵢ α) = id := rfl

@[simp] lemma coe_mul (e₁ e₂ : α ≃ᵢ α) : ⇑(e₁ * e₂) = e₁ ∘ e₂ := rfl

lemma mul_apply (e₁ e₂ : α ≃ᵢ α) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) := rfl

@[simp] lemma inv_apply_self (e : α ≃ᵢ α) (x: α) : e⁻¹ (e x) = x := e.symm_apply_apply x

@[simp] lemma apply_inv_self (e : α ≃ᵢ α) (x: α) : e (e⁻¹ x) = x := e.apply_symm_apply x

protected lemma complete_space [complete_space β] (e : α ≃ᵢ β) : complete_space α :=
complete_space_of_is_complete_univ $ is_complete_of_complete_image e.isometry.uniform_inducing $
  by rwa [set.image_univ, isometric.range_eq_univ, ← complete_space_iff_is_complete_univ]

lemma complete_space_iff (e : α ≃ᵢ β) : complete_space α ↔ complete_space β :=
by { split; introI H, exacts [e.symm.complete_space, e.complete_space] }

end pseudo_emetric_space

section pseudo_metric_space

variables [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)

@[simp] lemma diam_image (s : set α) : metric.diam (h '' s) = metric.diam s :=
h.isometry.diam_image s

@[simp] lemma diam_preimage (s : set β) : metric.diam (h ⁻¹' s) = metric.diam s :=
by rw [← image_symm, diam_image]

lemma diam_univ : metric.diam (univ : set α) = metric.diam (univ : set β) :=
congr_arg ennreal.to_real h.ediam_univ

@[simp] lemma preimage_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.ball x r) = metric.ball (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma preimage_sphere (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.sphere x r) = metric.sphere (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma preimage_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.closed_ball x r) = metric.closed_ball (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma image_ball (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.ball x r) = metric.ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_ball, symm_symm]

@[simp] lemma image_sphere (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.sphere x r) = metric.sphere (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_sphere, symm_symm]

@[simp] lemma image_closed_ball (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.closed_ball x r) = metric.closed_ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_closed_ball, symm_symm]

end pseudo_metric_space

end isometric

/-- An isometry induces an isometric isomorphism between the source space and the
range of the isometry. -/
@[simps to_equiv apply { simp_rhs := tt }]
def isometry.isometric_on_range [emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (h : isometry f) : α ≃ᵢ range f :=
{ isometry_to_fun := λx y, by simpa [subtype.edist_eq] using h x y,
  to_equiv := equiv.of_injective f h.injective }


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.defs
import Mathlib.logic.nontrivial
import Mathlib.PostPort

universes u_4 l u_1 u

namespace Mathlib

/-!
# Typeclasses for groups with an adjoined zero element

This file provides just the typeclass definitions, and the projection lemmas that expose their
members.

## Main definitions

* `group_with_zero`
* `comm_group_with_zero`
-/

-- We have to fix the universe of `G₀` here, since the default argument to

-- `group_with_zero.div'` cannot contain a universe metavariable.

/-- Typeclass for expressing that a type `M₀` with multiplication and a zero satisfies
`0 * a = 0` and `a * 0 = 0` for all `a : M₀`. -/
class mul_zero_class (M₀ : Type u_4) extends Mul M₀, HasZero M₀ where
  zero_mul : ∀ (a : M₀), 0 * a = 0
  mul_zero : ∀ (a : M₀), a * 0 = 0

@[simp] theorem zero_mul {M₀ : Type u_1} [mul_zero_class M₀] (a : M₀) : 0 * a = 0 :=
  mul_zero_class.zero_mul a

@[simp] theorem mul_zero {M₀ : Type u_1} [mul_zero_class M₀] (a : M₀) : a * 0 = 0 :=
  mul_zero_class.mul_zero a

/-- Predicate typeclass for expressing that `a * b = 0` implies `a = 0` or `b = 0`
for all `a` and `b` of type `G₀`. -/
class no_zero_divisors (M₀ : Type u_4) [Mul M₀] [HasZero M₀] where
  eq_zero_or_eq_zero_of_mul_eq_zero : ∀ {a b : M₀}, a * b = 0 → a = 0 ∨ b = 0

/-- A type `M` is a “monoid with zero” if it is a monoid with zero element, and `0` is left
and right absorbing. -/
class monoid_with_zero (M₀ : Type u_4) extends mul_zero_class M₀, monoid M₀ where

/-- A type `M` is a `cancel_monoid_with_zero` if it is a monoid with zero element, `0` is left
and right absorbing, and left/right multiplication by a non-zero element is injective. -/
class cancel_monoid_with_zero (M₀ : Type u_4) extends monoid_with_zero M₀ where
  mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c
  mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c

theorem mul_left_cancel' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀}
    (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
  cancel_monoid_with_zero.mul_left_cancel_of_ne_zero ha h

theorem mul_right_cancel' {M₀ : Type u_1} [cancel_monoid_with_zero M₀] {a : M₀} {b : M₀} {c : M₀}
    (hb : b ≠ 0) (h : a * b = c * b) : a = c :=
  cancel_monoid_with_zero.mul_right_cancel_of_ne_zero hb h

/-- A type `M` is a commutative “monoid with zero” if it is a commutative monoid with zero
element, and `0` is left and right absorbing. -/
class comm_monoid_with_zero (M₀ : Type u_4) extends comm_monoid M₀, monoid_with_zero M₀ where

/-- A type `M` is a `comm_cancel_monoid_with_zero` if it is a commutative monoid with zero element,
 `0` is left and right absorbing,
  and left/right multiplication by a non-zero element is injective. -/
class comm_cancel_monoid_with_zero (M₀ : Type u_4)
    extends comm_monoid_with_zero M₀, cancel_monoid_with_zero M₀ where

/-- A type `G₀` is a “group with zero” if it is a monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`.

Examples include division rings and the ordered monoids that are the
target of valuations in general valuation theory.-/
class group_with_zero (G₀ : Type u) extends div_inv_monoid G₀, nontrivial G₀, monoid_with_zero G₀
    where
  inv_zero : 0⁻¹ = 0
  mul_inv_cancel : ∀ (a : G₀), a ≠ 0 → a * (a⁻¹) = 1

@[simp] theorem inv_zero {G₀ : Type u} [group_with_zero G₀] : 0⁻¹ = 0 := group_with_zero.inv_zero

@[simp] theorem mul_inv_cancel {G₀ : Type u} [group_with_zero G₀] {a : G₀} (h : a ≠ 0) :
    a * (a⁻¹) = 1 :=
  group_with_zero.mul_inv_cancel a h

/-- A type `G₀` is a commutative “group with zero”
if it is a commutative monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`. -/
class comm_group_with_zero (G₀ : Type u_4) extends comm_monoid_with_zero G₀, group_with_zero G₀
    where

end Mathlib