/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import order.filter.basic
import data.pfun

/-!
# `tendsto` for relations and partial functions

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

This file generalizes `filter` definitions from functions to partial functions and relations.

## Considering functions and partial functions as relations

A function `f : α → β` can be considered as the relation `rel α β` which relates `x` and `f x` for
all `x`, and nothing else. This relation is called `function.graph f`.

A partial function `f : α →. β` can be considered as the relation `rel α β` which relates `x` and
`f x` for all `x` for which `f x` exists, and nothing else. This relation is called
`pfun.graph' f`.

In this regard, a function is a relation for which every element in `α` is related to exactly one
element in `β` and a partial function is a relation for which every element in `α` is related to at
most one element in `β`.

This file leverages this analogy to generalize `filter` definitions from functions to partial
functions and relations.

## Notes

`set.preimage` can be generalized to relations in two ways:
* `rel.preimage` returns the image of the set under the inverse relation.
* `rel.core` returns the set of elements that are only related to those in the set.
Both generalizations are sensible in the context of filters, so `filter.comap` and `filter.tendsto`
get two generalizations each.

We first take care of relations. Then the definitions for partial functions are taken as special
cases of the definitions for relations.
-/

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

open_locale filter

/-! ### Relations -/

/-- The forward map of a filter under a relation. Generalization of `filter.map` to relations. Note
that `rel.core` generalizes `set.preimage`. -/
def rmap (r : rel α β) (l : filter α) : filter β :=
{ sets             := {s | r.core s ∈ l},
  univ_sets        := by simp,
  sets_of_superset := λ s t hs st, mem_of_superset hs $ rel.core_mono _ st,
  inter_sets       := λ s t hs ht, by simp [rel.core_inter, inter_mem hs ht] }

theorem rmap_sets (r : rel α β) (l : filter α) : (l.rmap r).sets = r.core ⁻¹' l.sets := rfl

@[simp]
theorem mem_rmap (r : rel α β) (l : filter α) (s : set β) :
  s ∈ l.rmap r ↔ r.core s ∈ l :=
iff.rfl

@[simp]
theorem rmap_rmap (r : rel α β) (s : rel β γ) (l : filter α) :
  rmap s (rmap r l) = rmap (r.comp s) l :=
filter_eq $
by simp [rmap_sets, set.preimage, rel.core_comp]

@[simp]
lemma rmap_compose (r : rel α β) (s : rel β γ) : rmap s ∘ rmap r = rmap (r.comp s) :=
funext $ rmap_rmap _ _

/-- Generic "limit of a relation" predicate. `rtendsto r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `r`-core of `a` is an `l₁`-neighborhood. One generalization of
`filter.tendsto` to relations. -/
def rtendsto (r : rel α β) (l₁ : filter α) (l₂ : filter β) := l₁.rmap r ≤ l₂

theorem rtendsto_def (r : rel α β) (l₁ : filter α) (l₂ : filter β) :
  rtendsto r l₁ l₂ ↔ ∀ s ∈ l₂, r.core s ∈ l₁ :=
iff.rfl

/-- One way of taking the inverse map of a filter under a relation. One generalization of
`filter.comap` to relations. Note that `rel.core` generalizes `set.preimage`. -/
def rcomap (r : rel α β) (f : filter β) : filter α :=
{ sets             := rel.image (λ s t, r.core s ⊆ t) f.sets,
  univ_sets        := ⟨set.univ, univ_mem, set.subset_univ _⟩,
  sets_of_superset := λ a b ⟨a', ha', ma'a⟩ ab, ⟨a', ha', ma'a.trans ab⟩,
  inter_sets       := λ a b ⟨a', ha₁, ha₂⟩ ⟨b', hb₁, hb₂⟩,
                        ⟨a' ∩ b', inter_mem ha₁ hb₁,
                          (r.core_inter a' b').subset.trans (set.inter_subset_inter ha₂ hb₂)⟩ }

theorem rcomap_sets (r : rel α β) (f : filter β) :
  (rcomap r f).sets = rel.image (λ s t, r.core s ⊆ t) f.sets := rfl

theorem rcomap_rcomap (r : rel α β) (s : rel β γ) (l : filter γ) :
  rcomap r (rcomap s l) = rcomap (r.comp s) l :=
filter_eq $
begin
  ext t, simp [rcomap_sets, rel.image, rel.core_comp], split,
  { rintros ⟨u, ⟨v, vsets, hv⟩, h⟩,
    exact ⟨v, vsets, set.subset.trans (rel.core_mono _ hv) h⟩ },
  rintros ⟨t, tsets, ht⟩,
  exact ⟨rel.core s t, ⟨t, tsets, set.subset.rfl⟩, ht⟩
end

@[simp]
lemma rcomap_compose (r : rel α β) (s : rel β γ) : rcomap r ∘ rcomap s = rcomap (r.comp s) :=
funext $ rcomap_rcomap _ _

theorem rtendsto_iff_le_rcomap (r : rel α β) (l₁ : filter α) (l₂ : filter β) :
  rtendsto r l₁ l₂ ↔ l₁ ≤ l₂.rcomap r :=
begin
  rw rtendsto_def,
  change (∀ (s : set β), s ∈ l₂.sets → r.core s ∈ l₁) ↔ l₁ ≤ rcomap r l₂,
  simp [filter.le_def, rcomap, rel.mem_image], split,
  { exact λ h s t tl₂, mem_of_superset (h t tl₂) },
  { exact λ h t tl₂, h _ t tl₂ set.subset.rfl }
end

-- Interestingly, there does not seem to be a way to express this relation using a forward map.
-- Given a filter `f` on `α`, we want a filter `f'` on `β` such that `r.preimage s ∈ f` if
-- and only if `s ∈ f'`. But the intersection of two sets satisfying the lhs may be empty.

/-- One way of taking the inverse map of a filter under a relation. Generalization of `filter.comap`
to relations. -/
def rcomap' (r : rel α β) (f : filter β) : filter α :=
{ sets             := rel.image (λ s t, r.preimage s ⊆ t) f.sets,
  univ_sets        := ⟨set.univ, univ_mem, set.subset_univ _⟩,
  sets_of_superset := λ a b ⟨a', ha', ma'a⟩ ab, ⟨a', ha', ma'a.trans ab⟩,
  inter_sets       := λ a b ⟨a', ha₁, ha₂⟩ ⟨b', hb₁, hb₂⟩,
                        ⟨a' ∩ b', inter_mem ha₁ hb₁,
                         (@rel.preimage_inter _ _ r _ _).trans (set.inter_subset_inter ha₂ hb₂)⟩ }

