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

! This file was ported from Lean 3 source module analysis.complex.open_mapping
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Analytic.IsolatedZeros
import Mathbin.Analysis.Complex.CauchyIntegral
import Mathbin.Analysis.Complex.AbsMax

/-!
# The open mapping theorem for holomorphic functions

This file proves the open mapping theorem for holomorphic functions, namely that an analytic
function on a preconnected set of the complex plane is either constant or open. The main step is to
show a local version of the theorem that states that if `f` is analytic at a point `z₀`, then either
it is constant in a neighborhood of `z₀` or it maps any neighborhood of `z₀` to a neighborhood of
its image `f z₀`. The results extend in higher dimension to `g : E → ℂ`.

The proof of the local version on `ℂ` goes through two main steps: first, assuming that the function
is not constant around `z₀`, use the isolated zero principle to show that `‖f z‖` is bounded below
on a small `sphere z₀ r` around `z₀`, and then use the maximum principle applied to the auxiliary
function `(λ z, ‖f z - v‖)` to show that any `v` close enough to `f z₀` is in `f '' ball z₀ r`. That
second step is implemented in `diff_cont_on_cl.ball_subset_image_closed_ball`.

## Main results

* `analytic_at.eventually_constant_or_nhds_le_map_nhds` is the local version of the open mapping
  theorem around a point;
* `analytic_on.is_constant_or_is_open` is the open mapping theorem on a connected open set.
-/

open Set Filter Metric Complex

open Topology

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℂ E] {U : Set E} {f : ℂ → ℂ} {g : E → ℂ}
  {z₀ w : ℂ} {ε r m : ℝ}

/-- If the modulus of a holomorphic function `f` is bounded below by `ε` on a circle, then its range
contains a disk of radius `ε / 2`. -/
theorem DiffContOnCl.ball_subset_image_closedBall (h : DiffContOnCl ℂ f (ball z₀ r)) (hr : 0 < r)
    (hf : ∀ z ∈ sphere z₀ r, ε ≤ ‖f z - f z₀‖) (hz₀ : ∃ᶠ z in 𝓝 z₀, f z ≠ f z₀) :
    ball (f z₀) (ε / 2) ⊆ f '' closedBall z₀ r :=
  by
  /- This is a direct application of the maximum principle. Pick `v` close to `f z₀`, and look at
    the function `λ z, ‖f z - v‖`: it is bounded below on the circle, and takes a small value at `z₀`
    so it is not constant on the disk, which implies that its infimum is equal to `0` and hence that
    `v` is in the range of `f`. -/
  rintro v hv
  have h1 : DiffContOnCl ℂ (fun z => f z - v) (ball z₀ r) := h.sub_const v
  have h2 : ContinuousOn (fun z => ‖f z - v‖) (closed_ball z₀ r) :=
    continuous_norm.comp_continuous_on (closure_ball z₀ hr.ne.symm ▸ h1.continuous_on)
  have h3 : AnalyticOn ℂ f (ball z₀ r) := h.differentiable_on.analytic_on is_open_ball
  have h4 : ∀ z ∈ sphere z₀ r, ε / 2 ≤ ‖f z - v‖ := fun z hz => by
    linarith [hf z hz, show ‖v - f z₀‖ < ε / 2 from mem_ball.mp hv,
      norm_sub_sub_norm_sub_le_norm_sub (f z) v (f z₀)]
  have h5 : ‖f z₀ - v‖ < ε / 2 := by simpa [← dist_eq_norm, dist_comm] using mem_ball.mp hv
  obtain ⟨z, hz1, hz2⟩ : ∃ z ∈ ball z₀ r, IsLocalMin (fun z => ‖f z - v‖) z
  exact exists_local_min_mem_ball h2 (mem_closed_ball_self hr.le) fun z hz => h5.trans_le (h4 z hz)
  refine' ⟨z, ball_subset_closed_ball hz1, sub_eq_zero.mp _⟩
  have h6 := h1.differentiable_on.eventually_differentiable_at (is_open_ball.mem_nhds hz1)
  refine' (eventually_eq_or_eq_zero_of_is_local_min_norm h6 hz2).resolve_left fun key => _
  have h7 : ∀ᶠ w in 𝓝 z, f w = f z := by filter_upwards [key]with h <;> field_simp
  replace h7 : ∃ᶠ w in 𝓝[≠] z, f w = f z := (h7.filter_mono nhdsWithin_le_nhds).Frequently
  have h8 : IsPreconnected (ball z₀ r) := (convex_ball z₀ r).IsPreconnected
  have h9 := h3.eq_on_of_preconnected_of_frequently_eq analyticOn_const h8 hz1 h7
  have h10 : f z = f z₀ := (h9 (mem_ball_self hr)).symm
  exact not_eventually.mpr hz₀ (mem_of_superset (ball_mem_nhds z₀ hr) (h10 ▸ h9))
#align diff_cont_on_cl.ball_subset_image_closed_ball DiffContOnCl.ball_subset_image_closedBall

/-- A function `f : ℂ → ℂ` which is analytic at a point `z₀` is either constant in a neighborhood
of `z₀`, or behaves locally like an open function (in the sense that the image of every neighborhood
of `z₀` is a neighborhood of `f z₀`, as in `is_open_map_iff_nhds_le`). For a function `f : E → ℂ`
the same result holds, see `analytic_at.eventually_constant_or_nhds_le_map_nhds`. -/
theorem AnalyticAt.eventually_constant_or_nhds_le_map_nhds_aux (hf : AnalyticAt ℂ f z₀) :
    (∀ᶠ z in 𝓝 z₀, f z = f z₀) ∨ 𝓝 (f z₀) ≤ map f (𝓝 z₀) :=
  by
  /- The function `f` is analytic in a neighborhood of `z₀`; by the isolated zeros principle, if `f`
    is not constant in a neighborhood of `z₀`, then it is nonzero, and therefore bounded below, on
    every small enough circle around `z₀` and then `diff_cont_on_cl.ball_subset_image_closed_ball`
    provides an explicit ball centered at `f z₀` contained in the range of `f`. -/
  refine' or_iff_not_imp_left.mpr fun h => _
  refine' (nhds_basis_ball.le_basis_iff (nhds_basis_closed_ball.map f)).mpr fun R hR => _
  have h1 := (hf.eventually_eq_or_eventually_ne analyticAt_const).resolve_left h
  have h2 : ∀ᶠ z in 𝓝 z₀, AnalyticAt ℂ f z := (isOpen_analyticAt ℂ f).eventually_mem hf
  obtain ⟨ρ, hρ, h3, h4⟩ :
    ∃ ρ > 0, AnalyticOn ℂ f (closed_ball z₀ ρ) ∧ ∀ z ∈ closed_ball z₀ ρ, z ≠ z₀ → f z ≠ f z₀ := by
    simpa only [set_of_and, subset_inter_iff] using
      nhds_basis_closed_ball.mem_iff.mp (h2.and (eventually_nhds_within_iff.mp h1))
  replace h3 : DiffContOnCl ℂ f (ball z₀ ρ)
  exact
    ⟨h3.differentiable_on.mono ball_subset_closed_ball,
      (closure_ball z₀ hρ.lt.ne.symm).symm ▸ h3.continuous_on⟩
  let r := ρ ⊓ R
  have hr : 0 < r := lt_inf_iff.mpr ⟨hρ, hR⟩
  have h5 : closed_ball z₀ r ⊆ closed_ball z₀ ρ := closed_ball_subset_closed_ball inf_le_left
  have h6 : DiffContOnCl ℂ f (ball z₀ r) := h3.mono (ball_subset_ball inf_le_left)
  have h7 : ∀ z ∈ sphere z₀ r, f z ≠ f z₀ := fun z hz =>
    h4 z (h5 (sphere_subset_closed_ball hz)) (ne_of_mem_sphere hz hr.ne.symm)
  have h8 : (sphere z₀ r).Nonempty := normed_space.sphere_nonempty.mpr hr.le
  have h9 : ContinuousOn (fun x => ‖f x - f z₀‖) (sphere z₀ r) :=
    continuous_norm.comp_continuous_on
      ((h6.sub_const (f z₀)).continuousOn_ball.mono sphere_subset_closed_ball)
  obtain ⟨x, hx, hfx⟩ := (isCompact_sphere z₀ r).exists_forall_le h8 h9
  refine' ⟨‖f x - f z₀‖ / 2, half_pos (norm_sub_pos_iff.mpr (h7 x hx)), _⟩
  exact
    (h6.ball_subset_image_closed_ball hr (fun z hz => hfx z hz) (not_eventually.mp h)).trans
      (image_subset f (closed_ball_subset_closed_ball inf_le_right))
#align analytic_at.eventually_constant_or_nhds_le_map_nhds_aux AnalyticAt.eventually_constant_or_nhds_le_map_nhds_aux

