/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Patrick Massot
-/
import data.set.intervals.unordered_interval
import data.set.intervals.monoid
import data.set.pointwise.basic
import algebra.order.field.basic
import algebra.order.group.min_max

/-!
# (Pre)images of intervals

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

In this file we prove a bunch of trivial lemmas like “if we add `a` to all points of `[b, c]`,
then we get `[a + b, a + c]`”. For the functions `x ↦ x ± a`, `x ↦ a ± x`, and `x ↦ -x` we prove
lemmas about preimages and images of all intervals. We also prove a few lemmas about images under
`x ↦ a * x`, `x ↦ x * a` and `x ↦ x⁻¹`.
-/

open_locale interval pointwise

variables {α : Type*}

namespace set

section ordered_add_comm_group
variables [ordered_add_comm_group α] (a b c : α)

/-!
### Preimages under `x ↦ a + x`
-/

@[simp] lemma preimage_const_add_Ici : (λ x, a + x) ⁻¹' (Ici b) = Ici (b - a) :=
ext $ λ x, sub_le_iff_le_add'.symm

@[simp] lemma preimage_const_add_Ioi : (λ x, a + x) ⁻¹' (Ioi b) = Ioi (b - a) :=
ext $ λ x, sub_lt_iff_lt_add'.symm

@[simp] lemma preimage_const_add_Iic : (λ x, a + x) ⁻¹' (Iic b) = Iic (b - a) :=
ext $ λ x, le_sub_iff_add_le'.symm

@[simp] lemma preimage_const_add_Iio : (λ x, a + x) ⁻¹' (Iio b) = Iio (b - a) :=
ext $ λ x, lt_sub_iff_add_lt'.symm

@[simp] lemma preimage_const_add_Icc : (λ x, a + x) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_const_add_Ico : (λ x, a + x) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_const_add_Ioc : (λ x, a + x) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_const_add_Ioo : (λ x, a + x) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
by simp [← Ioi_inter_Iio]

/-!
### Preimages under `x ↦ x + a`
-/

@[simp] lemma preimage_add_const_Ici : (λ x, x + a) ⁻¹' (Ici b) = Ici (b - a) :=
ext $ λ x, sub_le_iff_le_add.symm

@[simp] lemma preimage_add_const_Ioi : (λ x, x + a) ⁻¹' (Ioi b) = Ioi (b - a) :=
ext $ λ x, sub_lt_iff_lt_add.symm

@[simp] lemma preimage_add_const_Iic : (λ x, x + a) ⁻¹' (Iic b) = Iic (b - a) :=
ext $ λ x, le_sub_iff_add_le.symm

@[simp] lemma preimage_add_const_Iio : (λ x, x + a) ⁻¹' (Iio b) = Iio (b - a) :=
ext $ λ x, lt_sub_iff_add_lt.symm

@[simp] lemma preimage_add_const_Icc : (λ x, x + a) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_add_const_Ico : (λ x, x + a) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_add_const_Ioc : (λ x, x + a) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_add_const_Ioo : (λ x, x + a) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
by simp [← Ioi_inter_Iio]

/-!
### Preimages under `x ↦ -x`
-/

@[simp] lemma preimage_neg_Ici : - Ici a = Iic (-a) := ext $ λ x, le_neg
@[simp] lemma preimage_neg_Iic : - Iic a = Ici (-a) := ext $ λ x, neg_le
@[simp] lemma preimage_neg_Ioi : - Ioi a = Iio (-a) := ext $ λ x, lt_neg
@[simp] lemma preimage_neg_Iio : - Iio a = Ioi (-a) := ext $ λ x, neg_lt

@[simp] lemma preimage_neg_Icc : - Icc a b = Icc (-b) (-a) :=
by simp [← Ici_inter_Iic, inter_comm]

@[simp] lemma preimage_neg_Ico : - Ico a b = Ioc (-b) (-a) :=
by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, inter_comm]

@[simp] lemma preimage_neg_Ioc : - Ioc a b = Ico (-b) (-a) :=
by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]

@[simp] lemma preimage_neg_Ioo : - Ioo a b = Ioo (-b) (-a) :=
by simp [← Ioi_inter_Iio, inter_comm]

/-!
### Preimages under `x ↦ x - a`
-/