@[simp]
lemma mem_rcomap' (r : rel α β) (l : filter β) (s : set α) :
  s ∈ l.rcomap' r ↔ ∃ t ∈ l, r.preimage t ⊆ s :=
iff.rfl

theorem rcomap'_sets (r : rel α β) (f : filter β) :
  (rcomap' r f).sets = rel.image (λ s t, r.preimage s ⊆ t) f.sets := rfl

@[simp]
theorem rcomap'_rcomap' (r : rel α β) (s : rel β γ) (l : filter γ) :
  rcomap' r (rcomap' s l) = rcomap' (r.comp s) l :=
filter.ext $ λ t,
begin
  simp [rcomap'_sets, rel.image, rel.preimage_comp], split,
  { rintro ⟨u, ⟨v, vsets, hv⟩, h⟩,
    exact ⟨v, vsets, (rel.preimage_mono _ hv).trans h⟩ },
  rintro ⟨t, tsets, ht⟩,
  exact ⟨s.preimage t, ⟨t, tsets, set.subset.rfl⟩, ht⟩
end

@[simp]
lemma rcomap'_compose (r : rel α β) (s : rel β γ) : rcomap' r ∘ rcomap' s = rcomap' (r.comp s) :=
funext $ rcomap'_rcomap' _ _

/-- Generic "limit of a relation" predicate. `rtendsto' r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `r`-preimage of `a` is an `l₁`-neighborhood. One generalization of
`filter.tendsto` to relations. -/
def rtendsto' (r : rel α β) (l₁ : filter α) (l₂ : filter β) := l₁ ≤ l₂.rcomap' r

theorem rtendsto'_def (r : rel α β) (l₁ : filter α) (l₂ : filter β) :
  rtendsto' r l₁ l₂ ↔ ∀ s ∈ l₂, r.preimage s ∈ l₁ :=
begin
  unfold rtendsto' rcomap', simp [le_def, rel.mem_image], split,
  { exact λ h s hs, h _ _ hs set.subset.rfl },
  { exact λ h s t ht, mem_of_superset (h t ht) }
end

theorem tendsto_iff_rtendsto (l₁ : filter α) (l₂ : filter β) (f : α → β) :
  tendsto f l₁ l₂ ↔ rtendsto (function.graph f) l₁ l₂ :=
by { simp [tendsto_def, function.graph, rtendsto_def, rel.core, set.preimage] }

theorem tendsto_iff_rtendsto' (l₁ : filter α) (l₂ : filter β) (f : α → β) :
  tendsto f l₁ l₂ ↔ rtendsto' (function.graph f) l₁ l₂ :=
by { simp [tendsto_def, function.graph, rtendsto'_def, rel.preimage_def, set.preimage] }

/-! ### Partial functions -/

/-- The forward map of a filter under a partial function. Generalization of `filter.map` to partial
functions. -/
def pmap (f : α →. β) (l : filter α) : filter β :=
filter.rmap f.graph' l

@[simp]
lemma mem_pmap (f : α →. β) (l : filter α) (s : set β) : s ∈ l.pmap f ↔ f.core s ∈ l :=
iff.rfl

/-- Generic "limit of a partial function" predicate. `ptendsto r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `p`-core of `a` is an `l₁`-neighborhood. One generalization of
`filter.tendsto` to partial function. -/
def ptendsto (f : α →. β) (l₁ : filter α) (l₂ : filter β) := l₁.pmap f ≤ l₂

theorem ptendsto_def (f : α →. β) (l₁ : filter α) (l₂ : filter β) :
  ptendsto f l₁ l₂ ↔ ∀ s ∈ l₂, f.core s ∈ l₁ :=
iff.rfl

theorem ptendsto_iff_rtendsto (l₁ : filter α) (l₂ : filter β) (f : α →. β) :
  ptendsto f l₁ l₂ ↔ rtendsto f.graph' l₁ l₂ :=
iff.rfl

theorem pmap_res (l : filter α) (s : set α) (f : α → β) :
  pmap (pfun.res f s) l = map f (l ⊓ 𝓟 s) :=
begin
  ext t,
  simp only [pfun.core_res, mem_pmap, mem_map, mem_inf_principal, imp_iff_not_or],
  refl
end

theorem tendsto_iff_ptendsto (l₁ : filter α) (l₂ : filter β) (s : set α) (f : α → β) :
  tendsto f (l₁ ⊓ 𝓟 s) l₂ ↔ ptendsto (pfun.res f s) l₁ l₂ :=
by simp only [tendsto, ptendsto, pmap_res]

theorem tendsto_iff_ptendsto_univ (l₁ : filter α) (l₂ : filter β) (f : α → β) :
  tendsto f l₁ l₂ ↔ ptendsto (pfun.res f set.univ) l₁ l₂ :=
by { rw ← tendsto_iff_ptendsto, simp [principal_univ] }

/-- Inverse map of a filter under a partial function. One generalization of `filter.comap` to
partial functions. -/
def pcomap' (f : α →. β) (l : filter β) : filter α :=
filter.rcomap' f.graph' l

/-- Generic "limit of a partial function" predicate. `ptendsto' r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `p`-preimage of `a` is an `l₁`-neighborhood. One generalization of
`filter.tendsto` to partial functions. -/
def ptendsto' (f : α →. β) (l₁ : filter α) (l₂ : filter β) := l₁ ≤ l₂.rcomap' f.graph'

theorem ptendsto'_def (f : α →. β) (l₁ : filter α) (l₂ : filter β) :
  ptendsto' f l₁ l₂ ↔ ∀ s ∈ l₂, f.preimage s ∈ l₁ :=
rtendsto'_def _ _ _

theorem ptendsto_of_ptendsto' {f : α →. β} {l₁ : filter α} {l₂ : filter β} :
  ptendsto' f l₁ l₂ → ptendsto f l₁ l₂ :=
begin
  rw [ptendsto_def, ptendsto'_def],
  exact λ h s sl₂, mem_of_superset (h s sl₂) (pfun.preimage_subset_core _ _),
end

theorem ptendsto'_of_ptendsto {f : α →. β} {l₁ : filter α} {l₂ : filter β} (h : f.dom ∈ l₁) :
  ptendsto f l₁ l₂ → ptendsto' f l₁ l₂ :=
begin
  rw [ptendsto_def, ptendsto'_def],
  intros h' s sl₂,
  rw pfun.preimage_eq,
  exact inter_mem (h' s sl₂) h
end

end filter


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen
-/

import tactic.ring
import tactic.abel

/-!
# Boolean rings

A Boolean ring is a ring where multiplication is idempotent. They are equivalent to Boolean
algebras.

## Main declarations

* `boolean_ring`: a typeclass for rings where multiplication is idempotent.
* `boolean_ring.to_boolean_algebra`: every Boolean ring is a Boolean algebra; this definition and
  the `sup` and `inf` notations for `boolean_ring` are localized as instances in the
  `boolean_algebra_of_boolean_ring` locale.

## Tags

boolean ring, boolean algebra

-/

/-- A Boolean ring is a ring where multiplication is idempotent. -/
class boolean_ring α extends ring α :=
(mul_self : ∀ a : α, a * a = a)

section boolean_ring
variables {α : Type*} [boolean_ring α] (a b : α)

instance : is_idempotent α (*) := ⟨boolean_ring.mul_self⟩

@[simp] lemma mul_self : a * a = a := boolean_ring.mul_self _

@[simp] lemma add_self : a + a = 0 :=
have a + a = a + a + (a + a) :=
  calc a + a = (a+a) * (a+a)           : by rw mul_self
         ... = a*a + a*a + (a*a + a*a) : by rw [add_mul, mul_add]
         ... = a + a + (a + a)         : by rw mul_self,
by rwa self_eq_add_left at this

@[simp] lemma neg_eq : -a = a :=
calc -a = -a + 0      : by rw add_zero
    ... = -a + -a + a : by rw [←neg_add_self, add_assoc]
    ... = a           : by rw [add_self, zero_add]

lemma add_eq_zero : a + b = 0 ↔ a = b :=
calc a + b = 0 ↔ a = -b : add_eq_zero_iff_eq_neg
           ... ↔ a = b  : by rw neg_eq

@[simp] lemma mul_add_mul : a*b + b*a = 0 :=
have a + b = a + b + (a*b + b*a) :=
  calc a + b = (a + b) * (a + b)       : by rw mul_self
         ... = a*a + a*b + (b*a + b*b) : by rw [add_mul, mul_add, mul_add]
         ... = a + a*b + (b*a + b)     : by simp only [mul_self]
         ... = a + b + (a*b + b*a)     : by abel,
by rwa self_eq_add_right at this

@[simp] lemma sub_eq_add : a - b = a + b :=
by rw [sub_eq_add_neg, add_right_inj, neg_eq]

@[simp] lemma mul_one_add_self : a * (1 + a) = 0 := by rw [mul_add, mul_one, mul_self, add_self]

end boolean_ring

namespace boolean_ring
variables {α : Type*} [boolean_ring α]

@[priority 100] -- Note [lower instance priority]
instance : comm_ring α :=
{ mul_comm := λ a b, by rw [←add_eq_zero, mul_add_mul],
  .. (infer_instance : boolean_ring α) }

/-- The join operation in a Boolean ring is `x + y + x*y`. -/
def has_sup : has_sup α := ⟨λ x y, x + y + x*y⟩
/-- The meet operation in a Boolean ring is `x * y`. -/
def has_inf : has_inf α := ⟨(*)⟩

-- Note [lower instance priority]
localized "attribute [instance, priority 100] boolean_ring.has_sup" in
  boolean_algebra_of_boolean_ring
localized "attribute [instance, priority 100] boolean_ring.has_inf" in
  boolean_algebra_of_boolean_ring

lemma sup_comm (a b : α) : a ⊔ b = b ⊔ a := by { dsimp only [(⊔)], ring }
lemma inf_comm (a b : α) : a ⊓ b = b ⊓ a := by { dsimp only [(⊓)], ring }

lemma sup_assoc (a b c : α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) := by { dsimp only [(⊔)], ring }
lemma inf_assoc (a b c : α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by { dsimp only [(⊓)], ring }

lemma sup_inf_self (a b : α) : a ⊔ a ⊓ b = a :=
by { dsimp only [(⊔), (⊓)], assoc_rw [mul_self, add_self, add_zero] }
lemma inf_sup_self (a b : α) : a ⊓ (a ⊔ b) = a :=
by { dsimp only [(⊔), (⊓)], assoc_rw [mul_add, mul_add, mul_self, mul_self, add_self, add_zero] }

lemma le_sup_inf (a b c : α) : (a ⊔ b) ⊓ (a ⊔ c) ⊔ (a ⊔ b ⊓ c) = a ⊔ b ⊓ c :=
by { dsimp only [(⊔), (⊓)], rw [le_sup_inf_aux, add_self, mul_self, zero_add] }

/-- The "set difference" operation in a Boolean ring is `x * (1 + y)`. -/
def has_sdiff : has_sdiff α := ⟨λ a b, a * (1 + b)⟩
/-- The bottom element of a Boolean ring is `0`. -/
def has_bot : has_bot α := ⟨0⟩

localized "attribute [instance, priority 100] boolean_ring.has_sdiff" in
  boolean_algebra_of_boolean_ring
localized "attribute [instance, priority 100] boolean_ring.has_bot" in
  boolean_algebra_of_boolean_ring

lemma sup_inf_sdiff (a b : α) : a ⊓ b ⊔ a \ b = a :=
calc a * b + a * (1 + b) + (a * b) * (a * (1 + b)) =
       a * b + a * (1 + b) + a * a * (b * (1 + b)) : by ac_refl
... = a * b + (a + a * b)           : by rw [mul_one_add_self, mul_zero, add_zero, mul_add, mul_one]
... = a + (a * b + a * b)                          : by ac_refl
... = a                                            : by rw [add_self, add_zero]

lemma inf_inf_sdiff (a b : α) : a ⊓ b ⊓ (a \ b) = ⊥ :=
calc a * b * (a * (1 + b)) = a * a * (b * (1 + b)) : by ac_refl
                       ... = 0                     : by rw [mul_one_add_self, mul_zero]

/--
The Boolean algebra structure on a Boolean ring.

The data is defined so that:
* `a ⊔ b` unfolds to `a + b + a * b`
* `a ⊓ b` unfolds to `a * b`
* `a ≤ b` unfolds to `a + b + a * b = b`
* `⊥` unfolds to `0`
* `⊤` unfolds to `1`
* `aᶜ` unfolds to `1 + a`
* `a \ b` unfolds to `a * (1 + b)`
-/
def to_boolean_algebra : boolean_algebra α :=
{ le_sup_inf := le_sup_inf,
  top := 1,
  le_top := λ a, show a + 1 + a * 1 = 1, by assoc_rw [mul_one, add_comm, add_self, add_zero],
  bot_le := λ a, show 0 + a + 0 * a = a, by rw [zero_mul, zero_add, add_zero],
  compl := λ a, 1 + a,
  sup_inf_sdiff := sup_inf_sdiff,
  inf_inf_sdiff := inf_inf_sdiff,
  inf_compl_le_bot := λ a,
    show a*(1+a) + 0 + a*(1+a)*0 = 0,
    by norm_num [mul_add, mul_self, add_self],
  top_le_sup_compl := λ a,
    begin
      change 1 + (a + (1+a) + a*(1+a)) + 1*(a + (1+a) + a*(1+a)) = a + (1+a) + a*(1+a),
      norm_num [mul_add, mul_self],
      rw [←add_assoc, add_self],
    end,
  sdiff_eq := λ a b, rfl,
  .. lattice.mk' sup_comm sup_assoc inf_comm inf_assoc sup_inf_self inf_sup_self,
  .. has_sdiff,
  .. has_bot }

localized "attribute [instance, priority 100] boolean_ring.to_boolean_algebra" in
  boolean_algebra_of_boolean_ring

end boolean_ring


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.basic
import Mathlib.algebra.group.basic
import Mathlib.algebra.group.hom
import Mathlib.algebra.group.pi
import Mathlib.algebra.group.prod
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/

namespace equiv

namespace perm

protected instance perm_group {α : Type u} : group (perm α) :=
  group.mk (fun (f g : perm α) => equiv.trans g f) sorry (equiv.refl α) sorry sorry equiv.symm
    (div_inv_monoid.div._default (fun (f g : perm α) => equiv.trans g f) sorry (equiv.refl α) sorry sorry equiv.symm)
    sorry

theorem mul_apply {α : Type u} (f : perm α) (g : perm α) (x : α) : coe_fn (f * g) x = coe_fn f (coe_fn g x) :=
  trans_apply g f x

theorem one_apply {α : Type u} (x : α) : coe_fn 1 x = x :=
  rfl

@[simp] theorem inv_apply_self {α : Type u} (f : perm α) (x : α) : coe_fn (f⁻¹) (coe_fn f x) = x :=
  symm_apply_apply f x

@[simp] theorem apply_inv_self {α : Type u} (f : perm α) (x : α) : coe_fn f (coe_fn (f⁻¹) x) = x :=
  apply_symm_apply f x

theorem one_def {α : Type u} : 1 = equiv.refl α :=
  rfl

theorem mul_def {α : Type u} (f : perm α) (g : perm α) : f * g = equiv.trans g f :=
  rfl

theorem inv_def {α : Type u} (f : perm α) : f⁻¹ = equiv.symm f :=
  rfl

@[simp] theorem coe_mul {α : Type u} (f : perm α) (g : perm α) : ⇑(f * g) = ⇑f ∘ ⇑g :=
  rfl

@[simp] theorem coe_one {α : Type u} : ⇑1 = id :=
  rfl

theorem eq_inv_iff_eq {α : Type u} {f : perm α} {x : α} {y : α} : x = coe_fn (f⁻¹) y ↔ coe_fn f x = y :=
  eq_symm_apply f

theorem inv_eq_iff_eq {α : Type u} {f : perm α} {x : α} {y : α} : coe_fn (f⁻¹) x = y ↔ x = coe_fn f y :=
  symm_apply_eq f

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] theorem trans_one {α : Sort u_1} {β : Type u_2} (e : α ≃ β) : equiv.trans e 1 = e :=
  trans_refl e

@[simp] theorem mul_refl {α : Type u} (e : perm α) : e * equiv.refl α = e :=
  trans_refl e

@[simp] theorem one_symm {α : Type u} : equiv.symm 1 = 1 :=
  refl_symm

@[simp] theorem refl_inv {α : Type u} : equiv.refl α⁻¹ = 1 :=
  refl_symm

@[simp] theorem one_trans {α : Type u_1} {β : Sort u_2} (e : α ≃ β) : equiv.trans 1 e = e :=
  refl_trans e

@[simp] theorem refl_mul {α : Type u} (e : perm α) : equiv.refl α * e = e :=
  refl_trans e

@[simp] theorem inv_trans {α : Type u} (e : perm α) : equiv.trans (e⁻¹) e = 1 :=
  symm_trans e

@[simp] theorem mul_symm {α : Type u} (e : perm α) : e * equiv.symm e = 1 :=
  symm_trans e

@[simp] theorem trans_inv {α : Type u} (e : perm α) : equiv.trans e (e⁻¹) = 1 :=
  trans_symm e

@[simp] theorem symm_mul {α : Type u} (e : perm α) : equiv.symm e * e = 1 :=
  trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] theorem sum_congr_mul {α : Type u_1} {β : Type u_2} (e : perm α) (f : perm β) (g : perm α) (h : perm β) : sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
  sum_congr_trans g h e f

@[simp] theorem sum_congr_inv {α : Type u_1} {β : Type u_2} (e : perm α) (f : perm β) : sum_congr e f⁻¹ = sum_congr (e⁻¹) (f⁻¹) :=
  sum_congr_symm e f

@[simp] theorem sum_congr_one {α : Type u_1} {β : Type u_2} : sum_congr 1 1 = 1 :=
  sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
def sum_congr_hom (α : Type u_1) (β : Type u_2) : perm α × perm β →* perm (α ⊕ β) :=
  monoid_hom.mk (fun (a : perm α × perm β) => sum_congr (prod.fst a) (prod.snd a)) sum_congr_one sorry

theorem sum_congr_hom_injective {α : Type u_1} {β : Type u_2} : function.injective ⇑(sum_congr_hom α β) := sorry

@[simp] theorem sum_congr_swap_one {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] (i : α) (j : α) : sum_congr (swap i j) 1 = swap (sum.inl i) (sum.inl j) :=
  sum_congr_swap_refl i j

@[simp] theorem sum_congr_one_swap {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] (i : β) (j : β) : sum_congr 1 (swap i j) = swap (sum.inr i) (sum.inr j) :=
  sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] theorem sigma_congr_right_mul {α : Type u_1} {β : α → Type u_2} (F : (a : α) → perm (β a)) (G : (a : α) → perm (β a)) : sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
  sigma_congr_right_trans G F

@[simp] theorem sigma_congr_right_inv {α : Type u_1} {β : α → Type u_2} (F : (a : α) → perm (β a)) : sigma_congr_right F⁻¹ = sigma_congr_right fun (a : α) => F a⁻¹ :=
  sigma_congr_right_symm F

@[simp] theorem sigma_congr_right_one {α : Type u_1} {β : α → Type u_2} : sigma_congr_right 1 = 1 :=
  sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
def sigma_congr_right_hom {α : Type u_1} (β : α → Type u_2) : ((a : α) → perm (β a)) →* perm (sigma fun (a : α) => β a) :=
  monoid_hom.mk sigma_congr_right sorry sorry

theorem sigma_congr_right_hom_injective {α : Type u_1} {β : α → Type u_2} : function.injective ⇑(sigma_congr_right_hom β) := sorry

end perm

@[simp] theorem swap_inv {α : Type u} [DecidableEq α] (x : α) (y : α) : swap x y⁻¹ = swap x y :=
  rfl

@[simp] theorem swap_mul_self {α : Type u} [DecidableEq α] (i : α) (j : α) : swap i j * swap i j = 1 :=
  swap_swap i j

theorem swap_mul_eq_mul_swap {α : Type u} [DecidableEq α] (f : perm α) (x : α) (y : α) : swap x y * f = f * swap (coe_fn (f⁻¹) x) (coe_fn (f⁻¹) y) := sorry

theorem mul_swap_eq_swap_mul {α : Type u} [DecidableEq α] (f : perm α) (x : α) (y : α) : f * swap x y = swap (coe_fn f x) (coe_fn f y) * f := sorry

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp] theorem swap_mul_self_mul {α : Type u} [DecidableEq α] (i : α) (j : α) (σ : perm α) : swap i j * (swap i j * σ) = σ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (swap i j * (swap i j * σ) = σ)) (Eq.symm (mul_assoc (swap i j) (swap i j) σ))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (swap i j * swap i j * σ = σ)) (swap_mul_self i j)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * σ = σ)) (one_mul σ))) (Eq.refl σ)))

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp] theorem mul_swap_mul_self {α : Type u} [DecidableEq α] (i : α) (j : α) (σ : perm α) : σ * swap i j * swap i j = σ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (σ * swap i j * swap i j = σ)) (mul_assoc σ (swap i j) (swap i j))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (σ * (swap i j * swap i j) = σ)) (swap_mul_self i j)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (σ * 1 = σ)) (mul_one σ))) (Eq.refl σ)))

/-- A stronger version of `mul_right_injective` -/
@[simp] theorem swap_mul_involutive {α : Type u} [DecidableEq α] (i : α) (j : α) : function.involutive (Mul.mul (swap i j)) :=
  swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp] theorem mul_swap_involutive {α : Type u} [DecidableEq α] (i : α) (j : α) : function.involutive fun (_x : perm α) => _x * swap i j :=
  mul_swap_mul_self i j

theorem swap_mul_eq_iff {α : Type u} [DecidableEq α] {i : α} {j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j := sorry

theorem mul_swap_eq_iff {α : Type u} [DecidableEq α] {i : α} {j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j := sorry

theorem swap_mul_swap_mul_swap {α : Type u} [DecidableEq α] {x : α} {y : α} {z : α} (hwz : x ≠ y) (hxz : x ≠ z) : swap y z * swap x y * swap y z = swap z x := sorry


import tactic
import binary
import hamming
import binary_codes
import algebra.module.submodule

/-!
# Linear Binary Codes

This file contains the definition of a linear binary code.
We also use this definition to formalize the Hamming(7,4) code
and some of its properties.
-/

open B BW binary_code

structure linear_binary_code (n M d : ℕ) extends binary_code n M d :=
  (is_subspace : subspace B (BW n))

def H74C : finset (BW 7) := {
  val := {
    ᴮ[O,O,O,O,O,O,O],
    ᴮ[I,I,O,I,O,O,I],
    ᴮ[O,I,O,I,O,I,O],
    ᴮ[I,O,O,O,O,I,I],
    ᴮ[I,O,O,I,I,O,O],
    ᴮ[O,I,O,O,I,O,I],
    ᴮ[I,I,O,O,I,I,O],
    ᴮ[O,O,O,I,I,I,I],
    ᴮ[I,I,I,O,O,O,O],
    ᴮ[O,O,I,I,O,O,I],
    ᴮ[I,O,I,I,O,I,O],
    ᴮ[O,I,I,O,O,I,I],
    ᴮ[O,I,I,I,I,O,O],
    ᴮ[I,O,I,O,I,O,I],
    ᴮ[O,O,I,O,I,I,O],
    ᴮ[I,I,I,I,I,I,I]
  },
  nodup := by simp,
}

def hamming74Code : linear_binary_code 7 16 3 :=
{
  cws := H74C,
  has_card_M := rfl,
  card_gte := by {have : H74C.card = 16, from rfl, linarith},
  has_min_distance_d := rfl,
  is_subspace := {
    carrier := H74C,
    zero_mem' := by {simp, left, refl},
    add_mem' := begin
      rintros a b
        (rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | ha)
        (rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | hb),
        all_goals {
          try {rw list.eq_of_mem_singleton ha},
          try {rw list.eq_of_mem_singleton hb},
          repeat {{left, refl} <|> right <|> refl},
        },
        all_goals {simp, refl},
    end,
    smul_mem' := begin
      intros c x x_mem,
      cases c,
        {conv {congr, apply_congr zero_smul}, simp, left, refl},
        {conv {congr, apply_congr one_smul}, exact x_mem}
    end,
  },
}

lemma hamming74Code_2_error_detecting :
  hamming74Code.to_binary_code.error_detecting 2 :=
begin
  rw [s_error_detecting_iff_min_distance_gt_s, hamming74Code.has_min_distance_d],
  linarith,
end

lemma hamming74Code_1_error_correcting :
  hamming74Code.to_binary_code.error_correcting 1 :=
begin
  rw [t_error_correcting_iff_min_distance_gte, hamming74Code.has_min_distance_d],
  linarith,
end

lemma hamming74Code_perfect :
  hamming74Code.to_binary_code.perfect :=
begin
  unfold perfect,
  rw [hamming74Code.has_card_M],
  simp,
  refl,
end


import tactic

-- set_option trace.simp_lemmas true
set_option trace.simplify.rewrite true

inductive sorted : list ℕ → Prop
| nil : sorted []
| single {x : ℕ} : sorted [x]
| two_or_more {x y : ℕ} {zs : list ℕ} (hle : x ≤ y)
    (hsorted : sorted (y :: zs)) :
  sorted (x :: y :: zs)

lemma sorted_3_5 :
  sorted [3, 5] :=
begin
  apply sorted.two_or_more, -- give us two goals:
  -- ⊢ 3 ≤ 5
  exact dec_trivial,
  -- ⊢ sorted [5]
  exact sorted.single,
end

lemma sorted_3_5₂ :
  sorted [3, 5] :=
sorted.two_or_more dec_trivial sorted.single
-- of_as_true : ∀ {c : Prop} [h₁ : decidable c], as_true c → c

lemma sorted_3_5₃ :
  sorted [3, 5] :=
sorted.two_or_more (of_as_true trivial) sorted.single

-- Some strange tries:

-- example : dec_trivial = of_as_true trivial := lean doesn't support that kind of proving?

-- example : sorted_3_5 ↔ sorted_3_5₂ := wrong
-- example (h1 : sorted_3_5) (h2 : sorted_3_5₂): h1 ↔ h2 := wrong

lemma sorted_7_9_9_11:
  sorted [7, 9, 9, 11] :=
sorted.two_or_more dec_trivial
  (
    sorted.two_or_more dec_trivial
    (
      sorted.two_or_more dec_trivial sorted.single
    )
  )

lemma sorted_7_9_9_11₂:
  sorted [7, 9, 9, 11,15,666,1000] :=
begin
  -- backward_chaining, -- unknown identifier 'backward_chaining'
  repeat {
    constructor,
    exact dec_trivial,
    try { exact sorted.single }
  },
    -- simp [sorted.two_or_more, sorted.single],
  /-
  simp see only that rules:
    list.nil_subset
    list.subset.refl
    list.subset_cons
    list.subset_append_left
    list.subset_append_right
  -/
end

example (x): 15 ≤ x → sorted [7, 9, 9, 11, 15, x] :=
begin
  assume h : 15 ≤ x,
   repeat {
    constructor,
    exact dec_trivial,
    try { exact sorted.single }
  },
  -- exact sorted.two_or_more (h : 15 ≤ x) (sorted.single : sorted [x]),
  apply sorted.two_or_more; exact sorted.single <|> assumption,
  tactic.trace_result,
end

example (x): x ≤ 15 ∧ 11 ≤ x → sorted [7, 9, 9, 11, x, 15] :=
begin
  assume h : x ≤ 15 ∧ 11 ≤ x,
  have h₁ := h.1, have h₂ := h.2, -- for good working assumption
   repeat {
    constructor,
    exact dec_trivial,
    try { exact sorted.single }
  },
  show_term { apply sorted.two_or_more; exact sorted.single <|> assumption <|> skip, },
  show_term { apply sorted.two_or_more; exact sorted.single <|> assumption <|> skip, },
  tactic.trace_result,
end

namespace helper
lemma sorted_nil : sorted [] := sorry
lemma sorted_single (n : ℕ): sorted [n] := sorry
lemma sorted_two_or_more
  (n m : ℕ) (ls : list ℕ)
  (hsorted : sorted (m :: ls)) :
    sorted (n :: m :: ls) := sorry
end helper

lemma ex1 : sorted [] :=
begin
  exact helper.sorted_nil,
end

#print ex1

lemma ex2 : sorted [] :=
begin
  simp only [helper.sorted_nil],
  -- [helper.sorted_nil]: sorted list.nil ==> true
  -- (id (propext (iff_true_intro helper.sorted_nil))).mpr trivial
end
#print ex2

lemma ex2' : sorted [] :=
begin
  simp only [sorted.nil],
  -- [sorted.nil]: sorted list.nil ==> true
  -- (id (propext (iff_true_intro sorted.nil))).mpr trivial
end
#print ex2'

lemma ex3 : sorted [1] ∧ sorted [] :=
begin
  simp only [sorted.nil, sorted.single, and_self],
end
#print ex3

lemma ex4 : sorted [1, 2] :=
begin
  -- library_search [sorted.two_or_more], not works
  -- have H : sorted [1],
  --   exact sorted.single,
  repeat {
    constructor,
    linarith,
    simp only [sorted.nil, sorted.single],
  },
end
#print ex4 -- proof is too long :( >> sorted.two_or_more (of_as_true trivial) sorted.single

lemma ex4' : sorted [1, 2] :=
  sorted.two_or_more dec_trivial sorted.single

#print ex4' -- sorted.two_or_more (of_as_true trivial) sorted.single

lemma ex5 : sorted [40, 70] :=
begin
  -- library_search [sorted.two_or_more], not works
  -- have H : sorted [1],
  --   exact sorted.single,
  repeat {
    constructor,
    linarith,
    simp only [sorted.single],
  },
end

lemma ex6 : sorted [1, 2, 3] :=
begin
  constructor,
  simp,
  constructor,
  simp,
  exact sorted.single,
end
#print ex6
/-
sorted_lists.lean:132:0: information print result
theorem ex6 : sorted [1, 2, 3] :=
sorted.two_or_more
  ((id ((propext nat.one_le_bit0_iff).trans (propext (λ {n : ℕ}, iff_true_intro nat.succ_pos')))).mpr trivial)
  (sorted.two_or_more ((id (propext nat.bit0_le_bit1_iff)).mpr (le_refl 1)) sorted.single)
-/

lemma ex7 : sorted [1, 2, 3, 4, 5] :=
begin
  repeat {constructor, simp, },
  exact sorted.single,
end
#print ex7
-- GIVE:
/-
sorted.two_or_more
  ((id ((propext nat.one_le_bit0_iff).trans (propext (λ {n : ℕ}, iff_true_intro nat.succ_pos')))).mpr trivial)
  (sorted.two_or_more ((id (propext nat.bit0_le_bit1_iff)).mpr (le_refl 1))
     (sorted.two_or_more ((id ((propext nat.bit1_le_bit0_iff).trans (propext nat.one_lt_bit0_iff))).mpr (le_refl 1))
        (sorted.two_or_more ((id ((propext nat.bit0_le_bit1_iff).trans (propext bit0_le_bit0))).mpr (le_refl 1))
           sorted.single)))
-/
-- EXPECTED:
/-
sorted.two_or_more (of_as_true trivial)
  (sorted.two_or_more (of_as_true trivial)
     (sorted.two_or_more (of_as_true trivial)
        (sorted.two_or_more (of_as_true trivial)
          sorted.single)))
-/

lemma ex7' : sorted [1, 2, 3, 3, 5] :=
begin
  -- constructor_matching _ <=> constructor
  repeat { constructor, exact dec_trivial, },
  exact sorted.single,
end
#print ex7'
/-
theorem ex7' : sorted [1, 2, 3, 3, 5] :=
sorted.two_or_more (of_as_true trivial)
  (sorted.two_or_more (of_as_true trivial)
     (sorted.two_or_more (of_as_true trivial)
        (sorted.two_or_more (of_as_true trivial)
            sorted.single)))
-/
lemma not_sorted_17_13 : ¬ sorted [2, 1] :=
begin
  assume h : sorted [2, 1],
  have h2: 2 ≤ 1 :=
    match h with
    | sorted.two_or_more hle _ := hle
    end,
  have h3: ¬ 2 ≤ 1 :=
    dec_trivial,
  -- contradiction, <=>
  show false, from by cc,
end
#print not_sorted_17_13
/-
sorted_lists.lean:202:0: information print result
theorem not_sorted_17_13 : ¬sorted [2, 1] :=
id
  (λ (h : sorted [2, 1]),
     (false_of_true_eq_false
        ((eq_true_intro
            ((λ (_a : sorted [2, 1]),
                _a.dcases_on (λ (H_1 : [2, 1] = list.nil), list.no_confusion H_1)
                  (λ {x : ℕ} (H_1 : [2, 1] = [x]),
                     list.no_confusion H_1
                       (λ (a : (1.add 0).succ = x), eq.rec (λ (tl_eq : [1] = list.nil), list.no_confusion tl_eq) a))
                  (λ {x y : ℕ} {zs : list ℕ} (hle : x ≤ y) (hsorted : sorted (y :: zs))
                   (H_1 : [2, 1] = x :: y :: zs),
                     list.no_confusion H_1
                       (λ (a : (1.add 0).succ = x),
                          eq.rec
                            (λ (hle : (1.add 0).succ ≤ y) (tl_eq : [1] = y :: zs),
                               list.no_confusion tl_eq
                                 (λ (a : 1 = y),
                                    eq.rec
                                      (λ (hsorted : sorted (1 :: zs)) (hle : (1.add 0).succ ≤ 1)
                                       (tl_eq : list.nil = zs),
                                         eq.rec
                                           (λ (hsorted : sorted [1]) (H_2 : _a == sorted.two_or_more hle hsorted),
                                              id_rhs ((1.add 0).succ ≤ 1) hle)
                                           tl_eq
                                           hsorted)
                                      a
                                      hsorted
                                      hle))
                            a
                            hle))
                  (eq.refl [2, 1])
                  (heq.refl _a))
               h)).symm.trans
           (eq_false_intro (of_as_true trivial)))).elim)
-/


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import set_theory.cardinal_ordinal
import analysis.specific_limits
import data.rat.denumerable
import data.set.intervals.image_preimage

/-!
# The cardinality of the reals

This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 2^ω`.

We shows that `#ℝ ≤ 2^ω` by noting that every real number is determined by a Cauchy-sequence of the
form `ℕ → ℚ`, which has cardinality `2^ω`. To show that `#ℝ ≥ 2^ω` we define an injection from
`{0, 1} ^ ℕ` to `ℝ` with `f ↦ Σ n, f n * (1 / 3) ^ n`.

We conclude that all intervals with distinct endpoints have cardinality continuum.

## Main definitions

* `cardinal.cantor_function` is the function that sends `f` in `{0, 1} ^ ℕ` to `ℝ` by
  `f ↦ Σ' n, f n * (1 / 3) ^ n`

## Main statements

* `cardinal.mk_real : #ℝ = 2 ^ omega`: the reals have cardinality continuum.
* `cardinal.not_countable_real`: the universal set of real numbers is not countable.
  We can use this same proof to show that all the other sets in this file are not countable.
* 8 lemmas of the form `mk_Ixy_real` for `x,y ∈ {i,o,c}` state that intervals on the reals
  have cardinality continuum.

## Tags
continuum, cardinality, reals, cardinality of the reals
-/

open nat set
open_locale cardinal
noncomputable theory

namespace cardinal

variables {c : ℝ} {f g : ℕ → bool} {n : ℕ}

/-- The body of the sum in `cantor_function`.
`cantor_function_aux c f n = c ^ n` if `f n = tt`;
`cantor_function_aux c f n = 0` if `f n = ff`. -/
def cantor_function_aux (c : ℝ) (f : ℕ → bool) (n : ℕ) : ℝ := cond (f n) (c ^ n) 0

@[simp] lemma cantor_function_aux_tt (h : f n = tt) : cantor_function_aux c f n = c ^ n :=
by simp [cantor_function_aux, h]

@[simp] lemma cantor_function_aux_ff (h : f n = ff) : cantor_function_aux c f n = 0 :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_nonneg (h : 0 ≤ c) : 0 ≤ cantor_function_aux c f n :=
by { cases h' : f n; simp [h'], apply pow_nonneg h }