/-- The *open mapping theorem* for holomorphic functions, local version: is a function `g : E → ℂ`
is analytic at a point `z₀`, then either it is constant in a neighborhood of `z₀`, or it maps every
neighborhood of `z₀` to a neighborhood of `z₀`. For the particular case of a holomorphic function on
`ℂ`, see `analytic_at.eventually_constant_or_nhds_le_map_nhds_aux`. -/
theorem AnalyticAt.eventually_constant_or_nhds_le_map_nhds {z₀ : E} (hg : AnalyticAt ℂ g z₀) :
    (∀ᶠ z in 𝓝 z₀, g z = g z₀) ∨ 𝓝 (g z₀) ≤ map g (𝓝 z₀) :=
  by
  /- The idea of the proof is to use the one-dimensional version applied to the restriction of `g`
    to lines going through `z₀` (indexed by `sphere (0 : E) 1`). If the restriction is eventually
    constant along each of these lines, then the identity theorem implies that `g` is constant on any
    ball centered at `z₀` on which it is analytic, and in particular `g` is eventually constant. If on
    the other hand there is one line along which `g` is not eventually constant, then the
    one-dimensional version of the open mapping theorem can be used to conclude. -/
  let ray : E → ℂ → E := fun z t => z₀ + t • z
  let gray : E → ℂ → ℂ := fun z => g ∘ ray z
  obtain ⟨r, hr, hgr⟩ := is_open_iff.mp (isOpen_analyticAt ℂ g) z₀ hg
  have h1 : ∀ z ∈ sphere (0 : E) 1, AnalyticOn ℂ (gray z) (ball 0 r) :=
    by
    refine' fun z hz t ht => AnalyticAt.comp _ _
    · exact hgr (by simpa [ray, norm_smul, mem_sphere_zero_iff_norm.mp hz] using ht)
    ·
      exact
        analytic_at_const.add
          ((ContinuousLinearMap.smulRight (ContinuousLinearMap.id ℂ ℂ) z).AnalyticAt t)
  by_cases ∀ z ∈ sphere (0 : E) 1, ∀ᶠ t in 𝓝 0, gray z t = gray z 0
  · left
    -- If g is eventually constant along every direction, then it is eventually constant
    refine' eventually_of_mem (ball_mem_nhds z₀ hr) fun z hz => _
    refine' (eq_or_ne z z₀).casesOn (congr_arg g) fun h' => _
    replace h' : ‖z - z₀‖ ≠ 0 := by simpa only [Ne.def, norm_eq_zero, sub_eq_zero]
    let w : E := ‖z - z₀‖⁻¹ • (z - z₀)
    have h3 : ∀ t ∈ ball (0 : ℂ) r, gray w t = g z₀ :=
      by
      have e1 : IsPreconnected (ball (0 : ℂ) r) := (convex_ball 0 r).IsPreconnected
      have e2 : w ∈ sphere (0 : E) 1 := by simp [w, norm_smul, h']
      specialize h1 w e2
      apply h1.eq_on_of_preconnected_of_eventually_eq analyticOn_const e1 (mem_ball_self hr)
      simpa [gray, ray] using h w e2
    have h4 : ‖z - z₀‖ < r := by simpa [dist_eq_norm] using mem_ball.mp hz
    replace h4 : ↑‖z - z₀‖ ∈ ball (0 : ℂ) r := by
      simpa only [mem_ball_zero_iff, norm_eq_abs, abs_of_real, abs_norm_eq_norm]
    simpa only [gray, ray, smul_smul, mul_inv_cancel h', one_smul, add_sub_cancel'_right,
      Function.comp_apply, coe_smul] using h3 (↑‖z - z₀‖) h4
  · right
    -- Otherwise, it is open along at least one direction and that implies the result
    push_neg  at h
    obtain ⟨z, hz, hrz⟩ := h
    specialize h1 z hz 0 (mem_ball_self hr)
    have h7 := h1.eventually_constant_or_nhds_le_map_nhds_aux.resolve_left hrz
    rw [show gray z 0 = g z₀ by simp [gray, ray], ← map_compose] at h7
    refine' h7.trans (map_mono _)
    have h10 : Continuous fun t : ℂ => z₀ + t • z :=
      continuous_const.add (continuous_id'.smul continuous_const)
    simpa using h10.tendsto 0
#align analytic_at.eventually_constant_or_nhds_le_map_nhds AnalyticAt.eventually_constant_or_nhds_le_map_nhds

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (s «expr ⊆ » U) -/
/-- The *open mapping theorem* for holomorphic functions, global version: if a function `g : E → ℂ`
is analytic on a connected set `U`, then either it is constant on `U`, or it is open on `U` (in the
sense that it maps any open set contained in `U` to an open set in `ℂ`). -/
theorem AnalyticOn.is_constant_or_isOpen (hg : AnalyticOn ℂ g U) (hU : IsPreconnected U) :
    (∃ w, ∀ z ∈ U, g z = w) ∨ ∀ (s) (_ : s ⊆ U), IsOpen s → IsOpen (g '' s) :=
  by
  by_cases ∃ z₀ ∈ U, ∀ᶠ z in 𝓝 z₀, g z = g z₀
  · obtain ⟨z₀, hz₀, h⟩ := h
    exact Or.inl ⟨g z₀, hg.eq_on_of_preconnected_of_eventually_eq analyticOn_const hU hz₀ h⟩
  · push_neg  at h
    refine' Or.inr fun s hs1 hs2 => is_open_iff_mem_nhds.mpr _
    rintro z ⟨w, hw1, rfl⟩
    exact
      (hg w (hs1 hw1)).eventually_constant_or_nhds_le_map_nhds.resolve_left (h w (hs1 hw1))
        (image_mem_map (hs2.mem_nhds hw1))
#align analytic_on.is_constant_or_is_open AnalyticOn.is_constant_or_isOpen


import tactic.interactive

-- Lean has the "quotient" function to make equivalence classes.
-- Here I try to figure out why it is needed.

universes u v

namespace xena

-- this doesn't work with Prop but do I care?

variable {α : Type u}
variable (r : α → α → Prop)

-- equiv reln closure of r
inductive requiv {α : Type u} (r : α → α → Prop) : α → α → Prop
| of_r (a b : α) : r a b → requiv a b
| refl (a : α) : requiv a a
| symm ⦃a b : α⦄ : requiv a b → requiv b a
| trans ⦃a b c : α⦄ : requiv a b → requiv b c → requiv a c

definition equiv_class (r : α → α → Prop) (b : α) : set α := {c : α | requiv r b c}

lemma equiv_useful {α : Type u} {β : Type v}
  (r : α → α → Prop) (f : α → β) (h : ∀ (a b : α), r a b → f a = f b) :
∀ a b : α, requiv r a b → f a = f b :=
begin
  intros a b H,
  induction H with c d H c c d H1 H2 c d e H1 H2 H3 H4,
  { apply h,assumption},
  { refl},
  { rw H2},
  { rw H3,assumption}
end

definition quot {β : Type u} (r : β → β → Prop) : Type u :=
{eq_cl : set β // ∃ a : β, equiv_class r a = eq_cl}

namespace quot

definition mk : Π {α : Type u} (r : α → α → Prop), α → quot r :=
λ α r a, ⟨equiv_class r a,a,rfl⟩

theorem ind : ∀ {α : Type u} {r : α → α → Prop} {β : quot r → Prop},
    (∀ (a : α), β (mk r a)) → ∀ (q : quot r), β q :=
λ α r β h q,
begin
  rcases q with ⟨C,a,Ha⟩,
  convert h a,
  rw Ha,
end

noncomputable definition lift :
  Π {α : Type u} {r : α → α → Prop} {β : Sort v} (f : α → β)
   (h : (∀ (a b : α), r a b → f a = f b)) (q : quot r), β :=
λ α r β f h q,begin
  apply f,
  rcases q with ⟨C,HC⟩,
  -- cases HC with a Ha, MEH
  let a := classical.some HC,
  have Ha : equiv_class r a = C := classical.some_spec HC, -- never use this
  exact a,
end

lemma mem_mk {α : Type u} (r : α → α → Prop) (a : α) : a ∈ (mk r a).1 := requiv.refl r a

-- the computation principle
variables (β : Type v) (f : α → β) (a : α)
variable (h : ∀ a b , r a b → f a = f b)
theorem thm : lift f h (mk r a) = f a := begin
  have Ha : a ∈ (mk r a).1 := requiv.refl r a,
  rcases (mk r a) with ⟨C,HC⟩,
  intro Ha,
  change a ∈ C at Ha,
  let b := classical.some HC,
  have Hb : equiv_class r b = C := classical.some_spec HC,
  show f b = f a,
  rw ←Hb at Ha,
  change requiv r b a at Ha,
  apply equiv_useful r f h,
  assumption
end

definition sound : ∀ {α : Type u} {r : α → α → Prop} {a b : α}, r a b → quot.mk r a = quot.mk r b :=
λ α r a b h,begin
  unfold mk,
  suffices : equiv_class r a = equiv_class r b,
    simp [this],
  ext x,
  split,
  { intro Hx,
    show requiv r b x,
    apply requiv.trans _ Hx,
    apply requiv.symm,
    apply requiv.of_r,
    assumption},
  { intro Hx,
    show requiv r a x,
    apply requiv.trans _ Hx,
    apply requiv.of_r,
    assumption}
end

#print axioms sound -- quot.sound -- oops!

end quot

end xena
#check @quotient.lift
/-
quotient.lift :
  Π {α : Sort u_1} {β : Sort u_2} [s : setoid α] (f : α → β),
    (∀ (a b : α), a ≈ b → f a = f b) → quotient s → β
    -/

example {α β : Type} [s : setoid α] (f : α → β) (h : ∀ a b : α, a ≈ b → f a = f b) (x : α) :
quotient.lift f h (quotient.mk x) = f x := rfl


def and_emoji (a b : Prop) := a ∧ b
def or_emoji (a b : Prop) := a ∨ b
def iff_emoji (a b : Prop) := a ↔ b
def impl_emoji (a b : Prop) := a → b

infix `😂` : 55 := and_emoji
infix `😆` : 45 := iff_emoji
infix `😶` : 55 := or_emoji
infix `😉` : 50 := and.intro
infix `😇` : 40 := iff.intro

notation `🤜` a : 50 := or.inl a
notation a `🤛` : 50 := or.inr a
notation a `👈` : 90 := and.elim_right a
notation `👉` a : 90 := and.elim_left a
notation `👍` a `👌` b `👌` c := or.elim a b c

example : ∀ p q r, p 😂 (q 😶 r) 😆 (p 😂 q) 😶 (p 😂 r) :=
λ p q r,
    (λ pqr : p 😂 (q 😶 r),
        (👍 (pqr👈)
            👌(λ pfq, 🤜 (👉pqr 😉 pfq))
            👌(λ pfr, (👉pqr 😉 pfr) 🤛)
        )
    )
    😇
    (λ pqpr : (p 😂 q) 😶 (p 😂 r),
        (👍 pqpr
            👌(λ pq, 👉pq 😉 (🤜 pq👈))
            👌(λ pr, 👉pr 😉 (pr👈 🤛))
        )
    )

example : ∀ P Q, P 😂 Q 😆 Q 😂 P :=
λ P Q,
        (λ pq, pq👈 😉 👉pq)
        😇
        (λ qp, qp👈 😉 👉qp)


import data.polynomial
       data.real.basic
       polynomial_derivations

-- set_option profiler true

section step

open polynomial

parameters Δ : polynomial ℝ → polynomial ℝ

parameter Δ1 : Δ X = C 1
parameter Δ2 : ∀ (f g : polynomial ℝ), Δ(f + g) = Δ f + Δ g
parameter Δ3 : ∀ (k : ℝ) (f : polynomial ℝ), Δ(C k * f) = C k * Δ f
parameter Δ4 : ∀ (f g : polynomial ℝ), Δ(f * g) = f * Δ g + g * Δ f
include Δ1 Δ2 Δ3 Δ4

definition d : polynomial_derivation ℝ :=
{ to_fun := Δ,
  map_add' := Δ2,
  map_C_mul' := Δ3,
  map_mul' := Δ4 }

theorem Δ_is_derivative (p : polynomial ℝ) : Δ p = derivative p := begin
  show d p = derivative p,
  apply p.induction_on,
  { intro a, simp only [polynomial_derivation.map_C, polynomial.derivative_C]},
  { intros p q hp hq, rw [derivative_add, d.map_add, hp, hq] },
  intros n a IH,
  rw [pow_succ, mul_comm X, <-mul_assoc, d.map_mul, derivative_mul,
  derivative_X, IH], unfold_coes, rw [(show d.to_fun = Δ, by refl),
  Δ1, mul_one, (show C a * X ^ n * C 1 = C a * X ^ n, by simp only [mul_one, polynomial.C_1])],
  ring,
end

end step


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kyle Miller
-/
import data.finset.basic
import data.set.functor
import data.finite.basic

/-!
# Finite sets

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

This file defines predicates for finite and infinite sets and provides
`fintype` instances for many set constructions. It also proves basic facts
about finite sets and gives ways to manipulate `set.finite` expressions.

## Main definitions

* `set.finite : set α → Prop`
* `set.infinite : set α → Prop`
* `set.to_finite` to prove `set.finite` for a `set` from a `finite` instance.
* `set.finite.to_finset` to noncomputably produce a `finset` from a `set.finite` proof.
  (See `set.to_finset` for a computable version.)

## Implementation

A finite set is defined to be a set whose coercion to a type has a `fintype` instance.
Since `set.finite` is `Prop`-valued, this is the mere fact that the `fintype` instance
exists.

There are two components to finiteness constructions. The first is `fintype` instances for each
construction. This gives a way to actually compute a `finset` that represents the set, and these
may be accessed using `set.to_finset`. This gets the `finset` in the correct form, since otherwise
`finset.univ : finset s` is a `finset` for the subtype for `s`. The second component is
"constructors" for `set.finite` that give proofs that `fintype` instances exist classically given
other `set.finite` proofs. Unlike the `fintype` instances, these *do not* use any decidability
instances since they do not compute anything.

## Tags

finite sets
-/

open set function

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

namespace set

/-- A set is finite if there is a `finset` with the same elements.
This is represented as there being a `fintype` instance for the set
coerced to a type.

Note: this is a custom inductive type rather than `nonempty (fintype s)`
so that it won't be frozen as a local instance. -/
@[protected] inductive finite (s : set α) : Prop
| intro : fintype s → finite

-- The `protected` attribute does not take effect within the same namespace block.
end set

namespace set

lemma finite_def {s : set α} : s.finite ↔ nonempty (fintype s) := ⟨λ ⟨h⟩, ⟨h⟩, λ ⟨h⟩, ⟨h⟩⟩

alias finite_def ↔ finite.nonempty_fintype _

lemma finite_coe_iff {s : set α} : finite s ↔ s.finite :=
by rw [finite_iff_nonempty_fintype, finite_def]

/-- Constructor for `set.finite` using a `finite` instance. -/
theorem to_finite (s : set α) [finite s] : s.finite :=
finite_coe_iff.mp ‹_›

/-- Construct a `finite` instance for a `set` from a `finset` with the same elements. -/
protected lemma finite.of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : p.finite :=
⟨fintype.of_finset s H⟩

/-- Projection of `set.finite` to its `finite` instance.
This is intended to be used with dot notation.
See also `set.finite.fintype` and `set.finite.nonempty_fintype`. -/
protected lemma finite.to_subtype {s : set α} (h : s.finite) : finite s :=
finite_coe_iff.mpr h

/-- A finite set coerced to a type is a `fintype`.
This is the `fintype` projection for a `set.finite`.

Note that because `finite` isn't a typeclass, this definition will not fire if it
is made into an instance -/
protected noncomputable def finite.fintype {s : set α} (h : s.finite) : fintype s :=
h.nonempty_fintype.some

/-- Using choice, get the `finset` that represents this `set.` -/
protected noncomputable def finite.to_finset {s : set α} (h : s.finite) : finset α :=
@set.to_finset _ _ h.fintype

theorem finite.exists_finset {s : set α} (h : s.finite) :
  ∃ s' : finset α, ∀ a : α, a ∈ s' ↔ a ∈ s :=
by { casesI h, exact ⟨s.to_finset, λ _, mem_to_finset⟩ }

theorem finite.exists_finset_coe {s : set α} (h : s.finite) :
  ∃ s' : finset α, ↑s' = s :=
by { casesI h, exact ⟨s.to_finset, s.coe_to_finset⟩ }

/-- Finite sets can be lifted to finsets. -/
instance : can_lift (set α) (finset α) coe set.finite :=
{ prf := λ s hs, hs.exists_finset_coe }

/-- A set is infinite if it is not finite.

This is protected so that it does not conflict with global `infinite`. -/
protected def infinite (s : set α) : Prop := ¬ s.finite

@[simp] lemma not_infinite {s : set α} : ¬ s.infinite ↔ s.finite := not_not

alias not_infinite ↔ _ finite.not_infinite

attribute [simp] finite.not_infinite

/-- See also `finite_or_infinite`, `fintype_or_infinite`. -/
protected lemma finite_or_infinite (s : set α) : s.finite ∨ s.infinite := em _
protected lemma infinite_or_finite (s : set α) : s.infinite ∨ s.finite := em' _

/-! ### Basic properties of `set.finite.to_finset` -/

namespace finite
variables {s t : set α} {a : α} {hs : s.finite} {ht : t.finite}

@[simp] protected lemma mem_to_finset (h : s.finite) : a ∈ h.to_finset ↔ a ∈ s :=
@mem_to_finset _ _ h.fintype _

@[simp] protected lemma coe_to_finset (h : s.finite) : (h.to_finset : set α) = s :=
@coe_to_finset _ _ h.fintype

@[simp] protected lemma to_finset_nonempty (h : s.finite) : h.to_finset.nonempty ↔ s.nonempty :=
by rw [← finset.coe_nonempty, finite.coe_to_finset]

/-- Note that this is an equality of types not holding definitionally. Use wisely. -/
lemma coe_sort_to_finset (h : s.finite) : ↥h.to_finset = ↥s :=
by rw [← finset.coe_sort_coe _, h.coe_to_finset]

@[simp] protected lemma to_finset_inj : hs.to_finset = ht.to_finset ↔ s = t :=
@to_finset_inj _ _ _ hs.fintype ht.fintype

@[simp] lemma to_finset_subset {t : finset α} : hs.to_finset ⊆ t ↔ s ⊆ t :=
by rw [←finset.coe_subset, finite.coe_to_finset]

@[simp] lemma to_finset_ssubset {t : finset α} : hs.to_finset ⊂ t ↔ s ⊂ t :=
by rw [←finset.coe_ssubset, finite.coe_to_finset]

@[simp] lemma subset_to_finset {s : finset α} : s ⊆ ht.to_finset ↔ ↑s ⊆ t :=
by rw [←finset.coe_subset, finite.coe_to_finset]

@[simp] lemma ssubset_to_finset {s : finset α} : s ⊂ ht.to_finset ↔ ↑s ⊂ t :=
by rw [←finset.coe_ssubset, finite.coe_to_finset]

@[mono] protected lemma to_finset_subset_to_finset : hs.to_finset ⊆ ht.to_finset ↔ s ⊆ t :=
by simp only [← finset.coe_subset, finite.coe_to_finset]

@[mono] protected lemma to_finset_ssubset_to_finset : hs.to_finset ⊂ ht.to_finset ↔ s ⊂ t :=
by simp only [← finset.coe_ssubset, finite.coe_to_finset]

alias finite.to_finset_subset_to_finset ↔ _ to_finset_mono
alias finite.to_finset_ssubset_to_finset ↔ _ to_finset_strict_mono

attribute [protected] to_finset_mono to_finset_strict_mono

@[simp] protected lemma to_finset_set_of [fintype α] (p : α → Prop) [decidable_pred p]
  (h : {x | p x}.finite) :
  h.to_finset = finset.univ.filter p :=
by { ext, simp }

@[simp] lemma disjoint_to_finset {hs : s.finite} {ht : t.finite} :
  disjoint hs.to_finset ht.to_finset ↔ disjoint s t :=
@disjoint_to_finset _ _ _ hs.fintype ht.fintype

protected lemma to_finset_inter [decidable_eq α] (hs : s.finite) (ht : t.finite)
  (h : (s ∩ t).finite) : h.to_finset = hs.to_finset ∩ ht.to_finset :=
by { ext, simp }

protected lemma to_finset_union [decidable_eq α] (hs : s.finite) (ht : t.finite)
  (h : (s ∪ t).finite) : h.to_finset = hs.to_finset ∪ ht.to_finset :=
by { ext, simp }

protected lemma to_finset_diff [decidable_eq α] (hs : s.finite) (ht : t.finite)
  (h : (s \ t).finite) : h.to_finset = hs.to_finset \ ht.to_finset :=
by { ext, simp }

protected lemma to_finset_symm_diff [decidable_eq α] (hs : s.finite) (ht : t.finite)
  (h : (s ∆ t).finite) : h.to_finset = hs.to_finset ∆ ht.to_finset :=
by { ext, simp [mem_symm_diff, finset.mem_symm_diff] }

protected lemma to_finset_compl [decidable_eq α] [fintype α] (hs : s.finite) (h : sᶜ.finite) :
  h.to_finset = hs.to_finsetᶜ :=
by { ext, simp }

@[simp] protected lemma to_finset_empty (h : (∅ : set α).finite) : h.to_finset = ∅ :=
by { ext, simp }

@[simp] protected lemma to_finset_univ [fintype α] (h : (set.univ : set α).finite) :
  h.to_finset = finset.univ :=
by { ext, simp }

@[simp] protected lemma to_finset_eq_empty {h : s.finite} : h.to_finset = ∅ ↔ s = ∅ :=
@to_finset_eq_empty _ _ h.fintype

@[simp] protected lemma to_finset_eq_univ [fintype α] {h : s.finite} :
  h.to_finset = finset.univ ↔ s = univ :=
@to_finset_eq_univ _ _ _ h.fintype

protected lemma to_finset_image [decidable_eq β] (f : α → β) (hs : s.finite) (h : (f '' s).finite) :
  h.to_finset = hs.to_finset.image f :=
by { ext, simp }

@[simp] protected lemma to_finset_range [decidable_eq α] [fintype β] (f : β → α)
  (h : (range f).finite) :
  h.to_finset = finset.univ.image f :=
by { ext, simp }

end finite

/-! ### Fintype instances

Every instance here should have a corresponding `set.finite` constructor in the next section.
 -/

section fintype_instances

instance fintype_univ [fintype α] : fintype (@univ α) :=
fintype.of_equiv α (equiv.set.univ α).symm

/-- If `(set.univ : set α)` is finite then `α` is a finite type. -/
noncomputable def fintype_of_finite_univ (H : (univ : set α).finite) : fintype α :=
@fintype.of_equiv _ (univ : set α) H.fintype (equiv.set.univ _)

instance fintype_union [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
  fintype (s ∪ t : set α) := fintype.of_finset (s.to_finset ∪ t.to_finset) $ by simp

instance fintype_sep (s : set α) (p : α → Prop) [fintype s] [decidable_pred p] :
  fintype ({a ∈ s | p a} : set α) := fintype.of_finset (s.to_finset.filter p) $ by simp

instance fintype_inter (s t : set α) [decidable_eq α] [fintype s] [fintype t] :
  fintype (s ∩ t : set α) := fintype.of_finset (s.to_finset ∩ t.to_finset) $ by simp

/-- A `fintype` instance for set intersection where the left set has a `fintype` instance. -/
instance fintype_inter_of_left (s t : set α) [fintype s] [decidable_pred (∈ t)] :
  fintype (s ∩ t : set α) := fintype.of_finset (s.to_finset.filter (∈ t)) $ by simp

/-- A `fintype` instance for set intersection where the right set has a `fintype` instance. -/
instance fintype_inter_of_right (s t : set α) [fintype t] [decidable_pred (∈ s)] :
  fintype (s ∩ t : set α) := fintype.of_finset (t.to_finset.filter (∈ s)) $ by simp [and_comm]

/-- A `fintype` structure on a set defines a `fintype` structure on its subset. -/
def fintype_subset (s : set α) {t : set α} [fintype s] [decidable_pred (∈ t)] (h : t ⊆ s) :
  fintype t :=
by { rw ← inter_eq_self_of_subset_right h, apply set.fintype_inter_of_left }

instance fintype_diff [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
  fintype (s \ t : set α) := fintype.of_finset (s.to_finset \ t.to_finset) $ by simp

instance fintype_diff_left (s t : set α) [fintype s] [decidable_pred (∈ t)] :
  fintype (s \ t : set α) := set.fintype_sep s (∈ tᶜ)

instance fintype_Union [decidable_eq α] [fintype (plift ι)]
  (f : ι → set α) [∀ i, fintype (f i)] : fintype (⋃ i, f i) :=
fintype.of_finset (finset.univ.bUnion (λ i : plift ι, (f i.down).to_finset)) $ by simp

instance fintype_sUnion [decidable_eq α] {s : set (set α)}
  [fintype s] [H : ∀ (t : s), fintype (t : set α)] : fintype (⋃₀ s) :=
by { rw sUnion_eq_Union, exact @set.fintype_Union _ _ _ _ _ H }

/-- A union of sets with `fintype` structure over a set with `fintype` structure has a `fintype`
structure. -/
def fintype_bUnion [decidable_eq α] {ι : Type*} (s : set ι) [fintype s]
  (t : ι → set α) (H : ∀ i ∈ s, fintype (t i)) : fintype (⋃(x ∈ s), t x) :=
fintype.of_finset
(s.to_finset.attach.bUnion
  (λ x, by { haveI := H x (by simpa using x.property), exact (t x).to_finset })) $ by simp

instance fintype_bUnion' [decidable_eq α] {ι : Type*} (s : set ι) [fintype s]
  (t : ι → set α) [∀ i, fintype (t i)] : fintype (⋃(x ∈ s), t x) :=
fintype.of_finset (s.to_finset.bUnion (λ x, (t x).to_finset)) $ by simp

/-- If `s : set α` is a set with `fintype` instance and `f : α → set β` is a function such that
each `f a`, `a ∈ s`, has a `fintype` structure, then `s >>= f` has a `fintype` structure. -/
def fintype_bind {α β} [decidable_eq β] (s : set α) [fintype s]
  (f : α → set β) (H : ∀ a ∈ s, fintype (f a)) : fintype (s >>= f) :=
set.fintype_bUnion s f H

instance fintype_bind' {α β} [decidable_eq β] (s : set α) [fintype s]
  (f : α → set β) [H : ∀ a, fintype (f a)] : fintype (s >>= f) :=
set.fintype_bUnion' s f

instance fintype_empty : fintype (∅ : set α) := fintype.of_finset ∅ $ by simp

instance fintype_singleton (a : α) : fintype ({a} : set α) := fintype.of_finset {a} $ by simp

instance fintype_pure : ∀ a : α, fintype (pure a : set α) :=
set.fintype_singleton

/-- A `fintype` instance for inserting an element into a `set` using the
corresponding `insert` function on `finset`. This requires `decidable_eq α`.
There is also `set.fintype_insert'` when `a ∈ s` is decidable. -/
instance fintype_insert (a : α) (s : set α) [decidable_eq α] [fintype s] :
  fintype (insert a s : set α) :=
fintype.of_finset (insert a s.to_finset) $ by simp

/-- A `fintype` structure on `insert a s` when inserting a new element. -/
def fintype_insert_of_not_mem {a : α} (s : set α) [fintype s] (h : a ∉ s) :
  fintype (insert a s : set α) :=
fintype.of_finset ⟨a ::ₘ s.to_finset.1, s.to_finset.nodup.cons (by simp [h]) ⟩ $ by simp

/-- A `fintype` structure on `insert a s` when inserting a pre-existing element. -/
def fintype_insert_of_mem {a : α} (s : set α) [fintype s] (h : a ∈ s) :
  fintype (insert a s : set α) :=
fintype.of_finset s.to_finset $ by simp [h]

/-- The `set.fintype_insert` instance requires decidable equality, but when `a ∈ s`
is decidable for this particular `a` we can still get a `fintype` instance by using
`set.fintype_insert_of_not_mem` or `set.fintype_insert_of_mem`.

This instance pre-dates `set.fintype_insert`, and it is less efficient.
When `decidable_mem_of_fintype` is made a local instance, then this instance would
override `set.fintype_insert` if not for the fact that its priority has been
adjusted. See Note [lower instance priority]. -/
@[priority 100]
instance fintype_insert' (a : α) (s : set α) [decidable $ a ∈ s] [fintype s] :
  fintype (insert a s : set α) :=
if h : a ∈ s then fintype_insert_of_mem s h else fintype_insert_of_not_mem s h

instance fintype_image [decidable_eq β] (s : set α) (f : α → β) [fintype s] : fintype (f '' s) :=
fintype.of_finset (s.to_finset.image f) $ by simp

/-- If a function `f` has a partial inverse and sends a set `s` to a set with `[fintype]` instance,
then `s` has a `fintype` structure as well. -/
def fintype_of_fintype_image (s : set α)
  {f : α → β} {g} (I : is_partial_inv f g) [fintype (f '' s)] : fintype s :=
fintype.of_finset ⟨_, (f '' s).to_finset.2.filter_map g $ injective_of_partial_inv_right I⟩ $ λ a,
begin
  suffices : (∃ b x, f x = b ∧ g b = some a ∧ x ∈ s) ↔ a ∈ s,
  by simpa [exists_and_distrib_left.symm, and.comm, and.left_comm, and.assoc],
  rw exists_swap,
  suffices : (∃ x, x ∈ s ∧ g (f x) = some a) ↔ a ∈ s, {simpa [and.comm, and.left_comm, and.assoc]},
  simp [I _, (injective_of_partial_inv I).eq_iff]
end

instance fintype_range [decidable_eq α] (f : ι → α) [fintype (plift ι)] :
  fintype (range f) :=
fintype.of_finset (finset.univ.image $ f ∘ plift.down) $ by simp [equiv.plift.exists_congr_left]

instance fintype_map {α β} [decidable_eq β] :
  ∀ (s : set α) (f : α → β) [fintype s], fintype (f <$> s) := set.fintype_image

instance fintype_lt_nat (n : ℕ) : fintype {i | i < n} :=
fintype.of_finset (finset.range n) $ by simp

instance fintype_le_nat (n : ℕ) : fintype {i | i ≤ n} :=
by simpa [nat.lt_succ_iff] using set.fintype_lt_nat (n+1)

/-- This is not an instance so that it does not conflict with the one
in src/order/locally_finite. -/
def nat.fintype_Iio (n : ℕ) : fintype (Iio n) :=
set.fintype_lt_nat n

instance fintype_prod (s : set α) (t : set β) [fintype s] [fintype t] :
  fintype (s ×ˢ t : set (α × β)) :=
fintype.of_finset (s.to_finset ×ˢ t.to_finset) $ by simp

instance fintype_off_diag [decidable_eq α] (s : set α) [fintype s] : fintype s.off_diag :=
fintype.of_finset s.to_finset.off_diag $ by simp

/-- `image2 f s t` is `fintype` if `s` and `t` are. -/
instance fintype_image2 [decidable_eq γ] (f : α → β → γ) (s : set α) (t : set β)
  [hs : fintype s] [ht : fintype t] : fintype (image2 f s t : set γ) :=
by { rw ← image_prod, apply set.fintype_image }

instance fintype_seq [decidable_eq β] (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
  fintype (f.seq s) :=
by { rw seq_def, apply set.fintype_bUnion' }

instance fintype_seq' {α β : Type u} [decidable_eq β]
  (f : set (α → β)) (s : set α) [fintype f] [fintype s] : fintype (f <*> s) :=
set.fintype_seq f s

instance fintype_mem_finset (s : finset α) : fintype {a | a ∈ s} :=
finset.fintype_coe_sort s

end fintype_instances

end set

/-! ### Finset -/

namespace finset

/-- Gives a `set.finite` for the `finset` coerced to a `set`.
This is a wrapper around `set.to_finite`. -/
@[simp] lemma finite_to_set (s : finset α) : (s : set α).finite := set.to_finite _

@[simp] lemma finite_to_set_to_finset (s : finset α) : s.finite_to_set.to_finset = s :=
by { ext, rw [set.finite.mem_to_finset, mem_coe] }

end finset

namespace multiset

@[simp] lemma finite_to_set (s : multiset α) : {x | x ∈ s}.finite :=
by { classical, simpa only [← multiset.mem_to_finset] using s.to_finset.finite_to_set }

@[simp] lemma finite_to_set_to_finset [decidable_eq α] (s : multiset α) :
  s.finite_to_set.to_finset = s.to_finset :=
by { ext x, simp }

end multiset

@[simp] lemma list.finite_to_set (l : list α) : {x | x ∈ l}.finite :=
(show multiset α, from ⟦l⟧).finite_to_set

/-! ### Finite instances

There is seemingly some overlap between the following instances and the `fintype` instances
in `data.set.finite`. While every `fintype` instance gives a `finite` instance, those
instances that depend on `fintype` or `decidable` instances need an additional `finite` instance
to be able to generally apply.

Some set instances do not appear here since they are consequences of others, for example
`subtype.finite` for subsets of a finite type.
-/

namespace finite.set

open_locale classical

example {s : set α} [finite α] : finite s := infer_instance
example : finite (∅ : set α) := infer_instance
example (a : α) : finite ({a} : set α) := infer_instance

instance finite_union (s t : set α) [finite s] [finite t] :
  finite (s ∪ t : set α) :=
by { casesI nonempty_fintype s, casesI nonempty_fintype t, apply_instance }

instance finite_sep (s : set α) (p : α → Prop) [finite s] :
  finite ({a ∈ s | p a} : set α) :=
by { casesI nonempty_fintype s, apply_instance }

protected lemma subset (s : set α) {t : set α} [finite s] (h : t ⊆ s) : finite t :=
by { rw ←sep_eq_of_subset h, apply_instance }

instance finite_inter_of_right (s t : set α) [finite t] :
  finite (s ∩ t : set α) := finite.set.subset t (inter_subset_right s t)

instance finite_inter_of_left (s t : set α) [finite s] :
  finite (s ∩ t : set α) := finite.set.subset s (inter_subset_left s t)

instance finite_diff (s t : set α) [finite s] :
  finite (s \ t : set α) := finite.set.subset s (diff_subset s t)

instance finite_range (f : ι → α) [finite ι] : finite (range f) :=
by { haveI := fintype.of_finite (plift ι), apply_instance }

instance finite_Union [finite ι] (f : ι → set α) [∀ i, finite (f i)] : finite (⋃ i, f i) :=
begin
  rw [Union_eq_range_psigma],
  apply set.finite_range
end

instance finite_sUnion {s : set (set α)} [finite s] [H : ∀ (t : s), finite (t : set α)] :
  finite (⋃₀ s) :=
by { rw sUnion_eq_Union, exact @finite.set.finite_Union _ _ _ _ H }

lemma finite_bUnion {ι : Type*} (s : set ι) [finite s] (t : ι → set α) (H : ∀ i ∈ s, finite (t i)) :
  finite (⋃(x ∈ s), t x) :=
begin
  rw [bUnion_eq_Union],
  haveI : ∀ (i : s), finite (t i) := λ i, H i i.property,
  apply_instance,
end

instance finite_bUnion' {ι : Type*} (s : set ι) [finite s] (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋃(x ∈ s), t x) :=
finite_bUnion s t (λ i h, infer_instance)

/--
Example: `finite (⋃ (i < n), f i)` where `f : ℕ → set α` and `[∀ i, finite (f i)]`
(when given instances from `data.nat.interval`).
-/
instance finite_bUnion'' {ι : Type*} (p : ι → Prop) [h : finite {x | p x}]
  (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋃ x (h : p x), t x) :=
@finite.set.finite_bUnion' _ _ (set_of p) h t _

instance finite_Inter {ι : Sort*} [nonempty ι] (t : ι → set α) [∀ i, finite (t i)] :
  finite (⋂ i, t i) :=
finite.set.subset (t $ classical.arbitrary ι) (Inter_subset _ _)

instance finite_insert (a : α) (s : set α) [finite s] : finite (insert a s : set α) :=
finite.set.finite_union {a} s

instance finite_image (s : set α) (f : α → β) [finite s] : finite (f '' s) :=
by { casesI nonempty_fintype s, apply_instance }

instance finite_replacement [finite α] (f : α → β) : finite {(f x) | (x : α)} :=
finite.set.finite_range f

instance finite_prod (s : set α) (t : set β) [finite s] [finite t] :
  finite (s ×ˢ t : set (α × β)) :=
finite.of_equiv _ (equiv.set.prod s t).symm

instance finite_image2 (f : α → β → γ) (s : set α) (t : set β) [finite s] [finite t] :
  finite (image2 f s t : set γ) :=
by { rw ← image_prod, apply_instance }

instance finite_seq (f : set (α → β)) (s : set α) [finite f] [finite s] : finite (f.seq s) :=
by { rw seq_def, apply_instance }

end finite.set

namespace set

/-! ### Constructors for `set.finite`

Every constructor here should have a corresponding `fintype` instance in the previous section
(or in the `fintype` module).

The implementation of these constructors ideally should be no more than `set.to_finite`,
after possibly setting up some `fintype` and classical `decidable` instances.
-/
section set_finite_constructors

@[nontriviality] lemma finite.of_subsingleton [subsingleton α] (s : set α) : s.finite := s.to_finite

theorem finite_univ [finite α] : (@univ α).finite := set.to_finite _

theorem finite_univ_iff : (@univ α).finite ↔ finite α :=
finite_coe_iff.symm.trans (equiv.set.univ α).finite_iff

alias finite_univ_iff ↔ _root_.finite.of_finite_univ _

theorem finite.union {s t : set α} (hs : s.finite) (ht : t.finite) : (s ∪ t).finite :=
by { casesI hs, casesI ht, apply to_finite }

theorem finite.finite_of_compl {s : set α} (hs : s.finite) (hsc : sᶜ.finite) : finite α :=
by { rw [← finite_univ_iff, ← union_compl_self s], exact hs.union hsc }

lemma finite.sup {s t : set α} : s.finite → t.finite → (s ⊔ t).finite := finite.union

theorem finite.sep {s : set α} (hs : s.finite) (p : α → Prop) : {a ∈ s | p a}.finite :=
by { casesI hs, apply to_finite }

theorem finite.inter_of_left {s : set α} (hs : s.finite) (t : set α) : (s ∩ t).finite :=
by { casesI hs, apply to_finite }

theorem finite.inter_of_right {s : set α} (hs : s.finite) (t : set α) : (t ∩ s).finite :=
by { casesI hs, apply to_finite }

theorem finite.inf_of_left {s : set α} (h : s.finite) (t : set α) : (s ⊓ t).finite :=
h.inter_of_left t

theorem finite.inf_of_right {s : set α} (h : s.finite) (t : set α) : (t ⊓ s).finite :=
h.inter_of_right t

theorem finite.subset {s : set α} (hs : s.finite) {t : set α} (ht : t ⊆ s) : t.finite :=
by { casesI hs, haveI := finite.set.subset _ ht, apply to_finite }

theorem finite.diff {s : set α} (hs : s.finite) (t : set α) : (s \ t).finite :=
by { casesI hs, apply to_finite }

theorem finite.of_diff {s t : set α} (hd : (s \ t).finite) (ht : t.finite) : s.finite :=
(hd.union ht).subset $ subset_diff_union _ _

theorem finite_Union [finite ι] {f : ι → set α} (H : ∀ i, (f i).finite) :
  (⋃ i, f i).finite :=
by { haveI := λ i, (H i).fintype, apply to_finite }

theorem finite.sUnion {s : set (set α)} (hs : s.finite) (H : ∀ t ∈ s, set.finite t) :
  (⋃₀ s).finite :=
by { casesI hs, haveI := λ (i : s), (H i i.2).to_subtype, apply to_finite }

theorem finite.bUnion {ι} {s : set ι} (hs : s.finite)
  {t : ι → set α} (ht : ∀ i ∈ s, (t i).finite) : (⋃(i ∈ s), t i).finite :=
by { classical, casesI hs,
     haveI := fintype_bUnion s t (λ i hi, (ht i hi).fintype), apply to_finite }

/-- Dependent version of `finite.bUnion`. -/
theorem finite.bUnion' {ι} {s : set ι} (hs : s.finite)
  {t : Π (i ∈ s), set α} (ht : ∀ i ∈ s, (t i ‹_›).finite) : (⋃(i ∈ s), t i ‹_›).finite :=
by { casesI hs, rw [bUnion_eq_Union], apply finite_Union (λ (i : s), ht i.1 i.2), }

theorem finite.sInter {α : Type*} {s : set (set α)} {t : set α} (ht : t ∈ s)
  (hf : t.finite) : (⋂₀ s).finite :=
hf.subset (sInter_subset_of_mem ht)

theorem finite.bind {α β} {s : set α} {f : α → set β} (h : s.finite) (hf : ∀ a ∈ s, (f a).finite) :
  (s >>= f).finite :=
h.bUnion hf

@[simp] theorem finite_empty : (∅ : set α).finite := to_finite _

protected lemma infinite.nonempty {s : set α} (h : s.infinite) : s.nonempty :=
nonempty_iff_ne_empty.2 $ by { rintro rfl, exact h finite_empty }

@[simp] theorem finite_singleton (a : α) : ({a} : set α).finite := to_finite _

theorem finite_pure (a : α) : (pure a : set α).finite := to_finite _

@[simp] theorem finite.insert (a : α) {s : set α} (hs : s.finite) : (insert a s).finite :=
by { casesI hs, apply to_finite }

theorem finite.image {s : set α} (f : α → β) (hs : s.finite) : (f '' s).finite :=
by { casesI hs, apply to_finite }

theorem finite_range (f : ι → α) [finite ι] : (range f).finite :=
to_finite _

lemma finite.dependent_image {s : set α} (hs : s.finite) (F : Π i ∈ s, β) :
  {y : β | ∃ x (hx : x ∈ s), y = F x hx}.finite :=
by { casesI hs, simpa [range, eq_comm] using finite_range (λ x : s, F x x.2) }

theorem finite.map {α β} {s : set α} : ∀ (f : α → β), s.finite → (f <$> s).finite :=
finite.image

theorem finite.of_finite_image {s : set α} {f : α → β} (h : (f '' s).finite) (hi : set.inj_on f s) :
  s.finite :=
by { casesI h, exact ⟨fintype.of_injective (λ a, (⟨f a.1, mem_image_of_mem f a.2⟩ : f '' s))
                       (λ a b eq, subtype.eq $ hi a.2 b.2 $ subtype.ext_iff_val.1 eq)⟩ }

lemma finite_of_finite_preimage {f : α → β} {s : set β} (h : (f ⁻¹' s).finite)
  (hs : s ⊆ range f) : s.finite :=
by { rw [← image_preimage_eq_of_subset hs], exact finite.image f h }

theorem finite.of_preimage {f : α → β} {s : set β} (h : (f ⁻¹' s).finite) (hf : surjective f) :
  s.finite :=
hf.image_preimage s ▸ h.image _

theorem finite.preimage {s : set β} {f : α → β}
  (I : set.inj_on f (f⁻¹' s)) (h : s.finite) : (f ⁻¹' s).finite :=
(h.subset (image_preimage_subset f s)).of_finite_image I

theorem finite.preimage_embedding {s : set β} (f : α ↪ β) (h : s.finite) : (f ⁻¹' s).finite :=
h.preimage (λ _ _ _ _ h', f.injective h')

lemma finite_lt_nat (n : ℕ) : set.finite {i | i < n} := to_finite _

lemma finite_le_nat (n : ℕ) : set.finite {i | i ≤ n} := to_finite _

section prod
variables {s : set α} {t : set β}

protected lemma finite.prod (hs : s.finite) (ht : t.finite) : (s ×ˢ t : set (α × β)).finite :=
by { casesI hs, casesI ht, apply to_finite }

lemma finite.of_prod_left (h : (s ×ˢ t : set (α × β)).finite) : t.nonempty → s.finite :=
λ ⟨b, hb⟩, (h.image prod.fst).subset $ λ a ha, ⟨(a, b), ⟨ha, hb⟩, rfl⟩

lemma finite.of_prod_right (h : (s ×ˢ t : set (α × β)).finite) : s.nonempty → t.finite :=
λ ⟨a, ha⟩, (h.image prod.snd).subset $ λ b hb, ⟨(a, b), ⟨ha, hb⟩, rfl⟩

protected lemma infinite.prod_left (hs : s.infinite) (ht : t.nonempty) : (s ×ˢ t).infinite :=
λ h, hs $ h.of_prod_left ht

protected lemma infinite.prod_right (ht : t.infinite) (hs : s.nonempty) : (s ×ˢ t).infinite :=
λ h, ht $ h.of_prod_right hs

protected lemma infinite_prod :
  (s ×ˢ t).infinite ↔ s.infinite ∧ t.nonempty ∨ t.infinite ∧ s.nonempty :=
begin
  refine ⟨λ h, _, _⟩,
  { simp_rw [set.infinite, and_comm (¬ _), ←not_imp],
    by_contra',
    exact h ((this.1 h.nonempty.snd).prod $ this.2 h.nonempty.fst) },
  { rintro (h | h),
    { exact h.1.prod_left h.2 },
    { exact h.1.prod_right h.2 } }
end

lemma finite_prod : (s ×ˢ t).finite ↔ (s.finite ∨ t = ∅) ∧ (t.finite ∨ s = ∅) :=
by simp only [←not_infinite, set.infinite_prod, not_or_distrib, not_and_distrib,
  not_nonempty_iff_eq_empty]

protected lemma finite.off_diag (hs : s.finite) : s.off_diag.finite :=
by { classical, casesI hs, apply set.to_finite }

protected lemma finite.image2 (f : α → β → γ) (hs : s.finite) (ht : t.finite) :
  (image2 f s t).finite :=
by { casesI hs, casesI ht, apply to_finite }

end prod

theorem finite.seq {f : set (α → β)} {s : set α} (hf : f.finite) (hs : s.finite) :
  (f.seq s).finite :=
by { classical, casesI hf, casesI hs, apply to_finite }

theorem finite.seq' {α β : Type u} {f : set (α → β)} {s : set α} (hf : f.finite) (hs : s.finite) :
  (f <*> s).finite :=
hf.seq hs

theorem finite_mem_finset (s : finset α) : {a | a ∈ s}.finite := to_finite _

lemma subsingleton.finite {s : set α} (h : s.subsingleton) : s.finite :=
h.induction_on finite_empty finite_singleton

lemma finite_preimage_inl_and_inr {s : set (α ⊕ β)} :
  (sum.inl ⁻¹' s).finite ∧ (sum.inr ⁻¹' s).finite ↔ s.finite :=
⟨λ h, image_preimage_inl_union_image_preimage_inr s ▸ (h.1.image _).union (h.2.image _),
  λ h, ⟨h.preimage (sum.inl_injective.inj_on _), h.preimage (sum.inr_injective.inj_on _)⟩⟩

theorem exists_finite_iff_finset {p : set α → Prop} :
  (∃ s : set α, s.finite ∧ p s) ↔ ∃ s : finset α, p ↑s :=
⟨λ ⟨s, hs, hps⟩, ⟨hs.to_finset, hs.coe_to_finset.symm ▸ hps⟩,
  λ ⟨s, hs⟩, ⟨s, s.finite_to_set, hs⟩⟩

/-- There are finitely many subsets of a given finite set -/
lemma finite.finite_subsets {α : Type u} {a : set α} (h : a.finite) : {b | b ⊆ a}.finite :=
⟨fintype.of_finset ((finset.powerset h.to_finset).map finset.coe_emb.1) $ λ s,
  by simpa [← @exists_finite_iff_finset α (λ t, t ⊆ a ∧ t = s), finite.subset_to_finset,
    ← and.assoc] using h.subset⟩

/-- Finite product of finite sets is finite -/
lemma finite.pi {δ : Type*} [finite δ] {κ : δ → Type*} {t : Π d, set (κ d)}
  (ht : ∀ d, (t d).finite) :
  (pi univ t).finite :=
begin
  casesI nonempty_fintype δ,
  lift t to Π d, finset (κ d) using ht,
  classical,
  rw ← fintype.coe_pi_finset,
  apply finset.finite_to_set
end

/-- A finite union of finsets is finite. -/
lemma union_finset_finite_of_range_finite (f : α → finset β) (h : (range f).finite) :
  (⋃ a, (f a : set β)).finite :=
by { rw ← bUnion_range, exact h.bUnion (λ y hy, y.finite_to_set) }

lemma finite_range_ite {p : α → Prop} [decidable_pred p] {f g : α → β} (hf : (range f).finite)
  (hg : (range g).finite) : (range (λ x, if p x then f x else g x)).finite :=
(hf.union hg).subset range_ite_subset

lemma finite_range_const {c : β} : (range (λ x : α, c)).finite :=
(finite_singleton c).subset range_const_subset

end set_finite_constructors

/-! ### Properties -/

instance finite.inhabited : inhabited {s : set α // s.finite} := ⟨⟨∅, finite_empty⟩⟩

@[simp] lemma finite_union {s t : set α} : (s ∪ t).finite ↔ s.finite ∧ t.finite :=
⟨λ h, ⟨h.subset (subset_union_left _ _), h.subset (subset_union_right _ _)⟩,
 λ ⟨hs, ht⟩, hs.union ht⟩

theorem finite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
  (f '' s).finite ↔ s.finite :=
⟨λ h, h.of_finite_image hi, finite.image _⟩

lemma univ_finite_iff_nonempty_fintype :
  (univ : set α).finite ↔ nonempty (fintype α) :=
⟨λ h, ⟨fintype_of_finite_univ h⟩, λ ⟨_i⟩, by exactI finite_univ⟩

@[simp] lemma finite.to_finset_singleton {a : α} (ha : ({a} : set α).finite := finite_singleton _) :
  ha.to_finset = {a} :=
finset.ext $ by simp

@[simp] lemma finite.to_finset_insert [decidable_eq α] {s : set α} {a : α}
  (hs : (insert a s).finite) :
  hs.to_finset = insert a (hs.subset $ subset_insert _ _).to_finset :=
finset.ext $ by simp

lemma finite.to_finset_insert' [decidable_eq α] {a : α} {s : set α} (hs : s.finite) :
  (hs.insert a).to_finset = insert a hs.to_finset :=
finite.to_finset_insert _

lemma finite.to_finset_prod {s : set α} {t : set β} (hs : s.finite) (ht : t.finite) :
hs.to_finset ×ˢ ht.to_finset = (hs.prod ht).to_finset := finset.ext $ by simp

lemma finite.to_finset_off_diag {s : set α} [decidable_eq α] (hs : s.finite) :
hs.off_diag.to_finset = hs.to_finset.off_diag := finset.ext $ by simp

lemma finite.fin_embedding {s : set α} (h : s.finite) : ∃ (n : ℕ) (f : fin n ↪ α), range f = s :=
⟨_, (fintype.equiv_fin (h.to_finset : set α)).symm.as_embedding, by simp⟩

lemma finite.fin_param {s : set α} (h : s.finite) :
  ∃ (n : ℕ) (f : fin n → α), injective f ∧ range f = s :=
let ⟨n, f, hf⟩ := h.fin_embedding in ⟨n, f, f.injective, hf⟩

lemma finite_option {s : set (option α)} : s.finite ↔ {x : α | some x ∈ s}.finite :=
⟨λ h, h.preimage_embedding embedding.some,
  λ h, ((h.image some).insert none).subset $
    λ x, option.cases_on x (λ _, or.inl rfl) (λ x hx, or.inr $ mem_image_of_mem _ hx)⟩

lemma finite_image_fst_and_snd_iff {s : set (α × β)} :
  (prod.fst '' s).finite ∧ (prod.snd '' s).finite ↔ s.finite :=
⟨λ h, (h.1.prod h.2).subset $ λ x h, ⟨mem_image_of_mem _ h, mem_image_of_mem _ h⟩,
  λ h, ⟨h.image _, h.image _⟩⟩

lemma forall_finite_image_eval_iff {δ : Type*} [finite δ] {κ : δ → Type*} {s : set (Π d, κ d)} :
  (∀ d, (eval d '' s).finite) ↔ s.finite :=
⟨λ h, (finite.pi h).subset $ subset_pi_eval_image _ _, λ h d, h.image _⟩

lemma eq_finite_Union_of_finite_subset_Union  {ι} {s : ι → set α} {t : set α} (tfin : t.finite)
  (h : t ⊆ ⋃ i, s i) :
  ∃ I : set ι, I.finite ∧ ∃ σ : {i | i ∈ I} → set α,
     (∀ i, (σ i).finite) ∧ (∀ i, σ i ⊆ s i) ∧ t = ⋃ i, σ i :=
let ⟨I, Ifin, hI⟩ := finite_subset_Union tfin h in
⟨I, Ifin, λ x, s x ∩ t,
    λ i, tfin.subset (inter_subset_right _ _),
    λ i, inter_subset_left _ _,
    begin
      ext x,
      rw mem_Union,
      split,
      { intro x_in,
        rcases mem_Union.mp (hI x_in) with ⟨i, _, ⟨hi, rfl⟩, H⟩,
        use [i, hi, H, x_in] },
      { rintros ⟨i, hi, H⟩,
        exact H }
    end⟩

@[elab_as_eliminator]
theorem finite.induction_on {C : set α → Prop} {s : set α} (h : s.finite)
  (H0 : C ∅) (H1 : ∀ {a s}, a ∉ s → set.finite s → C s → C (insert a s)) : C s :=
begin
  lift s to finset α using h,
  induction s using finset.cons_induction_on with a s ha hs,
  { rwa [finset.coe_empty] },
  { rw [finset.coe_cons],
    exact @H1 a s ha (set.to_finite _) hs }
end

/-- Analogous to `finset.induction_on'`. -/
@[elab_as_eliminator]
theorem finite.induction_on' {C : set α → Prop} {S : set α} (h : S.finite)
  (H0 : C ∅) (H1 : ∀ {a s}, a ∈ S → s ⊆ S → a ∉ s → C s → C (insert a s)) : C S :=
begin
  refine @set.finite.induction_on α (λ s, s ⊆ S → C s) S h (λ _, H0) _ subset.rfl,
  intros a s has hsf hCs haS,
  rw insert_subset at haS,
  exact H1 haS.1 haS.2 has (hCs haS.2)
end

@[elab_as_eliminator]
theorem finite.dinduction_on {C : ∀ (s : set α), s.finite → Prop} {s : set α} (h : s.finite)
  (H0 : C ∅ finite_empty)
  (H1 : ∀ {a s}, a ∉ s → ∀ h : set.finite s, C s h → C (insert a s) (h.insert a)) :
  C s h :=
have ∀ h : s.finite, C s h,
  from finite.induction_on h (λ h, H0) (λ a s has hs ih h, H1 has hs (ih _)),
this h

section
local attribute [instance] nat.fintype_Iio

/--
If `P` is some relation between terms of `γ` and sets in `γ`,
such that every finite set `t : set γ` has some `c : γ` related to it,
then there is a recursively defined sequence `u` in `γ`
so `u n` is related to the image of `{0, 1, ..., n-1}` under `u`.

(We use this later to show sequentially compact sets
are totally bounded.)
-/
lemma seq_of_forall_finite_exists  {γ : Type*}
  {P : γ → set γ → Prop} (h : ∀ t : set γ, t.finite → ∃ c, P c t) :
  ∃ u : ℕ → γ, ∀ n, P (u n) (u '' Iio n) :=
⟨λ n, @nat.strong_rec_on' (λ _, γ) n $ λ n ih, classical.some $ h
    (range $ λ m : Iio n, ih m.1 m.2)
    (finite_range _),
λ n, begin
  classical,
  refine nat.strong_rec_on' n (λ n ih, _),
  rw nat.strong_rec_on_beta', convert classical.some_spec (h _ _),
  ext x, split,
  { rintros ⟨m, hmn, rfl⟩, exact ⟨⟨m, hmn⟩, rfl⟩ },
  { rintros ⟨⟨m, hmn⟩, rfl⟩, exact ⟨m, hmn, rfl⟩ }
end⟩

end

/-! ### Cardinality -/

theorem empty_card : fintype.card (∅ : set α) = 0 := rfl

@[simp] theorem empty_card' {h : fintype.{u} (∅ : set α)} :
  @fintype.card (∅ : set α) h = 0 :=
eq.trans (by congr) empty_card

theorem card_fintype_insert_of_not_mem {a : α} (s : set α) [fintype s] (h : a ∉ s) :
  @fintype.card _ (fintype_insert_of_not_mem s h) = fintype.card s + 1 :=
by rw [fintype_insert_of_not_mem, fintype.card_of_finset];
   simp [finset.card, to_finset]; refl

@[simp] theorem card_insert {a : α} (s : set α)
  [fintype s] (h : a ∉ s) {d : fintype.{u} (insert a s : set α)} :
  @fintype.card _ d = fintype.card s + 1 :=
by rw ← card_fintype_insert_of_not_mem s h; congr

lemma card_image_of_inj_on {s : set α} [fintype s]
  {f : α → β} [fintype (f '' s)] (H : ∀x∈s, ∀y∈s, f x = f y → x = y) :
  fintype.card (f '' s) = fintype.card s :=
by haveI := classical.prop_decidable; exact
calc fintype.card (f '' s) = (s.to_finset.image f).card : fintype.card_of_finset' _ (by simp)
... = s.to_finset.card : finset.card_image_of_inj_on
    (λ x hx y hy hxy, H x (mem_to_finset.1 hx) y (mem_to_finset.1 hy) hxy)
... = fintype.card s : (fintype.card_of_finset' _ (λ a, mem_to_finset)).symm

lemma card_image_of_injective (s : set α) [fintype s]
  {f : α → β} [fintype (f '' s)] (H : function.injective f) :
  fintype.card (f '' s) = fintype.card s :=
card_image_of_inj_on $ λ _ _ _ _ h, H h

@[simp] theorem card_singleton (a : α) :
  fintype.card ({a} : set α) = 1 :=
fintype.card_of_subsingleton _

lemma card_lt_card {s t : set α} [fintype s] [fintype t] (h : s ⊂ t) :
  fintype.card s < fintype.card t :=
fintype.card_lt_of_injective_not_surjective (set.inclusion h.1) (set.inclusion_injective h.1) $
  λ hst, (ssubset_iff_subset_ne.1 h).2 (eq_of_inclusion_surjective hst)

lemma card_le_of_subset {s t : set α} [fintype s] [fintype t] (hsub : s ⊆ t) :
  fintype.card s ≤ fintype.card t :=
fintype.card_le_of_injective (set.inclusion hsub) (set.inclusion_injective hsub)

lemma eq_of_subset_of_card_le {s t : set α} [fintype s] [fintype t]
   (hsub : s ⊆ t) (hcard : fintype.card t ≤ fintype.card s) : s = t :=
(eq_or_ssubset_of_subset hsub).elim id
  (λ h, absurd hcard $ not_le_of_lt $ card_lt_card h)

lemma card_range_of_injective [fintype α] {f : α → β} (hf : injective f)
  [fintype (range f)] : fintype.card (range f) = fintype.card α :=
eq.symm $ fintype.card_congr $ equiv.of_injective f hf

lemma finite.card_to_finset {s : set α} [fintype s] (h : s.finite) :
  h.to_finset.card = fintype.card s :=
begin
  rw [← finset.card_attach, finset.attach_eq_univ, ← fintype.card],
  refine fintype.card_congr (equiv.set_congr _),
  ext x,
  show x ∈ h.to_finset ↔ x ∈ s,
  simp,
end

lemma card_ne_eq [fintype α] (a : α) [fintype {x : α | x ≠ a}] :
  fintype.card {x : α | x ≠ a} = fintype.card α - 1 :=
begin
  haveI := classical.dec_eq α,
  rw [←to_finset_card, to_finset_set_of, finset.filter_ne',
    finset.card_erase_of_mem (finset.mem_univ _), finset.card_univ],
end

/-! ### Infinite sets -/

theorem infinite_univ_iff : (@univ α).infinite ↔ infinite α :=
by rw [set.infinite, finite_univ_iff, not_finite_iff_infinite]

theorem infinite_univ [h : infinite α] : (@univ α).infinite :=
infinite_univ_iff.2 h

theorem infinite_coe_iff {s : set α} : infinite s ↔ s.infinite :=
not_finite_iff_infinite.symm.trans finite_coe_iff.not

alias infinite_coe_iff ↔ _ infinite.to_subtype

/-- Embedding of `ℕ` into an infinite set. -/
noncomputable def infinite.nat_embedding (s : set α) (h : s.infinite) : ℕ ↪ s :=
by { haveI := h.to_subtype, exact infinite.nat_embedding s }

lemma infinite.exists_subset_card_eq {s : set α} (hs : s.infinite) (n : ℕ) :
  ∃ t : finset α, ↑t ⊆ s ∧ t.card = n :=
⟨((finset.range n).map (hs.nat_embedding _)).map (embedding.subtype _), by simp⟩

lemma infinite_of_finite_compl [infinite α] {s : set α} (hs : sᶜ.finite) : s.infinite :=
λ h, set.infinite_univ (by simpa using hs.union h)

lemma finite.infinite_compl [infinite α] {s : set α} (hs : s.finite) : sᶜ.infinite :=
λ h, set.infinite_univ (by simpa using hs.union h)

protected theorem infinite.mono {s t : set α} (h : s ⊆ t) : s.infinite → t.infinite :=
mt (λ ht, ht.subset h)

lemma infinite.diff {s t : set α} (hs : s.infinite) (ht : t.finite) : (s \ t).infinite :=
λ h, hs $ h.of_diff ht

@[simp] lemma infinite_union {s t : set α} : (s ∪ t).infinite ↔ s.infinite ∨ t.infinite :=
by simp only [set.infinite, finite_union, not_and_distrib]

theorem infinite.of_image (f : α → β) {s : set α} (hs : (f '' s).infinite) : s.infinite :=
mt (finite.image f) hs

theorem infinite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
  (f '' s).infinite ↔ s.infinite :=
not_congr $ finite_image_iff hi

alias infinite_image_iff ↔ _ infinite.image

attribute [protected] infinite.image

section image2
variables {f : α → β → γ} {s : set α} {t : set β} {a : α} {b : β}

protected lemma infinite.image2_left (hs : s.infinite) (hb : b ∈ t) (hf : inj_on (λ a, f a b) s) :
  (image2 f s t).infinite :=
(hs.image hf).mono $ image_subset_image2_left hb

protected lemma infinite.image2_right (ht : t.infinite) (ha : a ∈ s) (hf : inj_on (f a) t) :
  (image2 f s t).infinite :=
(ht.image hf).mono $ image_subset_image2_right ha

theorem infinite_image2 (hfs : ∀ b ∈ t, inj_on (λ a, f a b) s) (hft : ∀ a ∈ s, inj_on (f a) t) :
  (image2 f s t).infinite ↔ s.infinite ∧ t.nonempty ∨ t.infinite ∧ s.nonempty :=
begin
  refine ⟨λ h, set.infinite_prod.1 _, _⟩,
  { rw ←image_uncurry_prod at h,
    exact h.of_image _ },
  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
    { exact hs.image2_left hb (hfs _ hb) },
    { exact ht.image2_right ha (hft _ ha) } }
end

end image2

theorem infinite_of_inj_on_maps_to {s : set α} {t : set β} {f : α → β}
  (hi : inj_on f s) (hm : maps_to f s t) (hs : s.infinite) : t.infinite :=
((infinite_image_iff hi).2 hs).mono (maps_to'.mp hm)

theorem infinite.exists_ne_map_eq_of_maps_to {s : set α} {t : set β} {f : α → β}
  (hs : s.infinite) (hf : maps_to f s t) (ht : t.finite) :
  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
begin
  contrapose! ht,
  exact infinite_of_inj_on_maps_to (λ x hx y hy, not_imp_not.1 (ht x hx y hy)) hf hs
end

theorem infinite_range_of_injective [infinite α] {f : α → β} (hi : injective f) :
  (range f).infinite :=
by { rw [←image_univ, infinite_image_iff (inj_on_of_injective hi _)], exact infinite_univ }

theorem infinite_of_injective_forall_mem [infinite α] {s : set β} {f : α → β}
  (hi : injective f) (hf : ∀ x : α, f x ∈ s) : s.infinite :=
by { rw ←range_subset_iff at hf, exact (infinite_range_of_injective hi).mono hf }

lemma infinite.exists_nat_lt {s : set ℕ} (hs : s.infinite) (n : ℕ) : ∃ m ∈ s, n < m :=
let ⟨m, hm⟩ := (hs.diff $ set.finite_le_nat n).nonempty in ⟨m, by simpa using hm⟩

lemma infinite.exists_not_mem_finset {s : set α} (hs : s.infinite) (f : finset α) :
  ∃ a ∈ s, a ∉ f :=
let ⟨a, has, haf⟩ := (hs.diff (to_finite f)).nonempty
in ⟨a, has, λ h, haf $ finset.mem_coe.1 h⟩

lemma not_inj_on_infinite_finite_image {f : α → β} {s : set α}
  (h_inf : s.infinite) (h_fin : (f '' s).finite) :
  ¬ inj_on f s :=
begin
  haveI : finite (f '' s) := finite_coe_iff.mpr h_fin,
  haveI : infinite s := infinite_coe_iff.mpr h_inf,
  have := not_injective_infinite_finite
    ((f '' s).cod_restrict (s.restrict f) $ λ x, ⟨x, x.property, rfl⟩),
  contrapose! this,
  rwa [injective_cod_restrict, ← inj_on_iff_injective],
end

/-! ### Order properties -/

lemma finite_is_top (α : Type*) [partial_order α] : {x : α | is_top x}.finite :=
(subsingleton_is_top α).finite

lemma finite_is_bot (α : Type*) [partial_order α] : {x : α | is_bot x}.finite :=
(subsingleton_is_bot α).finite

theorem infinite.exists_lt_map_eq_of_maps_to [linear_order α] {s : set α} {t : set β} {f : α → β}
  (hs : s.infinite) (hf : maps_to f s t) (ht : t.finite) :
  ∃ (x ∈ s) (y ∈ s), x < y ∧ f x = f y :=
let ⟨x, hx, y, hy, hxy, hf⟩ := hs.exists_ne_map_eq_of_maps_to hf ht
in hxy.lt_or_lt.elim (λ hxy, ⟨x, hx, y, hy, hxy, hf⟩) (λ hyx, ⟨y, hy, x, hx, hyx, hf.symm⟩)

lemma finite.exists_lt_map_eq_of_forall_mem [linear_order α] [infinite α] {t : set β}
  {f : α → β} (hf : ∀ a, f a ∈ t) (ht : t.finite) :
  ∃ a b, a < b ∧ f a = f b :=
begin
  rw ←maps_univ_to at hf,
  obtain ⟨a, -, b, -, h⟩ := (@infinite_univ α _).exists_lt_map_eq_of_maps_to hf ht,
  exact ⟨a, b, h⟩,
end

lemma exists_min_image [linear_order β] (s : set α) (f : α → β) (h1 : s.finite) :
  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f a ≤ f b
| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
  using h1.to_finset.exists_min_image f ⟨x, h1.mem_to_finset.2 hx⟩

lemma exists_max_image [linear_order β] (s : set α) (f : α → β) (h1 : s.finite) :
  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f b ≤ f a
| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
  using h1.to_finset.exists_max_image f ⟨x, h1.mem_to_finset.2 hx⟩

theorem exists_lower_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f a ≤ f b :=
begin
  by_cases hs : set.nonempty s,
  { exact let ⟨x₀, H, hx₀⟩ := set.exists_min_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
end

theorem exists_upper_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f b ≤ f a :=
begin
  by_cases hs : set.nonempty s,
  { exact let ⟨x₀, H, hx₀⟩ := set.exists_max_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
end

lemma finite.supr_binfi_of_monotone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
  [is_directed ι' (≤)] [order.frame α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
  (hf : ∀ i ∈ s, monotone (f i)) :
  (⨆ j, ⨅ i ∈ s, f i j) = ⨅ i ∈ s, ⨆ j, f i j :=
begin
  revert hf,
  refine hs.induction_on _ _,
  { intro hf, simp [supr_const] },
  { intros a s has hs ihs hf,
    rw [ball_insert_iff] at hf,
    simp only [infi_insert, ← ihs hf.2],
    exact supr_inf_of_monotone hf.1 (λ j₁ j₂ hj, infi₂_mono $ λ i hi, hf.2 i hi hj) }
end

lemma finite.supr_binfi_of_antitone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
  [is_directed ι' (swap (≤))] [order.frame α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
  (hf : ∀ i ∈ s, antitone (f i)) :
  (⨆ j, ⨅ i ∈ s, f i j) = ⨅ i ∈ s, ⨆ j, f i j :=
@finite.supr_binfi_of_monotone ι ι'ᵒᵈ α _ _ _ _ _ hs _ (λ i hi, (hf i hi).dual_left)

lemma finite.infi_bsupr_of_monotone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
  [is_directed ι' (swap (≤))] [order.coframe α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
  (hf : ∀ i ∈ s, monotone (f i)) :
  (⨅ j, ⨆ i ∈ s, f i j) = ⨆ i ∈ s, ⨅ j, f i j :=
hs.supr_binfi_of_antitone (λ i hi, (hf i hi).dual_right)

lemma finite.infi_bsupr_of_antitone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
  [is_directed ι' (≤)] [order.coframe α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
  (hf : ∀ i ∈ s, antitone (f i)) :
  (⨅ j, ⨆ i ∈ s, f i j) = ⨆ i ∈ s, ⨅ j, f i j :=
hs.supr_binfi_of_monotone (λ i hi, (hf i hi).dual_right)

lemma _root_.supr_infi_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
  [is_directed ι' (≤)] [order.frame α] {f : ι → ι' → α} (hf : ∀ i, monotone (f i)) :
  (⨆ j, ⨅ i, f i j) = ⨅ i, ⨆ j, f i j :=
by simpa only [infi_univ] using finite_univ.supr_binfi_of_monotone (λ i hi, hf i)

lemma _root_.supr_infi_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
  [is_directed ι' (swap (≤))] [order.frame α] {f : ι → ι' → α} (hf : ∀ i, antitone (f i)) :
  (⨆ j, ⨅ i, f i j) = ⨅ i, ⨆ j, f i j :=
@supr_infi_of_monotone ι ι'ᵒᵈ α _ _ _ _ _ _ (λ i, (hf i).dual_left)

lemma _root_.infi_supr_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
  [is_directed ι' (swap (≤))] [order.coframe α] {f : ι → ι' → α} (hf : ∀ i, monotone (f i)) :
  (⨅ j, ⨆ i, f i j) = ⨆ i, ⨅ j, f i j :=
supr_infi_of_antitone (λ i, (hf i).dual_right)

lemma _root_.infi_supr_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
  [is_directed ι' (≤)] [order.coframe α] {f : ι → ι' → α} (hf : ∀ i, antitone (f i)) :
  (⨅ j, ⨆ i, f i j) = ⨆ i, ⨅ j, f i j :=
supr_infi_of_monotone (λ i, (hf i).dual_right)

/-- An increasing union distributes over finite intersection. -/
lemma Union_Inter_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (≤)]
  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
supr_infi_of_monotone hs

/-- A decreasing union distributes over finite intersection. -/
lemma Union_Inter_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (swap (≤))]
  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, antitone (s i)) :
  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
supr_infi_of_antitone hs

/-- An increasing intersection distributes over finite union. -/
lemma Inter_Union_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (swap (≤))]
  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
  (⋂ j : ι', ⋃ i : ι, s i j) = ⋃ i : ι, ⋂ j : ι', s i j :=
infi_supr_of_monotone hs

/-- A decreasing intersection distributes over finite union. -/
lemma Inter_Union_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (≤)]
  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, antitone (s i)) :
  (⋂ j : ι', ⋃ i : ι, s i j) = ⋃ i : ι, ⋂ j : ι', s i j :=
infi_supr_of_antitone hs

lemma Union_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] {α : ι → Type*}
  {I : set ι} {s : Π i, ι' → set (α i)} (hI : I.finite) (hs : ∀ i ∈ I, monotone (s i)) :
  (⋃ j : ι', I.pi (λ i, s i j)) = I.pi (λ i, ⋃ j, s i j) :=
begin
  simp only [pi_def, bInter_eq_Inter, preimage_Union],
  haveI := hI.fintype,
  exact Union_Inter_of_monotone (λ i j₁ j₂ h, preimage_mono $ hs i i.2 h)
end

lemma Union_univ_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] [finite ι]
  {α : ι → Type*} {s : Π i, ι' → set (α i)} (hs : ∀ i, monotone (s i)) :
  (⋃ j : ι', pi univ (λ i, s i j)) = pi univ (λ i, ⋃ j, s i j) :=
Union_pi_of_monotone finite_univ (λ i _, hs i)

lemma finite_range_find_greatest {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ} :
  (range (λ x, nat.find_greatest (P x) b)).finite :=
(finite_le_nat b).subset $ range_subset_iff.2 $ λ x, nat.find_greatest_le _

lemma finite.exists_maximal_wrt [partial_order β] (f : α → β) (s : set α) (h : set.finite s) :
  s.nonempty → ∃ a ∈ s, ∀ a' ∈ s, f a ≤ f a' → f a = f a' :=
begin
  refine h.induction_on _ _,
  { exact λ h, absurd h not_nonempty_empty },
  intros a s his _ ih _,
  cases s.eq_empty_or_nonempty with h h,
  { use a, simp [h] },
  rcases ih h with ⟨b, hb, ih⟩,
  by_cases f b ≤ f a,
  { refine ⟨a, set.mem_insert _ _, λ c hc hac, le_antisymm hac _⟩,
    rcases set.mem_insert_iff.1 hc with rfl | hcs,
    { refl },
    { rwa [← ih c hcs (le_trans h hac)] } },
  { refine ⟨b, set.mem_insert_of_mem _ hb, λ c hc hbc, _⟩,
    rcases set.mem_insert_iff.1 hc with rfl | hcs,
    { exact (h hbc).elim },
    { exact ih c hcs hbc } }
end

section

variables [semilattice_sup α] [nonempty α] {s : set α}

/--A finite set is bounded above.-/
protected lemma finite.bdd_above (hs : s.finite) : bdd_above s :=
finite.induction_on hs bdd_above_empty $ λ a s _ _ h, h.insert a

/--A finite union of sets which are all bounded above is still bounded above.-/
lemma finite.bdd_above_bUnion {I : set β} {S : β → set α} (H : I.finite) :
  (bdd_above (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_above (S i)) :=
finite.induction_on H
  (by simp only [bUnion_empty, bdd_above_empty, ball_empty_iff])
  (λ a s ha _ hs, by simp only [bUnion_insert, ball_insert_iff, bdd_above_union, hs])

lemma infinite_of_not_bdd_above : ¬ bdd_above s → s.infinite := mt finite.bdd_above

end

section

variables [semilattice_inf α] [nonempty α] {s : set α}

/--A finite set is bounded below.-/
protected lemma finite.bdd_below (hs : s.finite) : bdd_below s := @finite.bdd_above αᵒᵈ _ _ _ hs

/--A finite union of sets which are all bounded below is still bounded below.-/
lemma finite.bdd_below_bUnion {I : set β} {S : β → set α} (H : I.finite) :
  bdd_below (⋃ i ∈ I, S i) ↔ ∀ i ∈ I, bdd_below (S i) :=
@finite.bdd_above_bUnion αᵒᵈ _ _ _ _ _ H

lemma infinite_of_not_bdd_below : ¬ bdd_below s → s.infinite :=
begin
  contrapose!,
  rw not_infinite,
  apply finite.bdd_below,
end

end

end set

namespace finset

/-- A finset is bounded above. -/
protected lemma bdd_above [semilattice_sup α] [nonempty α] (s : finset α) :
  bdd_above (↑s : set α) :=
s.finite_to_set.bdd_above

/-- A finset is bounded below. -/
protected lemma bdd_below [semilattice_inf α] [nonempty α] (s : finset α) :
  bdd_below (↑s : set α) :=
s.finite_to_set.bdd_below

end finset

variables [linear_order α]

/-- If a linear order does not contain any triple of elements `x < y < z`, then this type
is finite. -/
lemma finite.of_forall_not_lt_lt (h : ∀ ⦃x y z : α⦄, x < y → y < z → false) :
  finite α :=
begin
  nontriviality α,
  rcases exists_pair_ne α with ⟨x, y, hne⟩,
  refine @finite.of_fintype α ⟨{x, y}, λ z , _⟩,
  simpa [hne] using eq_or_eq_or_eq_of_forall_not_lt_lt h z x y
end

/-- If a set `s` does not contain any triple of elements `x < y < z`, then `s` is finite. -/
lemma set.finite_of_forall_not_lt_lt {s : set α} (h : ∀ (x y z ∈ s), x < y → y < z → false) :
  set.finite s :=
@set.to_finite _ s $ finite.of_forall_not_lt_lt $ by simpa only [set_coe.forall'] using h

lemma set.finite_diff_Union_Ioo (s : set α) : (s \ ⋃ (x ∈ s) (y ∈ s), Ioo x y).finite :=
set.finite_of_forall_not_lt_lt $ λ x hx y hy z hz hxy hyz, hy.2 $ mem_Union₂_of_mem hx.1 $
  mem_Union₂_of_mem hz.1 ⟨hxy, hyz⟩

lemma set.finite_diff_Union_Ioo' (s : set α) : (s \ ⋃ x : s × s, Ioo x.1 x.2).finite :=
by simpa only [Union, supr_prod, supr_subtype] using s.finite_diff_Union_Ioo


import .love09_hoare_logic_demo

/- # LoVe Homework 9: Hoare Logic

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1 (6 points): Hoare Logic for LOOP

We introduce the LOOP language: -/

namespace loop

inductive stmt : Type
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| it     : (state → Prop) → stmt → stmt
| loop   : stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/- The language is similar to WHILE. There are three differences:

* There is no `skip` statement.

* The `it` statement is an `if`–`then` construct with no `else` case.

* The `loop` construct corresponds to a randomized `while` loop. It executes
  the body an unspecified (possibly infinite) number of times.

The big-step semantics for LOOP is defined below. -/

inductive big_step : stmt × state → state → Prop
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| seq {S T s t u} (hs : big_step (S, s) t)
    (ht : big_step (T, t) u) :
  big_step (S ;; T, s) u
| it_true {b : state → Prop} {S s t} (hcond : b s) (hbody : big_step (S, s) t) :
  big_step (stmt.it b S, s) t
| it_false {b : state → Prop} {S s} (hcond : ¬ b s) :
  big_step (stmt.it b S, s) s
| loop_continue {S s t u} (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.loop S, t) u) :
  big_step (stmt.loop S, s) u
| loop_exit {S s} :
  big_step (stmt.loop S, s) s

infix ` ⟹ ` : 110 := big_step

/- The definition of Hoare triples for partial correctness is unsurprising: -/

def partial_hoare (P : state → Prop) (S : stmt) (Q : state → Prop) : Prop :=
∀s t, P s → (S, s) ⟹ t → Q t

local notation `{* ` P : 1 ` *} ` S : 1 ` {* ` Q : 1 ` *}` :=
partial_hoare P S Q

namespace partial_hoare

/- 1.1 (1 point). Prove the consequence rule. -/

lemma consequence {P P' Q Q' : state → Prop} {S} (h : {* P *} S {* Q *})
    (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} S {* Q' *} :=
sorry

/- 1.2 (1 point). Prove the rule for `assign`. -/

lemma assign_intro {P : state → Prop} {x} {a : state → ℕ} :
  {* λs, P (s{x ↦ a s}) *} stmt.assign x a {* P *} :=
sorry

/- 1.3 (1 point). Prove the rule for `seq`. -/

lemma seq_intro {P Q R S T} (hS : {* P *} S {* Q *}) (hT : {* Q *} T {* R *}) :
  {* P *} stmt.seq S T {* R *} :=
sorry

/- 1.4 (1 point). Prove the rule for `it`. -/

lemma it_intro {b P Q : state → Prop} {S}
    (htrue : {* λs, P s ∧ b s *} S {* Q *}) (hfalse : ∀s, P s ∧ ¬ b s → Q s) :
  {* P *} stmt.it b S {* Q *} :=
sorry

/- 1.5 (2 points). Prove the rule for `loop`. Notice the similarity with the
rule for `while` in the WHILE language. -/

lemma loop_intro {S} (P : state → Prop) (h : {* P *} S {* P *}) :
  {* P *} stmt.loop S {* P *} :=
sorry

end partial_hoare

end loop

/- ## Question 2 (3 points): Program Verification

The following WHILE program is intended to compute 2 to the power of `n`,
leaving the result in `y`. -/

def POWER_OF_TWO : stmt :=
stmt.assign "y" (λs, 1) ;;
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "y" (λs, s "y" * 2) ;;
   stmt.assign "n" (λs, s "n" - 1))

/- 2.1 (1 point). Define a recursive function that computes 2 to the power of
`n`. -/

def two_to_the_nth : ℕ → ℕ :=
sorry

/- Remember to test your function. Otherwise, you will have big difficulties
answering question 2.2 below. -/

#eval two_to_the_nth 0   -- expected: 1
#eval two_to_the_nth 1   -- expected: 2
#eval two_to_the_nth 2   -- expected: 4
#eval two_to_the_nth 3   -- expected: 8
#eval two_to_the_nth 8   -- expected: 256

/- 2.2 (2 points). Prove the correctness of `POWER_OF_TWO` using `vcg`. -/

lemma POWER_OF_TWO_correct (n₀ : ℕ) :
  {* λs, s "n" = n₀ *} POWER_OF_TWO {* λs, s "y" = two_to_the_nth n₀ *} :=
sorry

end LoVe


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

/-!
# Finitely supported product of finsets

This file defines the finitely supported product of finsets as a `finset (ι →₀ α)`.

## Main declarations

* `finset.finsupp`: Finitely supported product of finsets. `s.finset t` is the product of the `t i`
  over all `i ∈ s`.
* `finsupp.pi`: `f.pi` is the finset of `finsupp`s whose `i`-th value lies in `f i`. This is the
  special case of `finset.finsupp` where we take the product of the `f i` over the support of `f`.

## Implementation notes

We make heavy use of the fact that `0 : finset α` is `{0}`. This scalar actions convention turns out
to be precisely what we want here too.
-/

noncomputable theory

open finsupp
open_locale big_operators classical pointwise

variables {ι α : Type*} [has_zero α] {s : finset ι} {f : ι →₀ α}

namespace finset

/-- Finitely supported product of finsets. -/
protected def finsupp (s : finset ι) (t : ι → finset α) : finset (ι →₀ α) :=
(s.pi t).map ⟨indicator s, indicator_injective s⟩

lemma mem_finsupp_iff {t : ι → finset α} : f ∈ s.finsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_indicator_subset _ _, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact indicator_of_mem hi _ },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.finsupp t` precisely means that `f` is pointwise in `t`. -/
@[simp] lemma mem_finsupp_iff_of_support_subset {t : ι →₀ finset α} (ht : t.support ⊆ s) :
  f ∈ s.finsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_finsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (λ H, hi $ ht H)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

@[simp] lemma card_finsupp (s : finset ι) (t : ι → finset α) :
  (s.finsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

end finset

open finset

namespace finsupp

/-- Given a finitely supported function `f : ι →₀ finset α`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : ι →₀ finset α) : finset (ι →₀ α) := f.support.finsupp f

@[simp] lemma mem_pi {f : ι →₀ finset α} {g : ι →₀ α} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_finsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : ι →₀ finset α) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_finsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end finsupp


/-
Copyright (c) 2022 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import data.list.basic

/- outline of Lewis' theory of common knowledge (according to Cubitt and Sugden) -/

variable {indiv : Type}            -- type of individuals
variables {i j k : indiv}

/-- Reason-to-believe is a two-place relation between individuals and propositions -/
variable {R : indiv → Prop → Prop}

/-- Indication is a three-place relation between individuals and two propositions -/
variable {Ind : Prop → indiv → Prop → Prop}

/-- A and φ are propositions that are used in the definition of a basis for common knowledge -/
constants {A φ : Prop}
--variable {p : Prop}

/-- These axioms define a basis for common knowledge -/
--axiom C1 : R i A
--axiom C2 : Ind A i (R j A)
--axiom C3 : Ind A i φ

-- This axiom represents that all individuals share inductive standards and background knowledge
axiom C4 : ∀p, Ind A i p → R i (Ind A j p)

/-- This axiom represents the meaning of indication -/
axiom A1 : ∀p, Ind A i p → R i A → R i p

/-- This axiom is an assumption that Cubitt and Sugden need in their proof. -/
axiom A6 : ∀p, (Ind A i (R j A) ∧ R i (Ind A j p)) → Ind A i (R j p)

/-- The following lemmas are the first three steps in the proof of Lewis' theorem -/
lemma L1
(C1 : ∀ i : indiv, R i A)
(C2 : ∀ i j : indiv, Ind A i (R j A))
(C3 : ∀i : indiv, Ind A i φ)
: ∀i, R i φ := by intro i; exact A1 φ (C3 _) (C1 _)

lemma L2
(C1 : ∀i, R i A)
(C2 : ∀i j : indiv, Ind A i (R j A))
(C3 : ∀i : indiv, Ind A i φ)
: ∀ i j, (R i (R j φ)) :=
begin
intros i1 i2,
have h7 : R i1 (Ind A i2 φ) := by exact C4 φ (C3 _),
have h8 : Ind A i1 (R i2 φ) := by exact A6 φ (and.intro (C2 _ _) h7),
exact A1 (R i2 φ) h8 (C1 _)
end

lemma L3
(C1 : ∀i, R i A)
(C2 : ∀i j : indiv, Ind A i (R j A))
(C3 : ∀i : indiv, Ind A i φ)
: ∀ i j k, (R i (R j (R k φ))) :=
begin
    intros i₁ i₂ i₃,
    have h7 : R i₁ (Ind A i₃ φ) := by exact C4 φ (C3 _),
    have h8 : Ind A i₁ (R i₃ φ) := by exact A6 φ (and.intro (C2 _ _) h7),
    have h9 : R i₁ (Ind A i₂ (R i₃ φ)) := by exact C4 (R _ φ) h8,
    have h10: Ind A i₁ (R i₂ (R i₃ φ)) := by exact A6 (R _ φ) (and.intro (C2 _ _) h9),
    exact A1 (R i₂ (R i₃ φ)) h10 (C1 _),
end

/-- We could go on in this way, like Lewis and Cubitt and Sugden do.
    The use of ... (and so on) is, however, unsatisfactory.
    Therefore, we will show that a complete proof by induction is possible. -/

inductive G : Prop → Prop
| base                          : G φ
| step (p : Prop) (i : indiv)   : G p → G (R i p)

theorem Lewis (p : Prop) {R : indiv → Prop → Prop}
(h7 : @G indiv R p)
(C1 : ∀i, R i A)
(C2 : ∀i j : indiv, Ind A i (R j A))
(C3 : ∀i : indiv, Ind A i φ)
: ∀(i : indiv), R i p :=
begin
intro i,
have h1 : Ind A i p :=
    begin
    induction h7 with u j hu ih,
{   exact C3 _ },
{   have h3 : R i (Ind A j u) := C4 u ih,
    have h4 : Ind A i (R j u) := A6 u (and.intro (C2 _ _) h3),
    assumption }
    end,
exact A1 p h1 (C1 _)
end


import data.real.basic

variable f : ℝ → ℝ

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a

-- BEGIN
example (h : ∀ a, ∃ x, f x > a) : ¬ fn_has_ub f :=
begin
  intros fnub,
  cases fnub with a fnuba,
  cases h a with x hx,
  have : f x ≤ a,
    from fnuba x,
  linarith,
end

example : ¬ fn_has_ub (λ x, x) :=
begin
  intro fnub,
  cases fnub with a fnuba,
  have a_plus_1_le_a := fnuba (a + 1),
  simp at a_plus_1_le_a,
  linarith,
end

-- END


import tactic.ring_exp
import tactic.zify
import algebra.group_with_zero.power
import algebra.ring.pi
import tactic.field_simp

universes u

section addition
/-!
  ### `addition` section

  Test associativity and commutativity of `(+)`.
-/
example (a b : ℚ) : a = a := by ring_exp
example (a b : ℚ) : a + b = a + b := by ring_exp
example (a b : ℚ) : b + a = a + b := by ring_exp
example (a b : ℤ) : a + b + b = b + (a + b) := by ring_exp
example (a b c : ℕ) : a + b + b + (c + c) = c + (b + c) + (a + b) := by ring_exp
end addition

section numerals
/-!
  ### `numerals` section

  Test that numerals behave like rational numbers.
-/
example (a : ℕ) : a + 5 + 5 = 0 + a + 10 := by ring_exp
example (a : ℤ) : a + 5 + 5 = 0 + a + 10 := by ring_exp
example (a : ℚ) : (1/2) * a + (1/2) * a = a := by ring_exp
end numerals

section multiplication
/-!
  ### `multiplication section`

  Test that multiplication is associative and commutative.
  Also test distributivity of `(+)` and `(*)`.
-/
example (a : ℕ) : 0 = a * 0 := by ring_exp_eq
example (a : ℕ) : a = a * 1 := by ring_exp
example (a : ℕ) : a + a = a * 2 := by ring_exp
example (a b : ℤ) : a * b = b * a := by ring_exp
example (a b : ℕ) : a * 4 * b + a = a * (4 * b + 1) := by ring_exp
end multiplication

section exponentiation
/-!
  ### `exponentiation` section

  Test that exponentiation has the correct distributivity properties.
-/
example : 0 ^ 1 = 0 := by ring_exp
example : 0 ^ 2 = 0 := by ring_exp
example (a : ℕ) : a ^ 0 = 1 := by ring_exp
example (a : ℕ) : a ^ 1 = a := by ring_exp
example (a : ℕ) : a ^ 2 = a * a := by ring_exp
example (a b : ℕ) : a ^ b = a ^ b := by ring_exp
example (a b : ℕ) : a ^ (b + 1) = a * a ^ b := by ring_exp
example (n : ℕ) (a m : ℕ) : a * a^n * m = a^(n+1) * m := by ring_exp
example (n : ℕ) (a m : ℕ) : m * a^n * a = a^(n+1) * m := by ring_exp
example (n : ℕ) (a m : ℤ) : a * a^n * m = a^(n+1) * m := by ring_exp
example (n : ℕ) (m : ℤ) : 2 * 2^n * m = 2^(n+1) * m := by ring_exp
example (n : ℕ) (m : ℤ) : 2^(n+1) * m = 2 * 2^n * m := by ring_exp
example (n m : ℕ) (a : ℤ) : (a ^ n)^m = a^(n * m) := by ring_exp
example (n m : ℕ) (a : ℤ) : a^(n^0) = a^1 := by ring_exp
example (n : ℕ) : 0^(n + 1) = 0 := by ring_exp
example {α} [comm_ring α] (x : α) (k : ℕ) : x ^ (k + 2) = x * x * x^k := by ring_exp
example {α} [comm_ring α] (k : ℕ) (x y z : α) :
  x * (z * (x - y)) + (x * (y * y ^ k) - y * (y * y ^ k)) = (z * x + y * y ^ k) * (x - y)
:= by ring_exp

-- We can represent a large exponent `n` more efficiently than just `n` multiplications:
example (a b : ℚ) : (a * b) ^ 1000000 = (b * a) ^ 1000000 := by ring_exp

example (n : ℕ) : 2 ^ (n + 1 + 1)  = 2 * 2 ^ (n + 1) :=
by ring_exp_eq

-- power does not have to be a syntactic match to `monoid.has_pow`
example {α} [comm_ring α] (x : ℕ → α) : (x ^ 2 * x) = x ^ 3 := by ring_exp

-- Powers in the exponent get evaluated correctly.
example (X : ℤ) : (X^5 + 1) * (X^2^3 + X) = X^13 + X^8 + X^6 + X :=
by ring_exp

end exponentiation

section power_of_sum
/-!
  ### `power_of_sum` section

  Test that raising a sum to a power behaves like repeated multiplication,
  if needed.
-/
example (a b : ℤ) : (a + b)^2 = a^2 + b^2 + a * b + b * a := by ring_exp
example (a b : ℤ) (n : ℕ) : (a + b)^(n + 2) = (a^2 + b^2 + a * b + b * a) * (a + b)^n := by ring_exp
end power_of_sum

section negation
/-!
  ### `negation` section

  Test that negation and subtraction satisfy the expected properties,
  also in semirings such as `ℕ`.
-/
example {α} [comm_ring α] (a : α) : a - a = 0 := by ring_exp_eq
example (a : ℤ) : a - a = 0 := by ring_exp
example (a : ℤ) : a + - a = 0 := by ring_exp
example (a : ℤ) : - a = (-1) * a := by ring_exp
-- Here, (a - b) is treated as an atom.
example (a b : ℕ) : a - b + a + a = a - b + 2 * a := by ring_exp
example (n : ℕ) : n + 1 - 1 = n := by ring_exp! -- But we can force a bit of evaluation anyway.
end negation

constant f {α} : α → α
section complicated
/-!
  ### `complicated` section

  Test that complicated, real-life expressions also get normalized.
-/
example {α : Type} [linear_ordered_field α] (x : α) :
  2 * x + 1 * 1 - (2 * f (x + 1 / 2) + 2 * 1) + (1 * 1 - (2 * x - 2 * f (x + 1 / 2))) = 0
:= by ring_exp_eq
example {α : Type u} [linear_ordered_field α] (x : α) :
  f (x + 1 / 2) ^ 1 * -2 + (f (x + 1 / 2) ^ 1 * 2 + 0) = 0
:= by ring_exp_eq

example (x y : ℕ) : x + id y = y + id x := by ring_exp!

-- Here, we check that `n - s` is not treated as `n + additive_inverse s`,
-- if `s` doesn't have an additive inverse.
example (B s n : ℕ) : B * (f s * ((n - s) * f (n - s - 1))) = B * (n - s) * (f s * f (n - s - 1)) :=
by ring_exp

-- This is a somewhat subtle case: `-c/b` is parsed as `(-c)/b`,
-- so we can't simply treat both sides of the division as atoms.
-- Instead, we follow the `ring` tactic in interpreting `-c / b` as `-c * b⁻¹`,
-- with only `b⁻¹` an atom.
example {α} [linear_ordered_field α] (a b c : α) : a*(-c/b)*(-c/b) = a*((c/b)*(c/b)) := by ring_exp

-- test that `field_simp` works fine with powers and `ring_exp`.
example (x y : ℚ) (n : ℕ) (hx : x ≠ 0) (hy : y ≠ 0) :
  1/ (2/(x / y))^(2 * n) + y / y^(n+1) - (x/y)^n * (x/(2 * y))^n / 2 ^n = 1/y^n :=
begin
  field_simp,
  ring_exp
end
end complicated

-- Test that `nat.succ d` gets handled as `d + 1`.
example (d : ℕ) : 2 * (2 ^ d - 1) + 1 = 2 ^ d.succ - 1 :=
begin
  zify [nat.one_le_pow'],
  ring_exp,
end

-- Simplified instance of a bug reported by Patrick Massot:
-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/ring_exp.20bug
example (l : ℤ) : l - l = 0 :=
begin
  tactic.replace_at (tactic.ring_exp.normalize tactic.transparency.reducible) [] tt >> pure (),
  refl
end

-- Normalizing also works on more complicated expressions:
example (a b : ℤ) : (a^2 - b - b) + (2 * id b - a^2) = 0 :=
begin
  tactic.replace_at (tactic.ring_exp.normalize tactic.transparency.semireducible) [] tt >> pure (),
  refl
end

section conv
/-!
  ### `conv` section

  Test that `ring_exp` works inside of `conv`, both with and without `!`.
-/

example (n : ℕ) : (2^n * 2 + 1)^10 = (2^(n+1) + 1)^10 :=
begin
conv_rhs
{ congr,
  ring_exp, },
conv_lhs
{ congr,
  ring_exp, },
end

example (x y : ℤ) : x + id y - y + id x = x * 2 := begin
  conv_lhs { ring_exp!, },
end
end conv

section benchmark
/-!
  ### `benchmark` section

  The `ring_exp` tactic shouldn't be too slow.
-/
-- This last example was copied from `data/polynomial.lean`, because it timed out.
-- After some optimization, it doesn't.
variables {α : Type} [comm_ring α]
def pow_sub_pow_factor (x y : α) : Π {i : ℕ},{z // x^i - y^i = z*(x - y)}
| 0 := ⟨0, by simp⟩
| 1 := ⟨1, by simp⟩
| (k+2) :=
begin
  cases @pow_sub_pow_factor (k+1) with z hz,
  existsi z*x + y^(k+1),
  rw [pow_succ x, pow_succ y, ←sub_add_sub_cancel (x*x^(k+1)) (x*y^(k+1)),
  ←mul_sub x, hz],
  ring_exp_eq
end

-- Another benchmark: bound the growth of the complexity somewhat.
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 4 = (1 + x) ^ 4   := by try_for  5000 {ring_exp}
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 6 = (1 + x) ^ 6   := by try_for 10000 {ring_exp}
example {α} [comm_semiring α] (x : α) : (x + 1) ^ 8 = (1 + x) ^ 8   := by try_for 15000 {ring_exp}
end benchmark


namespace prop_12

variables A B C : Prop

theorem prop_12 : (A → (B → C)) → ((B ∧ ¬ C) → ¬ A) :=
assume h1: A → (B → C),
assume h2: B ∧ ¬ C,
have h3: B, from and.left h2,
have h4: ¬ C, from and.right h2,
have h5: ¬ (B → C), from
    (assume h6: B → C,
     have h7: C, from h6 h3,
     h4 h7),
show ¬ A, from (classical.by_contradiction
    (assume h8: ¬ ¬ A,
     have h9: A, from (classical.by_contradiction h8),
     have h10: B → C, from h1 h9,
     h5 h10))

-- end namespace
end prop_12


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import topology.algebra.module.basic

/-!
# Weak dual topology

This file defines the weak-* topology on duals of suitable topological modules `E` over suitable
topological semirings `𝕜`. The (weak) dual consists of continuous linear functionals `E →L[𝕜] 𝕜`
from `E` to scalars `𝕜`. The weak-* topology is the coarsest topology on this dual
`weak_dual 𝕜 E := (E →L[𝕜] 𝕜)` w.r.t. which the evaluation maps at all `z : E` are continuous.

The weak dual is a module over `𝕜` if the semiring `𝕜` is commutative.

## Main definitions

The main definitions are the type `weak_dual 𝕜 E` and a topology instance on it.

* `weak_dual 𝕜 E` is a type synonym for `dual 𝕜 E` (when the latter is defined): both are equal to
  the type `E →L[𝕜] 𝕜` of continuous linear maps from a module `E` over `𝕜` to the ring `𝕜`.
* The instance `weak_dual.topological_space` is the weak-* topology on `weak_dual 𝕜 E`, i.e., the
  coarsest topology making the evaluation maps at all `z : E` continuous.

## Main results

We establish that `weak_dual 𝕜 E` has the following structure:
* `weak_dual.has_continuous_add`: The addition in `weak_dual 𝕜 E` is continuous.
* `weak_dual.module`: If the scalars `𝕜` are a commutative semiring, then `weak_dual 𝕜 E` is a
  module over `𝕜`.
* `weak_dual.has_continuous_smul`: If the scalars `𝕜` are a commutative semiring, then the scalar
  multiplication by `𝕜` in `weak_dual 𝕜 E` is continuous.

We prove the following results characterizing the weak-* topology:
* `weak_dual.eval_continuous`: For any `z : E`, the evaluation mapping `weak_dual 𝕜 E → 𝕜` taking
  `x'`to `x' z` is continuous.
* `weak_dual.continuous_of_continuous_eval`: For a mapping to `weak_dual 𝕜 E` to be continuous,
  it suffices that its compositions with evaluations at all points `z : E` are continuous.
* `weak_dual.tendsto_iff_forall_eval_tendsto`: Convergence in `weak_dual 𝕜 E` can be characterized
  in terms of convergence of the evaluations at all points `z : E`.

## Notations

No new notation is introduced.

## Implementation notes

The weak-* topology is defined as the induced topology under the mapping that associates to a dual
element `x'` the functional `E → 𝕜`, when the space `E → 𝕜` of functionals is equipped with the
topology of pointwise convergence (product topology).

Typically one might assume that `𝕜` is a topological semiring in the sense of the typeclasses
`topological_space 𝕜`, `semiring 𝕜`, `has_continuous_add 𝕜`, `has_continuous_mul 𝕜`,
and that the space `E` is a topological module over `𝕜` in the sense of the typeclasses
`topological_space E`, `add_comm_monoid E`, `has_continuous_add E`, `module 𝕜 E`,
`has_continuous_smul 𝕜 E`. The definitions and results are, however, given with weaker assumptions
when possible.

## References

* https://en.wikipedia.org/wiki/Weak_topology#Weak-*_topology

## Tags

weak-star, weak dual

-/

noncomputable theory
open filter
open_locale topological_space

universes u v

section weak_star_topology
/-!
### Weak star topology on duals of topological modules
-/

variables (𝕜 : Type*) [topological_space 𝕜] [semiring 𝕜]
variables (E : Type*) [topological_space E] [add_comm_monoid E] [module 𝕜 E]

/-- The weak dual of a topological module `E` over a topological semiring `𝕜` consists of
continuous linear functionals from `E` to scalars `𝕜`. It is a type synonym with the usual dual
(when the latter is defined), but will be equipped with a different topology. -/
@[derive [inhabited, λ α, has_coe_to_fun α (λ _, E → 𝕜)]]
def weak_dual := E →L[𝕜] 𝕜

instance [has_continuous_add 𝕜] : add_comm_monoid (weak_dual 𝕜 E) :=
continuous_linear_map.add_comm_monoid

namespace weak_dual

/-- The weak-* topology instance `weak_dual.topological_space` on the dual of a topological module
`E` over a topological semiring `𝕜` is defined as the induced topology under the mapping that
associates to a dual element `x' : weak_dual 𝕜 E` the functional `E → 𝕜`, when the space `E → 𝕜`
of functionals is equipped with the topology of pointwise convergence (product topology). -/
instance : topological_space (weak_dual 𝕜 E) :=
topological_space.induced (λ x' : weak_dual 𝕜 E, λ z : E, x' z) Pi.topological_space

/-- The coercion `coe_fn : weak_dual 𝕜 E → (E → 𝕜)` is an embedding. -/
lemma coe_fn_embedding :
  embedding (coe_fn : weak_dual 𝕜 E → (E → 𝕜)) :=
by convert continuous_linear_map.coe_fn_injective.embedding_induced

lemma coe_fn_continuous :
  continuous (λ (x' : (weak_dual 𝕜 E)), (λ (z : E), x' z)) :=
continuous_induced_dom

lemma eval_continuous (z : E) : continuous (λ (x' : weak_dual 𝕜 E), x' z) :=
(continuous_pi_iff.mp (coe_fn_continuous 𝕜 E)) z

lemma continuous_of_continuous_eval {α : Type u} [topological_space α]
  {g : α → weak_dual 𝕜 E} (h : ∀ z, continuous (λ a, g a z)) : continuous g :=
continuous_induced_rng (continuous_pi_iff.mpr h)

theorem tendsto_iff_forall_eval_tendsto {γ : Type u} {F : filter γ}
  {ψs : γ → weak_dual 𝕜 E} {ψ : weak_dual 𝕜 E} :
  tendsto ψs F (𝓝 ψ) ↔ ∀ z : E, tendsto (λ i, ψs i z) F (𝓝 (ψ z)) :=
by rw [← tendsto_pi_nhds, (coe_fn_embedding 𝕜 E).tendsto_nhds_iff]

/-- Addition in `weak_dual 𝕜 E` is continuous. -/
instance [has_continuous_add 𝕜] : has_continuous_add (weak_dual 𝕜 E) :=
⟨continuous_induced_rng $ ((coe_fn_continuous 𝕜 E).comp continuous_fst).add
  ((coe_fn_continuous 𝕜 E).comp continuous_snd)⟩

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts on `weak_dual 𝕜 E`. -/
instance (M : Type*) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [topological_space M] [has_continuous_smul M 𝕜] :
  mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.mul_action

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts distributively on `weak_dual 𝕜 E`. -/
instance (M : Type*) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [topological_space M] [has_continuous_smul M 𝕜] [has_continuous_add 𝕜] :
  distrib_mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.distrib_mul_action

/-- If `𝕜` is a topological module over a semiring `R` and scalar multiplication commutes with the
multiplication on `𝕜`, then `weak_dual 𝕜 E` is a module over `R`. -/
instance (R : Type*) [semiring R] [module R 𝕜] [smul_comm_class 𝕜 R 𝕜]
  [topological_space R] [has_continuous_smul R 𝕜] [has_continuous_add 𝕜] :
  module R (weak_dual 𝕜 E) :=
continuous_linear_map.module

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it continuously acts on `weak_dual 𝕜 E`. -/
instance (M : Type*) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [topological_space M] [has_continuous_smul M 𝕜] :
  has_continuous_smul M (weak_dual 𝕜 E) :=
⟨continuous_induced_rng $ continuous_fst.smul ((coe_fn_continuous 𝕜 E).comp continuous_snd)⟩

end weak_dual

end weak_star_topology


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

Theory of topological rings.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.group
import Mathlib.ring_theory.ideal.basic
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-- A topological semiring is a semiring where addition and multiplication are continuous. -/
class topological_semiring (α : Type u) [topological_space α] [semiring α]
extends has_continuous_mul α, has_continuous_add α
where

/-- A topological ring is a ring where the ring operations are continuous. -/
class topological_ring (α : Type u) [topological_space α] [ring α]
extends has_continuous_mul α, has_continuous_add α
where
  continuous_neg : continuous fun (a : α) => -a

protected instance topological_ring.to_topological_semiring (α : Type u) [topological_space α] [ring α] [t : topological_ring α] : topological_semiring α :=
  topological_semiring.mk

protected instance topological_ring.to_topological_add_group (α : Type u) [topological_space α] [ring α] [t : topological_ring α] : topological_add_group α :=
  topological_add_group.mk topological_ring.continuous_neg

/-- In a topological ring, the left-multiplication `add_monoid_hom` is continuous. -/
theorem mul_left_continuous {α : Type u} [topological_space α] [ring α] [topological_ring α] (x : α) : continuous ⇑(add_monoid_hom.mul_left x) :=
  continuous.mul continuous_const continuous_id

/-- In a topological ring, the right-multiplication `add_monoid_hom` is continuous. -/
theorem mul_right_continuous {α : Type u} [topological_space α] [ring α] [topological_ring α] (x : α) : continuous ⇑(add_monoid_hom.mul_right x) :=
  continuous.mul continuous_id continuous_const

/-- The closure of an ideal in a topological ring as an ideal. -/
def ideal.closure {α : Type u_1} [topological_space α] [comm_ring α] [topological_ring α] (S : ideal α) : ideal α :=
  submodule.mk (closure ↑S) sorry sorry sorry

@[simp] theorem ideal.coe_closure {α : Type u_1} [topological_space α] [comm_ring α] [topological_ring α] (S : ideal α) : ↑(ideal.closure S) = closure ↑S :=
  rfl

protected instance topological_ring_quotient_topology {α : Type u_1} [topological_space α] [comm_ring α] (N : ideal α) : topological_space (ideal.quotient N) :=
  id quotient.topological_space

theorem quotient_ring_saturate {α : Type u_1} [comm_ring α] (N : ideal α) (s : set α) : ⇑(ideal.quotient.mk N) ⁻¹' (⇑(ideal.quotient.mk N) '' s) =
  set.Union fun (x : ↥N) => (fun (y : α) => subtype.val x + y) '' s := sorry

theorem quotient_ring.is_open_map_coe {α : Type u_1} [topological_space α] [comm_ring α] (N : ideal α) [topological_ring α] : is_open_map ⇑(ideal.quotient.mk N) := sorry

theorem quotient_ring.quotient_map_coe_coe {α : Type u_1} [topological_space α] [comm_ring α] (N : ideal α) [topological_ring α] : quotient_map fun (p : α × α) => (coe_fn (ideal.quotient.mk N) (prod.fst p), coe_fn (ideal.quotient.mk N) (prod.snd p)) := sorry

protected instance topological_ring_quotient {α : Type u_1} [topological_space α] [comm_ring α] (N : ideal α) [topological_ring α] : topological_ring (ideal.quotient N) :=
  topological_ring.mk
    (eq.mpr
      ((fun (f f_1 : ideal.quotient N → ideal.quotient N) (e_3 : f = f_1) => congr_arg continuous e_3)
        (fun (a : ideal.quotient N) => -a)
        (quotient.lift (Quot.mk setoid.r ∘ fun (a : α) => -a) (submodule.quotient.has_neg._proof_1 N))
        (Eq.refl fun (a : ideal.quotient N) => -a))
      (continuous_quotient_lift (submodule.quotient.has_neg._proof_1 N)
        (continuous.comp continuous_quot_mk continuous_neg)))