@[simp] lemma preimage_sub_const_Ici : (λ x, x - a) ⁻¹' (Ici b) = Ici (b + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Ioi : (λ x, x - a) ⁻¹' (Ioi b) = Ioi (b + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Iic : (λ x, x - a) ⁻¹' (Iic b) = Iic (b + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Iio : (λ x, x - a) ⁻¹' (Iio b) = Iio (b + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Icc : (λ x, x - a) ⁻¹' (Icc b c) = Icc (b + a) (c + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Ico : (λ x, x - a) ⁻¹' (Ico b c) = Ico (b + a) (c + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Ioc : (λ x, x - a) ⁻¹' (Ioc b c) = Ioc (b + a) (c + a) :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_sub_const_Ioo : (λ x, x - a) ⁻¹' (Ioo b c) = Ioo (b + a) (c + a) :=
by simp [sub_eq_add_neg]

/-!
### Preimages under `x ↦ a - x`
-/

@[simp]

@[simp] lemma preimage_const_sub_Iic : (λ x, a - x) ⁻¹' (Iic b) = Ici (a - b) :=
ext $ λ x, sub_le_comm

@[simp] lemma preimage_const_sub_Ioi : (λ x, a - x) ⁻¹' (Ioi b) = Iio (a - b) :=
ext $ λ x, lt_sub_comm

@[simp] lemma preimage_const_sub_Iio : (λ x, a - x) ⁻¹' (Iio b) = Ioi (a - b) :=
ext $ λ x, sub_lt_comm

@[simp] lemma preimage_const_sub_Icc : (λ x, a - x) ⁻¹' (Icc b c) = Icc (a - c) (a - b) :=
by simp [← Ici_inter_Iic, inter_comm]

@[simp] lemma preimage_const_sub_Ico : (λ x, a - x) ⁻¹' (Ico b c) = Ioc (a - c) (a - b) :=
by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]

@[simp] lemma preimage_const_sub_Ioc : (λ x, a - x) ⁻¹' (Ioc b c) = Ico (a - c) (a - b) :=
by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]

@[simp] lemma preimage_const_sub_Ioo : (λ x, a - x) ⁻¹' (Ioo b c) = Ioo (a - c) (a - b) :=
by simp [← Ioi_inter_Iio, inter_comm]

/-!
### Images under `x ↦ a + x`
-/

@[simp] lemma image_const_add_Iic : (λ x, a + x) '' Iic b = Iic (a + b) :=
by simp [add_comm]

@[simp] lemma image_const_add_Iio : (λ x, a + x) '' Iio b = Iio (a + b) :=
by simp [add_comm]

/-!
### Images under `x ↦ x + a`
-/

@[simp] lemma image_add_const_Iic : (λ x, x + a) '' Iic b = Iic (b + a) := by simp
@[simp] lemma image_add_const_Iio : (λ x, x + a) '' Iio b = Iio (b + a) := by simp

/-!
### Images under `x ↦ -x`
-/

lemma image_neg_Ici : has_neg.neg '' (Ici a) = Iic (-a) := by simp
lemma image_neg_Iic : has_neg.neg '' (Iic a) = Ici (-a) := by simp
lemma image_neg_Ioi : has_neg.neg '' (Ioi a) = Iio (-a) := by simp
lemma image_neg_Iio : has_neg.neg '' (Iio a) = Ioi (-a) := by simp
lemma image_neg_Icc : has_neg.neg '' (Icc a b) = Icc (-b) (-a) := by simp
lemma image_neg_Ico : has_neg.neg '' (Ico a b) = Ioc (-b) (-a) := by simp
lemma image_neg_Ioc : has_neg.neg '' (Ioc a b) = Ico (-b) (-a) := by simp
lemma image_neg_Ioo : has_neg.neg '' (Ioo a b) = Ioo (-b) (-a) := by simp

/-!
### Images under `x ↦ a - x`
-/

@[simp] lemma image_const_sub_Ici : (λ x, a - x) '' Ici b = Iic (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_const_sub_Iic : (λ x, a - x) '' Iic b = Ici (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

@[simp] lemma image_const_sub_Ioi : (λ x, a - x) '' Ioi b = Iio (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_const_sub_Iio : (λ x, a - x) '' Iio b = Ioi (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

@[simp] lemma image_const_sub_Icc : (λ x, a - x) '' Icc b c = Icc (a - c) (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

@[simp] lemma image_const_sub_Ico : (λ x, a - x) '' Ico b c = Ioc (a - c) (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

@[simp] lemma image_const_sub_Ioc : (λ x, a - x) '' Ioc b c = Ico (a - c) (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

@[simp] lemma image_const_sub_Ioo : (λ x, a - x) '' Ioo b c = Ioo (a - c) (a - b) :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]

/-!
### Images under `x ↦ x - a`
-/

@[simp] lemma image_sub_const_Ici : (λ x, x - a) '' Ici b = Ici (b - a) := by simp [sub_eq_neg_add]
@[simp] lemma image_sub_const_Iic : (λ x, x - a) '' Iic b = Iic (b - a) := by simp [sub_eq_neg_add]
@[simp] lemma image_sub_const_Ioi : (λ x, x - a) '' Ioi b = Ioi (b - a) := by simp [sub_eq_neg_add]
@[simp] lemma image_sub_const_Iio : (λ x, x - a) '' Iio b = Iio (b - a) := by simp [sub_eq_neg_add]

@[simp] lemma image_sub_const_Icc : (λ x, x - a) '' Icc b c = Icc (b - a) (c - a) :=
by simp [sub_eq_neg_add]

@[simp] lemma image_sub_const_Ico : (λ x, x - a) '' Ico b c = Ico (b - a) (c - a) :=
by simp [sub_eq_neg_add]

@[simp] lemma image_sub_const_Ioc : (λ x, x - a) '' Ioc b c = Ioc (b - a) (c - a) :=
by simp [sub_eq_neg_add]

@[simp] lemma image_sub_const_Ioo : (λ x, x - a) '' Ioo b c = Ioo (b - a) (c - a) :=
by simp [sub_eq_neg_add]

/-!
### Bijections
-/

lemma Iic_add_bij : bij_on (+a) (Iic b) (Iic (b + a)) :=
image_add_const_Iic a b ▸ ((add_left_injective _).inj_on _).bij_on_image

lemma Iio_add_bij : bij_on (+a) (Iio b) (Iio (b + a)) :=
image_add_const_Iio a b ▸ ((add_left_injective _).inj_on _).bij_on_image

end ordered_add_comm_group

section linear_ordered_add_comm_group
variables [linear_ordered_add_comm_group α] (a b c d : α)

@[simp] lemma preimage_const_add_uIcc : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
by simp only [←Icc_min_max, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]

@[simp] lemma preimage_add_const_uIcc : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
by simpa only [add_comm] using preimage_const_add_uIcc a b c

@[simp] lemma preimage_neg_uIcc : - [a, b] = [-a, -b] :=
by simp only [←Icc_min_max, preimage_neg_Icc, min_neg_neg, max_neg_neg]

@[simp] lemma preimage_sub_const_uIcc : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_const_sub_uIcc : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
by { simp_rw [←Icc_min_max, preimage_const_sub_Icc],
  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }

@[simp] lemma image_const_add_uIcc : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
by simp [add_comm]

@[simp] lemma image_add_const_uIcc : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
by simp

@[simp] lemma image_const_sub_uIcc : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_sub_const_uIcc : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
by simp [sub_eq_add_neg, add_comm]

lemma image_neg_uIcc : has_neg.neg '' [a, b] = [-a, -b] := by simp

variables {a b c d}

/-- If `[c, d]` is a subinterval of `[a, b]`, then the distance between `c` and `d` is less than or
equal to that of `a` and `b` -/
lemma abs_sub_le_of_uIcc_subset_uIcc (h : [c, d] ⊆ [a, b]) : |d - c| ≤ |b - a| :=
begin
  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
  rw [uIcc_subset_uIcc_iff_le] at h,
  exact sub_le_sub h.2 h.1,
end

/-- If `c ∈ [a, b]`, then the distance between `a` and `c` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_left_of_mem_uIcc (h : c ∈ [a, b]) : |c - a| ≤ |b - a| :=
abs_sub_le_of_uIcc_subset_uIcc $ uIcc_subset_uIcc_left h

/-- If `x ∈ [a, b]`, then the distance between `c` and `b` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_right_of_mem_uIcc (h : c ∈ [a, b]) : |b - c| ≤ |b - a| :=
abs_sub_le_of_uIcc_subset_uIcc $ uIcc_subset_uIcc_right h

end linear_ordered_add_comm_group

/-!
### Multiplication and inverse in a field
-/

section linear_ordered_field
variables [linear_ordered_field α] {a : α}

@[simp] lemma preimage_mul_const_Iio (a : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Iio a) = Iio (a / c) :=
ext $ λ x, (lt_div_iff h).symm

@[simp] lemma preimage_mul_const_Ioi (a : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Ioi a) = Ioi (a / c) :=
ext $ λ x, (div_lt_iff h).symm

@[simp] lemma preimage_mul_const_Iic (a : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Iic a) = Iic (a / c) :=
ext $ λ x, (le_div_iff h).symm

@[simp] lemma preimage_mul_const_Ici (a : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Ici a) = Ici (a / c) :=
ext $ λ x, (div_le_iff h).symm

@[simp] lemma preimage_mul_const_Ioo (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
by simp [← Ioi_inter_Iio, h]

@[simp] lemma preimage_mul_const_Ioc (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
by simp [← Ioi_inter_Iic, h]

@[simp] lemma preimage_mul_const_Ico (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
by simp [← Ici_inter_Iio, h]

@[simp] lemma preimage_mul_const_Icc (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
by simp [← Ici_inter_Iic, h]

@[simp] lemma preimage_mul_const_Iio_of_neg (a : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Iio a) = Ioi (a / c) :=
ext $ λ x, (div_lt_iff_of_neg h).symm

@[simp] lemma preimage_mul_const_Ioi_of_neg (a : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Ioi a) = Iio (a / c) :=
ext $ λ x, (lt_div_iff_of_neg h).symm

@[simp] lemma preimage_mul_const_Iic_of_neg (a : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Iic a) = Ici (a / c) :=
ext $ λ x, (div_le_iff_of_neg h).symm

@[simp] lemma preimage_mul_const_Ici_of_neg (a : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Ici a) = Iic (a / c) :=
ext $ λ x, (le_div_iff_of_neg h).symm

@[simp] lemma preimage_mul_const_Ioo_of_neg (a b : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
by simp [← Ioi_inter_Iio, h, inter_comm]

@[simp] lemma preimage_mul_const_Ioc_of_neg (a b : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, h, inter_comm]

@[simp] lemma preimage_mul_const_Ico_of_neg (a b : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, h, inter_comm]

@[simp] lemma preimage_mul_const_Icc_of_neg (a b : α) {c : α} (h : c < 0) :
  (λ x, x * c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
by simp [← Ici_inter_Iic, h, inter_comm]

@[simp] lemma preimage_const_mul_Iio (a : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Iio a) = Iio (a / c) :=
ext $ λ x, (lt_div_iff' h).symm

@[simp] lemma preimage_const_mul_Ioi (a : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Ioi a) = Ioi (a / c) :=
ext $ λ x, (div_lt_iff' h).symm

@[simp] lemma preimage_const_mul_Iic (a : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Iic a) = Iic (a / c) :=
ext $ λ x, (le_div_iff' h).symm

@[simp] lemma preimage_const_mul_Ici (a : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Ici a) = Ici (a / c) :=
ext $ λ x, (div_le_iff' h).symm

@[simp] lemma preimage_const_mul_Ioo (a b : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
by simp [← Ioi_inter_Iio, h]

@[simp] lemma preimage_const_mul_Ioc (a b : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
by simp [← Ioi_inter_Iic, h]

@[simp] lemma preimage_const_mul_Ico (a b : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
by simp [← Ici_inter_Iio, h]

@[simp] lemma preimage_const_mul_Icc (a b : α) {c : α} (h : 0 < c) :
  ((*) c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
by simp [← Ici_inter_Iic, h]

@[simp] lemma preimage_const_mul_Iio_of_neg (a : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Iio a) = Ioi (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Iio_of_neg a h

@[simp] lemma preimage_const_mul_Ioi_of_neg (a : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Ioi a) = Iio (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Ioi_of_neg a h

@[simp] lemma preimage_const_mul_Iic_of_neg (a : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Iic a) = Ici (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Iic_of_neg a h

@[simp] lemma preimage_const_mul_Ici_of_neg (a : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Ici a) = Iic (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Ici_of_neg a h

@[simp] lemma preimage_const_mul_Ioo_of_neg (a b : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Ioo_of_neg a b h

@[simp] lemma preimage_const_mul_Ioc_of_neg (a b : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Ioc_of_neg a b h

@[simp] lemma preimage_const_mul_Ico_of_neg (a b : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Ico_of_neg a b h

@[simp] lemma preimage_const_mul_Icc_of_neg (a b : α) {c : α} (h : c < 0) :
  ((*) c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
by simpa only [mul_comm] using preimage_mul_const_Icc_of_neg a b h

@[simp] lemma preimage_mul_const_uIcc (ha : a ≠ 0) (b c : α) :
  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
(lt_or_gt_of_ne ha).elim
  (λ h, by simp [←Icc_min_max, h, h.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
  (λ (ha : 0 < a), by simp [←Icc_min_max, ha, ha.le, min_div_div_right, max_div_div_right])

@[simp] lemma preimage_const_mul_uIcc (ha : a ≠ 0) (b c : α) :
  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
by simp only [← preimage_mul_const_uIcc ha, mul_comm]

@[simp] lemma preimage_div_const_uIcc (ha : a ≠ 0) (b c : α) :
  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
by simp only [div_eq_mul_inv, preimage_mul_const_uIcc (inv_ne_zero ha), inv_inv]

@[simp] lemma image_mul_const_uIcc (a b c : α) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
if ha : a = 0 then by simp [ha] else
calc (λ x, x * a) '' [b, c] = (λ x, x * a⁻¹) ⁻¹' [b, c] :
  (units.mk0 a ha).mul_right.image_eq_preimage _
... = (λ x, x / a) ⁻¹' [b, c] : by simp only [div_eq_mul_inv]
... = [b * a, c * a] : preimage_div_const_uIcc ha _ _

@[simp] lemma image_const_mul_uIcc (a b c : α) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
by simpa only [mul_comm] using image_mul_const_uIcc a b c

@[simp] lemma image_div_const_uIcc (a b c : α) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
by simp only [div_eq_mul_inv, image_mul_const_uIcc]

lemma image_mul_right_Icc' (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])

lemma image_mul_right_Icc {a b c : α} (hab : a ≤ b) (hc : 0 ≤ c) :
  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
begin
  cases eq_or_lt_of_le hc,
  { subst c,
    simp [(nonempty_Icc.2 hab).image_const] },
  exact image_mul_right_Icc' a b ‹0 < c›
end

lemma image_mul_left_Icc' {a : α} (h : 0 < a) (b c : α) :
  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
by { convert image_mul_right_Icc' b c h using 1; simp only [mul_comm _ a] }

lemma image_mul_left_Icc {a b c : α} (ha : 0 ≤ a) (hbc : b ≤ c) :
  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
by { convert image_mul_right_Icc hbc ha using 1; simp only [mul_comm _ a] }

lemma image_mul_right_Ioo (a b : α) {c : α} (h : 0 < c) :
  (λ x, x * c) '' Ioo a b = Ioo (a * c) (b * c) :=
((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])

lemma image_mul_left_Ioo {a : α} (h : 0 < a) (b c : α) :
  ((*) a) '' Ioo b c = Ioo (a * b) (a * c) :=
by { convert image_mul_right_Ioo b c h using 1; simp only [mul_comm _ a] }

/-- The (pre)image under `inv` of `Ioo 0 a` is `Ioi a⁻¹`. -/
lemma inv_Ioo_0_left {a : α} (ha : 0 < a) : (Ioo 0 a)⁻¹ = Ioi a⁻¹ :=
begin
  ext x,
  exact ⟨λ h, inv_inv x ▸ (inv_lt_inv ha h.1).2 h.2, λ h, ⟨inv_pos.2 $ (inv_pos.2 ha).trans h,
    inv_inv a ▸ (inv_lt_inv ((inv_pos.2 ha).trans h) (inv_pos.2 ha)).2 h⟩⟩,
end

lemma inv_Ioi {a : α} (ha : 0 < a) : (Ioi a)⁻¹ = Ioo 0 a⁻¹ :=
by rw [inv_eq_iff_eq_inv, inv_Ioo_0_left (inv_pos.2 ha), inv_inv]

lemma image_const_mul_Ioi_zero {k : Type*} [linear_ordered_field k]
  {x : k} (hx : 0 < x) :
  (λ y, x * y) '' Ioi (0 : k) = Ioi 0 :=
by erw [(units.mk0 x hx.ne').mul_left.image_eq_preimage, preimage_const_mul_Ioi 0 (inv_pos.mpr hx),
  zero_div]

/-!
### Images under `x ↦ a * x + b`
-/

@[simp] lemma image_affine_Icc' {a : α} (h : 0 < a) (b c d : α) :
  (λ x, a * x + b) '' Icc c d = Icc (a * c + b) (a * d + b) :=
begin
  suffices : (λ x, x + b) '' ((λ x, a * x) '' Icc c d) = Icc (a * c + b) (a * d + b),
  { rwa set.image_image at this, },
  rw [image_mul_left_Icc' h, image_add_const_Icc],
end

end linear_ordered_field
end set


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.urysohns_lemma
import topology.continuous_function.bounded

/-!
# Metrizability of a normal topological space with second countable topology

In this file we show that a normal topological space with second countable topology `X` is
metrizable: there exists a metric space structure that generates the same topology.

First we prove that `X` can be embedded into `l^∞`, then use this embedding to pull back the metric
space structure.
-/

open set filter metric
open_locale bounded_continuous_function filter topological_space

namespace topological_space

variables (X : Type*) [topological_space X] [normal_space X] [second_countable_topology X]

/-- A normal topological space with second countable topology can be embedded into `l^∞ = ℕ →ᵇ ℝ`.
-/
lemma exists_embedding_l_infty : ∃ f : X → (ℕ →ᵇ ℝ), embedding f :=
begin
  -- Choose a countable basis, and consider the set `s` of pairs of set `(U, V)` such that `U ∈ B`,
  -- `V ∈ B`, and `closure U ⊆ V`.
  rcases exists_countable_basis X with ⟨B, hBc, -, hB⟩,
  set s : set (set X × set X) := {UV ∈ B.prod B| closure UV.1 ⊆ UV.2},
  -- `s` is a countable set.
  haveI : encodable s := ((hBc.prod hBc).mono (inter_subset_left _ _)).to_encodable,
  -- We don't have the space of bounded (possibly discontinuous) functions, so we equip `s`
  -- with the discrete topology and deal with `s →ᵇ ℝ` instead.
  letI : topological_space s := ⊥, haveI : discrete_topology s := ⟨rfl⟩,
  suffices : ∃ f : X → (s →ᵇ ℝ), embedding f,
  { rcases this with ⟨f, hf⟩,
    exact ⟨λ x, (f x).extend (encodable.encode' s) 0, (bounded_continuous_function.isometry_extend
      (encodable.encode' s) (0 : ℕ →ᵇ ℝ)).embedding.comp hf⟩ },
  have hd : ∀ UV : s, disjoint (closure UV.1.1) (UV.1.2ᶜ) :=
    λ UV, disjoint_compl_right.mono_right (compl_subset_compl.2 UV.2.2),
  -- Choose a sequence of `εₙ > 0`, `n : s`, that is bounded above by `1` and tends to zero
  -- along the `cofinite` filter.
  obtain ⟨ε, ε01, hε⟩ : ∃ ε : s → ℝ, (∀ UV, ε UV ∈ Ioc (0 : ℝ) 1) ∧ tendsto ε cofinite (𝓝 0),
  { rcases pos_sum_of_encodable zero_lt_one s with ⟨ε, ε0, c, hεc, hc1⟩,
    refine ⟨ε, λ UV, ⟨ε0 UV, _⟩, hεc.summable.tendsto_cofinite_zero⟩,
    exact (le_has_sum hεc UV $ λ _ _, (ε0 _).le).trans hc1 },
  /- For each `UV = (U, V) ∈ s` we use Urysohn's lemma to choose a function `f UV` that is equal to
  zero on `U` and is equal to `ε UV` on the complement to `V`. -/
  have : ∀ UV : s, ∃ f : C(X, ℝ), eq_on f 0 UV.1.1 ∧ eq_on f (λ _, ε UV) UV.1.2ᶜ ∧
    ∀ x, f x ∈ Icc 0 (ε UV),
  { intro UV,
    rcases exists_continuous_zero_one_of_closed is_closed_closure
      (hB.is_open UV.2.1.2).is_closed_compl (hd UV) with ⟨f, hf₀, hf₁, hf01⟩,
    exact ⟨ε UV • f, λ x hx, by simp [hf₀ (subset_closure hx)], λ x hx, by simp [hf₁ hx],
      λ x, ⟨mul_nonneg (ε01 _).1.le (hf01 _).1, mul_le_of_le_one_right (ε01 _).1.le (hf01 _).2⟩⟩ },
  choose f hf0 hfε hf0ε,
  have hf01 : ∀ UV x, f UV x ∈ Icc (0 : ℝ) 1,
    from λ UV x, Icc_subset_Icc_right (ε01 _).2 (hf0ε _ _),
  /- The embedding is given by `F x UV = f UV x`. -/
  set F : X → s →ᵇ ℝ := λ x, ⟨⟨λ UV, f UV x, continuous_of_discrete_topology⟩, 1, λ UV₁ UV₂,
    real.dist_le_of_mem_Icc_01 (hf01 _ _) (hf01 _ _)⟩,
  have hF : ∀ x UV, F x UV = f UV x := λ _ _, rfl,
  refine ⟨F, embedding.mk' _ (λ x y hxy, _) (λ x, le_antisymm _ _)⟩,
  { /- First we prove that `F` is injective. Indeed, if `F x = F y` and `x ≠ y`, then we can find
    `(U, V) ∈ s` such that `x ∈ U` and `y ∉ V`, hence `F x UV = 0 ≠ ε UV = F y UV`. -/
    refine not_not.1 (λ Hne, _), -- `by_contra Hne` timeouts
    rcases hB.mem_nhds_iff.1 (is_open_ne.mem_nhds Hne) with ⟨V, hVB, hxV, hVy⟩,
    rcases hB.exists_closure_subset (hB.mem_nhds hVB hxV) with ⟨U, hUB, hxU, hUV⟩,
    set UV : ↥s := ⟨(U, V), ⟨hUB, hVB⟩, hUV⟩,
    apply (ε01 UV).1.ne,
    calc (0 : ℝ) = F x UV : (hf0 UV hxU).symm
             ... = F y UV : by rw hxy
             ... = ε UV   : hfε UV (λ h : y ∈ V, hVy h rfl) },
  { /- Now we prove that each neighborhood `V` of `x : X` include a preimage of a neighborhood of
    `F x` under `F`. Without loss of generality, `V` belongs to `B`. Choose `U ∈ B` such that
    `x ∈ V` and `closure V ⊆ U`. Then the preimage of the `(ε (U, V))`-neighborhood of `F x`
    is included by `V`. -/
    refine ((nhds_basis_ball.comap _).le_basis_iff hB.nhds_has_basis).2 _,
    rintro V ⟨hVB, hxV⟩,
    rcases hB.exists_closure_subset (hB.mem_nhds hVB hxV) with ⟨U, hUB, hxU, hUV⟩,
    set UV : ↥s := ⟨(U, V), ⟨hUB, hVB⟩, hUV⟩,
    refine ⟨ε UV, (ε01 UV).1, λ y (hy : dist (F y) (F x) < ε UV), _⟩,
    replace hy : dist (F y UV) (F x UV) < ε UV,
      from (bounded_continuous_function.dist_coe_le_dist _).trans_lt hy,
    contrapose! hy,
    rw [hF, hF, hfε UV hy, hf0 UV hxU, pi.zero_apply, dist_zero_right],
    exact le_abs_self _ },
  { /- Finally, we prove that `F` is continuous. Given `δ > 0`, consider the set `T` of `(U, V) ∈ s`
    such that `ε (U, V) ≥ δ`. Since `ε` tends to zero, `T` is finite. Since each `f` is continuous,
    we can choose a neighborhood such that `dist (F y (U, V)) (F x (U, V)) ≤ δ` for any
    `(U, V) ∈ T`. For `(U, V) ∉ T`, the same inequality is true because both `F y (U, V)` and
    `F x (U, V)` belong to the interval `[0, ε (U, V)]`. -/
    refine (nhds_basis_closed_ball.comap _).ge_iff.2 (λ δ δ0, _),
    have h_fin : finite {UV : s | δ ≤ ε UV}, by simpa only [← not_lt] using hε (gt_mem_nhds δ0),
    have : ∀ᶠ y in 𝓝 x, ∀ UV, δ ≤ ε UV → dist (F y UV) (F x UV) ≤ δ,
    { refine (eventually_all_finite h_fin).2 (λ UV hUV, _),
      exact (f UV).continuous.tendsto x (closed_ball_mem_nhds _ δ0) },
    refine this.mono (λ y hy, (bounded_continuous_function.dist_le δ0.le).2 $ λ UV, _),
    cases le_total δ (ε UV) with hle hle,
    exacts [hy _ hle, (real.dist_le_of_mem_Icc (hf0ε _ _) (hf0ε _ _)).trans (by rwa sub_zero)] }
end

/-- A normal topological space with second countable topology `X` is metrizable: there exists a
metric space structure that generates the same topology. This definition provides a `metric_space`
instance such that the corresponding `topological_space X` instance is definitionally equal
to the original one. -/
@[reducible] noncomputable def to_metric_space : metric_space X :=
@metric_space.replace_uniformity X
  ((uniform_space.comap (exists_embedding_l_infty X).some infer_instance).replace_topology
    (exists_embedding_l_infty X).some_spec.induced)
  (metric_space.induced (exists_embedding_l_infty X).some
    (exists_embedding_l_infty X).some_spec.inj infer_instance)
  rfl

end topological_space


import linear_algebra.matrix
import Tools.matrix_tools
universe variables u v w t
open_locale big_operators matrix
open matrix linear_map
/--
    Technical : `ite (x0 = x ∧ y0 = y) (1 : R) 0 = (ite (x0 = x) 1 0) * (ite (y0 = y) 1 0)`
-/
@[simp]lemma mul_ite_ite  {X : Type u}[fintype X][decidable_eq X] {R : Type v} [comm_ring R]{Y : Type u}
[fintype Y] [decidable_eq Y](x x0 : X) (y0 y : Y) :
    ite (x0 = x ∧ y0 = y) (1 : R) 0 = (ite (x0 = x) 1 0) * (ite (y0 = y) 1 0) :=
begin
    split_ifs,
        {rw mul_one},
        {rw h.2 at h_2, trivial},
        {rw h.1 at h_1,trivial},
        {rw h.1 at h_1,trivial},
        {rw [h_1,h_2] at h,push_neg at h,rcases h, {trivial}, {trivial}},
        {push_neg at h,rcases h,{trivial},{rw mul_zero}},
        {rw zero_mul},
        {rw zero_mul},
end
@[simp]lemma mul_ite_ite'{X : Type u}[fintype X][decidable_eq X] {R : Type v}  [comm_ring R]{Y : Type u}
[fintype Y] [decidable_eq Y](x x0 : X) (y0 y : Y) :
ite (  y0 = y ∧ x0 = x) (1 : R) 0 = (ite (x0 = x) 1 0) * (ite (y0 = y) 1 0) :=
begin
    rw ← mul_ite_ite, apply if_congr _ rfl rfl,exact and.comm,
end

variables {R : Type v}  [comm_ring R]
          {X : Type u}[fintype X][decidable_eq X]
          {Y : Type u}[fintype Y][decidable_eq Y]  -- same universe for matrix.

/--
    Elementary matrix : for `(x0,y0) ∈ X × Y` :
    `ℰ x0 y0 = λ x y, if x0 = x ∧ y0 = y then (1 : R) else 0`
-/
def ℰ : X → Y → X → Y → R := λ x0 y0 x y, if x0 = x ∧ y0 = y then (1 : R) else 0
/--
    Other expression of `ℰ`.
-/
lemma E_eq : (ℰ : X → Y → X → Y → R) = λ x0 y0 x y, (ite (x0 = x) 1 0) * (ite (y0 = y) 1 0)
:=  by ext; {erw ← mul_ite_ite, exact rfl}
/--
    `Transposition` of the elementary matrix.
    `transpose (ℰ x0 y0) = ℰ y0 x0`
-/
lemma E_transpose (x0 : X)(y0 : Y) : transpose (ℰ  x0 y0 : matrix X Y R) = ℰ y0 x0 :=
begin
    ext, rw transpose_val,unfold ℰ ,
    rw mul_ite_ite,
    rw mul_ite_ite,
    rw mul_comm,
end
lemma E_transpose' (x0 : X)(y0 : Y) : transpose (ℰ x0 y0 : matrix X Y R) = ℰ y0 x0 :=
begin
    ext, rw transpose_val,unfold ℰ ,
    apply if_congr _ rfl rfl, exact and.comm,
end
variables ( M : matrix X X R)
/--
    right multiplication by elementary matrix.
    `M ⬝ ℰ x0 y0 = λ x y, if  y0 = y then M x x0 else 0`
-/
@[simp]lemma mul_E (x0 : X)(y0 : Y) : M ⬝ ℰ x0 y0  = λ x y, if  y0 = y then M x x0 else 0 :=
begin
    ext x y, rw matrix.mul_val,
    unfold ℰ, simp  [-mul_ite_ite'],
end

@[simp]lemma mul_E' (x0 : X)(y0 : Y) : M ⬝ ℰ x0 y0  = λ x y, if  y0 = y then M x x0 else 0 :=
begin
    ext x y, rw mul_val,
    unfold ℰ,
    conv_lhs {
        apply_congr,skip,
        rw mul_ite_ite, rw ← mul_assoc, rw mul_ite _ (M x x_1) _ _ , rw mul_zero, rw mul_one,
        rw  ite_mul, rw zero_mul,
    },
    erw finset.sum_ite_eq,simp,
end
/--
     `M ⬝ ℰ x0 y0  = ∑ x, M x x0 • (ℰ x y0)`
-/
@[simp]lemma mul_E_sum (x0 : X)(y0 : Y) : M ⬝ ℰ x0 y0  = ∑ x, M x x0 • (ℰ x y0) :=
begin
    ext x y, rw mul_E,
    unfold ℰ, simp  [-mul_ite_ite'],
end
/--
    left multiplication by elementary matrix.
    `ℰ x0 y0  ⬝ M =  λ x y, if  x0 = x then M y0 y else 0 `
-/
@[simp]lemma E_mul (x0 : X)(y0 : Y) ( M : matrix Y Y R) : (ℰ x0 y0 : matrix X Y R) ⬝ M  =
            λ x y, if  x0 = x then M y0 y else 0 :=
begin
    ext x y, rw matrix.mul_val,
    unfold ℰ, simp,
end
@[simp]lemma E__mul_sum (x0 : X)(y0 : Y) ( M : matrix Y Y R):  (ℰ x0 y0 : matrix X Y R) ⬝ M
=  ∑ y, M y0 y • ℰ  x0 y :=
begin
ext, rw E_mul,unfold ℰ, simp,
end
/--
    middle multiplication by elementary matrix.
     `N ⬝ (ℰ x0 y0 ) ⬝ M = λ x y, N x x0 * M y0 y`
-/
@[simp]theorem mul_E_mul ( N : matrix X X R) (x0 : X)(y0 : Y) ( M : matrix Y Y R) :
 N ⬝ (ℰ x0 y0 ) ⬝ M = λ x y, N x x0 * M y0 y :=
begin
    ext x y,rw mul_E, conv_lhs {
        apply_congr,skip,simp,
    },
    erw finset.sum_ite_eq,
    simp,
 end
theorem mul_E_mul' ( N : matrix X X R) ( x x0 : X)(y y0 : Y) ( M : matrix Y Y R) :
 (N ⬝ (ℰ x0 y0 ) ⬝ M) x y =  N x x0 * M y0 y :=
begin
    rw mul_E_mul,
 end
lemma E_diag (y x: X) : ℰ y y x x = if x=y then (1 : R) else 0 := begin
    unfold ℰ, split_ifs, {exact rfl},{finish},{finish},{exact rfl},
end
lemma E_diag_ne ( y x a : X)(hyp : x ≠ y) : ℰ x y a a = (0 : R) := begin
    unfold ℰ,split_ifs, {finish}, {exact rfl},
end
/--
    Trace of the elementary matrix :  `if x = y then 1 else 0`
-/
 lemma trace_E (x y : X) : matrix.trace X  R R (ℰ x y) = if x = y then (1 : R) else 0 :=
 begin
    rw trace_value,
    split_ifs, rw h,
    conv_lhs {
        apply_congr,skip, rw E_diag,
    },
    erw finset.sum_ite_eq',simp,
    conv_lhs {
        apply_congr,skip, rw E_diag_ne _ _ _ h,
    },
    simp,
 end


import Aesop
import Mathlib.Data.Nat.Basic
import Mathlib.Data.Nat.Interval
import Mathlib.Data.Set.Basic
import Mathlib.Data.Fintype.Card
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.Ring

/-!
# International Mathematical Olympiad 1987, Problem 4

Prove that there is no function f : ℕ → ℕ such that f(f(n)) = n + 1987
for every n.
-/

namespace Imo1987Q4

lemma subset_finite {A B : Set ℕ} (h : A ⊆ B) (hab : Finite ↑B) : Finite ↑A := by
  rw[Set.finite_coe_iff]
  rw[Set.finite_coe_iff] at hab
  exact Set.Finite.subset hab h

lemma subset_fintype {A B : Set ℕ} (h : A ⊆ B) (hab : Fintype ↑B) : Fintype ↑A := by
  exact @Fintype.ofFinite A (subset_finite h (Finite.of_fintype ↑B))

/--
More general version of the problem.
-/
theorem imo1987_q4_generalized (m : ℕ) :
    (¬∃ f : ℕ → ℕ, ∀ n, f (f n) = n + (2 * m + 1)) := by
  -- Informal solution by Sawa Pavlov, listed at
  -- https://artofproblemsolving.com/wiki/index.php/1987_IMO_Problems/Problem_4

  intro hf
  obtain ⟨f, hf⟩ := hf

  -- Note that f is injective, because if f(n) = f(m),
  -- then f(f(n)) = f(f(m)), so m = n.
  have f_injective : f.Injective := by
    intros n m hnm; have hfn := hf n; simp_all only [add_left_inj]

  -- Let A := ℕ - f(ℕ) and B := f(A).
  let NN : Set ℕ := Set.univ
  let A : Set ℕ := NN \ (f '' NN)
  let B : Set ℕ := f '' A

  have hid := Set.image_diff f_injective NN (f '' NN)
  rw[show f '' (NN \ f '' NN) = B by rfl] at hid

  -- A and B are disjoint and have union ℕ - f(f(ℕ)).
  have ab_disjoint : Disjoint A B := by
    intros _C hca hcb c hc
    have hcca := hca hc
    have hccb := hcb hc
    aesop

  have ab_union : A ∪ B = NN \ (f '' (f '' NN)) := by
    rw[hid]
    apply Set.eq_of_subset_of_subset
    · intros x hx
      cases hx <;> aesop
    · intros x hx
      obtain ⟨_hx, hx'⟩ := hx
      cases Classical.em (x ∈ A) <;> aesop

  -- ... which is {0, 1, ... , 2 * m}.
  have ab_range : A ∪ B = {n | n < 2*m + 1} := by
    apply Set.eq_of_subset_of_subset
    · rw[ab_union]
      intros x hx
      simp at hx
      simp
      by_contra H
      push_neg at H
      have hz: ∃ z, x = (2 * m + 1) + z := exists_add_of_le H
      obtain ⟨z, hz⟩ := hz
      rw[hz] at hx
      have hzz := hx z
      rw[hf z] at hzz
      rw[add_comm] at hzz
      exact (hzz rfl).elim
    · rw[ab_union]
      intros x hx
      aesop

  -- But since f is injective they have the
  -- same number of elements, which is impossible since {0, 1, ... , 2 * m}
  -- has an odd number of elements.

  have ab_fintype : Fintype ↑(A ∪ B) := by rw[ab_range]; exact inferInstance

  have h2 : Fintype.card ↑(A ∪ B) = 2 * m + 1 := by
    have hc := @Fintype.card_congr' ↑(A ∪ B)
                  {x | x < 2 * m + 1} _ _ (by rw[ab_range])
    simp only [hc, Fintype.card_ofFinset, Finset.card_range]

  have a_fintype := subset_fintype (Set.subset_union_left A B) ab_fintype
  have b_fintype := subset_fintype (Set.subset_union_right A B) ab_fintype
  have h3 := @Set.toFinset_union ℕ A B _ a_fintype b_fintype ab_fintype
  rw[←@Set.toFinset_card _ (A ∪ B) ab_fintype] at h2
  rw[h3] at h2; clear h3
  have ab_disjoint' :=
    (@Set.disjoint_toFinset _ _ _ a_fintype b_fintype).mpr ab_disjoint
  rw[Finset.card_disjoint_union ab_disjoint'] at h2
  rw[Set.toFinset_card, Set.toFinset_card] at h2
  rw[Set.card_image_of_injective A f_injective] at h2
  ring_nf at h2
  have h4 := congrFun (congrArg HMod.hMod (f_injective (congrArg f h2))) 2
  norm_num at h4

theorem imo1987_q4 : (¬∃ f : ℕ → ℕ, ∀ n, f (f n) = n + 1987) := by
  rw[show 1987 = (2 * 993 + 1) by norm_num]
  exact imo1987_q4_generalized 993


import data.nat.basic
import data.finset.basic
import tactic
import matroid
import finset
import base_of

variables {α : Type*} [fintype α] [decidable_eq α] {m : matroid α} {A B : finset α}

open finset

namespace matroid

lemma circuit_sdiff  : m.circuit A → B ⊆ A → B ≠ ∅ → m.ind (A \ B) :=
begin
  rintro ⟨Anind, Aerase⟩ Bsubset Bnonempty,
  rw ← nonempty_iff_ne_empty at Bnonempty,
  rcases Bnonempty with ⟨x, xB⟩,
  have xA := Bsubset xB,
  refine m.ind_subset _ (A.erase x) _ (Aerase x xA),
  exact sdiff_subset_erase_of_mem xB,
end

lemma circuit_ssubset : m.circuit A → B ⊂ A → m.ind B :=
begin
  rintro ⟨Anind, Aerase⟩ Bsubset,
  rw ssubset_iff at Bsubset,
  rcases Bsubset with ⟨x, xB, x_insert⟩,
  rw insert_subset at x_insert,
  cases x_insert with xA h_subset,
  apply m.ind_subset _ (A.erase x) _ (Aerase x xA),
  rw ← erase_eq_of_not_mem xB,
  exact erase_subset_erase x h_subset,
end

lemma ind_iff_not_contains_circuit (A) : m.ind A ↔ ∀ C, m.circuit C → ¬ C ⊆ A :=
begin
  split, {
    intros Aind C Ccirc hCA,
    refine dep_superset hCA (Ccirc.1) Aind,
  }, {
    intros h,
    by_contradiction Aind,
    suffices subsets_dep : ∀ k ≤ A.card, ∃ B ⊆ A, B.card = k ∧ ¬ m.ind B, {
      obtain ⟨B, Bsub, Bcard, Bdep⟩ := subsets_dep 0 (zero_le _),
      rw [card_eq_zero] at Bcard,
      subst Bcard,
      exact Bdep m.ind_empty,
    },
    intros k k_le_card,
    refine nat.decreasing_induction (λ n, _) k_le_card _, {
      rintro ⟨B, hBA, Bcard, Bdep⟩,
      specialize h B,
      rw imp_not_comm at h,
      specialize h hBA,
      rw circuit at h,
      push_neg at h,
      obtain ⟨x, xAB, h_dep_erase⟩ := h Bdep,
      refine ⟨B.erase x, subset.trans (erase_subset _ _) hBA, _, h_dep_erase⟩,
      rw ← card_erase_of_mem' xAB at Bcard,
      exact nat.succ_inj'.1 Bcard,
    }, {
      use [A, subset.refl _, rfl],
    }
  }
end

lemma dep_iff_contains_circuit (A) : ¬ m.ind A ↔ ∃ C, m.circuit C ∧ C ⊆ A :=
begin
  have h := not_congr (ind_iff_not_contains_circuit A),
  push_neg at h,
  exact h,
end

theorem empty_not_circuit : ¬ m.circuit ∅ := λ ⟨empty_dep, _⟩, empty_dep m.ind_empty

theorem circuit_not_subset {A B} : m.circuit A → m.circuit B → A ⊆ B → A = B :=
begin
  rintro Acirc Bcirc h_subset,
  cases eq_or_ssubset_of_subset h_subset,
  { exact h, },
  {
    exfalso,
    exact Acirc.1 (circuit_ssubset Bcirc h),
  },
end

theorem circuit_common_element {x} (Acirc : m.circuit A) (Bcirc : m.circuit B):
  A ≠ B → x ∈ A → x ∈ B → ∃ C, m.circuit C ∧ C ⊆ ((A ∪ B).erase x) :=
begin
  intros A_neq_B xA xB,
  rw ← dep_iff_contains_circuit,
  intro union_ind,
  have inter_ind : m.ind (A ∩ B), from by {
    rw ind_iff_not_contains_circuit,
    intros C Ccirc Csub,
    have hAC := circuit_not_subset Ccirc Acirc (subset.trans Csub (inter_subset_left _ _)),
    have hBC := circuit_not_subset Ccirc Bcirc (subset.trans Csub (inter_subset_right _ _)),
    exact A_neq_B (eq.trans hAC.symm hBC),
  },
  have tmp : A ∩ B ⊆ A ∪ B := subset.trans (inter_subset_left _ _) (subset_union_left _ _),
  obtain ⟨X, hABX, hXbase_of⟩ := ind_subset_base_of tmp (inter_ind),
  have tmp2 := ind_card_le_base_of_card (erase_subset _ _) union_ind hXbase_of,

  replace tmp2 := nat.add_le_add_right tmp2 1,
  rw [card_erase_of_mem' (mem_union_left _ xA)] at tmp2,
  have tmp3 := card_le_of_subset hXbase_of.1,
  cases eq_or_eq_succ_of_le_and_le_succ tmp3 tmp2, {
    replace h := eq_of_subset_of_card_le (hXbase_of.1) (ge_of_eq h),
    subst h,
    refine (dep_iff_contains_circuit (A ∪ B)).2 _ hXbase_of.2.1,
    use [A, Acirc, subset_union_left _ _],
  }, {
    cases very_important_lemma hABX hXbase_of.1 h.symm, {
      refine (dep_iff_contains_circuit X).2 _ hXbase_of.2.1,
      use [A, Acirc, h_1],
    }, {
      refine (dep_iff_contains_circuit X).2 _ hXbase_of.2.1,
      use [B, Bcirc, h_1],
    }
  }
end

lemma circuit_subset_ind_insert {x} (Aind : m.ind A) (hx : x ∉ A) (Bcirc : m.circuit B) :
  B ⊆ insert x A → x ∈ B :=
begin
  intro Bsub,
  by_contradiction,
  rw [subset_insert_iff, erase_eq_of_not_mem h] at Bsub,
  exact (circuit_dep Bcirc) (ind_subset_def Bsub Aind),
end

theorem base_insert_unique_circuit {x} (Abase : m.base A) (hx : x ∉ A) :
  ∃! C, C ⊆ (insert x A) ∧ m.circuit C :=
begin
  have tmp : ¬ m.ind (insert x A) := Abase.2 x hx,
  obtain ⟨C, Ccirc, Csub⟩ := (dep_iff_contains_circuit _).1 tmp,
  use [C, Csub, Ccirc],
  rintro D ⟨Dsub, Dcirc⟩,
  have Cmem := circuit_subset_ind_insert (Abase.1) hx Ccirc Csub,
  have Dmem := circuit_subset_ind_insert (Abase.1) hx Dcirc Dsub,
  by_contradiction,
  rcases circuit_common_element Dcirc Ccirc h Dmem Cmem with ⟨U, Ucirc, Usub⟩,
  suffices hUA : U ⊆ A, {
    exact (circuit_dep Ucirc) (ind_subset_def hUA Abase.1),
  }, {
    have tmp : (D ∪ C) ⊆ (insert x A) := union_subset Dsub Csub,
    replace tmp := erase_subset_erase x tmp,
    rw erase_insert hx at tmp,
    exact subset.trans Usub tmp,
  }
end

end matroid


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.metric_space.baire
! 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.SpecificLimits.Basic
import Mathbin.Order.Filter.CountableInter
import Mathbin.Topology.GDelta
import Mathbin.Topology.Sets.Compacts

/-!
# Baire theorem

In a complete metric space, a countable intersection of dense open subsets is dense.

The good concept underlying the theorem is that of a Gδ set, i.e., a countable intersection
of open sets. Then Baire theorem can also be formulated as the fact that a countable
intersection of dense Gδ sets is a dense Gδ set. We prove Baire theorem, giving several different
formulations that can be handy. We also prove the important consequence that, if the space is
covered by a countable union of closed sets, then the union of their interiors is dense.

We also define the filter `residual α` generated by dense `Gδ` sets and prove that this filter
has the countable intersection property.
-/

noncomputable section

open Classical Topology Filter ENNReal

open Filter Encodable Set TopologicalSpace

variable {α : Type _} {β : Type _} {γ : Type _} {ι : Type _}

section BaireTheorem

open Emetric ENNReal

/-- The property `baire_space α` means that the topological space `α` has the Baire property:
any countable intersection of open dense subsets is dense.
Formulated here when the source space is ℕ (and subsumed below by `dense_Inter_of_open` working
with any encodable source space).-/
class BaireSpace (α : Type _) [TopologicalSpace α] : Prop where
  baire_property : ∀ f : ℕ → Set α, (∀ n, IsOpen (f n)) → (∀ n, Dense (f n)) → Dense (⋂ n, f n)
#align baire_space BaireSpace

/-- Baire theorems asserts that various topological spaces have the Baire property.
Two versions of these theorems are given.
The first states that complete pseudo_emetric spaces are Baire. -/
instance (priority := 100) baire_category_theorem_emetric_complete [PseudoEMetricSpace α]
    [CompleteSpace α] : BaireSpace α :=
  by
  refine' ⟨fun f ho hd => _⟩
  let B : ℕ → ℝ≥0∞ := fun n => 1 / 2 ^ n
  have Bpos : ∀ n, 0 < B n := by
    intro n
    simp only [B, one_div, one_mul, ENNReal.inv_pos]
    exact pow_ne_top two_ne_top
  /- Translate the density assumption into two functions `center` and `radius` associating
    to any n, x, δ, δpos a center and a positive radius such that
    `closed_ball center radius` is included both in `f n` and in `closed_ball x δ`.
    We can also require `radius ≤ (1/2)^(n+1)`, to ensure we get a Cauchy sequence later. -/
  have : ∀ n x δ, δ ≠ 0 → ∃ y r, 0 < r ∧ r ≤ B (n + 1) ∧ closed_ball y r ⊆ closed_ball x δ ∩ f n :=
    by
    intro n x δ δpos
    have : x ∈ closure (f n) := hd n x
    rcases EMetric.mem_closure_iff.1 this (δ / 2) (ENNReal.half_pos δpos) with ⟨y, ys, xy⟩
    rw [edist_comm] at xy
    obtain ⟨r, rpos, hr⟩ : ∃ r > 0, closed_ball y r ⊆ f n :=
      nhds_basis_closed_eball.mem_iff.1 (isOpen_iff_mem_nhds.1 (ho n) y ys)
    refine' ⟨y, min (min (δ / 2) r) (B (n + 1)), _, _, fun z hz => ⟨_, _⟩⟩
    show 0 < min (min (δ / 2) r) (B (n + 1))
    exact lt_min (lt_min (ENNReal.half_pos δpos) rpos) (Bpos (n + 1))
    show min (min (δ / 2) r) (B (n + 1)) ≤ B (n + 1)
    exact min_le_right _ _
    show z ∈ closed_ball x δ
    exact
      calc
        edist z x ≤ edist z y + edist y x := edist_triangle _ _ _
        _ ≤ min (min (δ / 2) r) (B (n + 1)) + δ / 2 := (add_le_add hz (le_of_lt xy))
        _ ≤ δ / 2 + δ / 2 := (add_le_add (le_trans (min_le_left _ _) (min_le_left _ _)) le_rfl)
        _ = δ := ENNReal.add_halves δ

    show z ∈ f n
    exact
      hr
        (calc
          edist z y ≤ min (min (δ / 2) r) (B (n + 1)) := hz
          _ ≤ r := le_trans (min_le_left _ _) (min_le_right _ _)
          )
  choose! center radius Hpos HB Hball using this
  refine' fun x => (mem_closure_iff_nhds_basis nhds_basis_closed_eball).2 fun ε εpos => _
  /- `ε` is positive. We have to find a point in the ball of radius `ε` around `x` belonging to all
    `f n`. For this, we construct inductively a sequence `F n = (c n, r n)` such that the closed ball
    `closed_ball (c n) (r n)` is included in the previous ball and in `f n`, and such that
    `r n` is small enough to ensure that `c n` is a Cauchy sequence. Then `c n` converges to a
    limit which belongs to all the `f n`. -/
  let F : ℕ → α × ℝ≥0∞ := fun n =>
    Nat.recOn n (Prod.mk x (min ε (B 0))) fun n p => Prod.mk (center n p.1 p.2) (radius n p.1 p.2)
  let c : ℕ → α := fun n => (F n).1
  let r : ℕ → ℝ≥0∞ := fun n => (F n).2
  have rpos : ∀ n, 0 < r n := by
    intro n
    induction' n with n hn
    exact lt_min εpos (Bpos 0)
    exact Hpos n (c n) (r n) hn.ne'
  have r0 : ∀ n, r n ≠ 0 := fun n => (rpos n).ne'
  have rB : ∀ n, r n ≤ B n := by
    intro n
    induction' n with n hn
    exact min_le_right _ _
    exact HB n (c n) (r n) (r0 n)
  have incl : ∀ n, closed_ball (c (n + 1)) (r (n + 1)) ⊆ closed_ball (c n) (r n) ∩ f n := fun n =>
    Hball n (c n) (r n) (r0 n)
  have cdist : ∀ n, edist (c n) (c (n + 1)) ≤ B n :=
    by
    intro n
    rw [edist_comm]
    have A : c (n + 1) ∈ closed_ball (c (n + 1)) (r (n + 1)) := mem_closed_ball_self
    have I :=
      calc
        closed_ball (c (n + 1)) (r (n + 1)) ⊆ closed_ball (c n) (r n) :=
          subset.trans (incl n) (inter_subset_left _ _)
        _ ⊆ closed_ball (c n) (B n) := closed_ball_subset_closed_ball (rB n)

    exact I A
  have : CauchySeq c := cauchySeq_of_edist_le_geometric_two _ one_ne_top cdist
  -- as the sequence `c n` is Cauchy in a complete space, it converges to a limit `y`.
  rcases cauchySeq_tendsto_of_complete this with ⟨y, ylim⟩
  -- this point `y` will be the desired point. We will check that it belongs to all
  -- `f n` and to `ball x ε`.
  use y
  simp only [exists_prop, Set.mem_interᵢ]
  have I : ∀ n, ∀ m ≥ n, closed_ball (c m) (r m) ⊆ closed_ball (c n) (r n) :=
    by
    intro n
    refine' Nat.le_induction _ fun m hnm h => _
    · exact subset.refl _
    · exact subset.trans (incl m) (subset.trans (inter_subset_left _ _) h)
  have yball : ∀ n, y ∈ closed_ball (c n) (r n) :=
    by
    intro n
    refine' is_closed_ball.mem_of_tendsto ylim _
    refine' (Filter.eventually_ge_atTop n).mono fun m hm => _
    exact I n m hm mem_closed_ball_self
  constructor
  show ∀ n, y ∈ f n
  · intro n
    have : closed_ball (c (n + 1)) (r (n + 1)) ⊆ f n :=
      subset.trans (incl n) (inter_subset_right _ _)
    exact this (yball (n + 1))
  show edist y x ≤ ε
  exact le_trans (yball 0) (min_le_left _ _)
#align baire_category_theorem_emetric_complete baire_category_theorem_emetric_complete

/-- The second theorem states that locally compact spaces are Baire. -/
instance (priority := 100) baire_category_theorem_locally_compact [TopologicalSpace α] [T2Space α]
    [LocallyCompactSpace α] : BaireSpace α :=
  by
  constructor
  intro f ho hd
  /- To prove that an intersection of open dense subsets is dense, prove that its intersection
    with any open neighbourhood `U` is dense. Define recursively a decreasing sequence `K` of
    compact neighbourhoods: start with some compact neighbourhood inside `U`, then at each step,
    take its interior, intersect with `f n`, then choose a compact neighbourhood inside the
    intersection.-/
  apply dense_iff_inter_open.2
  intro U U_open U_nonempty
  rcases exists_positiveCompacts_subset U_open U_nonempty with ⟨K₀, hK₀⟩
  have : ∀ (n) (K : positive_compacts α), ∃ K' : positive_compacts α, ↑K' ⊆ f n ∩ interior K :=
    by
    refine' fun n K => exists_positiveCompacts_subset ((ho n).inter isOpen_interior) _
    rw [inter_comm]
    exact (hd n).inter_open_nonempty _ isOpen_interior K.interior_nonempty
  choose K_next hK_next
  let K : ℕ → positive_compacts α := fun n => Nat.recOn n K₀ K_next
  -- This is a decreasing sequence of positive compacts contained in suitable open sets `f n`.
  have hK_decreasing : ∀ n : ℕ, ↑(K (n + 1)) ⊆ f n ∩ K n := fun n =>
    (hK_next n (K n)).trans <| inter_subset_inter_right _ interior_subset
  -- Prove that ̀`⋂ n : ℕ, K n` is inside `U ∩ ⋂ n : ℕ, (f n)`.
  have hK_subset : (⋂ n, K n : Set α) ⊆ U ∩ ⋂ n, f n :=
    by
    intro x hx
    simp only [mem_inter_iff, mem_Inter] at hx⊢
    exact ⟨hK₀ <| hx 0, fun n => (hK_decreasing n (hx (n + 1))).1⟩
  /- Prove that `⋂ n : ℕ, K n` is not empty, as an intersection of a decreasing sequence
    of nonempty compact subsets.-/
  have hK_nonempty : (⋂ n, K n : Set α).Nonempty :=
    IsCompact.nonempty_interᵢ_of_sequence_nonempty_compact_closed _
      (fun n => (hK_decreasing n).trans (inter_subset_right _ _)) (fun n => (K n).Nonempty)
      (K 0).IsCompact fun n => (K n).IsCompact.IsClosed
  exact hK_nonempty.mono hK_subset
#align baire_category_theorem_locally_compact baire_category_theorem_locally_compact

variable [TopologicalSpace α] [BaireSpace α]

/-- Definition of a Baire space. -/
theorem dense_interᵢ_of_open_nat {f : ℕ → Set α} (ho : ∀ n, IsOpen (f n)) (hd : ∀ n, Dense (f n)) :
    Dense (⋂ n, f n) :=
  BaireSpace.baire_property f ho hd
#align dense_Inter_of_open_nat dense_interᵢ_of_open_nat

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with ⋂₀. -/
theorem dense_interₛ_of_open {S : Set (Set α)} (ho : ∀ s ∈ S, IsOpen s) (hS : S.Countable)
    (hd : ∀ s ∈ S, Dense s) : Dense (⋂₀ S) :=
  by
  cases' S.eq_empty_or_nonempty with h h
  · simp [h]
  · rcases hS.exists_eq_range h with ⟨f, hf⟩
    have F : ∀ n, f n ∈ S := fun n => by rw [hf] <;> exact mem_range_self _
    rw [hf, sInter_range]
    exact dense_interᵢ_of_open_nat (fun n => ho _ (F n)) fun n => hd _ (F n)
#align dense_sInter_of_open dense_interₛ_of_open

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_open {S : Set β} {f : β → Set α} (ho : ∀ s ∈ S, IsOpen (f s))
    (hS : S.Countable) (hd : ∀ s ∈ S, Dense (f s)) : Dense (⋂ s ∈ S, f s) :=
  by
  rw [← sInter_image]
  apply dense_interₛ_of_open
  · rwa [ball_image_iff]
  · exact hS.image _
  · rwa [ball_image_iff]
#align dense_bInter_of_open dense_bInter_of_open

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_interᵢ_of_open [Encodable β] {f : β → Set α} (ho : ∀ s, IsOpen (f s))
    (hd : ∀ s, Dense (f s)) : Dense (⋂ s, f s) :=
  by
  rw [← sInter_range]
  apply dense_interₛ_of_open
  · rwa [forall_range_iff]
  · exact countable_range _
  · rwa [forall_range_iff]
#align dense_Inter_of_open dense_interᵢ_of_open

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
theorem dense_interₛ_of_Gδ {S : Set (Set α)} (ho : ∀ s ∈ S, IsGδ s) (hS : S.Countable)
    (hd : ∀ s ∈ S, Dense s) : Dense (⋂₀ S) :=
  by
  -- the result follows from the result for a countable intersection of dense open sets,
  -- by rewriting each set as a countable intersection of open sets, which are of course dense.
  choose T hTo hTc hsT using ho
  have : ⋂₀ S = ⋂₀ ⋃ s ∈ S, T s ‹_› :=
    by-- := (sInter_bUnion (λs hs, (hT s hs).2.2)).symm,
    simp only [sInter_Union, (hsT _ _).symm, ← sInter_eq_bInter]
  rw [this]
  refine' dense_interₛ_of_open _ (hS.bUnion hTc) _ <;> simp only [mem_Union] <;>
    rintro t ⟨s, hs, tTs⟩
  show IsOpen t
  exact hTo s hs t tTs
  show Dense t
  · intro x
    have := hd s hs x
    rw [hsT s hs] at this
    exact closure_mono (sInter_subset_of_mem tTs) this
#align dense_sInter_of_Gδ dense_interₛ_of_Gδ

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_interᵢ_of_Gδ [Encodable β] {f : β → Set α} (ho : ∀ s, IsGδ (f s))
    (hd : ∀ s, Dense (f s)) : Dense (⋂ s, f s) :=
  by
  rw [← sInter_range]
  exact dense_interₛ_of_Gδ (forall_range_iff.2 ‹_›) (countable_range _) (forall_range_iff.2 ‹_›)
#align dense_Inter_of_Gδ dense_interᵢ_of_Gδ

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_Gδ {S : Set β} {f : ∀ x ∈ S, Set α} (ho : ∀ s ∈ S, IsGδ (f s ‹_›))
    (hS : S.Countable) (hd : ∀ s ∈ S, Dense (f s ‹_›)) : Dense (⋂ s ∈ S, f s ‹_›) :=
  by
  rw [bInter_eq_Inter]
  haveI := hS.to_encodable
  exact dense_interᵢ_of_Gδ (fun s => ho s s.2) fun s => hd s s.2
#align dense_bInter_of_Gδ dense_bInter_of_Gδ

/-- Baire theorem: the intersection of two dense Gδ sets is dense. -/
theorem Dense.inter_of_Gδ {s t : Set α} (hs : IsGδ s) (ht : IsGδ t) (hsc : Dense s)
    (htc : Dense t) : Dense (s ∩ t) := by
  rw [inter_eq_Inter]
  apply dense_interᵢ_of_Gδ <;> simp [Bool.forall_bool, *]
#align dense.inter_of_Gδ Dense.inter_of_Gδ

/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
theorem eventually_residual {p : α → Prop} :
    (∀ᶠ x in residual α, p x) ↔ ∃ t : Set α, IsGδ t ∧ Dense t ∧ ∀ x ∈ t, p x :=
  calc
    (∀ᶠ x in residual α, p x) ↔ ∀ᶠ x in ⨅ (t : Set α) (ht : IsGδ t ∧ Dense t), 𝓟 t, p x := by
      simp only [residual, infᵢ_and]
    _ ↔ ∃ (t : Set α)(ht : IsGδ t ∧ Dense t), ∀ᶠ x in 𝓟 t, p x :=
      (mem_binfᵢ_of_directed
        (fun t₁ h₁ t₂ h₂ =>
          ⟨t₁ ∩ t₂, ⟨h₁.1.inter h₂.1, Dense.inter_of_Gδ h₁.1 h₂.1 h₁.2 h₂.2⟩, by simp⟩)
        ⟨univ, isGδ_univ, dense_univ⟩)
    _ ↔ _ := by simp [and_assoc']

#align eventually_residual eventually_residual

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (t «expr ⊆ » s) -/
/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
theorem mem_residual {s : Set α} : s ∈ residual α ↔ ∃ (t : _)(_ : t ⊆ s), IsGδ t ∧ Dense t :=
  (@eventually_residual α _ _ fun x => x ∈ s).trans <|
    exists_congr fun t => by rw [exists_prop, and_comm' (t ⊆ s), subset_def, and_assoc']
#align mem_residual mem_residual

theorem dense_of_mem_residual {s : Set α} (hs : s ∈ residual α) : Dense s :=
  let ⟨t, hts, _, hd⟩ := mem_residual.1 hs
  hd.mono hts
#align dense_of_mem_residual dense_of_mem_residual

instance : CountableInterFilter (residual α) :=
  ⟨by
    intro S hSc hS
    simp only [mem_residual] at *
    choose T hTs hT using hS
    refine' ⟨⋂ s ∈ S, T s ‹_›, _, _, _⟩
    · rw [sInter_eq_bInter]
      exact Inter₂_mono hTs
    · exact isGδ_binterᵢ hSc fun s hs => (hT s hs).1
    · exact dense_bInter_of_Gδ (fun s hs => (hT s hs).1) hSc fun s hs => (hT s hs).2⟩

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with `⋃`. -/
theorem IsGδ.dense_unionᵢ_interior_of_closed [Encodable ι] {s : Set α} (hs : IsGδ s) (hd : Dense s)
    {f : ι → Set α} (hc : ∀ i, IsClosed (f i)) (hU : s ⊆ ⋃ i, f i) : Dense (⋃ i, interior (f i)) :=
  by
  let g i := frontier (f i)ᶜ
  have hgo : ∀ i, IsOpen (g i) := fun i => is_closed_frontier.is_open_compl
  have hgd : Dense (⋂ i, g i) :=
    by
    refine' dense_interᵢ_of_open hgo fun i x => _
    rw [closure_compl, interior_frontier (hc _)]
    exact id
  refine' (hd.inter_of_Gδ hs (isGδ_interᵢ fun i => (hgo i).IsGδ) hgd).mono _
  rintro x ⟨hxs, hxg⟩
  rw [mem_Inter] at hxg
  rcases mem_Union.1 (hU hxs) with ⟨i, hi⟩
  exact mem_Union.2 ⟨i, self_diff_frontier (f i) ▸ ⟨hi, hxg _⟩⟩
#align is_Gδ.dense_Union_interior_of_closed IsGδ.dense_unionᵢ_interior_of_closed

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with a union over a countable set in any type. -/
theorem IsGδ.dense_bUnion_interior_of_closed {t : Set ι} {s : Set α} (hs : IsGδ s) (hd : Dense s)
    (ht : t.Countable) {f : ι → Set α} (hc : ∀ i ∈ t, IsClosed (f i)) (hU : s ⊆ ⋃ i ∈ t, f i) :
    Dense (⋃ i ∈ t, interior (f i)) :=
  by
  haveI := ht.to_encodable
  simp only [bUnion_eq_Union, SetCoe.forall'] at *
  exact hs.dense_Union_interior_of_closed hd hc hU
#align is_Gδ.dense_bUnion_interior_of_closed IsGδ.dense_bUnion_interior_of_closed

/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
is dense. Formulated here with `⋃₀`. -/
theorem IsGδ.dense_unionₛ_interior_of_closed {T : Set (Set α)} {s : Set α} (hs : IsGδ s)
    (hd : Dense s) (hc : T.Countable) (hc' : ∀ t ∈ T, IsClosed t) (hU : s ⊆ ⋃₀ T) :
    Dense (⋃ t ∈ T, interior t) :=
  hs.dense_bUnion_interior_of_closed hd hc hc' <| by rwa [← sUnion_eq_bUnion]
#align is_Gδ.dense_sUnion_interior_of_closed IsGδ.dense_unionₛ_interior_of_closed

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is a countable set in any type. -/
theorem dense_bUnion_interior_of_closed {S : Set β} {f : β → Set α} (hc : ∀ s ∈ S, IsClosed (f s))
    (hS : S.Countable) (hU : (⋃ s ∈ S, f s) = univ) : Dense (⋃ s ∈ S, interior (f s)) :=
  isGδ_univ.dense_bUnion_interior_of_closed dense_univ hS hc hU.ge
#align dense_bUnion_interior_of_closed dense_bUnion_interior_of_closed

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with `⋃₀`. -/
theorem dense_unionₛ_interior_of_closed {S : Set (Set α)} (hc : ∀ s ∈ S, IsClosed s)
    (hS : S.Countable) (hU : ⋃₀ S = univ) : Dense (⋃ s ∈ S, interior s) :=
  isGδ_univ.dense_unionₛ_interior_of_closed dense_univ hS hc hU.ge
#align dense_sUnion_interior_of_closed dense_unionₛ_interior_of_closed

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is an encodable type. -/
theorem dense_unionᵢ_interior_of_closed [Encodable β] {f : β → Set α} (hc : ∀ s, IsClosed (f s))
    (hU : (⋃ s, f s) = univ) : Dense (⋃ s, interior (f s)) :=
  isGδ_univ.dense_unionᵢ_interior_of_closed dense_univ hc hU.ge
#align dense_Union_interior_of_closed dense_unionᵢ_interior_of_closed

/-- One of the most useful consequences of Baire theorem: if a countable union of closed sets
covers the space, then one of the sets has nonempty interior. -/
theorem nonempty_interior_of_unionᵢ_of_closed [Nonempty α] [Encodable β] {f : β → Set α}
    (hc : ∀ s, IsClosed (f s)) (hU : (⋃ s, f s) = univ) : ∃ s, (interior <| f s).Nonempty := by
  simpa using (dense_unionᵢ_interior_of_closed hc hU).Nonempty
#align nonempty_interior_of_Union_of_closed nonempty_interior_of_unionᵢ_of_closed

end BaireTheorem


import ..lectures.love08_operational_semantics_demo

/-! # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Guarded Command Language

In 1976, E. W. Dijkstra introduced the guarded command language (GCL), a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

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

/-! The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug. Below we will take `σ := state`.

1.1. Complete the following big-step semantics, based on the informal
specification of GCL above. -/

inductive big_step : (stmt state × state) → state → Prop
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
| seq {S T s t u} (h₁ : big_step (S, s) t) (h₂ : big_step (T, t) u) :
  big_step (S ;; T, s) u
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
| loop_base {S s} :
  big_step (stmt.loop S, s) s
| loop_step {S s u} (t) (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.loop S, t) u) :
  big_step (stmt.loop S, s) u

infix ` ⟹ ` : 110 := big_step

/-! 1.2. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
begin
  apply iff.intro,
  { intro hasn,
    cases' hasn,
    refl },
  { intro heq,
    rw heq,
    exact big_step.assign }
end

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
begin
  apply iff.intro,
  { intro hast,
    cases' hast,
    simp * at * },
  { intros hand,
    cases' hand,
    rw left,
    apply big_step.assert right }
end

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
begin
  apply iff.intro,
  { intro hseq,
    cases' hseq,
    apply exists.intro,
    apply and.intro; assumption },
  { intro hseq,
    cases' hseq,
    cases' h,
    apply big_step.seq; assumption }
end

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
begin
  apply iff.intro,
  { intro hloop,
    cases' hloop,
    { apply or.intro_left,
      refl },
    { apply or.intro_right,
      apply exists.intro t,
      cc } },
  { intro hor,
    cases' hor,
    { rw h,
      apply big_step.loop_base },
    { cases' h,
      cases' h,
      apply big_step.loop_step; assumption } }
end

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
begin
  apply iff.intro,
  { intro hchoice,
    cases' hchoice,
    apply exists.intro i,
    apply exists.intro hless,
    assumption },
  { intro hex,
    cases' hex with i hex,
    cases' hex with hless hstep,
    apply big_step.choice; assumption }
end

end gcl

/-! 1.3. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  gcl.stmt.assign x a
| (S ;; T)          :=
  gcl_of S ;;
  gcl_of T
| (stmt.ite b S T)  :=
  gcl.stmt.choice [
    gcl.stmt.assert b ;; gcl_of S,
    gcl.stmt.assert (λs, ¬ b s) ;; gcl_of T
  ]
| (stmt.while b S)  :=
  gcl.stmt.loop
    (gcl.stmt.assert b ;;
     gcl_of S) ;;
  gcl.stmt.assert (λs, ¬ b s)

/-! 1.4. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

/-! Here are two other possibilities:

* `loop (assert (λ_, false))`
* `assign "x" (λs, s "x")`

There are infinitely many variants, e.g., `seq` of the above two solutions. -/

/-! ## Question 2: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix ` ≈ ` := big_step_equiv

/-! Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/-! 2.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
begin
  intros s t,
  apply iff.intro,
  { intro hasn,
    cases' hasn,
    simp * at * },
  { intro hskip,
    cases' hskip,
    simp * at * }
end

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
begin
  intros s t,
  apply iff.intro,
  { intro h,
    cases' h,
    cases' h_1,
    assumption },
  { intro h,
    exact big_step.seq big_step.skip h }
end

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
begin
  intros s t,
  apply iff.intro,
  { intro h,
    cases' h,
    cases' h_1,
    assumption },
  { intro h,
    exact big_step.seq h big_step.skip }
end

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
begin
  intros s t,
  apply iff.intro,
  { intro hite,
    cases' hite,
    { cases' hite,
      apply big_step.while_true; assumption },
    { cases' hite,
      apply big_step.while_false,
      assumption } },
  { intro while,
    cases' while,
    { apply big_step.ite_true hcond,
      apply big_step.seq; assumption },
    { apply big_step.ite_false hcond,
      exact big_step.skip } }
end

/-! 2.2 (**optional**). Program equivalence can be used to replace subprograms
by other subprograms with the same semantics. Prove the following so-called
congruence rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hseq,
    cases' hseq with _ _ _ _ _ _ _ u _ hS₁ hT₁,
    apply big_step.seq,
    { apply iff.elim_left (hS _ _) hS₁ },
    { apply iff.elim_left (hT _ _) hT₁ } },
  { intros hseq,
    cases' hseq with _ _ _ _ _ _ _ u _ hS₂ hT₂,
    apply big_step.seq,
    { exact iff.elim_right (hS _ _) hS₂ },
    { exact iff.elim_right (hT _ _) hT₂ } }
end

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hite,
    cases' hite,
    case ite_true : _ _ _ _ _ hcond hbody {
      apply big_step.ite_true hcond,
      exact iff.elim_left (hS _ _) hbody },
    case ite_false : _ _ _ _ _ hcond hbody {
      apply big_step.ite_false hcond,
      exact iff.elim_left (hT _ _) hbody } },
  { intro hite,
    cases' hite,
    case ite_true : _ _ _ _ _ hcond hbody {
      apply big_step.ite_true hcond,
      exact iff.elim_right (hS _ _) hbody },
    case ite_false : _ _ _ _ _ hcond hbody {
      apply big_step.ite_false hcond,
      exact iff.elim_right (hT _ _) hbody } }
end

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hwhile,
    induction' hwhile,
    case while_true : b S t u v hcond hbody hrest ih_body ih_rest {
      apply big_step.while_true hcond,
      exact iff.elim_left (hS _ _) hbody,
      exact ih_rest hS },
    case while_false {
      exact big_step.while_false hcond } },
  { intro hwhile,
    induction' hwhile,
    case while_true : b S t u v hcond hbody hrest ih_body ih_rest {
      apply big_step.while_true hcond,
      exact iff.elim_right (hS _ _) hbody,
      exact ih_rest hS },
    case while_false {
      exact big_step.while_false hcond } }
end

end LoVe


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.basic
import algebra.ordered_field
import algebra.archimedean
/-!
# Computable Continued Fractions

## Summary

We formalise the standard computation of (regular) continued fractions for linear ordered floor
fields. The algorithm is rather simple. Here is an outline of the procedure adapted from Wikipedia:

Take a value `v`. We call `⌊v⌋` the *integer part* of `v` and `v − ⌊v⌋` the *fractional part* of
`v`.  A continued fraction representation of `v` can then be given by `[⌊v⌋; b₀, b₁, b₂,...]`, where
`[b₀; b₁, b₂,...]` recursively is the continued fraction representation of `1 / (v − ⌊v⌋)`.  This
process stops when the fractional part hits 0.

In other words: to calculate a continued fraction representation of a number `v`, write down the
integer part (i.e. the floor) of `v`. Subtract this integer part from `v`. If the difference is 0,
stop; otherwise find the reciprocal of the difference and repeat. The procedure will terminate if
and only if `v` is rational.

For an example, refer to `int_fract_pair.stream`.

## Main definitions

- `generalized_continued_fraction.int_fract_pair.stream`: computes the stream of integer and
  fractional parts of a given value as described in the summary.
- `generalized_continued_fraction.of`: computes the generalised continued fraction of a value `v`.
  In fact, it computes a regular continued fraction that terminates if and only if `v` is rational
  (those proofs will be added in a future commit).

## Implementation Notes

There is an intermediate definition `generalized_continued_fraction.int_fract_pair.seq1` between
`generalized_continued_fraction.int_fract_pair.stream` and `generalized_continued_fraction.of`
to wire up things. User should not (need to) directly interact with it.

The computation of the integer and fractional pairs of a value can elegantly be
captured by a recursive computation of a stream of option pairs. This is done in
`int_fract_pair.stream`. However, the type then does not guarantee the first pair to always be
`some` value, as expected by a continued fraction.

To separate concerns, we first compute a single head term that always exists in
`generalized_continued_fraction.int_fract_pair.seq1` followed by the remaining stream of option
pairs. This sequence with a head term (`seq1`) is then transformed to a generalized continued
fraction in `generalized_continued_fraction.of` by extracting the wanted integer parts of the
head term and the stream.

## References

- https://en.wikipedia.org/wiki/Continued_fraction

## Tags

numerics, number theory, approximations, fractions
-/

namespace generalized_continued_fraction
open generalized_continued_fraction as gcf

-- Fix a carrier `K`.
variable (K : Type*)

/--
We collect an integer part `b = ⌊v⌋` and fractional part `fr = v - ⌊v⌋` of a value `v` in a pair
`⟨b, fr⟩`.
-/
structure int_fract_pair := (b : ℤ) (fr : K)

variable {K}

/-! Interlude: define some expected coercions and instances. -/
namespace int_fract_pair

/-- Make an `int_fract_pair` printable. -/
instance [has_repr K] : has_repr (int_fract_pair K) :=
⟨λ p, "(b : " ++ (repr p.b) ++ ", fract : " ++ (repr p.fr) ++ ")"⟩

instance inhabited [inhabited K] : inhabited (int_fract_pair K) := ⟨⟨0, (default _)⟩⟩

/--
Maps a function `f` on the fractional components of a given pair.
-/
def mapFr {β : Type*} (f : K → β) (gp : int_fract_pair K) : int_fract_pair β :=
⟨gp.b, f gp.fr⟩

section coe
/-! Interlude: define some expected coercions. -/
/- Fix another type `β` which we will convert to. -/
variables {β : Type*} [has_coe K β]

/-- Coerce a pair by coercing the fractional component. -/
instance has_coe_to_int_fract_pair : has_coe (int_fract_pair K) (int_fract_pair β) :=
⟨mapFr coe⟩

@[simp, norm_cast]
lemma coe_to_int_fract_pair {b : ℤ} {fr : K} :
  (↑(int_fract_pair.mk b fr) : int_fract_pair β) = int_fract_pair.mk b (↑fr : β) :=
rfl

end coe

-- Note: this could be relaxed to something like `linear_ordered_division_ring` in the
-- future.
/- Fix a discrete linear ordered field with `floor` function. -/
variables [linear_ordered_field K] [floor_ring K]

/-- Creates the integer and fractional part of a value `v`, i.e. `⟨⌊v⌋, v - ⌊v⌋⟩`. -/
protected def of (v : K) : int_fract_pair K := ⟨⌊v⌋, fract v⟩

/--
Creates the stream of integer and fractional parts of a value `v` needed to obtain the continued
fraction representation of `v` in `generalized_continued_fraction.of`. More precisely, given a value
`v : K`, it recursively computes a stream of option `ℤ × K` pairs as follows:
- `stream v 0 = some ⟨⌊v⌋, v - ⌊v⌋⟩`
- `stream v (n + 1) = some ⟨⌊frₙ⁻¹⌋, frₙ⁻¹ - ⌊frₙ⁻¹⌋⟩`,
    if `stream v n = some ⟨_, frₙ⟩` and `frₙ ≠ 0`
- `stream v (n + 1) = none`, otherwise

For example, let `(v : ℚ) := 3.4`. The process goes as follows:
- `stream v 0 = some ⟨⌊v⌋, v - ⌊v⌋⟩ = some ⟨3, 0.4⟩`
- `stream v 1 = some ⟨⌊0.4⁻¹⌋, 0.4⁻¹ - ⌊0.4⁻¹⌋⟩ = some ⟨⌊2.5⌋, 2.5 - ⌊2.5⌋⟩ = some ⟨2, 0.5⟩`
- `stream v 2 = some ⟨⌊0.5⁻¹⌋, 0.5⁻¹ - ⌊0.5⁻¹⌋⟩ = some ⟨⌊2⌋, 2 - ⌊2⌋⟩ = some ⟨2, 0⟩`
- `stream v n = none`, for `n ≥ 3`
-/
protected def stream (v : K) : stream $ option (int_fract_pair K)
| 0 := some (int_fract_pair.of v)
| (n + 1) := do ap_n ← stream n,
  if ap_n.fr = 0 then none else int_fract_pair.of ap_n.fr⁻¹

/--
Shows that `int_fract_pair.stream` has the sequence property, that is once we return `none` at
position `n`, we also return `none` at `n + 1`.
-/
lemma stream_is_seq (v : K) : (int_fract_pair.stream v).is_seq :=
by { assume _ hyp, simp [int_fract_pair.stream, hyp] }

/--
Uses `int_fract_pair.stream` to create a sequence with head (i.e. `seq1`) of integer and fractional
parts of a value `v`. The first value of `int_fract_pair.stream` is never `none`, so we can safely
extract it and put the tail of the stream in the sequence part.

This is just an intermediate representation and users should not (need to) directly interact with
it. The setup of rewriting/simplification lemmas that make the definitions easy to use is done in
`algebra.continued_fractions.computation.translations`.
-/
protected def seq1 (v : K) : seq1 $ int_fract_pair K :=
⟨ int_fract_pair.of v,--the head
  seq.tail -- take the tail of `int_fract_pair.stream` since the first element is already in the
  -- head create a sequence from `int_fract_pair.stream`
  ⟨ int_fract_pair.stream v, -- the underlying stream
    @stream_is_seq _ _ _ v ⟩ ⟩ -- the proof that the stream is a sequence

end int_fract_pair

/--
Returns the `generalized_continued_fraction` of a value. In fact, the returned gcf is also
a `continued_fraction` that terminates if and only if `v` is rational (those proofs will be
added in a future commit).

The continued fraction representation of `v` is given by `[⌊v⌋; b₀, b₁, b₂,...]`, where
`[b₀; b₁, b₂,...]` recursively is the continued fraction representation of `1 / (v − ⌊v⌋)`. This
process stops when the fractional part `v - ⌊v⌋` hits 0 at some step.

The implementation uses `int_fract_pair.stream` to obtain the partial denominators of the continued
fraction. Refer to said function for more details about the computation process.
-/
protected def of [linear_ordered_field K] [floor_ring K] (v : K) : gcf K :=
let ⟨h, s⟩ := int_fract_pair.seq1 v in -- get the sequence of integer and fractional parts.
⟨ h.b, -- the head is just the first integer part
  s.map (λ p, ⟨1, p.b⟩) ⟩ -- the sequence consists of the remaining integer parts as the partial
                          -- denominators; all partial numerators are simply 1

end generalized_continued_fraction


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Normed spaces.
-/
import algebra.module .metric_space
open real nat classical topology analysis analysis.metric_space
noncomputable theory

structure has_norm [class] (M : Type) : Type :=
(norm : M → ℝ)

namespace analysis
  definition norm {M : Type} [has_normM : has_norm M] (v : M) : ℝ := has_norm.norm v

  notation `∥`v`∥` := norm v
end analysis

/- real vector spaces -/
-- where is the right place to put this?
structure real_vector_space [class] (V : Type) extends vector_space ℝ V

section
  variables {V : Type} [real_vector_space V]

  -- these specializations help the elaborator when it is hard to infer the ring, e.g. with numerals

  proposition smul_left_distrib_real (a : ℝ) (u v : V) : a • (u + v) = a • u + a • v :=
  smul_left_distrib a u v

  proposition smul_right_distrib_real (a b : ℝ) (u : V) : (a + b) • u = a • u + b • u :=
  smul_right_distrib a b u

  proposition mul_smul_real (a : ℝ) (b : ℝ) (u : V) : (a * b) • u = a • (b • u) :=
  mul_smul a b u

  proposition one_smul_real (u : V) : (1 : ℝ) • u = u := one_smul u

  proposition zero_smul_real (u : V) : (0 : ℝ) • u = 0 := zero_smul u

  proposition smul_zero_real (a : ℝ) : a • (0 : V) = 0 := smul_zero a

  proposition neg_smul_real (a : ℝ) (u : V) : (-a) • u = - (a • u) := neg_smul a u

  proposition neg_one_smul_real (u : V) : -(1 : ℝ) • u = -u := neg_one_smul u

  proposition smul_neg_real (a : ℝ) (u : V) : a • (-u) = -(a • u) := smul_neg a u
end

/- real normed vector spaces -/

structure normed_vector_space [class] (V : Type) extends real_vector_space V, has_norm V :=
(norm_zero : norm zero = 0)
(eq_zero_of_norm_eq_zero : ∀ u : V, norm u = 0 → u = zero)
(norm_triangle : ∀ u v, norm (add u v) ≤ norm u + norm v)
(norm_smul : ∀ (a : ℝ) (v : V), norm (smul a v) = abs a * norm v)

namespace analysis
  variable {V : Type}
  variable [normed_vector_space V]

  proposition norm_zero : ∥ (0 : V) ∥ = 0 := !normed_vector_space.norm_zero

  proposition eq_zero_of_norm_eq_zero {u : V} (H : ∥ u ∥ = 0) : u = 0 :=
  !normed_vector_space.eq_zero_of_norm_eq_zero H

  proposition norm_triangle (u v : V) : ∥ u + v ∥ ≤ ∥ u ∥ + ∥ v ∥ :=
  !normed_vector_space.norm_triangle

  proposition norm_smul (a : ℝ) (v : V) : ∥ a • v ∥ = abs a * ∥ v ∥ :=
  !normed_vector_space.norm_smul

  proposition norm_neg (v : V) : ∥ -v ∥ = ∥ v ∥ :=
  have abs (1 : ℝ) = 1, from abs_of_nonneg zero_le_one,
  by rewrite [-@neg_one_smul ℝ V, norm_smul, abs_neg, this, one_mul]

  proposition norm_sub (u v : V) : ∥u - v∥ = ∥v - u∥ :=
    by rewrite [-norm_neg, neg_sub]

  proposition norm_ne_zero_of_ne_zero {u : V} (H : u ≠ 0) : ∥u∥ ≠ 0 :=
  suppose ∥u∥ = 0, H (eq_zero_of_norm_eq_zero this)

end analysis

section
  open analysis
  variable {V : Type}
  variable [normed_vector_space V]

  private definition nvs_dist [reducible] (u v : V) := ∥ u - v ∥

  private lemma nvs_dist_self (u : V) : nvs_dist u u = 0 :=
  by rewrite [↑nvs_dist, sub_self, norm_zero]

  private lemma eq_of_nvs_dist_eq_zero (u v : V) (H : nvs_dist u v = 0) : u = v :=
  have u - v = 0, from eq_zero_of_norm_eq_zero H,
  eq_of_sub_eq_zero this

  private lemma nvs_dist_triangle (u v w : V) : nvs_dist u w ≤ nvs_dist u v + nvs_dist v w :=
  calc
    nvs_dist u w = ∥ (u - v) + (v - w) ∥       : by rewrite [↑nvs_dist, *sub_eq_add_neg, add.assoc,
                                                             neg_add_cancel_left]
             ... ≤ ∥ u - v ∥ + ∥ v - w ∥       : norm_triangle
  private lemma nvs_dist_comm  (u v : V) : nvs_dist u v = nvs_dist v u :=
  by rewrite [↑nvs_dist, -norm_neg, neg_sub]

  definition normed_vector_space_to_metric_space [trans_instance]
      (V : Type) [nvsV : normed_vector_space V] :
    metric_space V :=
  ⦃ metric_space,
    dist               := nvs_dist,
    dist_self          := nvs_dist_self,
    eq_of_dist_eq_zero := eq_of_nvs_dist_eq_zero,
    dist_comm          := nvs_dist_comm,
    dist_triangle      := nvs_dist_triangle
  ⦄

  open nat

  proposition approaches_seq_norm_elim {X : ℕ → V} {x : V} (H : X ⟶ x [at ∞]) :
    ∀ {ε : ℝ}, ε > 0 → ∃ N₁ : ℕ, ∀ {n : ℕ}, n ≥ N₁ → ∥ X n - x ∥ < ε :=
  approaches_at_infty_dest H

  proposition dist_eq_norm_sub (u v : V) : dist u v = ∥ u - v ∥ := rfl

  proposition norm_eq_dist_zero (u : V) : ∥ u ∥ = dist u 0 :=
  by rewrite [dist_eq_norm_sub, sub_zero]

  proposition norm_nonneg (u : V) : ∥ u ∥ ≥ 0 :=
  by rewrite norm_eq_dist_zero; apply !dist_nonneg

  proposition norm_pos_of_ne_zero {v : V} (Hv : v ≠ 0) : ∥v∥ > 0 :=
    by_contradiction
      (suppose ¬ ∥v∥ > 0,
      have ∥v∥ = 0, from eq_of_le_of_ge (le_of_not_gt this) !norm_nonneg,
      Hv (eq_zero_of_norm_eq_zero this))
end

structure banach_space [class] (V : Type) extends nvsV : normed_vector_space V :=
(complete : ∀ X, @analysis.cauchy V (@normed_vector_space_to_metric_space V nvsV) X →
    @analysis.converges_seq V (@normed_vector_space_to_metric_space V nvsV) X)

definition banach_space_to_metric_space [trans_instance] (V : Type) [bsV : banach_space V] :
  complete_metric_space V :=
⦃ complete_metric_space, normed_vector_space_to_metric_space V,
  complete := banach_space.complete
⦄

namespace analysis

-- unfold some common definitions fully (copied from metric space, updated for normed_space notation)
-- TODO: copy these for ℝ as well?
namespace normed_vector_space
section
open set topology set.filter
variables {M N : Type}
--variable [HU : normed_vector_space U]
variable [normed_vector_space M]
--variables {f g : U → V}

section approaches
  variables {X : Type} {F : filter X} {f : X → M} {y : M}

  proposition approaches_intro (H : ∀ ε, ε > 0 → eventually (λ x, ∥(f x) - y∥ < ε) F) :
    (f ⟶ y) F :=
  approaches_intro H

  proposition approaches_dest (H : (f ⟶ y) F) {ε : ℝ} (εpos : ε > 0) :
    eventually (λ x, ∥(f x) - y∥ < ε) F :=
  approaches_dest H εpos

  variables (F f y)

  proposition approaches_iff : ((f ⟶ y) F) ↔ (∀ ε, ε > 0 → eventually (λ x, ∥(f x) - y∥ < ε) F) :=
  iff.intro approaches_dest approaches_intro

end approaches

proposition approaches_at_infty_intro {f : ℕ → M} {y : M}
    (H : ∀ ε, ε > 0 → ∃ N, ∀ n, n ≥ N → ∥(f n) - y∥ < ε) :
  f ⟶ y [at ∞] :=
approaches_at_infty_intro H

proposition approaches_at_infty_dest {f : ℕ → M} {y : M}
    (H : f ⟶ y [at ∞]) ⦃ε : ℝ⦄ (εpos : ε > 0) :
  ∃ N, ∀ ⦃n⦄, n ≥ N → ∥(f n) - y∥ < ε :=
approaches_at_infty_dest H εpos

proposition approaches_at_infty_iff (f : ℕ → M) (y : M) :
  f ⟶ y [at ∞] ↔ (∀ ε, ε > 0 → ∃ N, ∀ ⦃n⦄, n ≥ N → ∥(f n) - y∥ < ε) :=
iff.intro approaches_at_infty_dest approaches_at_infty_intro

variable [normed_vector_space N]

proposition approaches_at_dest {f : M → N} {y : N} {x : M}
    (H : f ⟶ y [at x]) ⦃ε : ℝ⦄ (εpos : ε > 0) :
  ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, ∥x' - x∥ < δ → x' ≠ x → ∥(f x') - y∥ < ε :=
approaches_at_dest H εpos

proposition approaches_at_intro {f : M → N} {y : N} {x : M}
    (H : ∀ ε, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, ∥x' - x∥ < δ → x' ≠ x → ∥(f x') - y∥ < ε) :
  f ⟶ y [at x] :=
approaches_at_intro H

proposition approaches_at_iff (f : M → N) (y : N) (x : M) : f ⟶ y [at x] ↔
    (∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, ∥x' - x∥ < δ → x' ≠ x → ∥(f x') - y∥ < ε) :=
iff.intro approaches_at_dest approaches_at_intro

end
end normed_vector_space

section
variable {V : Type}
variable [normed_vector_space V]
variable {A : Type}
variables {X : A → V}
variables {x : V}

proposition neg_approaches {F} (HX : (X ⟶ x) F) :
  ((λ n, - X n) ⟶ - x) F :=
  begin
    apply normed_vector_space.approaches_intro,
    intro ε Hε,
    apply set.filter.eventually_mono (approaches_dest HX Hε),
    intro x' Hx',
    rewrite [-norm_neg, neg_neg_sub_neg],
    apply Hx'
  end

proposition approaches_neg {F} (Hx : ((λ n, - X n) ⟶ - x) F) : (X ⟶ x) F :=
  have aux : X = λ n, (- (- X n)), from funext (take n, by rewrite neg_neg),
  by rewrite [aux, -neg_neg x]; exact neg_approaches Hx

proposition neg_approaches_iff {F} : (((λ n, - X n) ⟶ - x) F) ↔ ((X ⟶ x) F) :=
have aux : X = λ n, (- (- X n)), from funext (take n, by rewrite neg_neg),
iff.intro approaches_neg neg_approaches

proposition norm_approaches_zero_of_approaches_zero {F} (HX : (X ⟶ 0) F) : ((λ n, norm (X n)) ⟶ 0) F :=
  begin
    apply metric_space.approaches_intro,
    intro ε Hε,
    apply set.filter.eventually_mono (approaches_dest HX Hε),
    intro x Hx,
    change abs (∥X x∥ - 0) < ε,
    rewrite [sub_zero, abs_of_nonneg !norm_nonneg, -sub_zero (X x)],
    apply Hx
  end

proposition approaches_zero_of_norm_approaches_zero
    {F} (HX : ((λ n, norm (X n)) ⟶ 0) F) :
  (X ⟶ 0) F :=
  begin
    apply normed_vector_space.approaches_intro,
    intro ε Hε,
    apply set.filter.eventually_mono (approaches_dest HX Hε),
    intro x Hx,
    apply lt_of_abs_lt,
    rewrite [sub_zero, -sub_zero ∥X x∥],
    apply Hx
  end

proposition norm_approaches_zero_iff (X : ℕ → V) (F) :
  (((λ n, norm (X n)) ⟶ 0) F) ↔ ((X ⟶ 0) F) :=
iff.intro approaches_zero_of_norm_approaches_zero norm_approaches_zero_of_approaches_zero

end

section
variables {U V : Type}
--variable [HU : normed_vector_space U]
variable [HV : normed_vector_space V]
variables {f g : U → V}
open set-- filter causes error??
include  HV

theorem add_approaches {lf lg : V} {F : filter U} (Hf : (f ⟶ lf) F) (Hg : (g ⟶ lg) F) :
        ((λ y, f y + g y) ⟶ lf + lg) F :=
  begin
    apply normed_vector_space.approaches_intro,
    intro ε Hε,
    have e2pos : ε / 2 > 0, from div_pos_of_pos_of_pos Hε two_pos,
    have Hfl : filter.eventually (λ x, dist (f x) lf < ε / 2) F, from approaches_dest Hf e2pos,
    have Hgl : filter.eventually (λ x, dist (g x) lg < ε / 2) F, from approaches_dest Hg e2pos,
    apply filter.eventually_mono,
    apply filter.eventually_and Hfl Hgl,
    intro x Hfg,
    rewrite [add_sub_comm, -add_halves ε],
    apply lt_of_le_of_lt,
    apply norm_triangle,
    cases Hfg with Hf' Hg',
    apply add_lt_add,
    exact Hf', exact Hg'
  end

theorem smul_approaches {lf : V} {F : filter U} (Hf : (f ⟶ lf) F) (s : ℝ) :
        ((λ y, s • f y) ⟶ s • lf) F :=
  begin
    apply normed_vector_space.approaches_intro,
    intro ε Hε,
    cases em (s = 0) with seq sneq,
    {have H : (λ x, ∥(s • f x) - (s • lf)∥ < ε) = (λ x, true),
      begin apply funext, intro x, rewrite [seq, 2 zero_smul, sub_zero, norm_zero, eq_true], exact Hε end,
    rewrite H,
    apply filter.eventually_true},
    {have e2pos : ε / abs s > 0, from div_pos_of_pos_of_pos Hε (abs_pos_of_ne_zero sneq),
    have H : filter.eventually (λ x, ∥(f x) - lf∥ < ε / abs s) F, from approaches_dest Hf e2pos,
    apply filter.eventually_mono H,
    intro x Hx,
    rewrite [-smul_sub_left_distrib, norm_smul, mul.comm],
    apply mul_lt_of_lt_div,
    apply abs_pos_of_ne_zero sneq,
    apply Hx}
  end

end

namespace normed_vector_space
variables {U V : Type}
variables [HU : normed_vector_space U] [HV : normed_vector_space V]
variables {f g : U → V}
include HU HV
open set

theorem continuous_at_within_intro {x : U} {s : set U}
        (H : ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε) :
  continuous_at_on f x s :=
  metric_space.continuous_at_within_intro H

theorem continuous_at_on_dest {x : U} {s : set U} (Hfx : continuous_at_on f x s) :
         ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε :=
  metric_space.continuous_at_on_dest Hfx

theorem continuous_on_intro {s : set U}
        (H : ∀ x ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε) :
        continuous_on f s :=
  metric_space.continuous_on_intro H

theorem continuous_on_dest {s : set U} (H : continuous_on f s) {x : U} (Hxs : x ∈ s) :
        ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε :=
  metric_space.continuous_on_dest H Hxs

theorem continuous_intro
        (H : ∀ x ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε) :
        continuous f :=
  metric_space.continuous_intro H

theorem continuous_dest (H : continuous f) (x : U) :
         ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, ∥x' - x∥ < δ → ∥(f x') - (f x)∥ < ε :=
  metric_space.continuous_dest H x

theorem continuous_at_intro {x : U}
        (H : ∀ ε : ℝ, ε > 0 → (∃ δ : ℝ, δ > 0 ∧ ∀ x' : U, ∥x' - x∥ < δ → ∥f x' - f x∥ < ε)) :
        continuous_at f x :=
  metric_space.continuous_at_intro H

theorem continuous_at_dest {x : U} (H : continuous_at f x) :
         ∀ ε : ℝ, ε > 0 → (∃ δ : ℝ, δ > 0 ∧ ∀ x' : U, ∥x' - x∥ < δ → ∥f x' - f x∥ < ε) :=
  metric_space.continuous_at_dest H

end normed_vector_space

section

open topology
variables {U V : Type}
variables [HU : normed_vector_space U] [HV : normed_vector_space V]
variables {f g : U → V}
include HU HV

theorem neg_continuous (Hf : continuous f) : continuous (λ x : U, - f x) :=
  begin
    apply continuous_of_forall_continuous_at,
    intro x,
    apply continuous_at_of_tendsto_at,
    apply neg_approaches,
    apply tendsto_at_of_continuous_at,
    apply forall_continuous_at_of_continuous,
    apply Hf
  end

theorem add_continuous (Hf : continuous f) (Hg : continuous g) : continuous (λ x, f x + g x) :=
  begin
    apply continuous_of_forall_continuous_at,
    intro y,
    apply continuous_at_of_tendsto_at,
    apply add_approaches,
    all_goals apply tendsto_at_of_continuous_at,
    all_goals apply forall_continuous_at_of_continuous,
    repeat assumption
  end

theorem sub_continuous (Hf : continuous f) (Hg : continuous g) : continuous (λ x, f x - g x) :=
  begin
    apply continuous_of_forall_continuous_at,
    intro y,
    apply continuous_at_of_tendsto_at,
    apply add_approaches,
    all_goals apply tendsto_at_of_continuous_at,
    all_goals apply forall_continuous_at_of_continuous,
    assumption,
    apply neg_continuous,
    assumption
  end

theorem smul_continuous (s : ℝ) (Hf : continuous f) : continuous (λ x : U, s • f x) :=
  begin
    apply continuous_of_forall_continuous_at,
    intro y,
    apply continuous_at_of_tendsto_at,
    apply smul_approaches,
    apply tendsto_at_of_continuous_at,
    apply forall_continuous_at_of_continuous,
    assumption
  end

end

end analysis