lemma cantor_function_aux_eq (h : f n = g n) :
  cantor_function_aux c f n = cantor_function_aux c g n :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_succ (f : ℕ → bool) :
  (λ n, cantor_function_aux c f (n + 1)) = λ n, c * cantor_function_aux c (λ n, f (n + 1)) n :=
by { ext n, cases h : f (n + 1); simp [h, pow_succ] }

lemma summable_cantor_function (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  summable (cantor_function_aux c f) :=
begin
  apply (summable_geometric_of_lt_1 h1 h2).summable_of_eq_zero_or_self,
  intro n, cases h : f n; simp [h]
end

/-- `cantor_function c (f : ℕ → bool)` is `Σ n, f n * c ^ n`, where `tt` is interpreted as `1` and
`ff` is interpreted as `0`. It is implemented using `cantor_function_aux`. -/
def cantor_function (c : ℝ) (f : ℕ → bool) : ℝ := ∑' n, cantor_function_aux c f n

lemma cantor_function_le (h1 : 0 ≤ c) (h2 : c < 1) (h3 : ∀ n, f n → g n) :
  cantor_function c f ≤ cantor_function c g :=
begin
  apply tsum_le_tsum _ (summable_cantor_function f h1 h2) (summable_cantor_function g h1 h2),
  intro n, cases h : f n, simp [h, cantor_function_aux_nonneg h1],
  replace h3 : g n = tt := h3 n h, simp [h, h3]
end

lemma cantor_function_succ (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  cantor_function c f = cond (f 0) 1 0 + c * cantor_function c (λ n, f (n+1)) :=
begin
  rw [cantor_function, tsum_eq_zero_add (summable_cantor_function f h1 h2)],
  rw [cantor_function_aux_succ, tsum_mul_left, cantor_function_aux, pow_zero],
  refl
end

/-- `cantor_function c` is strictly increasing with if `0 < c < 1/2`, if we endow `ℕ → bool` with a
lexicographic order. The lexicographic order doesn't exist for these infinitary products, so we
explicitly write out what it means. -/
lemma increasing_cantor_function (h1 : 0 < c) (h2 : c < 1 / 2) {n : ℕ} {f g : ℕ → bool}
  (hn : ∀(k < n), f k = g k) (fn : f n = ff) (gn : g n = tt) :
  cantor_function c f < cantor_function c g :=
begin
  have h3 : c < 1, { apply h2.trans, norm_num },
  induction n with n ih generalizing f g,
  { let f_max : ℕ → bool := λ n, nat.rec ff (λ _ _, tt) n,
    have hf_max : ∀n, f n → f_max n,
    { intros n hn, cases n, rw [fn] at hn, contradiction, apply rfl },
    let g_min : ℕ → bool := λ n, nat.rec tt (λ _ _, ff) n,
    have hg_min : ∀n, g_min n → g n,
    { intros n hn, cases n, rw [gn], apply rfl, contradiction },
    apply (cantor_function_le (le_of_lt h1) h3 hf_max).trans_lt,
    refine lt_of_lt_of_le _ (cantor_function_le (le_of_lt h1) h3 hg_min),
    have : c / (1 - c) < 1,
    { rw [div_lt_one, lt_sub_iff_add_lt],
      { convert add_lt_add h2 h2, norm_num },
      rwa sub_pos },
    convert this,
    { rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv,
          ←tsum_geometric_of_lt_1 (le_of_lt h1) h3],
      apply zero_add },
    { convert tsum_eq_single 0 _,
      { apply_instance },
      { intros n hn, cases n, contradiction, refl } } },
  rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3],
  rw [hn 0 $ zero_lt_succ n],
  apply add_lt_add_left, rw mul_lt_mul_left h1, exact ih (λ k hk, hn _ $ succ_lt_succ hk) fn gn
