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

import algebra.char_p.pi
import algebra.char_p.quotient
import algebra.char_p.subring
import algebra.ring.pi
import analysis.special_functions.pow
import field_theory.perfect_closure
import ring_theory.localization.fraction_ring
import ring_theory.subring.basic
import ring_theory.valuation.integers

/-!
# Ring Perfection and Tilt

In this file we define the perfection of a ring of characteristic p, and the tilt of a field
given a valuation to `ℝ≥0`.

## TODO

Define the valuation on the tilt, and define a characteristic predicate for the tilt.

-/

universes u₁ u₂ u₃ u₄

open_locale nnreal

/-- The perfection of a monoid `M`, defined to be the projective limit of `M`
using the `p`-th power maps `M → M` indexed by the natural numbers, implemented as
`{ f : ℕ → M | ∀ n, f (n + 1) ^ p = f n }`. -/
def monoid.perfection (M : Type u₁) [comm_monoid M] (p : ℕ) : submonoid (ℕ → M) :=
{ carrier := { f | ∀ n, f (n + 1) ^ p = f n },
  one_mem' := λ n, one_pow _,
  mul_mem' := λ f g hf hg n, (mul_pow _ _ _).trans $ congr_arg2 _ (hf n) (hg n) }

/-- The perfection of a ring `R` with characteristic `p`, as a subsemiring,
defined to be the projective limit of `R` using the Frobenius maps `R → R`
indexed by the natural numbers, implemented as `{ f : ℕ → R | ∀ n, f (n + 1) ^ p = f n }`. -/
def ring.perfection_subsemiring (R : Type u₁) [comm_semiring R]
  (p : ℕ) [hp : fact p.prime] [char_p R p] :
  subsemiring (ℕ → R) :=
{ zero_mem' := λ n, zero_pow $ hp.1.pos,
  add_mem' := λ f g hf hg n, (frobenius_add R p _ _).trans $ congr_arg2 _ (hf n) (hg n),
  .. monoid.perfection R p }

/-- The perfection of a ring `R` with characteristic `p`, as a subring,
defined to be the projective limit of `R` using the Frobenius maps `R → R`
indexed by the natural numbers, implemented as `{ f : ℕ → R | ∀ n, f (n + 1) ^ p = f n }`. -/
def ring.perfection_subring (R : Type u₁) [comm_ring R]
  (p : ℕ) [hp : fact p.prime] [char_p R p] :
  subring (ℕ → R) :=
(ring.perfection_subsemiring R p).to_subring $ λ n, by simp_rw [← frobenius_def, pi.neg_apply,
    pi.one_apply, ring_hom.map_neg, ring_hom.map_one]

/-- The perfection of a ring `R` with characteristic `p`,
defined to be the projective limit of `R` using the Frobenius maps `R → R`
indexed by the natural numbers, implemented as `{f : ℕ → R // ∀ n, f (n + 1) ^ p = f n}`. -/
def ring.perfection (R : Type u₁) [comm_semiring R] (p : ℕ) : Type u₁ :=
{f // ∀ (n : ℕ), (f : ℕ → R) (n + 1) ^ p = f n}

namespace perfection

variables (R : Type u₁) [comm_semiring R] (p : ℕ) [hp : fact p.prime] [char_p R p]
include hp

instance : comm_semiring (ring.perfection R p) :=
(ring.perfection_subsemiring R p).to_comm_semiring

instance : char_p (ring.perfection R p) p :=
char_p.subsemiring (ℕ → R) p (ring.perfection_subsemiring R p)

instance ring (R : Type u₁) [comm_ring R] [char_p R p] : ring (ring.perfection R p) :=
(ring.perfection_subring R p).to_ring

instance comm_ring (R : Type u₁) [comm_ring R] [char_p R p] : comm_ring (ring.perfection R p) :=
(ring.perfection_subring R p).to_comm_ring

instance : inhabited (ring.perfection R p) := ⟨0⟩

/-- The `n`-th coefficient of an element of the perfection. -/
def coeff (n : ℕ) : ring.perfection R p →+* R :=
{ to_fun := λ f, f.1 n,
  map_one' := rfl,
  map_mul' := λ f g, rfl,
  map_zero' := rfl,
  map_add' := λ f g, rfl }

variables {R p}

@[ext] lemma ext {f g : ring.perfection R p} (h : ∀ n, coeff R p n f = coeff R p n g) : f = g :=
subtype.eq $ funext h

variables (R p)

/-- The `p`-th root of an element of the perfection. -/
def pth_root : ring.perfection R p →+* ring.perfection R p :=
{ to_fun := λ f, ⟨λ n, coeff R p (n + 1) f, λ n, f.2 _⟩,
  map_one' := rfl,
  map_mul' := λ f g, rfl,
  map_zero' := rfl,
  map_add' := λ f g, rfl }

variables {R p}

@[simp] lemma coeff_mk (f : ℕ → R) (hf) (n : ℕ) : coeff R p n ⟨f, hf⟩ = f n := rfl

lemma coeff_pth_root (f : ring.perfection R p) (n : ℕ) :
  coeff R p n (pth_root R p f) = coeff R p (n + 1) f :=
rfl

lemma coeff_pow_p (f : ring.perfection R p) (n : ℕ) :
  coeff R p (n + 1) (f ^ p) = coeff R p n f :=
by { rw ring_hom.map_pow, exact f.2 n }

lemma coeff_pow_p' (f : ring.perfection R p) (n : ℕ) :
  coeff R p (n + 1) f ^ p = coeff R p n f :=
f.2 n

lemma coeff_frobenius (f : ring.perfection R p) (n : ℕ) :
  coeff R p (n + 1) (frobenius _ p f) = coeff R p n f :=
by apply coeff_pow_p f n -- `coeff_pow_p f n` also works but is slow!

lemma coeff_iterate_frobenius (f : ring.perfection R p) (n m : ℕ) :
  coeff R p (n + m) (frobenius _ p ^[m] f) = coeff R p n f :=
nat.rec_on m rfl $ λ m ih, by erw [function.iterate_succ_apply', coeff_frobenius, ih]

lemma coeff_iterate_frobenius' (f : ring.perfection R p) (n m : ℕ) (hmn : m ≤ n) :
  coeff R p n (frobenius _ p ^[m] f) = coeff R p (n - m) f :=
eq.symm $ (coeff_iterate_frobenius _ _ m).symm.trans $ (tsub_add_cancel_of_le hmn).symm ▸ rfl

lemma pth_root_frobenius : (pth_root R p).comp (frobenius _ p) = ring_hom.id _ :=
ring_hom.ext $ λ x, ext $ λ n,
by rw [ring_hom.comp_apply, ring_hom.id_apply, coeff_pth_root, coeff_frobenius]

lemma frobenius_pth_root : (frobenius _ p).comp (pth_root R p) = ring_hom.id _ :=
ring_hom.ext $ λ x, ext $ λ n,
by rw [ring_hom.comp_apply, ring_hom.id_apply, ring_hom.map_frobenius, coeff_pth_root,
    ← ring_hom.map_frobenius, coeff_frobenius]

lemma coeff_add_ne_zero {f : ring.perfection R p} {n : ℕ} (hfn : coeff R p n f ≠ 0) (k : ℕ) :
  coeff R p (n + k) f ≠ 0 :=
nat.rec_on k hfn $ λ k ih h, ih $ by erw [← coeff_pow_p, ring_hom.map_pow, h, zero_pow hp.1.pos]

lemma coeff_ne_zero_of_le {f : ring.perfection R p} {m n : ℕ} (hfm : coeff R p m f ≠ 0)
  (hmn : m ≤ n) : coeff R p n f ≠ 0 :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_le hmn in hk.symm ▸ coeff_add_ne_zero hfm k

variables (R p)

instance perfect_ring : perfect_ring (ring.perfection R p) p :=
{ pth_root' := pth_root R p,
  frobenius_pth_root' := congr_fun $ congr_arg ring_hom.to_fun $ @frobenius_pth_root R _ p _ _,
  pth_root_frobenius' := congr_fun $ congr_arg ring_hom.to_fun $ @pth_root_frobenius R _ p _ _ }

/-- Given rings `R` and `S` of characteristic `p`, with `R` being perfect,
any homomorphism `R →+* S` can be lifted to a homomorphism `R →+* perfection S p`. -/
@[simps] def lift (R : Type u₁) [comm_semiring R] [char_p R p] [perfect_ring R p]
  (S : Type u₂) [comm_semiring S] [char_p S p] :
  (R →+* S) ≃ (R →+* ring.perfection S p) :=
{ to_fun := λ f,
  { to_fun := λ r, ⟨λ n, f $ _root_.pth_root R p ^[n] r,
      λ n, by rw [← f.map_pow, function.iterate_succ_apply', pth_root_pow_p]⟩,
    map_one' := ext $ λ n, (congr_arg f $ ring_hom.iterate_map_one _ _).trans f.map_one,
    map_mul' := λ x y, ext $ λ n, (congr_arg f $ ring_hom.iterate_map_mul _ _ _ _).trans $
      f.map_mul _ _,
    map_zero' := ext $ λ n, (congr_arg f $ ring_hom.iterate_map_zero _ _).trans f.map_zero,
    map_add' := λ x y, ext $ λ n, (congr_arg f $ ring_hom.iterate_map_add _ _ _ _).trans $
      f.map_add _ _ },
  inv_fun := ring_hom.comp $ coeff S p 0,
  left_inv := λ f, ring_hom.ext $ λ r, rfl,
  right_inv := λ f, ring_hom.ext $ λ r, ext $ λ n,
    show coeff S p 0 (f (_root_.pth_root R p ^[n] r)) = coeff S p n (f r),
    by rw [← coeff_iterate_frobenius _ 0 n, zero_add, ← ring_hom.map_iterate_frobenius,
      right_inverse_pth_root_frobenius.iterate] }

lemma hom_ext {R : Type u₁} [comm_semiring R] [char_p R p] [perfect_ring R p]
  {S : Type u₂} [comm_semiring S] [char_p S p] {f g : R →+* ring.perfection S p}
  (hfg : ∀ x, coeff S p 0 (f x) = coeff S p 0 (g x)) : f = g :=
(lift p R S).symm.injective $ ring_hom.ext hfg

variables {R} {S : Type u₂} [comm_semiring S] [char_p S p]

/-- A ring homomorphism `R →+* S` induces `perfection R p →+* perfection S p` -/
@[simps] def map (φ : R →+* S) : ring.perfection R p →+* ring.perfection S p :=
{ to_fun := λ f, ⟨λ n, φ (coeff R p n f), λ n, by rw [← φ.map_pow, coeff_pow_p']⟩,
  map_one' := subtype.eq $ funext $ λ n, φ.map_one,
  map_mul' := λ f g, subtype.eq $ funext $ λ n, φ.map_mul _ _,
  map_zero' := subtype.eq $ funext $ λ n, φ.map_zero,
  map_add' := λ f g, subtype.eq $ funext $ λ n, φ.map_add _ _ }

lemma coeff_map (φ : R →+* S) (f : ring.perfection R p) (n : ℕ) :
  coeff S p n (map p φ f) = φ (coeff R p n f) :=
rfl

end perfection

/-- A perfection map to a ring of characteristic `p` is a map that is isomorphic
to its perfection. -/
@[nolint has_nonempty_instance] structure perfection_map (p : ℕ) [fact p.prime]
  {R : Type u₁} [comm_semiring R] [char_p R p]
  {P : Type u₂} [comm_semiring P] [char_p P p] [perfect_ring P p] (π : P →+* R) : Prop :=
(injective : ∀ ⦃x y : P⦄, (∀ n, π (pth_root P p ^[n] x) = π (pth_root P p ^[n] y)) → x = y)
(surjective : ∀ f : ℕ → R, (∀ n, f (n + 1) ^ p = f n) →
  ∃ x : P, ∀ n, π (pth_root P p ^[n] x) = f n)

namespace perfection_map

variables {p : ℕ} [fact p.prime]
variables {R : Type u₁} [comm_semiring R] [char_p R p]
variables {P : Type u₃} [comm_semiring P] [char_p P p] [perfect_ring P p]

/-- Create a `perfection_map` from an isomorphism to the perfection. -/
@[simps] lemma mk' {f : P →+* R} (g : P ≃+* ring.perfection R p)
  (hfg : perfection.lift p P R f = g) :
  perfection_map p f :=
{ injective := λ x y hxy, g.injective $ (ring_hom.ext_iff.1 hfg x).symm.trans $
    eq.symm $ (ring_hom.ext_iff.1 hfg y).symm.trans $ perfection.ext $ λ n, (hxy n).symm,
  surjective := λ y hy, let ⟨x, hx⟩ := g.surjective ⟨y, hy⟩ in
    ⟨x, λ n, show perfection.coeff R p n (perfection.lift p P R f x) =
        perfection.coeff R p n ⟨y, hy⟩,
      by rw [hfg, ← coe_fn_coe_base, hx]⟩ }

variables (p R P)

/-- The canonical perfection map from the perfection of a ring. -/
lemma of : perfection_map p (perfection.coeff R p 0) :=
mk' (ring_equiv.refl _) $ (equiv.apply_eq_iff_eq_symm_apply _).2 rfl

/-- For a perfect ring, it itself is the perfection. -/
lemma id [perfect_ring R p] : perfection_map p (ring_hom.id R) :=
{ injective := λ x y hxy, hxy 0,
  surjective := λ f hf, ⟨f 0, λ n, show pth_root R p ^[n] (f 0) = f n,
    from nat.rec_on n rfl $ λ n ih, injective_pow_p p $
      by rw [function.iterate_succ_apply', pth_root_pow_p _, ih, hf]⟩ }

variables {p R P}
/-- A perfection map induces an isomorphism to the prefection. -/
noncomputable def equiv {π : P →+* R} (m : perfection_map p π) : P ≃+* ring.perfection R p :=
ring_equiv.of_bijective (perfection.lift p P R π)
⟨λ x y hxy, m.injective $ λ n, (congr_arg (perfection.coeff R p n) hxy : _),
λ f, let ⟨x, hx⟩ := m.surjective f.1 f.2 in ⟨x, perfection.ext $ hx⟩⟩

lemma equiv_apply {π : P →+* R} (m : perfection_map p π) (x : P) :
  m.equiv x = perfection.lift p P R π x :=
rfl

lemma comp_equiv {π : P →+* R} (m : perfection_map p π) (x : P) :
  perfection.coeff R p 0 (m.equiv x) = π x :=
rfl

lemma comp_equiv' {π : P →+* R} (m : perfection_map p π) :
  (perfection.coeff R p 0).comp ↑m.equiv = π :=
ring_hom.ext $ λ x, rfl

lemma comp_symm_equiv {π : P →+* R} (m : perfection_map p π) (f : ring.perfection R p) :
  π (m.equiv.symm f) = perfection.coeff R p 0 f :=
(m.comp_equiv _).symm.trans $ congr_arg _ $ m.equiv.apply_symm_apply f

lemma comp_symm_equiv' {π : P →+* R} (m : perfection_map p π) :
  π.comp ↑m.equiv.symm = perfection.coeff R p 0 :=
ring_hom.ext m.comp_symm_equiv

variables (p R P)
/-- Given rings `R` and `S` of characteristic `p`, with `R` being perfect,
any homomorphism `R →+* S` can be lifted to a homomorphism `R →+* P`,
where `P` is any perfection of `S`. -/
@[simps] noncomputable def lift [perfect_ring R p] (S : Type u₂) [comm_semiring S] [char_p S p]
  (P : Type u₃) [comm_semiring P] [char_p P p] [perfect_ring P p]
  (π : P →+* S) (m : perfection_map p π) :
  (R →+* S) ≃ (R →+* P) :=
{ to_fun := λ f, ring_hom.comp ↑m.equiv.symm $ perfection.lift p R S f,
  inv_fun := λ f, π.comp f,
  left_inv := λ f, by { simp_rw [← ring_hom.comp_assoc, comp_symm_equiv'],
    exact (perfection.lift p R S).symm_apply_apply f },
  right_inv := λ f, ring_hom.ext $ λ x, m.equiv.injective $ (m.equiv.apply_symm_apply _).trans $
    show perfection.lift p R S (π.comp f) x = ring_hom.comp ↑m.equiv f x,
    from ring_hom.ext_iff.1 ((perfection.lift p R S).apply_eq_iff_eq_symm_apply.2 rfl) _ }

variables {R p}

lemma hom_ext [perfect_ring R p] {S : Type u₂} [comm_semiring S] [char_p S p]
  {P : Type u₃} [comm_semiring P] [char_p P p] [perfect_ring P p]
  (π : P →+* S) (m : perfection_map p π) {f g : R →+* P}
  (hfg : ∀ x, π (f x) = π (g x)) : f = g :=
(lift p R S P π m).symm.injective $ ring_hom.ext hfg

variables {R P} (p) {S : Type u₂} [comm_semiring S] [char_p S p]
variables {Q : Type u₄} [comm_semiring Q] [char_p Q p] [perfect_ring Q p]

/-- A ring homomorphism `R →+* S` induces `P →+* Q`, a map of the respective perfections. -/
@[nolint unused_arguments]
noncomputable def map {π : P →+* R} (m : perfection_map p π) {σ : Q →+* S} (n : perfection_map p σ)
  (φ : R →+* S) : P →+* Q :=
lift p P S Q σ n $ φ.comp π

lemma comp_map {π : P →+* R} (m : perfection_map p π) {σ : Q →+* S} (n : perfection_map p σ)
  (φ : R →+* S) : σ.comp (map p m n φ) = φ.comp π :=
(lift p P S Q σ n).symm_apply_apply _

lemma map_map {π : P →+* R} (m : perfection_map p π) {σ : Q →+* S} (n : perfection_map p σ)
  (φ : R →+* S) (x : P) : σ (map p m n φ x) = φ (π x) :=
ring_hom.ext_iff.1 (comp_map p m n φ) x

-- Why is this slow?
lemma map_eq_map (φ : R →+* S) :
  @map p _ R _ _ _ _ _ _ S _ _ _ _ _ _ _ (of p R) _ (of p S) φ = perfection.map p φ :=
hom_ext _ (of p S) $ λ f, by rw [map_map, perfection.coeff_map]

end perfection_map

section perfectoid

variables (K : Type u₁) [field K] (v : valuation K ℝ≥0)
variables (O : Type u₂) [comm_ring O] [algebra O K] (hv : v.integers O)
variables (p : ℕ)
include hv

/-- `O/(p)` for `O`, ring of integers of `K`. -/
@[nolint unused_arguments has_nonempty_instance] def mod_p :=
O ⧸ (ideal.span {p} : ideal O)

variables [hp : fact p.prime] [hvp : fact (v p ≠ 1)]

namespace mod_p

instance : comm_ring (mod_p K v O hv p) :=
ideal.quotient.comm_ring _

include hp hvp
instance : char_p (mod_p K v O hv p) p :=
char_p.quotient O p $ mt hv.one_of_is_unit $ (map_nat_cast (algebra_map O K) p).symm ▸ hvp.1

instance : nontrivial (mod_p K v O hv p) :=
char_p.nontrivial_of_char_ne_one hp.1.ne_one

section classical
local attribute [instance] classical.dec

omit hp hvp
/-- For a field `K` with valuation `v : K → ℝ≥0` and ring of integers `O`,
a function `O/(p) → ℝ≥0` that sends `0` to `0` and `x + (p)` to `v(x)` as long as `x ∉ (p)`. -/
noncomputable def pre_val (x : mod_p K v O hv p) : ℝ≥0 :=
if x = 0 then 0 else v (algebra_map O K x.out')

variables {K v O hv p}
lemma pre_val_mk {x : O} (hx : (ideal.quotient.mk _ x : mod_p K v O hv p) ≠ 0) :
  pre_val K v O hv p (ideal.quotient.mk _ x) = v (algebra_map O K x) :=
begin
  obtain ⟨r, hr⟩ := ideal.mem_span_singleton'.1 (ideal.quotient.eq.1 $ quotient.sound' $
    @quotient.mk_out' O (ideal.span {p} : ideal O).quotient_rel x),
  refine (if_neg hx).trans (v.map_eq_of_sub_lt $ lt_of_not_le _),
  erw [← ring_hom.map_sub, ← hr, hv.le_iff_dvd],
  exact λ hprx, hx (ideal.quotient.eq_zero_iff_mem.2 $ ideal.mem_span_singleton.2 $
    dvd_of_mul_left_dvd hprx),
end

lemma pre_val_zero : pre_val K v O hv p 0 = 0 :=
if_pos rfl

lemma pre_val_mul {x y : mod_p K v O hv p} (hxy0 : x * y ≠ 0) :
  pre_val K v O hv p (x * y) = pre_val K v O hv p x * pre_val K v O hv p y :=
begin
  have hx0 : x ≠ 0 := mt (by { rintro rfl, rw zero_mul }) hxy0,
  have hy0 : y ≠ 0 := mt (by { rintro rfl, rw mul_zero }) hxy0,
  obtain ⟨r, rfl⟩ := ideal.quotient.mk_surjective x,
  obtain ⟨s, rfl⟩ := ideal.quotient.mk_surjective y,
  rw ← ring_hom.map_mul at hxy0 ⊢,
  rw [pre_val_mk hx0, pre_val_mk hy0, pre_val_mk hxy0, ring_hom.map_mul, v.map_mul]
end

lemma pre_val_add (x y : mod_p K v O hv p) :
  pre_val K v O hv p (x + y) ≤ max (pre_val K v O hv p x) (pre_val K v O hv p y) :=
begin
  by_cases hx0 : x = 0, { rw [hx0, zero_add], exact le_max_right _ _ },
  by_cases hy0 : y = 0, { rw [hy0, add_zero], exact le_max_left _ _ },
  by_cases hxy0 : x + y = 0, { rw [hxy0, pre_val_zero], exact zero_le _ },
  obtain ⟨r, rfl⟩ := ideal.quotient.mk_surjective x,
  obtain ⟨s, rfl⟩ := ideal.quotient.mk_surjective y,
  rw ← ring_hom.map_add at hxy0 ⊢,
  rw [pre_val_mk hx0, pre_val_mk hy0, pre_val_mk hxy0, ring_hom.map_add], exact v.map_add _ _
end

lemma v_p_lt_pre_val {x : mod_p K v O hv p} : v p < pre_val K v O hv p x ↔ x ≠ 0 :=
begin
  refine ⟨λ h hx, by { rw [hx, pre_val_zero] at h, exact not_lt_zero' h },
    λ h, lt_of_not_le $ λ hp, h _⟩,
  obtain ⟨r, rfl⟩ := ideal.quotient.mk_surjective x,
  rw [pre_val_mk h, ← map_nat_cast (algebra_map O K) p, hv.le_iff_dvd] at hp,
  rw [ideal.quotient.eq_zero_iff_mem, ideal.mem_span_singleton], exact hp
end

lemma pre_val_eq_zero {x : mod_p K v O hv p} : pre_val K v O hv p x = 0 ↔ x = 0 :=
⟨λ hvx, classical.by_contradiction $ λ hx0 : x ≠ 0,
  by { rw [← v_p_lt_pre_val, hvx] at hx0, exact not_lt_zero' hx0 },
λ hx, hx.symm ▸ pre_val_zero⟩

variables (hv hvp)

open nnreal

variables {hv} [hvp]
include hp
lemma mul_ne_zero_of_pow_p_ne_zero {x y : mod_p K v O hv p} (hx : x ^ p ≠ 0) (hy : y ^ p ≠ 0) :
  x * y ≠ 0 :=
begin
  obtain ⟨r, rfl⟩ := ideal.quotient.mk_surjective x,
  obtain ⟨s, rfl⟩ := ideal.quotient.mk_surjective y,
  have h1p : (0 : ℝ) < 1 / p := one_div_pos.2 (nat.cast_pos.2 hp.1.pos),
  rw ← ring_hom.map_mul, rw ← ring_hom.map_pow at hx hy,
  rw ← v_p_lt_val hv at hx hy ⊢,
  rw [ring_hom.map_pow, v.map_pow, ← rpow_lt_rpow_iff h1p, ← rpow_nat_cast, ← rpow_mul,
      mul_one_div_cancel (nat.cast_ne_zero.2 hp.1.ne_zero : (p : ℝ) ≠ 0), rpow_one] at hx hy,
  rw [ring_hom.map_mul, v.map_mul], refine lt_of_le_of_lt _ (mul_lt_mul₀ hx hy),
  by_cases hvp : v p = 0, { rw hvp, exact zero_le _ }, replace hvp := zero_lt_iff.2 hvp,
  conv_lhs { rw ← rpow_one (v p) }, rw ← rpow_add (ne_of_gt hvp),
  refine rpow_le_rpow_of_exponent_ge hvp (map_nat_cast (algebra_map O K) p ▸ hv.2 _) _,
  rw [← add_div, div_le_one (nat.cast_pos.2 hp.1.pos : 0 < (p : ℝ))], exact_mod_cast hp.1.two_le
end

end classical

end mod_p

/-- Perfection of `O/(p)` where `O` is the ring of integers of `K`. -/
@[nolint has_nonempty_instance] def pre_tilt :=
ring.perfection (mod_p K v O hv p) p

include hp hvp

namespace pre_tilt

instance : comm_ring (pre_tilt K v O hv p) :=
perfection.comm_ring p _

instance : char_p (pre_tilt K v O hv p) p :=
perfection.char_p (mod_p K v O hv p) p

section classical
open_locale classical

open perfection

/-- The valuation `Perfection(O/(p)) → ℝ≥0` as a function.
Given `f ∈ Perfection(O/(p))`, if `f = 0` then output `0`;
otherwise output `pre_val(f(n))^(p^n)` for any `n` such that `f(n) ≠ 0`. -/
noncomputable def val_aux (f : pre_tilt K v O hv p) : ℝ≥0 :=
if h : ∃ n, coeff _ _ n f ≠ 0
then mod_p.pre_val K v O hv p (coeff _ _ (nat.find h) f) ^ (p ^ nat.find h)
else 0

variables {K v O hv p}
lemma coeff_nat_find_add_ne_zero {f : pre_tilt K v O hv p} {h : ∃ n, coeff _ _ n f ≠ 0} (k : ℕ) :
  coeff _ _ (nat.find h + k) f ≠ 0 :=
coeff_add_ne_zero (nat.find_spec h) k

lemma val_aux_eq {f : pre_tilt K v O hv p} {n : ℕ} (hfn : coeff _ _ n f ≠ 0) :
  val_aux K v O hv p f = mod_p.pre_val K v O hv p (coeff _ _ n f) ^ (p ^ n) :=
begin
  have h : ∃ n, coeff _ _ n f ≠ 0 := ⟨n, hfn⟩,
  rw [val_aux, dif_pos h],
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le (nat.find_min' h hfn),
  induction k with k ih, { refl },
  obtain ⟨x, hx⟩ := ideal.quotient.mk_surjective (coeff _ _ (nat.find h + k + 1) f),
  have h1 : (ideal.quotient.mk _ x : mod_p K v O hv p) ≠ 0 := hx.symm ▸ hfn,
  have h2 : (ideal.quotient.mk _ (x ^ p) : mod_p K v O hv p) ≠ 0,
    by { erw [ring_hom.map_pow, hx, ← ring_hom.map_pow, coeff_pow_p],
      exact coeff_nat_find_add_ne_zero k },
  erw [ih (coeff_nat_find_add_ne_zero k), ← hx, ← coeff_pow_p, ring_hom.map_pow, ← hx,
      ← ring_hom.map_pow, mod_p.pre_val_mk h1, mod_p.pre_val_mk h2,
      ring_hom.map_pow, v.map_pow, ← pow_mul, pow_succ], refl
end

lemma val_aux_zero : val_aux K v O hv p 0 = 0 :=
dif_neg $ λ ⟨n, hn⟩, hn rfl

lemma val_aux_one : val_aux K v O hv p 1 = 1 :=
(val_aux_eq $ show coeff (mod_p K v O hv p) p 0 1 ≠ 0, from one_ne_zero).trans $
by { rw [pow_zero, pow_one, ring_hom.map_one, ← (ideal.quotient.mk _).map_one, mod_p.pre_val_mk,
    ring_hom.map_one, v.map_one],
  change (1 : mod_p K v O hv p) ≠ 0,
  exact one_ne_zero }

lemma val_aux_mul (f g : pre_tilt K v O hv p) :
  val_aux K v O hv p (f * g) = val_aux K v O hv p f * val_aux K v O hv p g :=
begin
  by_cases hf : f = 0, { rw [hf, zero_mul, val_aux_zero, zero_mul] },
  by_cases hg : g = 0, { rw [hg, mul_zero, val_aux_zero, mul_zero] },
  obtain ⟨m, hm⟩ : ∃ n, coeff _ _ n f ≠ 0 := not_forall.1 (λ h, hf $ perfection.ext h),
  obtain ⟨n, hn⟩ : ∃ n, coeff _ _ n g ≠ 0 := not_forall.1 (λ h, hg $ perfection.ext h),
  replace hm := coeff_ne_zero_of_le hm (le_max_left m n),
  replace hn := coeff_ne_zero_of_le hn (le_max_right m n),
  have hfg : coeff _ _ (max m n + 1) (f * g) ≠ 0,
  { rw ring_hom.map_mul,
    refine mod_p.mul_ne_zero_of_pow_p_ne_zero _ _,
    { rw [← ring_hom.map_pow, coeff_pow_p f], assumption },
    { rw [← ring_hom.map_pow, coeff_pow_p g], assumption } },
  rw [val_aux_eq (coeff_add_ne_zero hm 1), val_aux_eq (coeff_add_ne_zero hn 1), val_aux_eq hfg],
  rw ring_hom.map_mul at hfg ⊢, rw [mod_p.pre_val_mul hfg, mul_pow]
end

lemma val_aux_add (f g : pre_tilt K v O hv p) :
  val_aux K v O hv p (f + g) ≤ max (val_aux K v O hv p f) (val_aux K v O hv p g) :=
begin
  by_cases hf : f = 0, { rw [hf, zero_add, val_aux_zero, max_eq_right], exact zero_le _ },
  by_cases hg : g = 0, { rw [hg, add_zero, val_aux_zero, max_eq_left], exact zero_le _ },
  by_cases hfg : f + g = 0, { rw [hfg, val_aux_zero], exact zero_le _ },
  replace hf : ∃ n, coeff _ _ n f ≠ 0 := not_forall.1 (λ h, hf $ perfection.ext h),
  replace hg : ∃ n, coeff _ _ n g ≠ 0 := not_forall.1 (λ h, hg $ perfection.ext h),
  replace hfg : ∃ n, coeff _ _ n (f + g) ≠ 0 := not_forall.1 (λ h, hfg $ perfection.ext h),
  obtain ⟨m, hm⟩ := hf, obtain ⟨n, hn⟩ := hg, obtain ⟨k, hk⟩ := hfg,
  replace hm := coeff_ne_zero_of_le hm (le_trans (le_max_left m n) (le_max_left _ k)),
  replace hn := coeff_ne_zero_of_le hn (le_trans (le_max_right m n) (le_max_left _ k)),
  replace hk := coeff_ne_zero_of_le hk (le_max_right (max m n) k),
  rw [val_aux_eq hm, val_aux_eq hn, val_aux_eq hk, ring_hom.map_add],
  cases le_max_iff.1
    (mod_p.pre_val_add (coeff _ _ (max (max m n) k) f) (coeff _ _ (max (max m n) k) g)) with h h,
  { exact le_max_of_le_left (pow_le_pow_of_le_left' h _) },
  { exact le_max_of_le_right (pow_le_pow_of_le_left' h _) }
end

variables (K v O hv p)
/-- The valuation `Perfection(O/(p)) → ℝ≥0`.
Given `f ∈ Perfection(O/(p))`, if `f = 0` then output `0`;
otherwise output `pre_val(f(n))^(p^n)` for any `n` such that `f(n) ≠ 0`. -/
noncomputable def val : valuation (pre_tilt K v O hv p) ℝ≥0 :=
{ to_fun := val_aux K v O hv p,
  map_one' := val_aux_one,
  map_mul' := val_aux_mul,
  map_zero' := val_aux_zero,
  map_add_le_max' := val_aux_add }

variables {K v O hv p}
lemma map_eq_zero {f : pre_tilt K v O hv p} : val K v O hv p f = 0 ↔ f = 0 :=
begin
  by_cases hf0 : f = 0, { rw hf0, exact iff_of_true (valuation.map_zero _) rfl },
  obtain ⟨n, hn⟩ : ∃ n, coeff _ _ n f ≠ 0 := not_forall.1 (λ h, hf0 $ perfection.ext h),
  show val_aux K v O hv p f = 0 ↔ f = 0, refine iff_of_false (λ hvf, hn _) hf0,
  rw val_aux_eq hn at hvf, replace hvf := pow_eq_zero hvf, rwa mod_p.pre_val_eq_zero at hvf
end

end classical

instance : is_domain (pre_tilt K v O hv p) :=
begin
  haveI : nontrivial (pre_tilt K v O hv p) := ⟨(char_p.nontrivial_of_char_ne_one hp.1.ne_one).1⟩,
  haveI : no_zero_divisors (pre_tilt K v O hv p) := ⟨λ f g hfg,
    by { simp_rw ← map_eq_zero at hfg ⊢, contrapose! hfg, rw valuation.map_mul,
    exact mul_ne_zero hfg.1 hfg.2 }⟩,
  exact no_zero_divisors.to_is_domain _
end

end pre_tilt

/-- The tilt of a field, as defined in Perfectoid Spaces by Peter Scholze, as in
[scholze2011perfectoid]. Given a field `K` with valuation `K → ℝ≥0` and ring of integers `O`,
this is implemented as the fraction field of the perfection of `O/(p)`. -/
@[nolint has_nonempty_instance] def tilt :=
fraction_ring (pre_tilt K v O hv p)

namespace tilt

noncomputable instance : field (tilt K v O hv p) :=
fraction_ring.field

end tilt

end perfectoid


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

! This file was ported from Lean 3 source module data.multiset.powerset
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.Sublists
import Mathlib.Data.Multiset.Nodup

/-!
# The powerset of a multiset
-/

namespace Multiset

open List

variable {α : Type _}

/-! ### powerset -/

--Porting note: TODO: Write a more efficient version
/-- A helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` as multisets. -/
def powersetAux (l : List α) : List (Multiset α) :=
  (sublists l).map (↑)
#align multiset.powerset_aux Multiset.powersetAux

theorem powersetAux_eq_map_coe {l : List α} : powersetAux l = (sublists l).map (↑) :=
  rfl
#align multiset.powerset_aux_eq_map_coe Multiset.powersetAux_eq_map_coe

@[simp]
theorem mem_powersetAux {l : List α} {s} : s ∈ powersetAux l ↔ s ≤ ↑l :=
  Quotient.inductionOn s <| by simp [powersetAux_eq_map_coe, Subperm, and_comm]
#align multiset.mem_powerset_aux Multiset.mem_powersetAux

/-- Helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` (using `sublists'`), as multisets. -/
def powersetAux' (l : List α) : List (Multiset α) :=
  (sublists' l).map (↑)
#align multiset.powerset_aux' Multiset.powersetAux'

theorem powersetAux_perm_powersetAux' {l : List α} : powersetAux l ~ powersetAux' l := by
  rw [powersetAux_eq_map_coe]; exact (sublists_perm_sublists' _).map _
#align multiset.powerset_aux_perm_powerset_aux' Multiset.powersetAux_perm_powersetAux'

@[simp]
theorem powersetAux'_nil : powersetAux' (@nil α) = [0] :=
  rfl
#align multiset.powerset_aux'_nil Multiset.powersetAux'_nil

@[simp]
theorem powersetAux'_cons (a : α) (l : List α) :
    powersetAux' (a :: l) = powersetAux' l ++ List.map (cons a) (powersetAux' l) := by
  simp [powersetAux']; rfl
#align multiset.powerset_aux'_cons Multiset.powersetAux'_cons

theorem powerset_aux'_perm {l₁ l₂ : List α} (p : l₁ ~ l₂) : powersetAux' l₁ ~ powersetAux' l₂ := by
  induction' p with a l₁ l₂ p IH a b l l₁ l₂ l₃ _ _ IH₁ IH₂
  · simp
  · simp only [powersetAux'_cons]
    exact IH.append (IH.map _)
  · simp only [powersetAux'_cons, map_append, List.map_map, append_assoc]
    apply Perm.append_left
    rw [← append_assoc, ← append_assoc,
      (by funext s; simp [cons_swap] : cons b ∘ cons a = cons a ∘ cons b)]
    exact perm_append_comm.append_right _
  · exact IH₁.trans IH₂
#align multiset.powerset_aux'_perm Multiset.powerset_aux'_perm

theorem powersetAux_perm {l₁ l₂ : List α} (p : l₁ ~ l₂) : powersetAux l₁ ~ powersetAux l₂ :=
  powersetAux_perm_powersetAux'.trans <|
    (powerset_aux'_perm p).trans powersetAux_perm_powersetAux'.symm
#align multiset.powerset_aux_perm Multiset.powersetAux_perm

--Porting note: slightly slower implementation due to `map ofList`
/-- The power set of a multiset. -/
def powerset (s : Multiset α) : Multiset (Multiset α) :=
  Quot.liftOn s
    (fun l => (powersetAux l : Multiset (Multiset α)))
    (fun _ _ h => Quot.sound (powersetAux_perm h))
#align multiset.powerset Multiset.powerset

theorem powerset_coe (l : List α) : @powerset α l = ((sublists l).map (↑) : List (Multiset α)) :=
  congr_arg ((↑) : List (Multiset α) → Multiset (Multiset α)) powersetAux_eq_map_coe
#align multiset.powerset_coe Multiset.powerset_coe

@[simp]
theorem powerset_coe' (l : List α) : @powerset α l = ((sublists' l).map (↑) : List (Multiset α)) :=
  Quot.sound powersetAux_perm_powersetAux'
#align multiset.powerset_coe' Multiset.powerset_coe'

@[simp]
theorem powerset_zero : @powerset α 0 = {0} :=
  rfl
#align multiset.powerset_zero Multiset.powerset_zero

@[simp]
theorem powerset_cons (a : α) (s) : powerset (a ::ₘ s) = powerset s + map (cons a) (powerset s) :=
  Quotient.inductionOn s fun l => by simp; rfl
#align multiset.powerset_cons Multiset.powerset_cons

@[simp]
theorem mem_powerset {s t : Multiset α} : s ∈ powerset t ↔ s ≤ t :=
  Quotient.inductionOn₂ s t <| by simp [Subperm, and_comm]
#align multiset.mem_powerset Multiset.mem_powerset

theorem map_single_le_powerset (s : Multiset α) : s.map singleton ≤ powerset s :=
  Quotient.inductionOn s fun l => by
    simp only [powerset_coe, quot_mk_to_coe, coe_le, coe_map]
    show l.map (((↑) : List α → Multiset α) ∘ List.ret) <+~ (sublists l).map (↑)
    rw [← List.map_map]
    exact ((map_ret_sublist_sublists _).map _).subperm
#align multiset.map_single_le_powerset Multiset.map_single_le_powerset

@[simp]
theorem card_powerset (s : Multiset α) : card (powerset s) = 2 ^ card s :=
  Quotient.inductionOn s <| by simp
#align multiset.card_powerset Multiset.card_powerset

theorem revzip_powersetAux {l : List α} ⦃x⦄ (h : x ∈ revzip (powersetAux l)) : x.1 + x.2 = ↑l := by
  rw [revzip, powersetAux_eq_map_coe, ← map_reverse, zip_map, ← revzip, List.mem_map] at h
  simp only [Prod_map, Prod.exists] at h
  rcases h with ⟨l₁, l₂, h, rfl, rfl⟩
  exact Quot.sound (revzip_sublists _ _ _ h)
#align multiset.revzip_powerset_aux Multiset.revzip_powersetAux

theorem revzip_powersetAux' {l : List α} ⦃x⦄ (h : x ∈ revzip (powersetAux' l)) :
    x.1 + x.2 = ↑l := by
  rw [revzip, powersetAux', ← map_reverse, zip_map, ← revzip, List.mem_map] at h
  simp only [Prod_map, Prod.exists] at h
  rcases h with ⟨l₁, l₂, h, rfl, rfl⟩
  exact Quot.sound (revzip_sublists' _ _ _ h)
#align multiset.revzip_powerset_aux' Multiset.revzip_powersetAux'

--Porting note: I don't understand why `{α : Type u}` is necessary here
theorem revzip_powersetAux_lemma {α : Type u} [DecidableEq α] (l : List α) {l' : List (Multiset α)}
    (H : ∀ ⦃x : _ × _⦄, x ∈ revzip l' → x.1 + x.2 = ↑l) :
    revzip l' = l'.map fun x => (x, (l : Multiset α) - x) := by
  have :
    Forall₂ (fun (p : Multiset α × Multiset α) (s : Multiset α) => p = (s, ↑l - s)) (revzip l')
      ((revzip l').map Prod.fst) := by
    rw [forall₂_map_right_iff, forall₂_same]
    rintro ⟨s, t⟩ h
    dsimp
    rw [← H h, add_tsub_cancel_left]
  rw [← forall₂_eq_eq_eq, forall₂_map_right_iff]
  simpa using this
#align multiset.revzip_powerset_aux_lemma Multiset.revzip_powersetAux_lemma

theorem revzip_powersetAux_perm_aux' {l : List α} :
    revzip (powersetAux l) ~ revzip (powersetAux' l) := by
  haveI := Classical.decEq α
  rw [revzip_powersetAux_lemma l revzip_powersetAux, revzip_powersetAux_lemma l revzip_powersetAux']
  exact powersetAux_perm_powersetAux'.map _
#align multiset.revzip_powerset_aux_perm_aux' Multiset.revzip_powersetAux_perm_aux'

theorem revzip_powersetAux_perm {l₁ l₂ : List α} (p : l₁ ~ l₂) :
    revzip (powersetAux l₁) ~ revzip (powersetAux l₂) := by
  haveI := Classical.decEq α
  simp [fun l : List α => revzip_powersetAux_lemma l revzip_powersetAux, coe_eq_coe.2 p]
  exact (powersetAux_perm p).map _
#align multiset.revzip_powerset_aux_perm Multiset.revzip_powersetAux_perm

/-! ### powersetLen -/

/-- Helper function for `powersetLen`. Given a list `l`, `powersetLenAux n l` is the list
of sublists of length `n`, as multisets. -/
def powersetLenAux (n : ℕ) (l : List α) : List (Multiset α) :=
  sublistsLenAux n l (↑) []
#align multiset.powerset_len_aux Multiset.powersetLenAux

theorem powersetLenAux_eq_map_coe {n} {l : List α} :
    powersetLenAux n l = (sublistsLen n l).map (↑) := by
  rw [powersetLenAux, sublistsLenAux_eq, append_nil]
#align multiset.powerset_len_aux_eq_map_coe Multiset.powersetLenAux_eq_map_coe

@[simp]
theorem mem_powersetLenAux {n} {l : List α} {s} : s ∈ powersetLenAux n l ↔ s ≤ ↑l ∧ card s = n :=
  Quotient.inductionOn s <| by
    simp [powersetLenAux_eq_map_coe, Subperm]
    exact fun l₁ =>
      ⟨fun ⟨l₂, ⟨s, e⟩, p⟩ => ⟨⟨_, p, s⟩, p.symm.length_eq.trans e⟩,
       fun ⟨⟨l₂, p, s⟩, e⟩ => ⟨_, ⟨s, p.length_eq.trans e⟩, p⟩⟩
#align multiset.mem_powerset_len_aux Multiset.mem_powersetLenAux

@[simp]
theorem powersetLenAux_zero (l : List α) : powersetLenAux 0 l = [0] := by
  simp [powersetLenAux_eq_map_coe]
#align multiset.powerset_len_aux_zero Multiset.powersetLenAux_zero

@[simp]
theorem powersetLenAux_nil (n : ℕ) : powersetLenAux (n + 1) (@nil α) = [] :=
  rfl
#align multiset.powerset_len_aux_nil Multiset.powersetLenAux_nil

@[simp]
theorem powersetLenAux_cons (n : ℕ) (a : α) (l : List α) :
    powersetLenAux (n + 1) (a :: l) =
      powersetLenAux (n + 1) l ++ List.map (cons a) (powersetLenAux n l) := by
  simp [powersetLenAux_eq_map_coe]; rfl
#align multiset.powerset_len_aux_cons Multiset.powersetLenAux_cons

theorem powersetLenAux_perm {n} {l₁ l₂ : List α} (p : l₁ ~ l₂) :
    powersetLenAux n l₁ ~ powersetLenAux n l₂ := by
  induction' n with n IHn generalizing l₁ l₂
  · simp
  induction' p with a l₁ l₂ p IH a b l l₁ l₂ l₃ _ _ IH₁ IH₂
  · rfl
  · simp only [powersetLenAux_cons]
    exact IH.append ((IHn p).map _)
  · simp only [powersetLenAux_cons, append_assoc]
    apply Perm.append_left
    cases n
    · simp [Perm.swap]
    simp only [powersetLenAux_cons, map_append, List.map_map]
    rw [← append_assoc, ← append_assoc,
      (by funext s; simp [cons_swap] : cons b ∘ cons a = cons a ∘ cons b)]
    exact perm_append_comm.append_right _
  · exact IH₁.trans IH₂
#align multiset.powerset_len_aux_perm Multiset.powersetLenAux_perm

/-- `powersetLen n s` is the multiset of all submultisets of `s` of length `n`. -/
def powersetLen (n : ℕ) (s : Multiset α) : Multiset (Multiset α) :=
  Quot.liftOn s (fun l => (powersetLenAux n l : Multiset (Multiset α))) fun _ _ h =>
    Quot.sound (powersetLenAux_perm h)
#align multiset.powerset_len Multiset.powersetLen

theorem powersetLen_coe' (n) (l : List α) : @powersetLen α n l = powersetLenAux n l :=
  rfl
#align multiset.powerset_len_coe' Multiset.powersetLen_coe'

theorem powersetLen_coe (n) (l : List α) :
    @powersetLen α n l = ((sublistsLen n l).map (↑) : List (Multiset α)) :=
  congr_arg ((↑) : List (Multiset α) → Multiset (Multiset α)) powersetLenAux_eq_map_coe
#align multiset.powerset_len_coe Multiset.powersetLen_coe

@[simp]
theorem powersetLen_zero_left (s : Multiset α) : powersetLen 0 s = {0} :=
  Quotient.inductionOn s fun l => by simp [powersetLen_coe']
#align multiset.powerset_len_zero_left Multiset.powersetLen_zero_left

theorem powersetLen_zero_right (n : ℕ) : @powersetLen α (n + 1) 0 = 0 :=
  rfl
#align multiset.powerset_len_zero_right Multiset.powersetLen_zero_right

@[simp]
theorem powersetLen_cons (n : ℕ) (a : α) (s) :
    powersetLen (n + 1) (a ::ₘ s) = powersetLen (n + 1) s + map (cons a) (powersetLen n s) :=
  Quotient.inductionOn s fun l => by simp [powersetLen_coe']
#align multiset.powerset_len_cons Multiset.powersetLen_cons

@[simp]
theorem mem_powersetLen {n : ℕ} {s t : Multiset α} : s ∈ powersetLen n t ↔ s ≤ t ∧ card s = n :=
  Quotient.inductionOn t fun l => by simp [powersetLen_coe']
#align multiset.mem_powerset_len Multiset.mem_powersetLen

@[simp]
theorem card_powersetLen (n : ℕ) (s : Multiset α) :
    card (powersetLen n s) = Nat.choose (card s) n :=
  Quotient.inductionOn s <| by simp [powersetLen_coe]
#align multiset.card_powerset_len Multiset.card_powersetLen

theorem powersetLen_le_powerset (n : ℕ) (s : Multiset α) : powersetLen n s ≤ powerset s :=
  Quotient.inductionOn s fun l => by
    simp only [quot_mk_to_coe, powersetLen_coe, powerset_coe', coe_le]
    exact ((sublistsLen_sublist_sublists' _ _).map _).subperm
#align multiset.powerset_len_le_powerset Multiset.powersetLen_le_powerset

theorem powersetLen_mono (n : ℕ) {s t : Multiset α} (h : s ≤ t) :
    powersetLen n s ≤ powersetLen n t :=
  leInductionOn h fun {l₁ l₂} h => by
    simp only [powersetLen_coe, coe_le]
    exact ((sublistsLen_sublist_of_sublist _ h).map _).subperm
#align multiset.powerset_len_mono Multiset.powersetLen_mono

@[simp]
theorem powersetLen_empty {α : Type _} (n : ℕ) {s : Multiset α} (h : card s < n) :
    powersetLen n s = 0 :=
  card_eq_zero.mp (Nat.choose_eq_zero_of_lt h ▸ card_powersetLen _ _)
#align multiset.powerset_len_empty Multiset.powersetLen_empty

@[simp]
theorem powersetLen_card_add (s : Multiset α) {i : ℕ} (hi : 0 < i) :
    s.powersetLen (card s + i) = 0 :=
  powersetLen_empty _ (lt_add_of_pos_right (card s) hi)
#align multiset.powerset_len_card_add Multiset.powersetLen_card_add

theorem powersetLen_map {β : Type _} (f : α → β) (n : ℕ) (s : Multiset α) :
    powersetLen n (s.map f) = (powersetLen n s).map (map f) := by
  induction' s using Multiset.induction with t s ih generalizing n
  · cases n <;> simp [powersetLen_zero_left, powersetLen_zero_right]
  · cases n <;> simp [ih, map_comp_cons]
#align multiset.powerset_len_map Multiset.powersetLen_map

theorem pairwise_disjoint_powersetLen (s : Multiset α) :
    _root_.Pairwise fun i j => Multiset.Disjoint (s.powersetLen i) (s.powersetLen j) :=
  fun _ _ h _ hi hj =>
  h (Eq.trans (Multiset.mem_powersetLen.mp hi).right.symm (Multiset.mem_powersetLen.mp hj).right)
#align multiset.pairwise_disjoint_powerset_len Multiset.pairwise_disjoint_powersetLen

theorem bind_powerset_len {α : Type _} (S : Multiset α) :
    (bind (Multiset.range (card S + 1)) fun k => S.powersetLen k) = S.powerset := by
  induction S using Quotient.inductionOn
  simp_rw [quot_mk_to_coe, powerset_coe', powersetLen_coe, ← coe_range, coe_bind, ← List.bind_map,
    coe_card]
  exact coe_eq_coe.mpr ((List.range_bind_sublistsLen_perm _).map _)
#align multiset.bind_powerset_len Multiset.bind_powerset_len

@[simp]

alias nodup_powerset ↔ Nodup.ofPowerset Nodup.powerset
#align multiset.nodup.of_powerset Multiset.Nodup.ofPowerset
#align multiset.nodup.powerset Multiset.Nodup.powerset

protected theorem Nodup.powersetLen {n : ℕ} {s : Multiset α} (h : Nodup s) :
    Nodup (powersetLen n s) :=
  nodup_of_le (powersetLen_le_powerset _ _) (nodup_powerset.2 h)
#align multiset.nodup.powerset_len Multiset.Nodup.powersetLen

end Multiset


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import tactic.norm_num

/-!
# The `abel` tactic

Evaluate expressions in the language of additive, commutative monoids and groups.

-/

namespace tactic
namespace abel

meta structure cache :=
(α : expr)
(univ : level)
(α0 : expr)
(is_group : bool)
(inst : expr)

meta def mk_cache (e : expr) : tactic cache :=
do α ← infer_type e,
   c ← mk_app ``add_comm_monoid [α] >>= mk_instance,
   cg ← try_core (mk_app ``add_comm_group [α] >>= mk_instance),
   u ← mk_meta_univ,
   infer_type α >>= unify (expr.sort (level.succ u)),
   u ← get_univ_assignment u,
   α0 ← expr.of_nat α 0,
   match cg with
   | (some cg) := return ⟨α, u, α0, tt, cg⟩
   | _ := return ⟨α, u, α0, ff, c⟩
   end

meta def cache.app (c : cache) (n : name) (inst : expr) : list expr → expr :=
(@expr.const tt n [c.univ] c.α inst).mk_app

meta def cache.mk_app (c : cache) (n inst : name) (l : list expr) : tactic expr :=
do m ← mk_instance ((expr.const inst [c.univ] : expr) c.α), return $ c.app n m l

meta def add_g : name → name
| (name.mk_string s p) := name.mk_string (s ++ "g") p
| n := n

meta def cache.iapp (c : cache) (n : name) : list expr → expr :=
c.app (if c.is_group then add_g n else n) c.inst

def term {α} [add_comm_monoid α] (n : ℕ) (x a : α) : α := n • x + a
def termg {α} [add_comm_group α] (n : ℤ) (x a : α) : α := n • x + a

meta def cache.mk_term (c : cache) (n x a : expr) : expr := c.iapp ``term [n, x, a]

meta def cache.int_to_expr (c : cache) (n : ℤ) : tactic expr :=
expr.of_int (if c.is_group then `(ℤ) else `(ℕ)) n

meta inductive normal_expr : Type
| zero (e : expr) : normal_expr
| nterm (e : expr) (n : expr × ℤ) (x : expr) (a : normal_expr) : normal_expr

meta def normal_expr.e : normal_expr → expr
| (normal_expr.zero e) := e
| (normal_expr.nterm e _ _ _) := e

meta instance : has_coe normal_expr expr := ⟨normal_expr.e⟩
meta instance : has_coe_to_fun normal_expr := ⟨_, λ e, ((e : expr) : expr → expr)⟩

meta def normal_expr.term' (c : cache) (n : expr × ℤ) (x : expr) (a : normal_expr) : normal_expr :=
normal_expr.nterm (c.mk_term n.1 x a) n x a

meta def normal_expr.zero' (c : cache) : normal_expr := normal_expr.zero c.α0

meta def normal_expr.to_list : normal_expr → list (ℤ × expr)
| (normal_expr.zero _) := []
| (normal_expr.nterm _ (_, n) x a) := (n, x) :: a.to_list

open normal_expr

meta def normal_expr.to_string (e : normal_expr) : string :=
" + ".intercalate $ (to_list e).map $
λ ⟨n, e⟩, to_string n ++ " • (" ++ to_string e ++ ")"

meta def normal_expr.pp (e : normal_expr) : tactic format :=
do l ← (to_list e).mmap (λ ⟨n, e⟩, do
  pe ← pp e, return (to_fmt n ++ " • (" ++ pe ++ ")")),
  return $ format.join $ l.intersperse ↑" + "

meta instance : has_to_tactic_format normal_expr := ⟨normal_expr.pp⟩

meta def normal_expr.refl_conv (e : normal_expr) : tactic (normal_expr × expr) :=
do p ← mk_eq_refl e, return (e, p)

theorem const_add_term {α} [add_comm_monoid α] (k n x a a') (h : k + a = a') :
  k + @term α _ n x a = term n x a' := by simp [h.symm, term]; ac_refl

theorem term_add_const {α} [add_comm_monoid α] (n x a k a') (h : a + k = a') :
  @term α _ n x a + k = term n x a' := by simp [h.symm, term, add_assoc]

theorem term_add_constg {α} [add_comm_group α] (n x a k a') (h : a + k = a') :
  @termg α _ n x a + k = termg n x a' := by simp [h.symm, termg, add_assoc]

theorem term_add_term {α} [add_comm_monoid α] (n₁ x a₁ n₂ a₂ n' a')
  (h₁ : n₁ + n₂ = n') (h₂ : a₁ + a₂ = a') :
  @term α _ n₁ x a₁ + @term α _ n₂ x a₂ = term n' x a' :=
by simp [h₁.symm, h₂.symm, term, add_nsmul]; ac_refl

theorem term_add_termg {α} [add_comm_group α] (n₁ x a₁ n₂ a₂ n' a')
  (h₁ : n₁ + n₂ = n') (h₂ : a₁ + a₂ = a') :
  @termg α _ n₁ x a₁ + @termg α _ n₂ x a₂ = termg n' x a' :=
by simp [h₁.symm, h₂.symm, termg, add_gsmul]; ac_refl

theorem zero_term {α} [add_comm_monoid α] (x a) : @term α _ 0 x a = a :=
by simp [term, zero_nsmul, one_nsmul]

theorem zero_termg {α} [add_comm_group α] (x a) : @termg α _ 0 x a = a :=
by simp [termg]

meta def eval_add (c : cache) : normal_expr → normal_expr → tactic (normal_expr × expr)
| (zero _) e₂ := do
  p ← mk_app ``zero_add [e₂],
  return (e₂, p)
| e₁ (zero _) := do
  p ← mk_app ``add_zero [e₁],
  return (e₁, p)
| he₁@(nterm e₁ n₁ x₁ a₁) he₂@(nterm e₂ n₂ x₂ a₂) :=
  if expr.lex_lt x₁ x₂ then do
    (a', h) ← eval_add a₁ he₂,
    return (term' c n₁ x₁ a', c.iapp ``term_add_const [n₁.1, x₁, a₁, e₂, a', h])
  else if x₁ ≠ x₂ then do
    (a', h) ← eval_add he₁ a₂,
    return (term' c n₂ x₂ a', c.iapp ``const_add_term [e₁, n₂.1, x₂, a₂, a', h])
  else do
    (n', h₁) ← mk_app ``has_add.add [n₁.1, n₂.1] >>= norm_num.eval_field,
    (a', h₂) ← eval_add a₁ a₂,
    let k := n₁.2 + n₂.2,
    let p₁ := c.iapp ``term_add_term [n₁.1, x₁, a₁, n₂.1, a₂, n', a', h₁, h₂],
    if k = 0 then do
      p ← mk_eq_trans p₁ (c.iapp ``zero_term [x₁, a']),
      return (a', p)
    else return (term' c (n', k) x₁ a', p₁)

theorem term_neg {α} [add_comm_group α] (n x a n' a')
  (h₁ : -n = n') (h₂ : -a = a') :
  -@termg α _ n x a = termg n' x a' :=
by simp [h₂.symm, h₁.symm, termg]; ac_refl

meta def eval_neg (c : cache) : normal_expr → tactic (normal_expr × expr)
| (zero e) := do
  p ← c.mk_app ``neg_zero ``add_group [],
  return (zero' c, p)
| (nterm e n x a) := do
  (n', h₁) ← mk_app ``has_neg.neg [n.1] >>= norm_num.eval_field,
  (a', h₂) ← eval_neg a,
  return (term' c (n', -n.2) x a',
    c.app ``term_neg c.inst [n.1, x, a, n', a', h₁, h₂])

def smul {α} [add_comm_monoid α] (n : ℕ) (x : α) : α := n • x
def smulg {α} [add_comm_group α] (n : ℤ) (x : α) : α := n • x

theorem zero_smul {α} [add_comm_monoid α] (c) : smul c (0 : α) = 0 :=
by simp [smul, nsmul_zero]

theorem zero_smulg {α} [add_comm_group α] (c) : smulg c (0 : α) = 0 :=
by simp [smulg]

theorem term_smul {α} [add_comm_monoid α] (c n x a n' a')
  (h₁ : c * n = n') (h₂ : smul c a = a') :
  smul c (@term α _ n x a) = term n' x a' :=
by simp [h₂.symm, h₁.symm, term, smul, nsmul_add, mul_nsmul]

theorem term_smulg {α} [add_comm_group α] (c n x a n' a')
  (h₁ : c * n = n') (h₂ : smulg c a = a') :
  smulg c (@termg α _ n x a) = termg n' x a' :=
by simp [h₂.symm, h₁.symm, termg, smulg, gsmul_add, mul_gsmul]

meta def eval_smul (c : cache) (k : expr × ℤ) :
  normal_expr → tactic (normal_expr × expr)
| (zero _) := return (zero' c, c.iapp ``zero_smul [k.1])
| (nterm e n x a) := do
  (n', h₁) ← mk_app ``has_mul.mul [k.1, n.1] >>= norm_num.eval_field,
  (a', h₂) ← eval_smul a,
  return (term' c (n', k.2 * n.2) x a',
    c.iapp ``term_smul [k.1, n.1, x, a, n', a', h₁, h₂])

theorem term_atom {α} [add_comm_monoid α] (x : α) : x = term 1 x 0 :=
by simp [term]

theorem term_atomg {α} [add_comm_group α] (x : α) : x = termg 1 x 0 :=
by simp [termg]

meta def eval_atom (c : cache) (e : expr) : tactic (normal_expr × expr) :=
do n1 ← c.int_to_expr 1,
   return (term' c (n1, 1) e (zero' c), c.iapp ``term_atom [e])

lemma unfold_sub {α} [add_group α] (a b c : α)
  (h : a + -b = c) : a - b = c :=
by rw [sub_eq_add_neg, h]

theorem unfold_smul {α} [add_comm_monoid α] (n) (x y : α)
  (h : smul n x = y) : n • x = y := h

theorem unfold_smulg {α} [add_comm_group α] (n : ℕ) (x y : α)
  (h : smulg (int.of_nat n) x = y) : (n : ℤ) • x = y := h

theorem unfold_gsmul {α} [add_comm_group α] (n : ℤ) (x y : α)
  (h : smulg n x = y) : gsmul n x = y := h

lemma subst_into_smul {α} [add_comm_monoid α]
  (l r tl tr t) (prl : l = tl) (prr : r = tr)
  (prt : @smul α _ tl tr = t) : smul l r = t :=
by simp [prl, prr, prt]

lemma subst_into_smulg {α} [add_comm_group α]
  (l r tl tr t) (prl : l = tl) (prr : r = tr)
  (prt : @smulg α _ tl tr = t) : smulg l r = t :=
by simp [prl, prr, prt]

/-- Deal with a `smul` term of the form `e₁ • e₂`, handling both natural and integer `e₁`. -/
meta def eval_smul' (c : cache) (eval : expr → tactic (normal_expr × expr))
  (e₁ e₂ : expr) : tactic (normal_expr × expr) :=
do (e₁', p₁) ← norm_num.derive e₁ <|> refl_conv e₁,
  n ← if c.is_group then e₁'.to_int else coe <$> e₁'.to_nat,
  (e₂', p₂) ← eval e₂,
  (e', p) ← eval_smul c (e₁', n) e₂',
  return (e', c.iapp ``subst_into_smul [e₁, e₂, e₁', e₂', e', p₁, p₂, p])

meta def eval (c : cache) : expr → tactic (normal_expr × expr)
| `(%%e₁ + %%e₂) := do
  (e₁', p₁) ← eval e₁,
  (e₂', p₂) ← eval e₂,
  (e', p') ← eval_add c e₁' e₂',
  p ← c.mk_app ``norm_num.subst_into_add ``has_add [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
  return (e', p)
| `(%%e₁ - %%e₂) := do
  e₂' ← mk_app ``has_neg.neg [e₂],
  e ← mk_app ``has_add.add [e₁, e₂'],
  (e', p) ← eval e,
  p' ← c.mk_app ``unfold_sub ``add_group [e₁, e₂, e', p],
  return (e', p')
| `(- %%e) := do
  (e₁, p₁) ← eval e,
  (e₂, p₂) ← eval_neg c e₁,
  p ← c.mk_app ``norm_num.subst_into_neg ``has_neg [e, e₁, e₂, p₁, p₂],
  return (e₂, p)
| `(nsmul %%e₁ %%e₂) := do
  n ← if c.is_group then mk_app ``int.of_nat [e₁] else return e₁,
  (e', p) ← eval $ c.iapp ``smul [n, e₂],
  return (e', c.iapp ``unfold_smul [e₁, e₂, e', p])
| `(gsmul %%e₁ %%e₂) := do
  guardb c.is_group,
  (e', p) ← eval $ c.iapp ``smul [e₁, e₂],
  return (e', c.app ``unfold_gsmul c.inst [e₁, e₂, e', p])
| `(@has_scalar.smul nat _ add_monoid.has_scalar_nat %%e₁ %%e₂) := eval_smul' c eval e₁ e₂
| `(@has_scalar.smul int _ sub_neg_monoid.has_scalar_int %%e₁ %%e₂) := eval_smul' c eval e₁ e₂
| `(smul %%e₁ %%e₂) := eval_smul' c eval e₁ e₂
| `(smulg %%e₁ %%e₂) := eval_smul' c eval e₁ e₂
| e := eval_atom c e

meta def eval' (c : cache) (e : expr) : tactic (expr × expr) :=
do (e', p) ← eval c e, return (e', p)

@[derive has_reflect]
inductive normalize_mode | raw | term

instance : inhabited normalize_mode := ⟨normalize_mode.term⟩

meta def normalize (mode := normalize_mode.term) (e : expr) : tactic (expr × expr) := do
pow_lemma ← simp_lemmas.mk.add_simp ``pow_one,
let lemmas := match mode with
| normalize_mode.term :=
  [``term.equations._eqn_1, ``termg.equations._eqn_1, ``add_zero, ``one_nsmul, ``one_gsmul,
    ``gsmul_zero]
| _ := []
end,
lemmas ← lemmas.mfoldl simp_lemmas.add_simp simp_lemmas.mk,
(_, e', pr) ← ext_simplify_core () {}
  simp_lemmas.mk (λ _, failed) (λ _ _ _ _ e, do
    c ← mk_cache e,
    (new_e, pr) ← match mode with
    | normalize_mode.raw := eval' c
    | normalize_mode.term := trans_conv (eval' c)
                               (λ e, do (e', prf, _) ← simplify lemmas [] e, return (e', prf))
    end e,
    guard (¬ new_e =ₐ e),
    return ((), new_e, some pr, ff))
   (λ _ _ _ _ _, failed) `eq e,
return (e', pr)

end abel

namespace interactive
open interactive interactive.types lean.parser
open tactic.abel

local postfix `?`:9001 := optional

/-- Tactic for solving equations in the language of
*additive*, commutative monoids and groups.
This version of `abel` fails if the target is not an equality
that is provable by the axioms of commutative monoids/groups. -/
meta def abel1 : tactic unit :=
do `(%%e₁ = %%e₂) ← target,
  c ← mk_cache e₁,
  (e₁', p₁) ← eval c e₁,
  (e₂', p₂) ← eval c e₂,
  is_def_eq e₁' e₂',
  p ← mk_eq_symm p₂ >>= mk_eq_trans p₁,
  tactic.exact p

meta def abel.mode : lean.parser abel.normalize_mode :=
with_desc "(raw|term)?" $
do mode ← ident?, match mode with
| none       := return abel.normalize_mode.term
| some `term := return abel.normalize_mode.term
| some `raw  := return abel.normalize_mode.raw
| _          := failed
end

/--
Evaluate expressions in the language of *additive*, commutative monoids and groups.
It attempts to prove the goal outright if there is no `at`
specifier and the target is an equality, but if this
fails, it falls back to rewriting all monoid expressions into a normal form.
If there is an `at` specifier, it rewrites the given target into a normal form.
```lean
example {α : Type*} {a b : α} [add_comm_monoid α] : a + (b + a) = a + a + b := by abel
example {α : Type*} {a b : α} [add_comm_group α] : (a + b) - ((b + a) + a) = -a := by abel
example {α : Type*} {a b : α} [add_comm_group α] (hyp : a + a - a = b - b) : a = 0 :=
by { abel at hyp, exact hyp }
```
-/
meta def abel (SOP : parse abel.mode) (loc : parse location) : tactic unit :=
match loc with
| interactive.loc.ns [none] := abel1
| _ := failed
end <|>
do ns ← loc.get_locals,
   tt ← tactic.replace_at (normalize SOP) ns loc.include_goal
      | fail "abel failed to simplify",
   when loc.include_goal $ try tactic.reflexivity

add_tactic_doc
{ name        := "abel",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.abel],
  tags        := ["arithmetic", "decision procedure"] }

end interactive
end tactic


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

/-!
# Lebesgue measure on `ℂ`

In this file we define Lebesgue measure on `ℂ`. Since `ℂ` is defined as a `structure` as the
push-forward of the volume on `ℝ²` under the natural isomorphism. There are (at least) two
frequently used ways to represent `ℝ²` in `mathlib`: `ℝ × ℝ` and `fin 2 → ℝ`. We define measurable
equivalences (`measurable_equiv`) to both types and prove that both of them are volume preserving
(in the sense of `measure_theory.measure_preserving`).
-/

open measure_theory
noncomputable theory

namespace complex

/-- Lebesgue measure on `ℂ`. -/
instance measure_space : measure_space ℂ :=
⟨measure.map basis_one_I.equiv_fun.symm volume⟩

/-- Measurable equivalence between `ℂ` and `ℝ² = fin 2 → ℝ`. -/
def measurable_equiv_pi : ℂ ≃ᵐ (fin 2 → ℝ) :=
basis_one_I.equiv_fun.to_continuous_linear_equiv.to_homeomorph.to_measurable_equiv

/-- Measurable equivalence between `ℂ` and `ℝ × ℝ`. -/
def measurable_equiv_real_prod : ℂ ≃ᵐ (ℝ × ℝ) :=
equiv_real_prod_clm.to_homeomorph.to_measurable_equiv

lemma volume_preserving_equiv_pi :
  measure_preserving measurable_equiv_pi :=
(measurable_equiv_pi.symm.measurable.measure_preserving _).symm _

lemma volume_preserving_equiv_real_prod : measure_preserving measurable_equiv_real_prod :=
(volume_preserving_fin_two_arrow ℝ).comp volume_preserving_equiv_pi

end complex


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

! This file was ported from Lean 3 source module topology.algebra.order.intermediate_value
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.CompleteLatticeIntervals
import Mathlib.Topology.Order.Basic

/-!
# Intermediate Value Theorem

In this file we prove the Intermediate Value Theorem: if `f : α → β` is a function defined on a
connected set `s` that takes both values `≤ a` and values `≥ a` on `s`, then it is equal to `a` at
some point of `s`. We also prove that intervals in a dense conditionally complete order are
preconnected and any preconnected set is an interval. Then we specialize IVT to functions continuous
on intervals.

## Main results

* `IsPreconnected_I??` : all intervals `I??` are preconnected,
* `IsPreconnected.intermediate_value`, `intermediate_value_univ` : Intermediate Value Theorem for
  connected sets and connected spaces, respectively;
* `intermediate_value_Icc`, `intermediate_value_Icc'`: Intermediate Value Theorem for functions
  on closed intervals.

### Miscellaneous facts

* `IsClosed.Icc_subset_of_forall_mem_nhdsWithin` : “Continuous induction” principle;
  if `s ∩ [a, b]` is closed, `a ∈ s`, and for each `x ∈ [a, b) ∩ s` some of its right neighborhoods
  is included `s`, then `[a, b] ⊆ s`.
* `IsClosed.Icc_subset_of_forall_exists_gt`, `IsClosed.mem_of_ge_of_forall_exists_gt` : two
  other versions of the “continuous induction” principle.

## Tags

intermediate value theorem, connected space, connected set
-/

open Filter OrderDual TopologicalSpace Function Set

open Topology Filter

universe u v w

/-!
### Intermediate value theorem on a (pre)connected space

In this section we prove the following theorem (see `IsPreconnected.intermediate_value₂`): if `f`
and `g` are two functions continuous on a preconnected set `s`, `f a ≤ g a` at some `a ∈ s` and
`g b ≤ f b` at some `b ∈ s`, then `f c = g c` at some `c ∈ s`. We prove several versions of this
statement, including the classical IVT that corresponds to a constant function `g`.
-/

section

variable {X : Type u} {α : Type v} [TopologicalSpace X] [LinearOrder α] [TopologicalSpace α]
  [OrderClosedTopology α]

/-- Intermediate value theorem for two functions: if `f` and `g` are two continuous functions
on a preconnected space and `f a ≤ g a` and `g b ≤ f b`, then for some `x` we have `f x = g x`. -/
theorem intermediate_value_univ₂ [PreconnectedSpace X] {a b : X} {f g : X → α} (hf : Continuous f)
    (hg : Continuous g) (ha : f a ≤ g a) (hb : g b ≤ f b) : ∃ x, f x = g x := by
  obtain ⟨x, _, hfg, hgf⟩ : (univ ∩ { x | f x ≤ g x ∧ g x ≤ f x }).Nonempty
  exact
    isPreconnected_closed_iff.1 PreconnectedSpace.isPreconnected_univ _ _ (isClosed_le hf hg)
      (isClosed_le hg hf) (fun _ _ => le_total _ _) ⟨a, trivial, ha⟩ ⟨b, trivial, hb⟩
  exact ⟨x, le_antisymm hfg hgf⟩
#align intermediate_value_univ₂ intermediate_value_univ₂

theorem intermediate_value_univ₂_eventually₁ [PreconnectedSpace X] {a : X} {l : Filter X} [NeBot l]
    {f g : X → α} (hf : Continuous f) (hg : Continuous g) (ha : f a ≤ g a) (he : g ≤ᶠ[l] f) :
    ∃ x, f x = g x :=
  let ⟨_, h⟩ := he.exists; intermediate_value_univ₂ hf hg ha h
#align intermediate_value_univ₂_eventually₁ intermediate_value_univ₂_eventually₁

theorem intermediate_value_univ₂_eventually₂ [PreconnectedSpace X] {l₁ l₂ : Filter X} [NeBot l₁]
    [NeBot l₂] {f g : X → α} (hf : Continuous f) (hg : Continuous g) (he₁ : f ≤ᶠ[l₁] g)
    (he₂ : g ≤ᶠ[l₂] f) : ∃ x, f x = g x :=
  let ⟨_, h₁⟩ := he₁.exists
  let ⟨_, h₂⟩ := he₂.exists
  intermediate_value_univ₂ hf hg h₁ h₂
#align intermediate_value_univ₂_eventually₂ intermediate_value_univ₂_eventually₂

/-- Intermediate value theorem for two functions: if `f` and `g` are two functions continuous
on a preconnected set `s` and for some `a b ∈ s` we have `f a ≤ g a` and `g b ≤ f b`,
then for some `x ∈ s` we have `f x = g x`. -/
theorem IsPreconnected.intermediate_value₂ {s : Set X} (hs : IsPreconnected s) {a b : X}
    (ha : a ∈ s) (hb : b ∈ s) {f g : X → α} (hf : ContinuousOn f s) (hg : ContinuousOn g s)
    (ha' : f a ≤ g a) (hb' : g b ≤ f b) : ∃ x ∈ s, f x = g x :=
  let ⟨x, hx⟩ :=
    @intermediate_value_univ₂ s α _ _ _ _ (Subtype.preconnectedSpace hs) ⟨a, ha⟩ ⟨b, hb⟩ _ _
      (continuousOn_iff_continuous_restrict.1 hf) (continuousOn_iff_continuous_restrict.1 hg) ha'
      hb'
  ⟨x, x.2, hx⟩
#align is_preconnected.intermediate_value₂ IsPreconnected.intermediate_value₂

theorem IsPreconnected.intermediate_value₂_eventually₁ {s : Set X} (hs : IsPreconnected s) {a : X}
    {l : Filter X} (ha : a ∈ s) [NeBot l] (hl : l ≤ 𝓟 s) {f g : X → α} (hf : ContinuousOn f s)
    (hg : ContinuousOn g s) (ha' : f a ≤ g a) (he : g ≤ᶠ[l] f) : ∃ x ∈ s, f x = g x := by
  rw [continuousOn_iff_continuous_restrict] at hf hg
  obtain ⟨b, h⟩ :=
    @intermediate_value_univ₂_eventually₁ _ _ _ _ _ _ (Subtype.preconnectedSpace hs) ⟨a, ha⟩ _
      (comap_coe_neBot_of_le_principal hl) _ _ hf hg ha' (he.comap _)
  exact ⟨b, b.prop, h⟩
#align is_preconnected.intermediate_value₂_eventually₁ IsPreconnected.intermediate_value₂_eventually₁

theorem IsPreconnected.intermediate_value₂_eventually₂ {s : Set X} (hs : IsPreconnected s)
    {l₁ l₂ : Filter X} [NeBot l₁] [NeBot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f g : X → α}
    (hf : ContinuousOn f s) (hg : ContinuousOn g s) (he₁ : f ≤ᶠ[l₁] g) (he₂ : g ≤ᶠ[l₂] f) :
    ∃ x ∈ s, f x = g x := by
  rw [continuousOn_iff_continuous_restrict] at hf hg
  obtain ⟨b, h⟩ :=
    @intermediate_value_univ₂_eventually₂ _ _ _ _ _ _ (Subtype.preconnectedSpace hs) _ _
      (comap_coe_neBot_of_le_principal hl₁) (comap_coe_neBot_of_le_principal hl₂) _ _ hf hg
      (he₁.comap _) (he₂.comap _)
  exact ⟨b, b.prop, h⟩
#align is_preconnected.intermediate_value₂_eventually₂ IsPreconnected.intermediate_value₂_eventually₂

/-- **Intermediate Value Theorem** for continuous functions on connected sets. -/
theorem IsPreconnected.intermediate_value {s : Set X} (hs : IsPreconnected s) {a b : X} (ha : a ∈ s)
    (hb : b ∈ s) {f : X → α} (hf : ContinuousOn f s) : Icc (f a) (f b) ⊆ f '' s := fun _x hx =>
  hs.intermediate_value₂ ha hb hf continuousOn_const hx.1 hx.2
#align is_preconnected.intermediate_value IsPreconnected.intermediate_value

theorem IsPreconnected.intermediate_value_Ico {s : Set X} (hs : IsPreconnected s) {a : X}
    {l : Filter X} (ha : a ∈ s) [NeBot l] (hl : l ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s) {v : α}
    (ht : Tendsto f l (𝓝 v)) : Ico (f a) v ⊆ f '' s := fun _ h =>
  hs.intermediate_value₂_eventually₁ ha hl hf continuousOn_const h.1
    (eventually_ge_of_tendsto_gt h.2 ht)
#align is_preconnected.intermediate_value_Ico IsPreconnected.intermediate_value_Ico

theorem IsPreconnected.intermediate_value_Ioc {s : Set X} (hs : IsPreconnected s) {a : X}
    {l : Filter X} (ha : a ∈ s) [NeBot l] (hl : l ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s) {v : α}
    (ht : Tendsto f l (𝓝 v)) : Ioc v (f a) ⊆ f '' s := fun _ h =>
  (hs.intermediate_value₂_eventually₁ ha hl continuousOn_const hf h.2
    (eventually_le_of_tendsto_lt h.1 ht)).imp fun _ h => h.imp_right Eq.symm
#align is_preconnected.intermediate_value_Ioc IsPreconnected.intermediate_value_Ioc

theorem IsPreconnected.intermediate_value_Ioo {s : Set X} (hs : IsPreconnected s) {l₁ l₂ : Filter X}
    [NeBot l₁] [NeBot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    {v₁ v₂ : α} (ht₁ : Tendsto f l₁ (𝓝 v₁)) (ht₂ : Tendsto f l₂ (𝓝 v₂)) :
    Ioo v₁ v₂ ⊆ f '' s := fun _ h =>
  hs.intermediate_value₂_eventually₂ hl₁ hl₂ hf continuousOn_const
    (eventually_le_of_tendsto_lt h.1 ht₁) (eventually_ge_of_tendsto_gt h.2 ht₂)
#align is_preconnected.intermediate_value_Ioo IsPreconnected.intermediate_value_Ioo

theorem IsPreconnected.intermediate_value_Ici {s : Set X} (hs : IsPreconnected s) {a : X}
    {l : Filter X} (ha : a ∈ s) [NeBot l] (hl : l ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    (ht : Tendsto f l atTop) : Ici (f a) ⊆ f '' s := fun y h =>
  hs.intermediate_value₂_eventually₁ ha hl hf continuousOn_const h (tendsto_atTop.1 ht y)
#align is_preconnected.intermediate_value_Ici IsPreconnected.intermediate_value_Ici

theorem IsPreconnected.intermediate_value_Iic {s : Set X} (hs : IsPreconnected s) {a : X}
    {l : Filter X} (ha : a ∈ s) [NeBot l] (hl : l ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    (ht : Tendsto f l atBot) : Iic (f a) ⊆ f '' s := fun y h =>
  (hs.intermediate_value₂_eventually₁ ha hl continuousOn_const hf h (tendsto_atBot.1 ht y)).imp
    fun _ h => h.imp_right Eq.symm
#align is_preconnected.intermediate_value_Iic IsPreconnected.intermediate_value_Iic

theorem IsPreconnected.intermediate_value_Ioi {s : Set X} (hs : IsPreconnected s) {l₁ l₂ : Filter X}
    [NeBot l₁] [NeBot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    {v : α} (ht₁ : Tendsto f l₁ (𝓝 v)) (ht₂ : Tendsto f l₂ atTop) : Ioi v ⊆ f '' s := fun y h =>
  hs.intermediate_value₂_eventually₂ hl₁ hl₂ hf continuousOn_const
    (eventually_le_of_tendsto_lt h ht₁) (tendsto_atTop.1 ht₂ y)
#align is_preconnected.intermediate_value_Ioi IsPreconnected.intermediate_value_Ioi

theorem IsPreconnected.intermediate_value_Iio {s : Set X} (hs : IsPreconnected s) {l₁ l₂ : Filter X}
    [NeBot l₁] [NeBot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    {v : α} (ht₁ : Tendsto f l₁ atBot) (ht₂ : Tendsto f l₂ (𝓝 v)) : Iio v ⊆ f '' s := fun y h =>
  hs.intermediate_value₂_eventually₂ hl₁ hl₂ hf continuousOn_const (tendsto_atBot.1 ht₁ y)
    (eventually_ge_of_tendsto_gt h ht₂)
#align is_preconnected.intermediate_value_Iio IsPreconnected.intermediate_value_Iio

theorem IsPreconnected.intermediate_value_Iii {s : Set X} (hs : IsPreconnected s) {l₁ l₂ : Filter X}
    [NeBot l₁] [NeBot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α} (hf : ContinuousOn f s)
    (ht₁ : Tendsto f l₁ atBot) (ht₂ : Tendsto f l₂ atTop) : univ ⊆ f '' s := fun y _ =>
  hs.intermediate_value₂_eventually₂ hl₁ hl₂ hf continuousOn_const (tendsto_atBot.1 ht₁ y)
    (tendsto_atTop.1 ht₂ y)
set_option linter.uppercaseLean3 false in
#align is_preconnected.intermediate_value_Iii IsPreconnected.intermediate_value_Iii

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
theorem intermediate_value_univ [PreconnectedSpace X] (a b : X) {f : X → α} (hf : Continuous f) :
    Icc (f a) (f b) ⊆ range f := fun _ hx => intermediate_value_univ₂ hf continuous_const hx.1 hx.2
#align intermediate_value_univ intermediate_value_univ

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
theorem mem_range_of_exists_le_of_exists_ge [PreconnectedSpace X] {c : α} {f : X → α}
    (hf : Continuous f) (h₁ : ∃ a, f a ≤ c) (h₂ : ∃ b, c ≤ f b) : c ∈ range f :=
  let ⟨a, ha⟩ := h₁; let ⟨b, hb⟩ := h₂; intermediate_value_univ a b hf ⟨ha, hb⟩
#align mem_range_of_exists_le_of_exists_ge mem_range_of_exists_le_of_exists_ge

/-!
### (Pre)connected sets in a linear order

In this section we prove the following results:

* `IsPreconnected.ordConnected`: any preconnected set `s` in a linear order is `ord_connected`,
  i.e. `a ∈ s` and `b ∈ s` imply `Icc a b ⊆ s`;

* `IsPreconnected.mem_intervals`: any preconnected set `s` in a conditionally complete linear order
  is one of the intervals `Set.Icc`, `set.`Ico`, `set.Ioc`, `set.Ioo`, ``Set.Ici`, `Set.Iic`,
  `Set.Ioi`, `Set.Iio`; note that this is false for non-complete orders: e.g., in `ℝ \ {0}`, the set
  of positive numbers cannot be represented as `Set.Ioi _`.

-/

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
theorem IsPreconnected.Icc_subset {s : Set α} (hs : IsPreconnected s) {a b : α} (ha : a ∈ s)
    (hb : b ∈ s) : Icc a b ⊆ s := by
  simpa only [image_id] using hs.intermediate_value ha hb continuousOn_id
#align is_preconnected.Icc_subset IsPreconnected.Icc_subset

theorem IsPreconnected.ordConnected {s : Set α} (h : IsPreconnected s) : OrdConnected s :=
  ⟨fun _ hx _ hy => h.Icc_subset hx hy⟩
#align is_preconnected.ord_connected IsPreconnected.ordConnected

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
theorem IsConnected.Icc_subset {s : Set α} (hs : IsConnected s) {a b : α} (ha : a ∈ s)
    (hb : b ∈ s) : Icc a b ⊆ s :=
  hs.2.Icc_subset ha hb
#align is_connected.Icc_subset IsConnected.Icc_subset

/-- If preconnected set in a linear order space is unbounded below and above, then it is the whole
space. -/
theorem IsPreconnected.eq_univ_of_unbounded {s : Set α} (hs : IsPreconnected s) (hb : ¬BddBelow s)
    (ha : ¬BddAbove s) : s = univ := by
  refine' eq_univ_of_forall fun x => _
  obtain ⟨y, ys, hy⟩ : ∃ y ∈ s, y < x := not_bddBelow_iff.1 hb x
  obtain ⟨z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bddAbove_iff.1 ha x
  exact hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩
#align is_preconnected.eq_univ_of_unbounded IsPreconnected.eq_univ_of_unbounded

end

variable {α : Type u} {β : Type v} {γ : Type w} [ConditionallyCompleteLinearOrder α]
  [TopologicalSpace α] [OrderTopology α] [ConditionallyCompleteLinearOrder β] [TopologicalSpace β]
  [OrderTopology β] [Nonempty γ]

/-- A bounded connected subset of a conditionally complete linear order includes the open interval
`(Inf s, Sup s)`. -/
theorem IsConnected.Ioo_cinfₛ_csupₛ_subset {s : Set α} (hs : IsConnected s) (hb : BddBelow s)
    (ha : BddAbove s) : Ioo (infₛ s) (supₛ s) ⊆ s := fun _x hx =>
  let ⟨_y, ys, hy⟩ := (isGLB_lt_iff (isGLB_cinfₛ hs.nonempty hb)).1 hx.1
  let ⟨_z, zs, hz⟩ := (lt_isLUB_iff (isLUB_csupₛ hs.nonempty ha)).1 hx.2
  hs.Icc_subset ys zs ⟨hy.le, hz.le⟩
#align is_connected.Ioo_cInf_cSup_subset IsConnected.Ioo_cinfₛ_csupₛ_subset

theorem eq_Icc_cinfₛ_csupₛ_of_connected_bdd_closed {s : Set α} (hc : IsConnected s)
    (hb : BddBelow s) (ha : BddAbove s) (hcl : IsClosed s) : s = Icc (infₛ s) (supₛ s) :=
  (subset_Icc_cinfₛ_csupₛ hb ha).antisymm <|
    hc.Icc_subset (hcl.cinfₛ_mem hc.nonempty hb) (hcl.csupₛ_mem hc.nonempty ha)
#align eq_Icc_cInf_cSup_of_connected_bdd_closed eq_Icc_cinfₛ_csupₛ_of_connected_bdd_closed

theorem IsPreconnected.Ioi_cinfₛ_subset {s : Set α} (hs : IsPreconnected s) (hb : BddBelow s)
    (ha : ¬BddAbove s) : Ioi (infₛ s) ⊆ s := fun x hx =>
  have sne : s.Nonempty := nonempty_of_not_bddAbove ha
  let ⟨_y, ys, hy⟩ : ∃ y ∈ s, y < x := (isGLB_lt_iff (isGLB_cinfₛ sne hb)).1 hx
  let ⟨_z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bddAbove_iff.1 ha x
  hs.Icc_subset ys zs ⟨hy.le, hz.le⟩
#align is_preconnected.Ioi_cInf_subset IsPreconnected.Ioi_cinfₛ_subset

theorem IsPreconnected.Iio_csupₛ_subset {s : Set α} (hs : IsPreconnected s) (hb : ¬BddBelow s)
    (ha : BddAbove s) : Iio (supₛ s) ⊆ s :=
  @IsPreconnected.Ioi_cinfₛ_subset αᵒᵈ _ _ _ s hs ha hb
#align is_preconnected.Iio_cSup_subset IsPreconnected.Iio_csupₛ_subset

/-- A preconnected set in a conditionally complete linear order is either one of the intervals
`[Inf s, Sup s]`, `[Inf s, Sup s)`, `(Inf s, Sup s]`, `(Inf s, Sup s)`, `[Inf s, +∞)`,
`(Inf s, +∞)`, `(-∞, Sup s]`, `(-∞, Sup s)`, `(-∞, +∞)`, or `∅`. The converse statement requires
`α` to be densely ordererd. -/
theorem IsPreconnected.mem_intervals {s : Set α} (hs : IsPreconnected s) :
    s ∈
      ({Icc (infₛ s) (supₛ s), Ico (infₛ s) (supₛ s), Ioc (infₛ s) (supₛ s), Ioo (infₛ s) (supₛ s),
          Ici (infₛ s), Ioi (infₛ s), Iic (supₛ s), Iio (supₛ s), univ, ∅} :
        Set (Set α)) := by
  rcases s.eq_empty_or_nonempty with (rfl | hne)
  · apply_rules [Or.inr, mem_singleton]
  have hs' : IsConnected s := ⟨hne, hs⟩
  by_cases hb : BddBelow s <;> by_cases ha : BddAbove s
  · rcases mem_Icc_Ico_Ioc_Ioo_of_subset_of_subset (hs'.Ioo_cinfₛ_csupₛ_subset hb ha)
        (subset_Icc_cinfₛ_csupₛ hb ha) with (hs | hs | hs | hs)
    · exact Or.inl hs
    · exact Or.inr <| Or.inl hs
    · exact Or.inr <| Or.inr <| Or.inl hs
    · exact Or.inr <| Or.inr <| Or.inr <| Or.inl hs
  · refine' Or.inr <| Or.inr <| Or.inr <| Or.inr _
    cases'
      mem_Ici_Ioi_of_subset_of_subset (hs.Ioi_cinfₛ_subset hb ha) fun x hx => cinfₛ_le hb hx with
      hs hs
    · exact Or.inl hs
    · exact Or.inr (Or.inl hs)
  · iterate 6 apply Or.inr
    cases' mem_Iic_Iio_of_subset_of_subset (hs.Iio_csupₛ_subset hb ha) fun x hx => le_csupₛ ha hx
      with hs hs
    · exact Or.inl hs
    · exact Or.inr (Or.inl hs)
  · iterate 8 apply Or.inr
    exact Or.inl (hs.eq_univ_of_unbounded hb ha)
#align is_preconnected.mem_intervals IsPreconnected.mem_intervals

/-- A preconnected set is either one of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`,
`Iic`, `Iio`, or `univ`, or `∅`. The converse statement requires `α` to be densely ordered. Though
one can represent `∅` as `(Inf s, Inf s)`, we include it into the list of possible cases to improve
readability. -/
theorem setOf_isPreconnected_subset_of_ordered :
    { s : Set α | IsPreconnected s } ⊆
      -- bounded intervals
      (range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo)) ∪
      -- unbounded intervals and `univ`
      (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) := by
  intro s hs
  rcases hs.mem_intervals with (hs | hs | hs | hs | hs | hs | hs | hs | hs | hs)
  · exact Or.inl <| Or.inl <| Or.inl <| Or.inl ⟨(infₛ s, supₛ s), hs.symm⟩
  · exact Or.inl <| Or.inl <| Or.inl <| Or.inr ⟨(infₛ s, supₛ s), hs.symm⟩
  · exact Or.inl <| Or.inl <| Or.inr ⟨(infₛ s, supₛ s), hs.symm⟩
  · exact Or.inl <| Or.inr ⟨(infₛ s, supₛ s), hs.symm⟩
  · exact Or.inr <| Or.inl <| Or.inl <| Or.inl <| Or.inl ⟨infₛ s, hs.symm⟩
  · exact Or.inr <| Or.inl <| Or.inl <| Or.inl <| Or.inr ⟨infₛ s, hs.symm⟩
  · exact Or.inr <| Or.inl <| Or.inl <| Or.inr ⟨supₛ s, hs.symm⟩
  · exact Or.inr <| Or.inl <| Or.inr ⟨supₛ s, hs.symm⟩
  · exact Or.inr <| Or.inr <| Or.inl hs
  · exact Or.inr <| Or.inr <| Or.inr hs
#align set_of_is_preconnected_subset_of_ordered setOf_isPreconnected_subset_of_ordered

/-!
### Intervals are connected

In this section we prove that a closed interval (hence, any `ord_connected` set) in a dense
conditionally complete linear order is preconnected.
-/

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and the set `s ∩ [a, b)` has no maximal point, then `b ∈ s`. -/
theorem IsClosed.mem_of_ge_of_forall_exists_gt {a b : α} {s : Set α} (hs : IsClosed (s ∩ Icc a b))
    (ha : a ∈ s) (hab : a ≤ b) (hgt : ∀ x ∈ s ∩ Ico a b, (s ∩ Ioc x b).Nonempty) : b ∈ s := by
  let S := s ∩ Icc a b
  replace ha : a ∈ S
  exact ⟨ha, left_mem_Icc.2 hab⟩
  have Sbd : BddAbove S := ⟨b, fun z hz => hz.2.2⟩
  let c := supₛ (s ∩ Icc a b)
  have c_mem : c ∈ S := hs.csupₛ_mem ⟨_, ha⟩ Sbd
  have c_le : c ≤ b := csupₛ_le ⟨_, ha⟩ fun x hx => hx.2.2
  cases' eq_or_lt_of_le c_le with hc hc
  exact hc ▸ c_mem.1
  exfalso
  rcases hgt c ⟨c_mem.1, c_mem.2.1, hc⟩ with ⟨x, xs, cx, xb⟩
  exact not_lt_of_le (le_csupₛ Sbd ⟨xs, le_trans (le_csupₛ Sbd ha) (le_of_lt cx), xb⟩) cx
#align is_closed.mem_of_ge_of_forall_exists_gt IsClosed.mem_of_ge_of_forall_exists_gt

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `a ≤ x < y ≤ b`, `x ∈ s`, the set `s ∩ (x, y]`
is not empty, then `[a, b] ⊆ s`. -/
theorem IsClosed.Icc_subset_of_forall_exists_gt {a b : α} {s : Set α} (hs : IsClosed (s ∩ Icc a b))
    (ha : a ∈ s) (hgt : ∀ x ∈ s ∩ Ico a b, ∀ y ∈ Ioi x, (s ∩ Ioc x y).Nonempty) : Icc a b ⊆ s := by
  intro y hy
  have : IsClosed (s ∩ Icc a y) :=
    by
    suffices s ∩ Icc a y = s ∩ Icc a b ∩ Icc a y
      by
      rw [this]
      exact IsClosed.inter hs isClosed_Icc
    rw [inter_assoc]
    congr
    exact (inter_eq_self_of_subset_right <| Icc_subset_Icc_right hy.2).symm
  exact
    IsClosed.mem_of_ge_of_forall_exists_gt this ha hy.1 fun x hx =>
      hgt x ⟨hx.1, Ico_subset_Ico_right hy.2 hx.2⟩ y hx.2.2
#align is_closed.Icc_subset_of_forall_exists_gt IsClosed.Icc_subset_of_forall_exists_gt

variable [DenselyOrdered α] {a b : α}

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `x ∈ s ∩ [a, b)` the set `s` includes some open
neighborhood of `x` within `(x, +∞)`, then `[a, b] ⊆ s`. -/
theorem IsClosed.Icc_subset_of_forall_mem_nhdsWithin {a b : α} {s : Set α}
    (hs : IsClosed (s ∩ Icc a b)) (ha : a ∈ s) (hgt : ∀ x ∈ s ∩ Ico a b, s ∈ 𝓝[>] x) :
    Icc a b ⊆ s := by
  apply hs.Icc_subset_of_forall_exists_gt ha
  rintro x ⟨hxs, hxab⟩ y hyxb
  have : s ∩ Ioc x y ∈ 𝓝[>] x :=
    inter_mem (hgt x ⟨hxs, hxab⟩) (Ioc_mem_nhdsWithin_Ioi ⟨le_rfl, hyxb⟩)
  exact (nhdsWithin_Ioi_self_neBot' ⟨b, hxab.2⟩).nonempty_of_mem this
#align is_closed.Icc_subset_of_forall_mem_nhds_within IsClosed.Icc_subset_of_forall_mem_nhdsWithin

theorem isPreconnected_Icc_aux (x y : α) (s t : Set α) (hxy : x ≤ y) (hs : IsClosed s)
    (ht : IsClosed t) (hab : Icc a b ⊆ s ∪ t) (hx : x ∈ Icc a b ∩ s) (hy : y ∈ Icc a b ∩ t) :
    (Icc a b ∩ (s ∩ t)).Nonempty := by
  have xyab : Icc x y ⊆ Icc a b := Icc_subset_Icc hx.1.1 hy.1.2
  by_contra hst
  suffices : Icc x y ⊆ s
  exact hst ⟨y, xyab <| right_mem_Icc.2 hxy, this <| right_mem_Icc.2 hxy, hy.2⟩
  apply (IsClosed.inter hs isClosed_Icc).Icc_subset_of_forall_mem_nhdsWithin hx.2
  rintro z ⟨zs, hz⟩
  have zt : z ∈ tᶜ := fun zt => hst ⟨z, xyab <| Ico_subset_Icc_self hz, zs, zt⟩
  have : tᶜ ∩ Ioc z y ∈ 𝓝[>] z :=
    by
    rw [← nhdsWithin_Ioc_eq_nhdsWithin_Ioi hz.2]
    exact mem_nhdsWithin.2 ⟨tᶜ, ht.isOpen_compl, zt, Subset.rfl⟩
  apply mem_of_superset this
  have : Ioc z y ⊆ s ∪ t := fun w hw => hab (xyab ⟨le_trans hz.1 (le_of_lt hw.1), hw.2⟩)
  exact fun w ⟨wt, wzy⟩ => (this wzy).elim id fun h => (wt h).elim
#align is_preconnected_Icc_aux isPreconnected_Icc_aux

/-- A closed interval in a densely ordered conditionally complete linear order is preconnected. -/
theorem isPreconnected_Icc : IsPreconnected (Icc a b) :=
  isPreconnected_closed_iff.2
    (by
      rintro s t hs ht hab ⟨x, hx⟩ ⟨y, hy⟩
      -- This used to use `wlog`, but it was causing timeouts.
      cases' le_total x y with h h
      · exact isPreconnected_Icc_aux x y s t h hs ht hab hx hy
      · rw [inter_comm s t]
        rw [union_comm s t] at hab
        exact isPreconnected_Icc_aux y x t s h ht hs hab hy hx)
#align is_preconnected_Icc isPreconnected_Icc

theorem isPreconnected_uIcc : IsPreconnected (uIcc a b) :=
  isPreconnected_Icc
#align is_preconnected_uIcc isPreconnected_uIcc

theorem Set.OrdConnected.isPreconnected {s : Set α} (h : s.OrdConnected) : IsPreconnected s :=
  isPreconnected_of_forall_pair fun x hx y hy =>
    ⟨uIcc x y, h.uIcc_subset hx hy, left_mem_uIcc, right_mem_uIcc, isPreconnected_uIcc⟩
#align set.ord_connected.is_preconnected Set.OrdConnected.isPreconnected

theorem isPreconnected_iff_ordConnected {s : Set α} : IsPreconnected s ↔ OrdConnected s :=
  ⟨IsPreconnected.ordConnected, Set.OrdConnected.isPreconnected⟩
#align is_preconnected_iff_ord_connected isPreconnected_iff_ordConnected

theorem isPreconnected_Ici : IsPreconnected (Ici a) :=
  ordConnected_Ici.isPreconnected
#align is_preconnected_Ici isPreconnected_Ici

theorem isPreconnected_Iic : IsPreconnected (Iic a) :=
  ordConnected_Iic.isPreconnected
#align is_preconnected_Iic isPreconnected_Iic

theorem isPreconnected_Iio : IsPreconnected (Iio a) :=
  ordConnected_Iio.isPreconnected
#align is_preconnected_Iio isPreconnected_Iio

theorem isPreconnected_Ioi : IsPreconnected (Ioi a) :=
  ordConnected_Ioi.isPreconnected
#align is_preconnected_Ioi isPreconnected_Ioi

theorem isPreconnected_Ioo : IsPreconnected (Ioo a b) :=
  ordConnected_Ioo.isPreconnected
#align is_preconnected_Ioo isPreconnected_Ioo

theorem isPreconnected_Ioc : IsPreconnected (Ioc a b) :=
  ordConnected_Ioc.isPreconnected
#align is_preconnected_Ioc isPreconnected_Ioc

theorem isPreconnected_Ico : IsPreconnected (Ico a b) :=
  ordConnected_Ico.isPreconnected
#align is_preconnected_Ico isPreconnected_Ico

theorem isConnected_Ici : IsConnected (Ici a) :=
  ⟨nonempty_Ici, isPreconnected_Ici⟩
#align is_connected_Ici isConnected_Ici

theorem isConnected_Iic : IsConnected (Iic a) :=
  ⟨nonempty_Iic, isPreconnected_Iic⟩
#align is_connected_Iic isConnected_Iic

theorem isConnected_Ioi [NoMaxOrder α] : IsConnected (Ioi a) :=
  ⟨nonempty_Ioi, isPreconnected_Ioi⟩
#align is_connected_Ioi isConnected_Ioi

theorem isConnected_Iio [NoMinOrder α] : IsConnected (Iio a) :=
  ⟨nonempty_Iio, isPreconnected_Iio⟩
#align is_connected_Iio isConnected_Iio

theorem isConnected_Icc (h : a ≤ b) : IsConnected (Icc a b) :=
  ⟨nonempty_Icc.2 h, isPreconnected_Icc⟩
#align is_connected_Icc isConnected_Icc

theorem isConnected_Ioo (h : a < b) : IsConnected (Ioo a b) :=
  ⟨nonempty_Ioo.2 h, isPreconnected_Ioo⟩
#align is_connected_Ioo isConnected_Ioo

theorem isConnected_Ioc (h : a < b) : IsConnected (Ioc a b) :=
  ⟨nonempty_Ioc.2 h, isPreconnected_Ioc⟩
#align is_connected_Ioc isConnected_Ioc

theorem isConnected_Ico (h : a < b) : IsConnected (Ico a b) :=
  ⟨nonempty_Ico.2 h, isPreconnected_Ico⟩
#align is_connected_Ico isConnected_Ico

instance (priority := 100) ordered_connected_space : PreconnectedSpace α :=
  ⟨ordConnected_univ.isPreconnected⟩
#align ordered_connected_space ordered_connected_space

/-- In a dense conditionally complete linear order, the set of preconnected sets is exactly
the set of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`, `Iic`, `Iio`, `(-∞, +∞)`,
or `∅`. Though one can represent `∅` as `(infₛ s, infₛ s)`, we include it into the list of
possible cases to improve readability. -/
theorem setOf_isPreconnected_eq_of_ordered :
    { s : Set α | IsPreconnected s } =
      -- bounded intervals
      range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo) ∪
      -- unbounded intervals and `univ`
      (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) := by
  refine' Subset.antisymm setOf_isPreconnected_subset_of_ordered _
  simp only [subset_def, forall_range_iff, uncurry, or_imp, forall_and, mem_union,
    mem_setOf_eq, insert_eq, mem_singleton_iff, forall_eq, forall_true_iff, and_true_iff,
    isPreconnected_Icc, isPreconnected_Ico, isPreconnected_Ioc, isPreconnected_Ioo,
    isPreconnected_Ioi, isPreconnected_Iio, isPreconnected_Ici, isPreconnected_Iic,
    isPreconnected_univ, isPreconnected_empty]
#align set_of_is_preconnected_eq_of_ordered setOf_isPreconnected_eq_of_ordered

/-!
### Intermediate Value Theorem on an interval

In this section we prove several versions of the Intermediate Value Theorem for a function
continuous on an interval.
-/

variable {δ : Type _} [LinearOrder δ] [TopologicalSpace δ] [OrderClosedTopology δ]

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≤ t ≤ f b`.-/
theorem intermediate_value_Icc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : ContinuousOn f (Icc a b)) :
    Icc (f a) (f b) ⊆ f '' Icc a b :=
  isPreconnected_Icc.intermediate_value (left_mem_Icc.2 hab) (right_mem_Icc.2 hab) hf
#align intermediate_value_Icc intermediate_value_Icc

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≥ t ≥ f b`.-/
theorem intermediate_value_Icc' {a b : α} (hab : a ≤ b) {f : α → δ}
    (hf : ContinuousOn f (Icc a b)) : Icc (f b) (f a) ⊆ f '' Icc a b :=
  isPreconnected_Icc.intermediate_value (right_mem_Icc.2 hab) (left_mem_Icc.2 hab) hf
#align intermediate_value_Icc' intermediate_value_Icc'

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, unordered case. -/
theorem intermediate_value_uIcc {a b : α} {f : α → δ} (hf : ContinuousOn f (uIcc a b)) :
    uIcc (f a) (f b) ⊆ f '' uIcc a b := by
  cases le_total (f a) (f b) <;> simp [*, isPreconnected_uIcc.intermediate_value]
#align intermediate_value_uIcc intermediate_value_uIcc

theorem intermediate_value_Ico {a b : α} (hab : a ≤ b) {f : α → δ} (hf : ContinuousOn f (Icc a b)) :
    Ico (f a) (f b) ⊆ f '' Ico a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.2 (not_lt_of_le (he ▸ h.1))) fun hlt =>
    @IsPreconnected.intermediate_value_Ico _ _ _ _ _ _ _ isPreconnected_Ico _ _ ⟨refl a, hlt⟩
      (right_nhdsWithin_Ico_neBot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self) _
      ((hf.continuousWithinAt ⟨hab, refl b⟩).mono Ico_subset_Icc_self)
#align intermediate_value_Ico intermediate_value_Ico

theorem intermediate_value_Ico' {a b : α} (hab : a ≤ b) {f : α → δ}
    (hf : ContinuousOn f (Icc a b)) : Ioc (f b) (f a) ⊆ f '' Ico a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.1 (not_lt_of_le (he ▸ h.2))) fun hlt =>
    @IsPreconnected.intermediate_value_Ioc _ _ _ _ _ _ _ isPreconnected_Ico _ _ ⟨refl a, hlt⟩
      (right_nhdsWithin_Ico_neBot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self) _
      ((hf.continuousWithinAt ⟨hab, refl b⟩).mono Ico_subset_Icc_self)
#align intermediate_value_Ico' intermediate_value_Ico'

theorem intermediate_value_Ioc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : ContinuousOn f (Icc a b)) :
    Ioc (f a) (f b) ⊆ f '' Ioc a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.2 (not_le_of_lt (he ▸ h.1))) fun hlt =>
    @IsPreconnected.intermediate_value_Ioc _ _ _ _ _ _ _ isPreconnected_Ioc _ _ ⟨hlt, refl b⟩
      (left_nhdsWithin_Ioc_neBot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self) _
      ((hf.continuousWithinAt ⟨refl a, hab⟩).mono Ioc_subset_Icc_self)
#align intermediate_value_Ioc intermediate_value_Ioc

theorem intermediate_value_Ioc' {a b : α} (hab : a ≤ b) {f : α → δ}
    (hf : ContinuousOn f (Icc a b)) : Ico (f b) (f a) ⊆ f '' Ioc a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.1 (not_le_of_lt (he ▸ h.2))) fun hlt =>
    @IsPreconnected.intermediate_value_Ico _ _ _ _ _ _ _ isPreconnected_Ioc _ _ ⟨hlt, refl b⟩
      (left_nhdsWithin_Ioc_neBot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self) _
      ((hf.continuousWithinAt ⟨refl a, hab⟩).mono Ioc_subset_Icc_self)
#align intermediate_value_Ioc' intermediate_value_Ioc'

theorem intermediate_value_Ioo {a b : α} (hab : a ≤ b) {f : α → δ} (hf : ContinuousOn f (Icc a b)) :
    Ioo (f a) (f b) ⊆ f '' Ioo a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.2 (not_lt_of_lt (he ▸ h.1))) fun hlt =>
    @IsPreconnected.intermediate_value_Ioo _ _ _ _ _ _ _ isPreconnected_Ioo _ _
      (left_nhdsWithin_Ioo_neBot hlt) (right_nhdsWithin_Ioo_neBot hlt) inf_le_right inf_le_right _
      (hf.mono Ioo_subset_Icc_self) _ _
      ((hf.continuousWithinAt ⟨refl a, hab⟩).mono Ioo_subset_Icc_self)
      ((hf.continuousWithinAt ⟨hab, refl b⟩).mono Ioo_subset_Icc_self)
#align intermediate_value_Ioo intermediate_value_Ioo

theorem intermediate_value_Ioo' {a b : α} (hab : a ≤ b) {f : α → δ}
    (hf : ContinuousOn f (Icc a b)) : Ioo (f b) (f a) ⊆ f '' Ioo a b :=
  Or.elim (eq_or_lt_of_le hab) (fun he _ h => absurd h.1 (not_lt_of_lt (he ▸ h.2))) fun hlt =>
    @IsPreconnected.intermediate_value_Ioo _ _ _ _ _ _ _ isPreconnected_Ioo _ _
      (right_nhdsWithin_Ioo_neBot hlt) (left_nhdsWithin_Ioo_neBot hlt) inf_le_right inf_le_right _
      (hf.mono Ioo_subset_Icc_self) _ _
      ((hf.continuousWithinAt ⟨hab, refl b⟩).mono Ioo_subset_Icc_self)
      ((hf.continuousWithinAt ⟨refl a, hab⟩).mono Ioo_subset_Icc_self)
#align intermediate_value_Ioo' intermediate_value_Ioo'

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `Icc (f x) (f y)`. -/
theorem ContinuousOn.surjOn_Icc {s : Set α} [hs : OrdConnected s] {f : α → δ}
    (hf : ContinuousOn f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) : SurjOn f s (Icc (f a) (f b)) :=
  hs.isPreconnected.intermediate_value ha hb hf
#align continuous_on.surj_on_Icc ContinuousOn.surjOn_Icc

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `[f x, f y]`. -/
theorem ContinuousOn.surjOn_uIcc {s : Set α} [hs : OrdConnected s] {f : α → δ}
    (hf : ContinuousOn f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) : SurjOn f s (uIcc (f a) (f b)) :=
  by cases' le_total (f a) (f b) with hab hab <;> simp [hf.surjOn_Icc, *]
#align continuous_on.surj_on_uIcc ContinuousOn.surjOn_uIcc

/-- A continuous function which tendsto `Fitler.atTop` along `Filter.atTop` and to `atBot` along
`at_bot` is surjective. -/
theorem Continuous.surjective {f : α → δ} (hf : Continuous f) (h_top : Tendsto f atTop atTop)
    (h_bot : Tendsto f atBot atBot) : Function.Surjective f := fun p =>
  mem_range_of_exists_le_of_exists_ge hf (h_bot.eventually (eventually_le_atBot p)).exists
    (h_top.eventually (eventually_ge_atTop p)).exists
#align continuous.surjective Continuous.surjective

/-- A continuous function which tendsto `Filter.atBot` along `Filter.atTop` and to `Filter.atTop`
along `atBot` is surjective. -/
theorem Continuous.surjective' {f : α → δ} (hf : Continuous f) (h_top : Tendsto f atBot atTop)
    (h_bot : Tendsto f atTop atBot) : Function.Surjective f :=
  @Continuous.surjective αᵒᵈ _ _ _ _ _ _ _ _ _ hf h_top h_bot
#align continuous.surjective' Continuous.surjective'

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `at_bot : Filter β` along `at_bot : Filter ↥s` and tends to `Filter.atTop : Filter β` along
`Filter.atTop : Filter ↥s`, then the restriction of `f` to `s` is surjective. We formulate the
conclusion as `Function.surjOn f s Set.univ`. -/
theorem ContinuousOn.surjOn_of_tendsto {f : α → δ} {s : Set α} [OrdConnected s] (hs : s.Nonempty)
    (hf : ContinuousOn f s) (hbot : Tendsto (fun x : s => f x) atBot atBot)
    (htop : Tendsto (fun x : s => f x) atTop atTop) : SurjOn f s univ :=
  haveI := Classical.inhabited_of_nonempty hs.to_subtype
  surjOn_iff_surjective.2 <| hf.restrict.surjective htop hbot
#align continuous_on.surj_on_of_tendsto ContinuousOn.surjOn_of_tendsto

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `Filter.atTop : Filter β` along `Filter.atBot : Filter ↥s` and tends to
`Filter.atBot : Filter β` along `Filter.atTop : Filter ↥s`, then the restriction of `f` to `s` is
surjective. We formulate the conclusion as `Function.surjOn f s Set.univ`. -/
theorem ContinuousOn.surjOn_of_tendsto' {f : α → δ} {s : Set α} [OrdConnected s] (hs : s.Nonempty)
    (hf : ContinuousOn f s) (hbot : Tendsto (fun x : s => f x) atBot atTop)
    (htop : Tendsto (fun x : s => f x) atTop atBot) : SurjOn f s univ :=
  @ContinuousOn.surjOn_of_tendsto α _ _ _ _ δᵒᵈ _ _ _ _ _ _ hs hf hbot htop
#align continuous_on.surj_on_of_tendsto' ContinuousOn.surjOn_of_tendsto'