end

/-- `cantor_function c` is injective if `0 < c < 1/2`. -/
lemma cantor_function_injective (h1 : 0 < c) (h2 : c < 1 / 2) :
  function.injective (cantor_function c) :=
begin
  intros f g hfg, classical, by_contra h, revert hfg,
  have : ∃n, f n ≠ g n,
  { rw [←not_forall], intro h', apply h, ext, apply h' },
  let n := nat.find this,
  have hn : ∀ (k : ℕ), k < n → f k = g k,
  { intros k hk, apply of_not_not, exact nat.find_min this hk },
  cases fn : f n,
  { apply ne_of_lt, refine increasing_cantor_function h1 h2 hn fn _,
    apply eq_tt_of_not_eq_ff, rw [←fn], apply ne.symm, exact nat.find_spec this },
  { apply ne_of_gt, refine increasing_cantor_function h1 h2 (λ k hk, (hn k hk).symm) _ fn,
    apply eq_ff_of_not_eq_tt, rw [←fn], apply ne.symm, exact nat.find_spec this }
end

/-- The cardinality of the reals, as a type. -/
lemma mk_real : #ℝ = 2 ^ omega.{0} :=
begin
  apply le_antisymm,
  { rw real.equiv_Cauchy.cardinal_eq,
    apply mk_quotient_le.trans, apply (mk_subtype_le _).trans,
    rw [←power_def, mk_nat, mk_rat, power_self_eq (le_refl _)] },
  { convert mk_le_of_injective (cantor_function_injective _ _),
    rw [←power_def, mk_bool, mk_nat], exact 1 / 3, norm_num, norm_num }
end

/-- The cardinality of the reals, as a set. -/
lemma mk_univ_real : #(set.univ : set ℝ) = 2 ^ omega.{0} :=
by rw [mk_univ, mk_real]

/-- The reals are not countable. -/
lemma not_countable_real : ¬ countable (set.univ : set ℝ) :=
by { rw [countable_iff, not_le, mk_univ_real], apply cantor }

/-- The cardinality of the interval (a, ∞). -/
lemma mk_Ioi_real (a : ℝ) : #(Ioi a) = 2 ^ omega.{0} :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  rw [← not_lt], intro h,
  refine ne_of_lt _ mk_univ_real,
  have hu : Iio a ∪ {a} ∪ Ioi a = set.univ,
  { convert Iic_union_Ioi, exact Iio_union_right },
  rw ← hu,
  refine lt_of_le_of_lt (mk_union_le _ _) _,
  refine lt_of_le_of_lt (add_le_add_right (mk_union_le _ _) _) _,
  have h2 : (λ x, a + a - x) '' Ioi a = Iio a,
  { convert image_const_sub_Ioi _ _, simp },
  rw ← h2,
  refine add_lt_of_lt (cantor _).le _ h,
  refine add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _,
  rw mk_singleton,
  exact one_lt_omega.trans (cantor _)
end

/-- The cardinality of the interval [a, ∞). -/
lemma mk_Ici_real (a : ℝ) : #(Ici a) = 2 ^ omega.{0} :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioi_real a ▸ mk_le_mk_of_subset Ioi_subset_Ici_self)

/-- The cardinality of the interval (-∞, a). -/
lemma mk_Iio_real (a : ℝ) : #(Iio a) = 2 ^ omega.{0} :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h2 : (λ x, a + a - x) '' Iio a = Ioi a,
  { convert image_const_sub_Iio _ _, simp },
  exact mk_Ioi_real a ▸ h2 ▸ mk_image_le
end

/-- The cardinality of the interval (-∞, a]. -/
lemma mk_Iic_real (a : ℝ) : #(Iic a) = 2 ^ omega.{0} :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Iio_real a ▸ mk_le_mk_of_subset Iio_subset_Iic_self)

/-- The cardinality of the interval (a, b). -/
lemma mk_Ioo_real {a b : ℝ} (h : a < b) : #(Ioo a b) = 2 ^ omega.{0} :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h1 : #((λ x, x - a) '' Ioo a b) ≤ #(Ioo a b) := mk_image_le,
  refine le_trans _ h1,
  rw [image_sub_const_Ioo, sub_self],
  replace h := sub_pos_of_lt h,
  have h2 : #(has_inv.inv '' Ioo 0 (b - a)) ≤ #(Ioo 0 (b - a)) := mk_image_le,
  refine le_trans _ h2,
  rw [image_inv_Ioo_0_left h, mk_Ioi_real]
end

/-- The cardinality of the interval [a, b). -/

/-- The cardinality of the interval [a, b]. -/
lemma mk_Icc_real {a b : ℝ} (h : a < b) : #(Icc a b) = 2 ^ omega.{0} :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Icc_self)

/-- The cardinality of the interval (a, b]. -/
lemma mk_Ioc_real {a b : ℝ} (h : a < b) : #(Ioc a b) = 2 ^ omega.{0} :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ioc_self)

end cardinal