/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.rat.order
import data.int.char_zero

/-!
# Casts for Rational Numbers

## Summary

We define the canonical injection from ℚ into an arbitrary division ring and prove various
casting lemmas showing the well-behavedness of this injection.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom, cast, coercion, casting
-/

namespace rat
variable {α : Type*}
open_locale rat

section with_div_ring
variable [division_ring α]

/-- Construct the canonical injection from `ℚ` into an arbitrary
  division ring. If the field has positive characteristic `p`,
  we define `1 / p = 1 / 0 = 0` for consistency with our
  division by zero convention. -/
-- see Note [coercion into rings]
@[priority 900] instance cast_coe : has_coe_t ℚ α := ⟨λ r, r.1 / r.2⟩

@[simp] theorem cast_of_int (n : ℤ) : (of_int n : α) = n :=
show (n / (1:ℕ) : α) = n, by rw [nat.cast_one, div_one]

@[simp, norm_cast] theorem cast_coe_int (n : ℤ) : ((n : ℚ) : α) = n :=
by rw [coe_int_eq_of_int, cast_of_int]

@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℚ) : α) = n := cast_coe_int n

@[simp, norm_cast] theorem cast_zero : ((0 : ℚ) : α) = 0 :=
(cast_of_int _).trans int.cast_zero

@[simp, norm_cast] theorem cast_one : ((1 : ℚ) : α) = 1 :=
(cast_of_int _).trans int.cast_one

theorem cast_commute (r : ℚ) (a : α) : commute ↑r a :=
(r.1.cast_commute a).div_left (r.2.cast_commute a)

theorem cast_comm (r : ℚ) (a : α) : (r : α) * a = a * r :=
(cast_commute r a).eq

theorem commute_cast (a : α) (r : ℚ) : commute a r :=
(r.cast_commute a).symm

@[norm_cast] theorem cast_mk_of_ne_zero (a b : ℤ)
  (b0 : (b:α) ≠ 0) : (a /. b : α) = a / b :=
begin
  have b0' : b ≠ 0, { refine mt _ b0, simp {contextual := tt} },
  cases e : a /. b with n d h c,
  have d0 : (d:α) ≠ 0,
  { intro d0,
    have dd := denom_dvd a b,
    cases (show (d:ℤ) ∣ b, by rwa e at dd) with k ke,
    have : (b:α) = (d:α) * (k:α), {rw [ke, int.cast_mul], refl},
    rw [d0, zero_mul] at this, contradiction },
  rw [num_denom'] at e,
  have := congr_arg (coe : ℤ → α) ((mk_eq b0' $ ne_of_gt $ int.coe_nat_pos.2 h).1 e),
  rw [int.cast_mul, int.cast_mul, int.cast_coe_nat] at this,
  symmetry, change (a / b : α) = n / d,
  rw [div_eq_mul_inv, eq_div_iff_mul_eq d0, mul_assoc, (d.commute_cast _).eq,
      ← mul_assoc, this, mul_assoc, mul_inv_cancel b0, mul_one]
end

@[norm_cast] theorem cast_add_of_ne_zero : ∀ {m n : ℚ},
  (m.denom : α) ≠ 0 → (n.denom : α) ≠ 0 → ((m + n : ℚ) : α) = m + n
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := λ (d₁0 : (d₁:α) ≠ 0) (d₂0 : (d₂:α) ≠ 0), begin
  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 rfl),
  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 rfl),
  rw [num_denom', num_denom', add_def d₁0' d₂0'],
  suffices : (n₁ * (d₂ * (d₂⁻¹ * d₁⁻¹)) +
    n₂ * (d₁ * d₂⁻¹) * d₁⁻¹ : α) = n₁ * d₁⁻¹ + n₂ * d₂⁻¹,
  { rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, cast_mk_of_ne_zero],
    { simpa [division_def, left_distrib, right_distrib, mul_inv_rev', d₁0, d₂0, mul_assoc] },
    all_goals {simp [d₁0, d₂0]} },
  rw [← mul_assoc (d₂:α), mul_inv_cancel d₂0, one_mul,
      (nat.cast_commute _ _).eq], simp [d₁0, mul_assoc]
end

@[simp, norm_cast] theorem cast_neg : ∀ n, ((-n : ℚ) : α) = -n
| ⟨n, d, h, c⟩ := show (↑-n / d : α) = -(n / d),
  by rw [div_eq_mul_inv, div_eq_mul_inv, int.cast_neg, neg_mul_eq_neg_mul]

@[norm_cast] theorem cast_sub_of_ne_zero {m n : ℚ}
  (m0 : (m.denom : α) ≠ 0) (n0 : (n.denom : α) ≠ 0) : ((m - n : ℚ) : α) = m - n :=
have ((-n).denom : α) ≠ 0, by cases n; exact n0,
by simp [sub_eq_add_neg, (cast_add_of_ne_zero m0 this)]

@[norm_cast] theorem cast_mul_of_ne_zero : ∀ {m n : ℚ},
  (m.denom : α) ≠ 0 → (n.denom : α) ≠ 0 → ((m * n : ℚ) : α) = m * n
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := λ (d₁0 : (d₁:α) ≠ 0) (d₂0 : (d₂:α) ≠ 0), begin
  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 rfl),
  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 rfl),
  rw [num_denom', num_denom', mul_def d₁0' d₂0'],
  suffices : (n₁ * ((n₂ * d₂⁻¹) * d₁⁻¹) : α) = n₁ * (d₁⁻¹ * (n₂ * d₂⁻¹)),
  { rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, cast_mk_of_ne_zero],
    { simpa [division_def, mul_inv_rev', d₁0, d₂0, mul_assoc] },
    all_goals {simp [d₁0, d₂0]} },
  rw [(d₁.commute_cast (_:α)).inv_right'.eq]
end

@[norm_cast] theorem cast_inv_of_ne_zero : ∀ {n : ℚ},
  (n.num : α) ≠ 0 → (n.denom : α) ≠ 0 → ((n⁻¹ : ℚ) : α) = n⁻¹
| ⟨n, d, h, c⟩ := λ (n0 : (n:α) ≠ 0) (d0 : (d:α) ≠ 0), begin
  have n0' : (n:ℤ) ≠ 0 := λ e, by rw e at n0; exact n0 rfl,
  have d0' : (d:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d0; exact d0 rfl),
  rw [num_denom', inv_def],
  rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, inv_div];
  simp [n0, d0]
end

@[norm_cast] theorem cast_div_of_ne_zero {m n : ℚ} (md : (m.denom : α) ≠ 0)
  (nn : (n.num : α) ≠ 0) (nd : (n.denom : α) ≠ 0) : ((m / n : ℚ) : α) = m / n :=
have (n⁻¹.denom : ℤ) ∣ n.num,
by conv in n⁻¹.denom { rw [←(@num_denom n), inv_def] };
   apply denom_dvd,
have (n⁻¹.denom : α) = 0 → (n.num : α) = 0, from
λ h, let ⟨k, e⟩ := this in
  by have := congr_arg (coe : ℤ → α) e;
     rwa [int.cast_mul, int.cast_coe_nat, h, zero_mul] at this,
by rw [division_def, cast_mul_of_ne_zero md (mt this nn), cast_inv_of_ne_zero nn nd, division_def]

@[simp, norm_cast] theorem cast_inj [char_zero α] : ∀ {m n : ℚ}, (m : α) = n ↔ m = n
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := begin
  refine ⟨λ h, _, congr_arg _⟩,
  have d₁0 : d₁ ≠ 0 := ne_of_gt h₁,
  have d₂0 : d₂ ≠ 0 := ne_of_gt h₂,
  have d₁a : (d₁:α) ≠ 0 := nat.cast_ne_zero.2 d₁0,
  have d₂a : (d₂:α) ≠ 0 := nat.cast_ne_zero.2 d₂0,
  rw [num_denom', num_denom'] at h ⊢,
  rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero] at h; simp [d₁0, d₂0] at h ⊢,
  rwa [eq_div_iff_mul_eq d₂a, division_def, mul_assoc, (d₁.cast_commute (d₂:α)).inv_left'.eq,
    ← mul_assoc, ← division_def, eq_comm, eq_div_iff_mul_eq d₁a, eq_comm,
    ← int.cast_coe_nat, ← int.cast_mul, ← int.cast_coe_nat, ← int.cast_mul,
    int.cast_inj, ← mk_eq (int.coe_nat_ne_zero.2 d₁0) (int.coe_nat_ne_zero.2 d₂0)] at h
end

theorem cast_injective [char_zero α] : function.injective (coe : ℚ → α)
| m n := cast_inj.1

@[simp] theorem cast_eq_zero [char_zero α] {n : ℚ} : (n : α) = 0 ↔ n = 0 :=
by rw [← cast_zero, cast_inj]

theorem cast_ne_zero [char_zero α] {n : ℚ} : (n : α) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

@[simp, norm_cast] theorem cast_add [char_zero α] (m n) :
  ((m + n : ℚ) : α) = m + n :=
cast_add_of_ne_zero (nat.cast_ne_zero.2 $ ne_of_gt m.pos) (nat.cast_ne_zero.2 $ ne_of_gt n.pos)

@[simp, norm_cast] theorem cast_sub [char_zero α] (m n) :
  ((m - n : ℚ) : α) = m - n :=
cast_sub_of_ne_zero (nat.cast_ne_zero.2 $ ne_of_gt m.pos) (nat.cast_ne_zero.2 $ ne_of_gt n.pos)

@[simp, norm_cast] theorem cast_mul [char_zero α] (m n) :
  ((m * n : ℚ) : α) = m * n :=
cast_mul_of_ne_zero (nat.cast_ne_zero.2 $ ne_of_gt m.pos) (nat.cast_ne_zero.2 $ ne_of_gt n.pos)

@[simp, norm_cast] theorem cast_bit0 [char_zero α] (n : ℚ) :
  ((bit0 n : ℚ) : α) = bit0 n :=
cast_add _ _

@[simp, norm_cast] theorem cast_bit1 [char_zero α] (n : ℚ) :
  ((bit1 n : ℚ) : α) = bit1 n :=
by rw [bit1, cast_add, cast_one, cast_bit0]; refl

variable (α)

/-- Coercion `ℚ → α` as a `ring_hom`. -/
def cast_hom [char_zero α] : ℚ →+* α := ⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩

variable {α}

@[simp] lemma coe_cast_hom [char_zero α] : ⇑(cast_hom α) = coe := rfl

@[simp, norm_cast] theorem cast_inv [char_zero α] (n) : ((n⁻¹ : ℚ) : α) = n⁻¹ :=
(cast_hom α).map_inv _

@[simp, norm_cast] theorem cast_div [char_zero α] (m n) :
  ((m / n : ℚ) : α) = m / n :=
(cast_hom α).map_div _ _

@[norm_cast] theorem cast_mk [char_zero α] (a b : ℤ) : ((a /. b) : α) = a / b :=
by simp only [mk_eq_div, cast_div, cast_coe_int]

@[simp, norm_cast] theorem cast_pow [char_zero α] (q) (k : ℕ) :
  ((q ^ k : ℚ) : α) = q ^ k :=
(cast_hom α).map_pow q k

end with_div_ring

@[simp, norm_cast] theorem cast_nonneg [linear_ordered_field α] : ∀ {n : ℚ}, 0 ≤ (n : α) ↔ 0 ≤ n
| ⟨n, d, h, c⟩ :=
  by { rw [num_denom', cast_mk, mk_eq_div, div_nonneg_iff, div_nonneg_iff], norm_cast }

@[simp, norm_cast] theorem cast_le [linear_ordered_field α] {m n : ℚ} : (m : α) ≤ n ↔ m ≤ n :=
by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]

@[simp, norm_cast] theorem cast_lt [linear_ordered_field α] {m n : ℚ} : (m : α) < n ↔ m < n :=
by simpa [-cast_le] using not_congr (@cast_le α _ n m)

@[simp] theorem cast_nonpos [linear_ordered_field α] {n : ℚ} : (n : α) ≤ 0 ↔ n ≤ 0 :=
by rw [← cast_zero, cast_le]

@[simp] theorem cast_pos [linear_ordered_field α] {n : ℚ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

@[simp] theorem cast_lt_zero [linear_ordered_field α] {n : ℚ} : (n : α) < 0 ↔ n < 0 :=
by rw [← cast_zero, cast_lt]

@[simp, norm_cast] theorem cast_id : ∀ n : ℚ, ↑n = n
| ⟨n, d, h, c⟩ := by rw [num_denom', cast_mk, mk_eq_div]

@[simp, norm_cast] theorem cast_min [linear_ordered_field α] {a b : ℚ} :
  (↑(min a b) : α) = min a b :=
by by_cases a ≤ b; simp [h, min]

@[simp, norm_cast] theorem cast_max [linear_ordered_field α] {a b : ℚ} :
  (↑(max a b) : α) = max a b :=
by by_cases b ≤ a; simp [h, max]

@[simp, norm_cast] theorem cast_abs [linear_ordered_field α] {q : ℚ} :
  ((abs q : ℚ) : α) = abs q :=
by simp [abs]

end rat

open rat ring_hom

lemma ring_hom.eq_rat_cast {k} [division_ring k] (f : ℚ →+* k) (r : ℚ) : f r = r :=
calc f r = f (r.1 / r.2) : by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]
     ... = f r.1 / f r.2 : f.map_div _ _
     ... = r.1 / r.2     : by rw [map_nat_cast, map_int_cast]

-- This seems to be true for a `[char_p k]` too because `k'` must have the same characteristic
-- but the proof would be much longer
lemma ring_hom.map_rat_cast {k k'} [division_ring k] [char_zero k] [division_ring k']
  (f : k →+* k') (r : ℚ) :
  f r = r :=
(f.comp (cast_hom k)).eq_rat_cast r

lemma ring_hom.ext_rat {R : Type*} [semiring R] (f g : ℚ →+* R) : f = g :=
begin
  ext r,
  refine rat.num_denom_cases_on' r _,
  intros a b b0,
  let φ : ℤ →+* R := f.comp (int.cast_ring_hom ℚ),
  let ψ : ℤ →+* R := g.comp (int.cast_ring_hom ℚ),
  rw [rat.mk_eq_div, int.cast_coe_nat],
  have b0' : (b:ℚ) ≠ 0 := nat.cast_ne_zero.2 b0,
  have : ∀ n : ℤ, f n = g n := λ n, show φ n = ψ n, by rw [φ.ext_int ψ],
  calc f (a * b⁻¹)
      = f a * f b⁻¹ * (g (b:ℤ) * g b⁻¹) :
        by rw [int.cast_coe_nat, ← g.map_mul, mul_inv_cancel b0', g.map_one, mul_one, f.map_mul]
  ... = g a * f b⁻¹ * (f (b:ℤ) * g b⁻¹) : by rw [this a, ← this b]
  ... = g (a * b⁻¹) :
        by rw [int.cast_coe_nat, mul_assoc, ← mul_assoc (f b⁻¹),
              ← f.map_mul, inv_mul_cancel b0', f.map_one, one_mul, g.map_mul]
end

instance rat.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℚ →+* R) :=
⟨ring_hom.ext_rat⟩

namespace monoid_with_zero_hom

variables {M : Type*} [group_with_zero M]

/-- If `f` and `g` agree on the integers then they are equal `φ`.

See note [partially-applied ext lemmas] for why `comp` is used here. -/
@[ext]
theorem ext_rat {f g : monoid_with_zero_hom ℚ M}
  (same_on_int : f.comp (int.cast_ring_hom ℚ).to_monoid_with_zero_hom =
    g.comp (int.cast_ring_hom ℚ).to_monoid_with_zero_hom) : f = g :=
begin
  have same_on_int' : ∀ k : ℤ, f k = g k := congr_fun same_on_int,
  ext x,
  rw [← @rat.num_denom x, rat.mk_eq_div, f.map_div, g.map_div,
    same_on_int' x.num, same_on_int' x.denom],
end

/-- Positive integer values of a morphism `φ` and its value on `-1` completely determine `φ`. -/
theorem ext_rat_on_pnat {f g : monoid_with_zero_hom ℚ M}
  (same_on_neg_one : f (-1) = g (-1)) (same_on_pnat : ∀ n : ℕ, 0 < n → f n = g n) : f = g :=
ext_rat $ ext_int' (by simpa) ‹_›

end monoid_with_zero_hom


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

/-!
# Bind operation for multisets

This file defines a few basic operations on `multiset`, notably the monadic bind.

## Main declarations

* `multiset.join`: The join, aka union or sum, of multisets.
* `multiset.bind`: The bind of a multiset-indexed family of multisets.
* `multiset.product`: Cartesian product of two multisets.
* `multiset.sigma`: Disjoint sum of multisets in a sigma type.
-/

variables {α β γ δ : Type*}

namespace multiset

/-! ### Join -/

/-- `join S`, where `S` is a multiset of multisets, is the lift of the list join
  operation, that is, the union of all the sets.
     join {{1, 2}, {1, 2}, {0, 1}} = {0, 1, 1, 1, 2, 2} -/
def join : multiset (multiset α) → multiset α := sum

lemma coe_join : ∀ L : list (list α),
  join (L.map (@coe _ (multiset α) _) : multiset (multiset α)) = L.join
| []       := rfl
| (l :: L) := congr_arg (λ s : multiset α, ↑l + s) (coe_join L)

@[simp] lemma join_zero : @join α 0 = 0 := rfl
@[simp] lemma join_cons (s S) : @join α (s ::ₘ S) = s + join S := sum_cons _ _
@[simp] lemma join_add (S T) : @join α (S + T) = join S + join T := sum_add _ _
@[simp] lemma singleton_join (a) : join ({a} : multiset (multiset α)) = a := sum_singleton _

@[simp] lemma mem_join {a S} : a ∈ @join α S ↔ ∃ s ∈ S, a ∈ s :=
multiset.induction_on S (by simp) $
  by simp [or_and_distrib_right, exists_or_distrib] {contextual := tt}

@[simp] lemma card_join (S) : card (@join α S) = sum (map card S) :=
multiset.induction_on S (by simp) (by simp)

lemma rel_join {r : α → β → Prop} {s t} (h : rel (rel r) s t) : rel r s.join t.join :=
begin
  induction h,
  case rel.zero { simp },
  case rel.cons : a b s t hab hst ih { simpa using hab.add ih }
end

/-! ### Bind -/

section bind
variables (a : α) (s t : multiset α) (f g : α → multiset β)

/-- `s.bind f` is the monad bind operation, defined as `(s.map f).join`. It is the union of `f a` as
`a` ranges over `s`. -/
def bind (s : multiset α) (f : α → multiset β) : multiset β := (s.map f).join

@[simp] lemma coe_bind (l : list α) (f : α → list β) : @bind α β l (λ a, f a) = l.bind f :=
by rw [list.bind, ←coe_join, list.map_map]; refl

@[simp] lemma zero_bind : bind 0 f = 0 := rfl
@[simp] lemma cons_bind : (a ::ₘ s).bind f = f a + s.bind f := by simp [bind]
@[simp] lemma singleton_bind : bind {a} f = f a := by simp [bind]
@[simp] lemma add_bind : (s + t).bind f = s.bind f + t.bind f := by simp [bind]
@[simp] lemma bind_zero : s.bind (λ a, 0 : α → multiset β) = 0 := by simp [bind, join, nsmul_zero]
@[simp] lemma bind_add : s.bind (λ a, f a + g a) = s.bind f + s.bind g := by simp [bind, join]

@[simp] lemma bind_cons (f : α → β) (g : α → multiset β) :
  s.bind (λ a, f a ::ₘ g a) = map f s + s.bind g :=
multiset.induction_on s (by simp) (by simp [add_comm, add_left_comm] {contextual := tt})

@[simp] lemma bind_singleton (f : α → β) : s.bind (λ x, ({f x} : multiset β)) = map f s :=
multiset.induction_on s (by rw [zero_bind, map_zero]) (by simp [singleton_add])

@[simp] lemma mem_bind {b s} {f : α → multiset β} : b ∈ bind s f ↔ ∃ a ∈ s, b ∈ f a :=
by simp [bind]; simp [-exists_and_distrib_right, exists_and_distrib_right.symm];
   rw exists_swap; simp [and_assoc]

@[simp] lemma card_bind : (s.bind f).card = (s.map (card ∘ f)).sum := by simp [bind]

lemma bind_congr {f g : α → multiset β} {m : multiset α} :
  (∀ a ∈ m, f a = g a) → bind m f = bind m g :=
by simp [bind] {contextual := tt}

lemma bind_hcongr {β' : Type*} {m : multiset α} {f : α → multiset β} {f' : α → multiset β'}
  (h : β = β') (hf : ∀a ∈ m, f a == f' a) :
  bind m f == bind m f' :=
begin subst h, simp at hf, simp [bind_congr hf] end

lemma map_bind (m : multiset α) (n : α → multiset β) (f : β → γ) :
  map f (bind m n) = bind m (λ a, map f (n a)) :=
multiset.induction_on m (by simp) (by simp {contextual := tt})

lemma bind_map (m : multiset α) (n : β → multiset γ) (f : α → β) :
  bind (map f m) n = bind m (λ a, n (f a)) :=
multiset.induction_on m (by simp) (by simp {contextual := tt})

lemma bind_assoc {s : multiset α} {f : α → multiset β} {g : β → multiset γ} :
  (s.bind f).bind g = s.bind (λ a, (f a).bind g) :=
multiset.induction_on s (by simp) (by simp {contextual := tt})

lemma bind_bind (m : multiset α) (n : multiset β) {f : α → β → multiset γ} :
  (bind m $ λ a, bind n $ λ b, f a b) = (bind n $ λ b, bind m $ λ a, f a b) :=
multiset.induction_on m (by simp) (by simp {contextual := tt})

lemma bind_map_comm (m : multiset α) (n : multiset β) {f : α → β → γ} :
  (bind m $ λ a, n.map $ λ b, f a b) = (bind n $ λ b, m.map $ λ a, f a b) :=
multiset.induction_on m (by simp) (by simp {contextual := tt})

@[simp, to_additive]
lemma prod_bind [comm_monoid β] (s : multiset α) (t : α → multiset β) :
  (s.bind t).prod = (s.map $ λ a, (t a).prod).prod :=
multiset.induction_on s (by simp) (assume a s ih, by simp [ih, cons_bind])

lemma rel_bind {r : α → β → Prop} {p : γ → δ → Prop} {s t} {f : α → multiset γ} {g : β → multiset δ}
  (h : (r ⇒ rel p) f g) (hst : rel r s t) :
  rel p (s.bind f) (t.bind g) :=
by { apply rel_join, rw rel_map, exact hst.mono (λ a ha b hb hr, h hr) }

lemma count_sum [decidable_eq α] {m : multiset β} {f : β → multiset α} {a : α} :
  count a (map f m).sum = sum (m.map $ λ b, count a $ f b) :=
multiset.induction_on m (by simp) ( by simp)

lemma count_bind [decidable_eq α] {m : multiset β} {f : β → multiset α} {a : α} :
  count a (bind m f) = sum (m.map $ λ b, count a $ f b) := count_sum

lemma le_bind {α β : Type*} {f : α → multiset β} (S : multiset α) {x : α} (hx : x ∈ S) :
  f x ≤ S.bind f :=
begin
  classical,
  rw le_iff_count, intro a,
  rw count_bind, apply le_sum_of_mem,
  rw mem_map, exact ⟨x, hx, rfl⟩
end
end bind

/-! ### Product of two multisets -/

section product
variables (a : α) (b : β) (s : multiset α) (t : multiset β)

/-- The multiplicity of `(a, b)` in `s.product t` is
  the product of the multiplicity of `a` in `s` and `b` in `t`. -/
def product (s : multiset α) (t : multiset β) : multiset (α × β) := s.bind $ λ a, t.map $ prod.mk a

@[simp] lemma coe_product (l₁ : list α) (l₂ : list β) : @product α β l₁ l₂ = l₁.product l₂ :=
by { rw [product, list.product, ←coe_bind], simp }

@[simp] lemma zero_product : @product α β 0 t = 0 := rfl
--TODO: Add `product_zero`

@[simp] lemma cons_product : (a ::ₘ s).product t = map (prod.mk a) t + s.product t :=
by simp [product]

@[simp] lemma product_singleton : ({a} : multiset α).product ({b} : multiset β) = {(a, b)} :=
by simp only [product, bind_singleton, map_singleton]

@[simp] lemma add_product (s t : multiset α) (u : multiset β) :
  (s + t).product u = s.product u + product t u :=
by simp [product]

@[simp] lemma product_add (s : multiset α) : ∀ t u : multiset β,
  s.product (t + u) = s.product t + s.product u :=
multiset.induction_on s (λ t u, rfl) $ λ a s IH t u,
  by rw [cons_product, IH]; simp; cc

@[simp] lemma mem_product {s t} : ∀ {p : α × β}, p ∈ @product α β s t ↔ p.1 ∈ s ∧ p.2 ∈ t
| (a, b) := by simp [product, and.left_comm]

@[simp] lemma card_product : (s.product t).card = s.card * t.card :=
by simp [product, repeat, (∘), mul_comm]

end product

/-! ### Disjoint sum of multisets -/

section sigma
variables {σ : α → Type*} (a : α) (s : multiset α) (t : Π a, multiset (σ a))

/-- `sigma s t` is the dependent version of `product`. It is the sum of
  `(a, b)` as `a` ranges over `s` and `b` ranges over `t a`. -/
protected def sigma (s : multiset α) (t : Π a, multiset (σ a)) : multiset (Σ a, σ a) :=
s.bind $ λ a, (t a).map $ sigma.mk a

@[simp] lemma coe_sigma (l₁ : list α) (l₂ : Π a, list (σ a)) :
  @multiset.sigma α σ l₁ (λ a, l₂ a) = l₁.sigma l₂ :=
by rw [multiset.sigma, list.sigma, ←coe_bind]; simp

@[simp] lemma zero_sigma : @multiset.sigma α σ 0 t = 0 := rfl

@[simp] lemma cons_sigma : (a ::ₘ s).sigma t = (t a).map (sigma.mk a) + s.sigma t :=
by simp [multiset.sigma]

@[simp] lemma sigma_singleton (b : α → β) :
  ({a} : multiset α).sigma (λ a, ({b a} : multiset β)) = {⟨a, b a⟩} := rfl

@[simp] lemma add_sigma (s t : multiset α) (u : Π a, multiset (σ a)) :
  (s + t).sigma u = s.sigma u + t.sigma u :=
by simp [multiset.sigma]

@[simp] lemma sigma_add : ∀ t u : Π a, multiset (σ a),
  s.sigma (λ a, t a + u a) = s.sigma t + s.sigma u :=
multiset.induction_on s (λ t u, rfl) $ λ a s IH t u,
  by rw [cons_sigma, IH]; simp; cc

@[simp] lemma mem_sigma {s t} : ∀ {p : Σ a, σ a},
  p ∈ @multiset.sigma α σ s t ↔ p.1 ∈ s ∧ p.2 ∈ t p.1
| ⟨a, b⟩ := by simp [multiset.sigma, and_assoc, and.left_comm]

@[simp] lemma card_sigma :
  card (s.sigma t) = sum (map (λ a, card (t a)) s) :=
by simp [multiset.sigma, (∘)]

end sigma
end multiset


variable g : ℕ → ℕ → ℕ
variable hg : g 0 0 = 0

theorem gex1 : ∃ x, g x x = x := ⟨0, hg⟩
theorem gex2 : ∃ x, g x 0 = x := ⟨0, hg⟩
theorem gex3 : ∃ x, g 0 0 = x := ⟨0, hg⟩
theorem gex4 : ∃ x, g x x = 0 := ⟨0, hg⟩

set_option pp.implicit true
#print gex1
#print gex2
#print gex3
#print gex4


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

! This file was ported from Lean 3 source module analysis.von_neumann_algebra.basic
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Dual
import Mathbin.Analysis.NormedSpace.Star.Basic
import Mathbin.Analysis.Complex.Basic
import Mathbin.Analysis.InnerProductSpace.Adjoint
import Mathbin.Algebra.Star.Subalgebra

/-!
# Von Neumann algebras

We give the "abstract" and "concrete" definitions of a von Neumann algebra.
We still have a major project ahead of us to show the equivalence between these definitions!

An abstract von Neumann algebra `wstar_algebra M` is a C^* algebra with a Banach space predual,
per Sakai (1971).

A concrete von Neumann algebra `von_neumann_algebra H` (where `H` is a Hilbert space)
is a *-closed subalgebra of bounded operators on `H` which is equal to its double commutant.

We'll also need to prove the von Neumann double commutant theorem,
that the concrete definition is equivalent to a *-closed subalgebra which is weakly closed.
-/

universe u v

/-- Sakai's definition of a von Neumann algebra as a C^* algebra with a Banach space predual.

So that we can unambiguously talk about these "abstract" von Neumann algebras
in parallel with the "concrete" ones (weakly closed *-subalgebras of B(H)),
we name this definition `wstar_algebra`.

Note that for now we only assert the mere existence of predual, rather than picking one.
This may later prove problematic, and need to be revisited.
Picking one may cause problems with definitional unification of different instances.
One the other hand, not picking one means that the weak-* topology
(which depends on a choice of predual) must be defined using the choice,
and we may be unhappy with the resulting opaqueness of the definition.
-/
class WstarAlgebra (M : Type u) [NormedRing M] [StarRing M] [CstarRing M] [Module ℂ M]
  [NormedAlgebra ℂ M] [StarModule ℂ M] where
  exists_predual :
    ∃ (X : Type u)(_ : NormedAddCommGroup X)(_ : NormedSpace ℂ X)(_ : CompleteSpace X),
      Nonempty (NormedSpace.Dual ℂ X ≃ₗᵢ⋆[ℂ] M)
#align wstar_algebra WstarAlgebra

-- TODO: Without this, `von_neumann_algebra` times out. Why?
/-- The double commutant definition of a von Neumann algebra,
as a *-closed subalgebra of bounded operators on a Hilbert space,
which is equal to its double commutant.

Note that this definition is parameterised by the Hilbert space
on which the algebra faithfully acts, as is standard in the literature.
See `wstar_algebra` for the abstract notion (a C^*-algebra with Banach space predual).

Note this is a bundled structure, parameterised by the Hilbert space `H`,
rather than a typeclass on the type of elements.
Thus we can't say that the bounded operators `H →L[ℂ] H` form a `von_neumann_algebra`
(although we will later construct the instance `wstar_algebra (H →L[ℂ] H)`),
and instead will use `⊤ : von_neumann_algebra H`.
-/
@[nolint has_nonempty_instance]
structure VonNeumannAlgebra (H : Type u) [NormedAddCommGroup H] [InnerProductSpace ℂ H]
  [CompleteSpace H] extends StarSubalgebra ℂ (H →L[ℂ] H) where
  centralizer_centralizer' : Set.centralizer (Set.centralizer carrier) = carrier
#align von_neumann_algebra VonNeumannAlgebra

/-- Consider a von Neumann algebra acting on a Hilbert space `H` as a *-subalgebra of `H →L[ℂ] H`.
(That is, we forget that it is equal to its double commutant
or equivalently that it is closed in the weak and strong operator topologies.)
-/
add_decl_doc VonNeumannAlgebra.toStarSubalgebra

namespace VonNeumannAlgebra

variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H]

instance : SetLike (VonNeumannAlgebra H) (H →L[ℂ] H) :=
  ⟨VonNeumannAlgebra.carrier, fun S T h => by cases S <;> cases T <;> congr ⟩

instance : StarMemClass (VonNeumannAlgebra H) (H →L[ℂ] H) where star_mem s a := s.star_mem'

instance : SubringClass (VonNeumannAlgebra H) (H →L[ℂ] H)
    where
  add_mem := add_mem'
  mul_mem := mul_mem'
  one_mem := one_mem'
  zero_mem := zero_mem'
  neg_mem s a ha := show -a ∈ s.toStarSubalgebra from neg_mem ha

@[simp]
theorem mem_carrier {S : VonNeumannAlgebra H} {x : H →L[ℂ] H} :
    x ∈ S.carrier ↔ x ∈ (S : Set (H →L[ℂ] H)) :=
  Iff.rfl
#align von_neumann_algebra.mem_carrier VonNeumannAlgebra.mem_carrier

@[ext]
theorem ext {S T : VonNeumannAlgebra H} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
  SetLike.ext h
#align von_neumann_algebra.ext VonNeumannAlgebra.ext

@[simp]
theorem centralizer_centralizer (S : VonNeumannAlgebra H) :
    Set.centralizer (Set.centralizer (S : Set (H →L[ℂ] H))) = S :=
  S.centralizer_centralizer'
#align von_neumann_algebra.centralizer_centralizer VonNeumannAlgebra.centralizer_centralizer

/-- The centralizer of a `von_neumann_algebra`, as a `von_neumann_algebra`.-/
def commutant (S : VonNeumannAlgebra H) : VonNeumannAlgebra H :=
  {
    StarSubalgebra.centralizer ℂ (S : Set (H →L[ℂ] H)) fun a (ha : a ∈ S) =>
      (star_mem ha : _) with
    carrier := Set.centralizer (S : Set (H →L[ℂ] H))
    centralizer_centralizer' := by rw [S.centralizer_centralizer] }
#align von_neumann_algebra.commutant VonNeumannAlgebra.commutant

@[simp]
theorem coe_commutant (S : VonNeumannAlgebra H) :
    ↑S.commutant = Set.centralizer (S : Set (H →L[ℂ] H)) :=
  rfl
#align von_neumann_algebra.coe_commutant VonNeumannAlgebra.coe_commutant

@[simp]
theorem mem_commutant_iff {S : VonNeumannAlgebra H} {z : H →L[ℂ] H} :
    z ∈ S.commutant ↔ ∀ g ∈ S, g * z = z * g :=
  Iff.rfl
#align von_neumann_algebra.mem_commutant_iff VonNeumannAlgebra.mem_commutant_iff

@[simp]
theorem commutant_commutant (S : VonNeumannAlgebra H) : S.commutant.commutant = S :=
  SetLike.coe_injective S.centralizer_centralizer'
#align von_neumann_algebra.commutant_commutant VonNeumannAlgebra.commutant_commutant

end VonNeumannAlgebra


lemma p_equiv_np_implies_false : ∀ P, ¬(P ↔ ¬P) :=
begin
  intro P,
  by_contradiction,
  have h := classical.em P, cases h,
  { have np := h.mp h_1,
    apply (np h_1), },
  { have p := h.mpr h_1,
    apply (h_1 p), }
end


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default

universes u v

namespace Mathlib

namespace smt

def array (α : Type u) (β : Type v) :=
  α → β

def select {α : Type u} {β : Type v} (a : array α β) (i : α) : β :=
  a i

theorem arrayext {α : Type u} {β : Type v} (a₁ : array α β) (a₂ : array α β) : (∀ (i : α), select a₁ i = select a₂ i) → a₁ = a₂ :=
  funext

def store {α : Type u} {β : Type v} [DecidableEq α] (a : array α β) (i : α) (v : β) : array α β :=
  fun (j : α) => ite (j = i) v (select a j)

@[simp] theorem select_store {α : Type u} {β : Type v} [DecidableEq α] (a : array α β) (i : α) (v : β) : select (store a i v) i = v := sorry

@[simp] theorem select_store_ne {α : Type u} {β : Type v} [DecidableEq α] (a : array α β) (i : α) (j : α) (v : β) : j ≠ i → select (store a i v) j = select a j := sorry


import lambda_calculus.utlc.basic
import lambda_calculus.utlc.identities
import lambda_calculus.utlc.reduction
import lambda_calculus.utlc.beta.basic
import lambda_calculus.utlc.eta.basic

namespace lambda_calculus
namespace utlc
namespace βη

def head_step (f g: utlc) := β.head_step f g ∨ η.head_step f g

instance : has_βη_reduction utlc := ⟨ reduction_step_of head_step ⟩

theorem step_iff (f g: utlc): f →βη g ↔ f →β g ∨ f →η g :=
begin
  induction f generalizing g;
  simp only [lambda_notation, dot_notation, has_βη_reduction.step] at *,
  { simp [head_step] },
  { simp [lambda_reduction_step_iff, head_step, η.lambda_step_iff, β.lambda_step_iff, f_ih,
      and_or_distrib_left, exists_or_distrib,
      @or.left_comm _ (f_f = g ↑¹ 0 · ↓0)] },
  { simp [dot_reduction_step_iff, head_step, η.dot_step_iff', β.dot_step_iff, f_ih_f, f_ih_g,
      and_or_distrib_left, exists_or_distrib, and.assoc, or.assoc],
    conv {
      congr,
      congr,
      congr,
      funext,
      rw [and_comm],
      skip,
      skip,
    }, itauto }
end

theorem reduction_of_beta {f g: utlc}: f ↠β g → f ↠βη g :=
begin
  intro p,
  induction p with x g hfx hxg ih,
  refl,
  apply trans ih (relation.refl_trans_gen.single _),
  rw [step_iff],
  exact or.inl hxg,
end

theorem reduction_of_eta {f g: utlc}: f ↠η g → f ↠βη g :=
begin
  intro p,
  induction p with x g hfx hxg ih,
  refl,
  apply trans ih (relation.refl_trans_gen.single _),
  rw [step_iff],
  exact or.inr hxg,
end

def head_reduced (f: utlc): bool := β.head_reduced f ∧ η.head_reduced f

def reduced := reduced_of head_reduced

theorem reduced_iff_no_reduction {f: utlc}: reduced f ↔ ∀ g, ¬ f →βη g :=
begin
  apply reduced_iff_not_reduction_step,
  intro f,
  simp [head_reduced, head_step, β.head_reduced_iff_not_head_step, η.head_reduced_iff_not_head_step,
    forall_and_distrib, not_or_distrib],
end

end βη
end utlc
end lambda_calculus


constants p q : Prop

lemma t1 : p → q → p :=
  assume hp : p,
  assume hq : q,
  show p, from hp


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

import algebra.category.Module.basic
import linear_algebra.basic
import category_theory.abelian.basic
--import exact
import modules.trivial_equivalence
import modules.mono_epi
import modules.to_mathlib

open category_theory
open category_theory.limits
open category_theory.abelian
open category_theory.preadditive
open category_theory.limits.walking_parallel_pair
open linear_map

noncomputable theory

universe u

variables {R : Type u} [ring R]

namespace Module

section cokernel
variables {M N : Module R} (f : M ⟶ N)

def cokernel_cocone : cofork f 0 :=
cokernel_cofork.of_π (up f.range.mkq) $ comp_mkq _

def cokernel_is_colimit : is_colimit (cokernel_cocone f) :=
cofork.is_colimit.mk _
  (λ s, f.range.liftq (cofork.π s) $ range_le_ker_iff.2 $ cokernel_cofork.condition s)
  (λ s, f.range.liftq_mkq (cofork.π s) _)
  (λ s m h,
  begin
    haveI : epi (up f.range.mkq) := epi_of_range_eq_top _ (submodule.range_mkq _),
    apply (cancel_epi (up f.range.mkq)).1,
    convert h walking_parallel_pair.one,
    exact submodule.liftq_mkq _ _ _
  end)

end cokernel

section cokernel

instance module_has_cokernels : has_cokernels.{u} (Module R) :=
⟨λ _ _ f, ⟨cokernel_cocone f, cokernel_is_colimit f⟩⟩

end cokernel

section products

def module_has_limit_pair (M N : Module R) : has_limit (pair M N) :=
{ cone := @binary_fan.mk _ _ M N (of R $ M × N) (fst R M N) (snd R M N),
  is_limit :=
  { lift := λ s, prod (s.π.app walking_pair.left) (s.π.app walking_pair.right),
    fac' := λ s j, walking_pair.cases_on j (fst_prod _ _) (snd_prod _ _),
    uniq' := λ s m h,
    begin
      ext,
      rw prod_apply,
      { rw ←h walking_pair.left, refl },
      { rw ←h walking_pair.right, refl }
    end } }

section

local attribute [instance] module_has_limit_pair

instance module_has_binary_products : has_binary_products.{u} (Module R) :=
has_binary_products_of_has_limit_pair (Module R)

end

def module_has_colimit_pair (M N : Module R) : has_colimit (pair M N) :=
{ cocone := @binary_cofan.mk _ _ M N (of R $ M × N) (inl R M N) (inr R M N),
  is_colimit :=
  { desc := λ s, coprod (s.ι.app walking_pair.left) (s.ι.app walking_pair.right),
    fac' := λ s j, walking_pair.cases_on j (coprod_inl _ _) (coprod_inr _ _),
    uniq' := λ s m h,
    begin
      ext,
      erw [coprod_apply, ←h walking_pair.left, ←h walking_pair.right,
        binary_cofan.mk_ι_app_left, binary_cofan.mk_ι_app_right, comp_apply, comp_apply, ←map_add],
      apply congr_arg,
      rw [inl_apply, inr_apply, prod.mk_add_mk, zero_add, add_zero, prod.mk.eta]
    end } }

section

local attribute [instance] module_has_colimit_pair

instance module_has_binary_coproducts : has_binary_coproducts.{u} (Module R) :=
has_binary_coproducts_of_has_colimit_pair (Module R)

end

end products

instance : abelian.{u} (Module.{u} R) :=
{ hom_group := by apply_instance,
  distrib_left' := λ P Q R f f' g,
    show (f + f') ≫ g = f ≫ g + f' ≫ g, by ext; simp,
  distrib_right' := λ P Q R f g g',
    show f ≫ (g + g') = f ≫ g + f ≫ g', by ext; simp,
  has_zero_object := by apply_instance,
  has_binary_products := by apply_instance,
  has_binary_coproducts := by apply_instance,
  has_kernels := by apply_instance,
  has_cokernels := by apply_instance,
  mono_is_kernel := λ A B f m,
  { Z := of R f.range.quotient,
    g := f.range.mkq,
    w := comp_mkq f,
    is_limit := begin
      refine kernel.transport _ _ _ _,
      { haveI := m,
        exact up_equiv (equiv_range_of_ker_bot f (ker_eq_bot_of_mono f)), },
      { ext, refl }
    end },
  epi_is_cokernel := λ A B f e,
  { W := of R f.ker,
    g := f.ker.subtype,
    w := ker_comp f,
    is_colimit := begin
      refine cokernel.transport _ _ _ _,
      { haveI := e,
        exact up_equiv (equiv_range_of_range_top f (range_eq_top_of_epi f)), },
      { ext, refl }
    end } }

section
variables {X Y Z : Module R} (f : X ⟶ Y) (g : Y ⟶ Z)

lemma exact_is_exact : exact f g ↔ f.range = g.ker :=
⟨λ h, le_antisymm (range_le_ker_iff.2 h.1) (ker_le_range_iff.2 h.2),
 λ h, ⟨range_le_ker_iff.1 $ le_of_eq h, ker_le_range_iff.1 $ le_of_eq h.symm⟩⟩

 end

end Module


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Bryan Gin-ge Chen, Robert Y. Lewis, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.doc_commands
import Mathlib.PostPort

namespace Mathlib

/-!

# Core tactic documentation

This file adds the majority of the interactive tactics from core Lean (i.e. pre-mathlib) to
the API documentation.

## TODO

* Make a PR to core changing core docstrings to the docstrings below,
and also changing the docstrings of `cc`, `simp` and `conv` to the ones
already in the API docs.

* SMT tactics are currently not documented.

* `rsimp` and `constructor_matching` are currently not documented.

* `dsimp` deserves better documentation.
-/

/-- Proves a goal of the form `s = t` when `s` and `t` are expressions built up out of a binary
operation, and equality can be proved using associativity and commutativity of that operation. -/
/--
`by_cases p` splits the main goal into two cases, assuming `h : p` in the first branch, and
`h : ¬ p` in the second branch. You can specify the name of the new hypothesis using the syntax
`by_cases h : p`.

If `p` is not already decidable, `by_cases` will use the instance `classical.prop_decidable p`.
-/
/--
If the target of the main goal is a proposition `p`, `by_contra h` reduces the goal to proving
`false` using the additional hypothesis `h : ¬ p`. If `h` is omitted, a name is generated
automatically.

This tactic requires that `p` is decidable. To ensure that all propositions are decidable via
classical reasoning, use `open_locale classical`
(or `local attribute [instance, priority 10] classical.prop_decidable` if you are not using
mathlib).
-/
/--
`cases_matching p` applies the `cases` tactic to a hypothesis `h : type`
if `type` matches the pattern `p`.

`cases_matching [p_1, ..., p_n]` applies the `cases` tactic to a hypothesis `h : type`
if `type` matches one of the given patterns.

`cases_matching* p` is a more efficient and compact version
of `focus1 { repeat { cases_matching p } }`.
It is more efficient because the pattern is compiled once.

`casesm` is shorthand for `cases_matching`.

Example: The following tactic destructs all conjunctions and disjunctions in the current context.
```
cases_matching* [_ ∨ _, _ ∧ _]
```
-/
/--
* `cases_type I` applies the `cases` tactic to a hypothesis `h : (I ...)`
* `cases_type I_1 ... I_n` applies the `cases` tactic to a hypothesis
  `h : (I_1 ...)` or ... or `h : (I_n ...)`
* `cases_type* I` is shorthand for `focus1 { repeat { cases_type I } }`
* `cases_type! I` only applies `cases` if the number of resulting subgoals is <= 1.

Example: The following tactic destructs all conjunctions and disjunctions in the current context.
```
cases_type* or and
```
-/
/--
Close goals of the form `n ≠ m` when `n` and `m` have type `nat`, `char`, `string`, `int`
or `fin sz`, and they are literals. It also closes goals of the form `n < m`, `n > m`, `n ≤ m` and
`n ≥ m` for `nat`. If the goal is of the form `n = m`, then it tries to close it using reflexivity.

In mathlib, consider using `norm_num` instead for numeric types.
-/
/--
The `congr` tactic attempts to identify both sides of an equality goal `A = B`,
leaving as new goals the subterms of `A` and `B` which are not definitionally equal.
Example: suppose the goal is `x * f y = g w * f z`. Then `congr` will produce two goals:
`x = g w` and `y = z`.

If `x y : t`, and an instance `subsingleton t` is in scope, then any goals of the form
`x = y` are solved automatically.

Note that `congr` can be over-aggressive at times; the `congr'` tactic in mathlib
provides a more refined approach, by taking a parameter that limits the recursion depth.
-/
/--
A variant of `rw` that uses the unifier more aggressively, unfolding semireducible definitions.
-/
/--
`existsi e` will instantiate an existential quantifier in the target with `e` and leave the
instantiated body as the new target. More generally, it applies to any inductive type with one
constructor and at least two arguments, applying the constructor with `e` as the first argument
and leaving the remaining arguments as goals.

`existsi [e₁, ..., eₙ]` iteratively does the same for each expression in the list.

Note: in mathlib, the `use` tactic is an equivalent tactic which sometimes is smarter with
unification.
-/
/--
Apply function extensionality and introduce new hypotheses.
The tactic `funext` will keep applying new the `funext` lemma until the goal target is not reducible
to
```
  |-  ((fun x, ...) = (fun x, ...))
```
The variant `funext h₁ ... hₙ` applies `funext` `n` times, and uses the given identifiers to name
the new hypotheses.

Note also the mathlib tactic `ext`, which applies as many extensionality lemmas as possible.
-/
/--
If the current goal is a Pi/forall `∀ x : t, u` (resp. `let x := t in u`) then `intro` puts
`x : t` (resp. `x := t`) in the local context. The new subgoal target is `u`.

If the goal is an arrow `t → u`, then it puts `h : t` in the local context and the new goal
target is `u`.

If the goal is neither a Pi/forall nor begins with a let binder, the tactic `intro` applies the
tactic `whnf` until an introduction can be applied or the goal is not head reducible. In the latter
case, the tactic fails.

The variant `intro z` uses the identifier `z` to name the new hypothesis.

The variant `intros` will keep introducing new hypotheses until the goal target is not a Pi/forall
or let binder.

The variant `intros h₁ ... hₙ` introduces `n` new hypotheses using the given identifiers to name
them.
-/
/--
`left` applies the first constructor when the type of the target is an inductive data type with
two constructors.

Similarly, `right` applies the second constructor.
-/
/--
`let h : t := p` adds the hypothesis `h : t := p` to the current goal if `p` a term of type `t`.
If `t` is omitted, it will be inferred.

`let h : t` adds the hypothesis `h : t := ?M` to the current goal and opens a new subgoal `?M : t`.
The new subgoal becomes the main goal. If `t` is omitted, it will be replaced by a fresh
metavariable.

If `h` is omitted, the name `this` is used.

Note the related mathlib tactic `set a := t with h`, which adds the hypothesis `h : a = t` to
the local context and replaces `t` with `a` everywhere it can.
-/
/--
This tactic applies to a goal whose target has the form `t ~ u` where `~` is a reflexive relation,
that is, a relation which has a reflexivity lemma tagged with the attribute `[refl]`.
The tactic checks whether `t` and `u` are definitionally equal and then solves the goal.
-/
/--
`rw e` applies an equation or iff `e` as a rewrite rule to the main goal. If `e` is preceded by
left arrow (`←` or `<-`), the rewrite is applied in the reverse direction. If `e` is a defined
constant, then the equational lemmas associated with `e` are used. This provides a convenient
way to unfold `e`.

`rw [e₁, ..., eₙ]` applies the given rules sequentially.

`rw e at l` rewrites `e` at location(s) `l`, where `l` is either `*` or a list of hypotheses
in the local context. In the latter case, a turnstile `⊢` or `|-` can also be used, to signify
the target of the goal.

`rewrite` is synonymous with `rw`.
-/
/- conv mode tactics -/

/--
Navigate to the left-hand-side of a relation.
A goal of `| a = b` will turn into the the goal `| a`.
-/
/--
Navigate to the right-hand-side of a relation.
A goal of `| a = b` will turn into the the goal `| b`.
-/
/--
Navigate into every argument of the current head function.
A target of `| (a * b) * c` will turn into the two targets `| a * b` and `| c`.
-/
/--
Navigate into the contents of top-level `λ` binders.
A target of `| λ a, a + b` will turn into the target `| a + b` and introduce `a` into the local
context.
If there are multiple binders, all of them will be entered, and if there are none, this tactic is a no-op.
-/
/--
Navigate into the first scope matching the expression.

For a target of `| ∀ c, a + (b + c) = 1`, `find (b + _) { ... }` will run the tactics within the
`{}` with a target of `| b + c`.
-/
/--
Navigate into the numbered scopes matching the expression.

For a target of `| λ c, 10 * c + 20 * c + 30 * c`, `for (_ * _) [1, 3] { ... }` will run the
tactics within the `{}` with first a target of `| 10 * c`, then a target of `| 30 * c`.
-/
/--
End conversion of the current goal. This is often what is needed when muscle memory would type `sorry`.


-- Bottcher map for Julia sets

import logic.basic
noncomputable theory

-- Values that make sense only on a set
def if_p {A : Type} [has_zero A] (P : Prop) (f : P → A) : A :=
  @dite _ _ (classical.dec P) (λ p, f p) (λ _, 0)

lemma if_p_true {A : Type} [has_zero A] {P : Prop} {f : P → A} (p : P) : if_p P f = f p := by { rw if_p, simp [p] }
lemma if_p_false {A : Type} [has_zero A] {P : Prop} {f : P → A} (p : ¬P) : if_p P f = 0 := by { rw if_p, simp [p] }

-- If the body of if_p does not depend on the P, we can drop it on a set where P holds
lemma if_p_const' {A B : Type} [has_zero B] {f : A → B}
    (s : set A) (P : A → Prop) (p : ∀ a, a ∈ s → P a)
    : ∀ a, a ∈ s → if_p (P a) (λ _, f a) = f a := begin
  intros a m, rw if_p_true (p a m)
end

-- Special case of if_p_const' where P = a ∈ s
lemma if_p_const {A B : Type} [has_zero B] {f : A → B} (s : set A)
    : ∀ a : A, a ∈ s → if_p (a ∈ s) (λ _, f a) = f a := begin
  intros a m, rw if_p_true m
end


def f (x y : Nat) : Nat :=
  match x, y with
  | 0, 0 => 1
  | _, _ => 2

example (h : f x y = 1) : f x y ≠ 2 := by
  simp [f] at *
  split
  next => decide
  next x' y' hnp => simp [hnp] at h


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  --Let A be an open covering of R^n.
  assume A : set (set (euclidean_space ℝ (fin n))),
  assume hA : is_open_cover A,

  --We now construct a locally finite open refinement C of A that covers R^n.
  have h1 : ∃ C : set (set (euclidean_space ℝ (fin n))), is_open_cover C ∧ is_locally_finite_refinement A C,
  {
    --First, we define a collection of pen balls.
    --Let B_0 = phi, and for each n in N, let B_m denote the ball of radius m centered at 0.
    have h1a : ∀ (m : ℕ), ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∃ (a : ℝ) (b : fin n), (a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a),
    {
      assume m : ℕ,
      let Bm : set (euclidean_space ℝ (fin n)),
      let hBm : is_open Bm,
      let hBm1 : ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∃ (a : ℝ) (b : fin n), (a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a),
      {
        assume x : euclidean_space ℝ (fin n),
        split,
        {
          assume h1 : x ∈ Bm,
          let a : ℝ,
          let b : fin n,
          have h2 : ∃ (a : ℝ) (b : fin n), (a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a),
          {
            have h2a : ∃ (a : ℝ) (b : fin n), abs (x i - b i) < a, from by auto [h1],
            have h2b : ∃ (a : ℝ) (b : fin n), ((a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a)), from by auto [h2a],
            exact h2b,
          },
          have h3 : ∃! (a : ℝ) (b : fin n), ((a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a)), from by auto [h2],
          have h4 : ∃ (a : ℝ) (b : fin n), ((a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a)), from by auto [exists_unique.exists, h3],
          exact h4,
        },
        {
          assume h1 : ∃ (a : ℝ) (b : fin n), (a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a),
          let a : ℝ,
          let b : fin n,
          have h2 : a > 0 ∧ ∀ (i : fin n), abs (x i - b i) < a, from by auto [h1],
          have h3 : x ∈ Bm, from by auto [h2],
          exact h3,
        },
      },
      exact hBm1,
    },
    have h1b : ∀ (m : ℕ), ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∃ (a : ℝ) (b : fin n), (a > 0) ∧ (∀ (i : fin n), abs (x i - b i) < a), from by auto [h1a],

    --Given m, set Bar{B_m} is compact in R^n by the Heine-Borel theorem, so choose finitely many elements of A that cover Bar{B_m} and intersect each one with the open set R^n setminus Bar{B_{m - 1}}, and let C_m denote this collection of open sets (each an open subset of an element of A).
    have h1c : ∀ (m : ℕ), ∃ Cm : set (set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ (∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm ↔ (∃ (V : set (euclidean_space ℝ (fin n))), V ∈ A ∧ U = V ∩ (set.inter_compl (set.compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl (set.inter_compl))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))),
    {
      assume m : ℕ,
      let Cm : set (set (euclidean_space ℝ (fin n))),
      let hCm : is_open_cover Cm,
      let hCm1 : ∀ (U : set (euclidean_space
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  intros A HA,
  have B0 : set (euclidean_space ℝ (fin n)) := ∅,
  have Bm : ∀ m : ℕ, set (euclidean_space ℝ (fin n)) := λ m, ball (0 : euclidean_space ℝ (fin n)) m,
  have B : ∀ m : ℕ, set (euclidean_space ℝ (fin n)) := λ m, closure (Bm m),
  have Cm : ∀ (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from
  begin
    assume (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    have h1 : (Bm m) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h2 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h3 : (Bm m) ⊆ A, from by auto [set.subset_inter_iff, set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h4 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h5 : ∃ (C : set (euclidean_space ℝ (fin n))), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_inter_of_subset],
    show ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_of_mem_of_subset, set.exists.elim] using [h5],
  end,
  have Cm' : ∀ (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from
  begin
    assume (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    have h1 : (Bm m) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h2 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h3 : (Bm m) ⊆ A, from by auto [set.subset_inter_iff, set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h4 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h5 : ∃ (C : set (euclidean_space ℝ (fin n))), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_inter_of_subset],
    show ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_of_mem_of_subset, set.exists.elim] using [h5],
  end,
  have Cm'' : ∀ (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from
  begin
    assume (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    have h1 : (Bm m) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h2 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h3 : (Bm m) ⊆ A, from by auto [set.subset_inter_iff, set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h4 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h5 : ∃ (C : set (euclidean_space ℝ (fin n))), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_inter_of_subset],
    show ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_of_mem_of_subset, set.exists.elim] using [h5],
  end,
  have Cm''' : ∀ (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from
  begin
    assume (m : ℕ) (A : set (euclidean_space ℝ (fin n))),
    have h1 : (Bm m) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h2 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h3 : (Bm m) ⊆ A, from by auto [set.subset_inter_iff, set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h4 : (Bm (m-1)) ∩ A ≠ ∅, from by auto [set.inter_ne_empty_iff, set.mem_of_mem_closure],
    have h5 : ∃ (C : set (euclidean_space ℝ (fin n))), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_inter_of_subset],
    show ∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ HA), (Bm m) ⊆ C ∧ (Bm (m-1)) ∩ C = ∅, from by auto [set.exists_of_mem_of_subset, set.ex
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  have h1 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m), from exists_nat.of_le (le_of_lt ((x : ℝ) + 1)),
    have h2 : ∃ m : ℕ, (m ≤ x + 1), from exists_nat.of_le (le_add_right x 1),
    have h3 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1), from
    begin
      cases h1 with m hm,
      cases h2 with n hn,
      existsi max m n,
      apply and.intro,
      apply le_max_left,
      apply le_max_right,
    end,
    exact h3,
  end,
  have h2 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1), from h1 x n,
    cases h1 with m hm,
    have h2 : ∀ (n : ℕ), m ≤ n → x ≤ n, from le_trans (and.elim_right hm) (le_add_left x 1),
    existsi m,
    apply and.intro,
    apply and.elim_left hm,
    apply and.intro,
    apply and.elim_right hm,
    exact h2,
  end,
  have h3 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n), from h2 x n,
    cases h1 with m hm,
    have h2 : ∀ (n : ℕ), x ≤ n → m ≤ n, from le_trans (and.elim_right (and.elim_right hm)) (le_add_left x 1),
    existsi m,
    apply and.intro,
    apply and.elim_left hm,
    apply and.intro,
    apply and.elim_right (and.elim_left hm),
    apply and.intro,
    apply and.elim_right (and.elim_left hm),
    exact h2,
  end,
  have h4 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n ∧ ∀ (n : ℕ), m ≤ n → x + 1 ≤ n), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n), from h3 x n,
    cases h1 with m hm,
    have h2 : ∀ (n : ℕ), m ≤ n → x + 1 ≤ n, from le_trans (and.elim_right (and.elim_right (and.elim_right (and.elim_left hm)))) (le_add_right x 1),
    existsi m,
    apply and.intro,
    apply and.elim_left hm,
    apply and.intro,
    apply and.elim_right (and.elim_left hm),
    apply and.intro,
    apply and.elim_right (and.elim_left (and.elim_left hm)),
    apply and.intro,
    apply and.elim_right (and.elim_left (and.elim_left hm)),
    exact h2,
  end,
  have h5 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n ∧ ∀ (n : ℕ), m ≤ n → x + 1 ≤ n ∧ ∀ (n : ℕ), x ≤ n → x + 1 ≤ n), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n ∧ ∀ (n : ℕ), m ≤ n → x + 1 ≤ n), from h4 x n,
    cases h1 with m hm,
    have h2 : ∀ (n : ℕ), x ≤ n → x + 1 ≤ n, from le_trans (and.elim_right (and.elim_right (and.elim_right (and.elim_left (and.elim_left hm))))) (le_add_right x 1),
    existsi m,
    apply and.intro,
    apply and.elim_left hm,
    apply and.intro,
    apply and.elim_right (and.elim_left hm),
    apply and.intro,
    apply and.elim_right (and.elim_left (and.elim_left hm)),
    apply and.intro,
    apply and.elim_right (and.elim_left (and.elim_left (and.elim_left hm))),
    apply and.intro,
    apply and.elim_right (and.elim_left (and.elim_left (and.elim_left hm))),
    exact h2,
  end,
  have h6 : ∀ (x : ℝ) (n : ℕ), ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n ∧ ∀ (n : ℕ), m ≤ n → x + 1 ≤ n ∧ ∀ (n : ℕ), x ≤ n → x + 1 ≤ n ∧ ∀ (n : ℕ), x + 1 ≤ n → m ≤ n), from
  begin
    assume (x : ℝ) (n : ℕ),
    have h1 : ∃ m : ℕ, (x ≤ m ∧ m ≤ x + 1 ∧ ∀ (n : ℕ), m ≤ n → x ≤ n ∧ ∀ (n : ℕ), x ≤ n → m ≤ n ∧ ∀ (n : ℕ), m ≤ n → x + 1 ≤ n ∧ ∀ (n : ℕ), x ≤ n → x + 1 ≤ n), from h5 x n,
    cases h1 with m hm,
    have h2 : ∀ (n : ℕ), x + 1 ≤ n → m ≤ n
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ A : set (euclidean_space ℝ (fin n)), is_open A → is_open (A ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.inter_univ],
  have h2 : ∀ m : ℕ, is_open (set.Iio (m : ℝ) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h3 : ∀ m : ℕ, is_open (set.Icc (m : ℝ) (m + 1) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h4 : (set.Iio (0 : ℝ) ∩ (univ : set (euclidean_space ℝ (fin n)))) ⊆ (set.Icc (0 : ℝ) 1 ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h5 : (set.Icc (0 : ℝ) 1 ∩ (univ : set (euclidean_space ℝ (fin n)))) ⊆ (set.Iio (0 : ℝ) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h6 : is_open (set.Iio (0 : ℝ) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [h2, h3, h4, h5],
  have h7 : ∀ m : ℕ, is_open (set.Ico (m : ℝ) (m + 1) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h8 : is_open (set.Ico (0 : ℝ) 1 ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [h7],
  have h9 : ∀ m : ℕ, is_open (set.Icc (m : ℝ) (m + 1) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h10 : ∀ m : ℕ, is_open (set.Icc (m : ℝ) (m + 1)), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h11 : ∀ m : ℕ, is_open (set.Iio (m : ℝ)), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h12 : ∀ m : ℕ, is_open (set.Ico (m : ℝ)), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h13 : ∀ m : ℕ, is_open (set.Icc (m : ℝ) (m + 1) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h14 : ∀ m : ℕ, is_open (set.Icc (m : ℝ) (m + 1)), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h15 : ∀ m : ℕ, is_open (set.Ico (m : ℝ) (m + 1) ∩ (univ : set (euclidean_space ℝ (fin n)))), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_univ],
  have h16 : ∀ m : ℕ, is_open (set.Ico (m : ℝ) (m + 1)), from by auto [set.Iio_subset_Ioi, set.Ioi_subset_Icc, set.Icc_subset_Ioc, set.Ioc_subset_Ico, set.Ico_subset_Ioo, set.Ioo_subset_Icc, set.Icc_subset_Icc, set.Icc_subset_univ, set.inter_un
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let A := λ (a : ℝ), {b : ℝ | a < b},
  have h1 : ∀ (a : ℝ), is_open (A a), from by auto [is_open_lt],
  let B := λ (a : ℝ), {b : ℝ | b < a},
  have h2 : ∀ (a : ℝ), is_open (B a), from by auto [is_open_gt],
  have h3 : ∀ (a : ℝ), is_open (A a) ∧ is_open (B a), from by auto [h1, h2],
  have h4 : ∀ (a : ℝ) (h : a > 0), ∃ b : ℝ, b > a, from by auto [h1],
  have h5 : ∀ (a : ℝ) (h : a < 0), ∃ b : ℝ, b < a, from by auto [h2],
  have h6 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b ≠ a, from by auto [h4, h5],
  have h7 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h8 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h9 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h10 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h11 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h12 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h13 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h14 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h15 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h16 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h17 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h18 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h19 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h20 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h21 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h22 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h23 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h24 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h25 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h26 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h27 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h28 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h29 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h30 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h31 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h32 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h33 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h34 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h35 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h36 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h37 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h38 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h39 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h40 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h41 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h42 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h43 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h44 : ∀ (a : ℝ) (h : a ≠ 0), ∃ b : ℝ, b = a, from by auto [h4, h5],
  have h45
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m} ∈ (𝓝 (0 : ℝ ^ n)), from by auto [nhds_zero, set.mem_nhds_sets_iff, set.mem_ball],
  have h2 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥} ∈ (𝓝 (0 : ℝ ^ n)), from by auto [nhds_zero, set.mem_nhds_sets_iff, set.mem_ball],
  have h3 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ < m} ∈ (𝓝 (0 : ℝ ^ n)), from by auto [nhds_zero, set.mem_nhds_sets_iff, set.mem_ball],
  have h4 : ∀ m : ℕ, {x : ℝ ^ n // m < ∥x∥} ∈ (𝓝 (0 : ℝ ^ n)), from by auto [nhds_zero, set.mem_nhds_sets_iff, set.mem_ball],
  have h5 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h6 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h7 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h8 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h9 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h10 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h11 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h12 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h13 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h14 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h15 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h16 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h17 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h18 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h19 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h20 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h21 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h22 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,
  have h23 : ∀ m : ℕ, {x : ℝ ^ n // ∥x∥ ≤ m ∧ ∥x∥ < m + 1} = {x : ℝ ^ n // ∥x∥ ≤ m} ∩ {x : ℝ ^ n // ∥x∥ < m + 1}, from by auto,
  have h24 : ∀ m : ℕ, {x : ℝ ^ n // m ≤ ∥x∥ ∧ m + 1 < ∥x∥} = {x : ℝ ^ n // m ≤ ∥x∥} ∩ {x : ℝ ^ n // m + 1 < ∥x∥}, from by auto,

end --Needs more than 2000 tokens!

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let A : set (euclidean_space ℝ (fin n)) → Prop := λ x, (is_open x),
  let S : set (euclidean_space ℝ (fin n)) := univ,
  let T : set (euclidean_space ℝ (fin n)) → Prop := λ x, (is_open x) ∧ cover S x ∧ locally_finite x,
  let U : set (euclidean_space ℝ (fin n)) → Prop := λ x, (is_open x) ∧ cover S x,
  let C : set (euclidean_space ℝ (fin n)) → Prop := λ x, (is_open x) ∧ locally_finite x,
  have h1 : S ∈ 𝒫 (euclidean_space ℝ (fin n)), from by auto [set.univ_mem_powerset],
  have h2 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C), from by auto [set.is_open_of_mem_powerset],
  have h3 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C, from by auto [set.is_open_of_mem_powerset, set.cover_univ, set.univ_mem_powerset],
  have h4 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C, from by auto [set.is_open_of_mem_powerset, set.cover_univ, set.univ_mem_powerset, set.locally_finite_of_mem_powerset],
  have h5 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ locally_finite C, from by auto [set.is_open_of_mem_powerset, set.locally_finite_of_mem_powerset],
  have h6 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C ↔ (is_open C) ∧ cover S C, from by auto [iff_iff_iff_iff],
  have h7 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C ↔ (is_open C) ∧ locally_finite C, from by auto [iff_iff_iff_iff],
  have h8 : T = U ∨ T = C, from by auto [set.ext],
  have h9 : (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C) ↔ (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C), from by auto [h6],
  have h10 : (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C) ↔ (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ locally_finite C), from by auto [h7],
  have h11 : (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∧ locally_finite C) ↔ (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C) ∨ (∃ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ locally_finite C), from by auto [h8, h9, h10, exists_or_distrib],
  have h12 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C, from by auto [set.is_open_of_mem_powerset, set.cover_univ, set.univ_mem_powerset],
  have h13 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ locally_finite C, from by auto [set.is_open_of_mem_powerset, set.locally_finite_of_mem_powerset],
  have h14 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∨ (is_open C) ∧ locally_finite C, from by auto [h11],
  have h15 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∨ (is_open C) ∧ locally_finite C, from by auto [h14, h12, h13, classical.or_iff_not_imp_left, set.ext, classical.not_not_iff_iff],
  have h16 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∨ (is_open C) ∧ locally_finite C, from by auto [h15, set.ext],
  have h17 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∨ (is_open C) ∧ locally_finite C, from by auto [h16, set.ext],
  have h18 : ∀ (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ 𝒫 (euclidean_space ℝ (fin n))), (is_open C) ∧ cover S C ∨ (is_open C) ∧ locally_finite C, from by auto [h17, set.
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A),
  have h1 : is_open (⋃ (m : ℕ), (λ (x : euclidean_space ℝ (fin n)), (∃ (m : ℕ), ∀ (i : fin n), abs (x $ i) ≤ m)) ⁻¹' {m} ∩ A) := by auto [is_open_Inter, is_open_Ball, is_open_Union, is_open_Inter, is_open_Ball, is_open_Union],
  have h2 :  (⋃ (m : ℕ), (λ (x : euclidean_space ℝ (fin n)), (∃ (m : ℕ), ∀ (i : fin n), abs (x $ i) ≤ m)) ⁻¹' {m} ∩ A) = A, from by auto [ext_iff],

  show ∃ (B : set (euclidean_space ℝ (fin n))), is_open B ∧ is_locally_finite B ∧ ⋃ B = A, from by auto [exists_prop, h1, h2],
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.equivalence
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation

/--
`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

To construct an `adjunction` between two functors, it's often easier to instead use the
constructors `mk_of_hom_equiv` or `mk_of_unit_counit`. To construct a left adjoint,
there are also constructors `left_adjoint_of_equiv` and `adjunction_of_equiv_left` (as
well as their duals) which can be simpler in practice.

Uniqueness of adjoints is shown in `category_theory.adjunction.opposites`.

See https://stacks.math.columbia.edu/tag/0037.
-/
structure adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : D ⥤ C)
where
  hom_equiv : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ functor.obj G Y)
  unit : 𝟭 ⟶ F ⋙ G
  counit : G ⋙ F ⟶ 𝟭
  hom_equiv_unit' : autoParam
  (∀ {X : C} {Y : D} {f : functor.obj F X ⟶ Y}, coe_fn (hom_equiv X Y) f = nat_trans.app unit X ≫ functor.map G f)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hom_equiv_counit' : autoParam
  (∀ {X : C} {Y : D} {g : X ⟶ functor.obj G Y},
    coe_fn (equiv.symm (hom_equiv X Y)) g = functor.map F g ≫ nat_trans.app counit Y)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

infixl:15 " ⊣ " => Mathlib.category_theory.adjunction

/-- A class giving a chosen right adjoint to the functor `left`. -/
class is_left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (left : C ⥤ D)
where
  right : D ⥤ C
  adj : left ⊣ right

/-- A class giving a chosen left adjoint to the functor `right`. -/
class is_right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (right : D ⥤ C)
where
  left : C ⥤ D
  adj : left ⊣ right

/-- Extract the left adjoint from the instance giving the chosen adjoint. -/
def left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C) [is_right_adjoint R] : C ⥤ D :=
  is_right_adjoint.left R

/-- Extract the right adjoint from the instance giving the chosen adjoint. -/
def right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D) [is_left_adjoint L] : D ⥤ C :=
  is_left_adjoint.right L

/-- The adjunction associated to a functor known to be a left adjoint. -/
def adjunction.of_left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (left : C ⥤ D) [is_left_adjoint left] : left ⊣ right_adjoint left :=
  is_left_adjoint.adj

/-- The adjunction associated to a functor known to be a right adjoint. -/
def adjunction.of_right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (right : C ⥤ D) [is_right_adjoint right] : left_adjoint right ⊣ right :=
  is_right_adjoint.adj

namespace adjunction

@[simp] theorem hom_equiv_unit {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : F ⊣ G) {X : C} {Y : D} {f : functor.obj F X ⟶ Y} : coe_fn (hom_equiv c X Y) f = nat_trans.app (unit c) X ≫ functor.map G f := sorry

@[simp] theorem hom_equiv_counit {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : F ⊣ G) {X : C} {Y : D} {g : X ⟶ functor.obj G Y} : coe_fn (equiv.symm (hom_equiv c X Y)) g = functor.map F g ≫ nat_trans.app (counit c) Y := sorry

@[simp] theorem hom_equiv_naturality_left_symm {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X) (g : X ⟶ functor.obj G Y) : coe_fn (equiv.symm (hom_equiv adj X' Y)) (f ≫ g) = functor.map F f ≫ coe_fn (equiv.symm (hom_equiv adj X Y)) g := sorry

@[simp] theorem hom_equiv_naturality_left {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X) (g : functor.obj F X ⟶ Y) : coe_fn (hom_equiv adj X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (hom_equiv adj X Y) g := sorry

@[simp] theorem hom_equiv_naturality_right {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : D} {Y' : D} (f : functor.obj F X ⟶ Y) (g : Y ⟶ Y') : coe_fn (hom_equiv adj X Y') (f ≫ g) = coe_fn (hom_equiv adj X Y) f ≫ functor.map G g := sorry

@[simp] theorem hom_equiv_naturality_right_symm {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : D} {Y' : D} (f : X ⟶ functor.obj G Y) (g : Y ⟶ Y') : coe_fn (equiv.symm (hom_equiv adj X Y')) (f ≫ functor.map G g) = coe_fn (equiv.symm (hom_equiv adj X Y)) f ≫ g := sorry

@[simp] theorem left_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) : whisker_right (unit adj) F ≫ whisker_left F (counit adj) = nat_trans.id (𝟭 ⋙ F) := sorry

@[simp] theorem right_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) : whisker_left G (unit adj) ≫ whisker_right (counit adj) G = nat_trans.id (G ⋙ 𝟭) := sorry

@[simp] theorem left_triangle_components_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {X' : D} (f' : functor.obj 𝟭 (functor.obj F X) ⟶ X') : functor.map F (nat_trans.app (unit adj) X) ≫ nat_trans.app (counit adj) (functor.obj F X) ≫ f' = f' := sorry

@[simp] theorem right_triangle_components {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {Y : D} : nat_trans.app (unit adj) (functor.obj G Y) ≫ functor.map G (nat_trans.app (counit adj) Y) = 𝟙 :=
  congr_arg (fun (t : nat_trans (G ⋙ 𝟭) (G ⋙ 𝟭)) => nat_trans.app t Y) (right_triangle adj)

@[simp] theorem counit_naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : D} {Y : D} (f : X ⟶ Y) : functor.map F (functor.map G f) ≫ nat_trans.app (counit adj) Y = nat_trans.app (counit adj) X ≫ f :=
  nat_trans.naturality (counit adj) f

@[simp] theorem unit_naturality {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X : C} {Y : C} (f : X ⟶ Y) : nat_trans.app (unit adj) X ≫ functor.map G (functor.map F f) = f ≫ nat_trans.app (unit adj) Y :=
  Eq.symm (nat_trans.naturality (unit adj) f)

theorem hom_equiv_apply_eq {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {A : C} {B : D} (f : functor.obj F A ⟶ B) (g : A ⟶ functor.obj G B) : coe_fn (hom_equiv adj A B) f = g ↔ f = coe_fn (equiv.symm (hom_equiv adj A B)) g := sorry

theorem eq_hom_equiv_apply {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {A : C} {B : D} (f : functor.obj F A ⟶ B) (g : A ⟶ functor.obj G B) : g = coe_fn (hom_equiv adj A B) f ↔ coe_fn (equiv.symm (hom_equiv adj A B)) g = f := sorry

end adjunction

namespace adjunction

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
structure core_hom_equiv {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : D ⥤ C)
where
  hom_equiv : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ functor.obj G Y)
  hom_equiv_naturality_left_symm' : autoParam
  (∀ {X' X : C} {Y : D} (f : X' ⟶ X) (g : X ⟶ functor.obj G Y),
    coe_fn (equiv.symm (hom_equiv X' Y)) (f ≫ g) = functor.map F f ≫ coe_fn (equiv.symm (hom_equiv X Y)) g)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hom_equiv_naturality_right' : autoParam
  (∀ {X : C} {Y Y' : D} (f : functor.obj F X ⟶ Y) (g : Y ⟶ Y'),
    coe_fn (hom_equiv X Y') (f ≫ g) = coe_fn (hom_equiv X Y) f ≫ functor.map G g)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

namespace core_hom_equiv

@[simp] theorem hom_equiv_naturality_left_symm {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : core_hom_equiv F G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X) (g : X ⟶ functor.obj G Y) : coe_fn (equiv.symm (hom_equiv c X' Y)) (f ≫ g) = functor.map F f ≫ coe_fn (equiv.symm (hom_equiv c X Y)) g := sorry

@[simp] theorem hom_equiv_naturality_right {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : core_hom_equiv F G) {X : C} {Y : D} {Y' : D} (f : functor.obj F X ⟶ Y) (g : Y ⟶ Y') : coe_fn (hom_equiv c X Y') (f ≫ g) = coe_fn (hom_equiv c X Y) f ≫ functor.map G g := sorry

@[simp] theorem hom_equiv_naturality_left {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X' : C} {X : C} {Y : D} (f : X' ⟶ X) (g : functor.obj F X ⟶ Y) : coe_fn (hom_equiv adj X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (hom_equiv adj X Y) g := sorry

@[simp] theorem hom_equiv_naturality_right_symm {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X : C} {Y : D} {Y' : D} (f : X ⟶ functor.obj G Y) (g : Y ⟶ Y') : coe_fn (equiv.symm (hom_equiv adj X Y')) (f ≫ functor.map G g) = coe_fn (equiv.symm (hom_equiv adj X Y)) f ≫ g := sorry

end core_hom_equiv

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
structure core_unit_counit {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : D ⥤ C)
where
  unit : 𝟭 ⟶ F ⋙ G
  counit : G ⋙ F ⟶ 𝟭
  left_triangle' : autoParam (whisker_right unit F ≫ iso.hom (functor.associator F G F) ≫ whisker_left F counit = nat_trans.id (𝟭 ⋙ F))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_triangle' : autoParam (whisker_left G unit ≫ iso.inv (functor.associator G F G) ≫ whisker_right counit G = nat_trans.id (G ⋙ 𝟭))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

namespace core_unit_counit

@[simp] theorem left_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : core_unit_counit F G) : whisker_right (unit c) F ≫ iso.hom (functor.associator F G F) ≫ whisker_left F (counit c) = nat_trans.id (𝟭 ⋙ F) := sorry

@[simp] theorem right_triangle {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (c : core_unit_counit F G) : whisker_left G (unit c) ≫ iso.inv (functor.associator G F G) ≫ whisker_right (counit c) G = nat_trans.id (G ⋙ 𝟭) := sorry

end core_unit_counit

/-- Construct an adjunction between `F` and `G` out of a natural bijection between each
`F.obj X ⟶ Y` and `X ⟶ G.obj Y`. -/
@[simp] theorem mk_of_hom_equiv_counit_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) (Y : D) : nat_trans.app (counit (mk_of_hom_equiv adj)) Y =
  equiv.inv_fun (core_hom_equiv.hom_equiv adj (functor.obj G Y) (functor.obj 𝟭 Y)) 𝟙 :=
  Eq.refl (nat_trans.app (counit (mk_of_hom_equiv adj)) Y)

/-- Construct an adjunction between functors `F` and `G` given a unit and counit for the adjunction
satisfying the triangle identities. -/
@[simp] theorem mk_of_unit_counit_counit {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : core_unit_counit F G) : counit (mk_of_unit_counit adj) = core_unit_counit.counit adj :=
  Eq.refl (counit (mk_of_unit_counit adj))

/-- The adjunction between the identity functor on a category and itself. -/
def id {C : Type u₁} [category C] : 𝟭 ⊣ 𝟭 :=
  mk (fun (X Y : C) => equiv.refl (functor.obj 𝟭 X ⟶ Y)) 𝟙 𝟙

-- Satisfy the inhabited linter.

protected instance inhabited {C : Type u₁} [category C] : Inhabited (𝟭 ⊣ 𝟭) :=
  { default := id }

/-- If F and G are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simp] theorem equiv_homset_left_of_nat_iso_symm_apply {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {F' : C ⥤ D} (iso : F ≅ F') {X : C} {Y : D} (g : functor.obj F' X ⟶ Y) : coe_fn (equiv.symm (equiv_homset_left_of_nat_iso iso)) g = nat_trans.app (iso.hom iso) X ≫ g :=
  Eq.refl (coe_fn (equiv.symm (equiv_homset_left_of_nat_iso iso)) g)

/-- If G and H are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simp] theorem equiv_homset_right_of_nat_iso_apply {C : Type u₁} [category C] {D : Type u₂} [category D] {G : D ⥤ C} {G' : D ⥤ C} (iso : G ≅ G') {X : C} {Y : D} (f : X ⟶ functor.obj G Y) : coe_fn (equiv_homset_right_of_nat_iso iso) f = f ≫ nat_trans.app (iso.hom iso) Y :=
  Eq.refl (coe_fn (equiv_homset_right_of_nat_iso iso) f)

/-- Transport an adjunction along an natural isomorphism on the left. -/
def of_nat_iso_left {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} {H : D ⥤ C} (adj : F ⊣ H) (iso : F ≅ G) : G ⊣ H :=
  mk_of_hom_equiv
    (core_hom_equiv.mk
      fun (X : C) (Y : D) => equiv.trans (equiv_homset_left_of_nat_iso (iso.symm iso)) (hom_equiv adj X Y))

/-- Transport an adjunction along an natural isomorphism on the right. -/
def of_nat_iso_right {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} {H : D ⥤ C} (adj : F ⊣ G) (iso : G ≅ H) : F ⊣ H :=
  mk_of_hom_equiv
    (core_hom_equiv.mk fun (X : C) (Y : D) => equiv.trans (hom_equiv adj X Y) (equiv_homset_right_of_nat_iso iso))

/-- Transport being a right adjoint along a natural isomorphism. -/
def right_adjoint_of_nat_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (h : F ≅ G) [r : is_right_adjoint F] : is_right_adjoint G :=
  is_right_adjoint.mk (is_right_adjoint.left F) (of_nat_iso_right is_right_adjoint.adj h)

/-- Transport being a left adjoint along a natural isomorphism. -/
def left_adjoint_of_nat_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : C ⥤ D} (h : F ≅ G) [r : is_left_adjoint F] : is_left_adjoint G :=
  is_left_adjoint.mk (is_left_adjoint.right F) (of_nat_iso_left is_left_adjoint.adj h)

/--
Composition of adjunctions.

See https://stacks.math.columbia.edu/tag/0DV0.
-/
def comp {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} {E : Type u₃} [ℰ : category E] (H : D ⥤ E) (I : E ⥤ D) (adj₁ : F ⊣ G) (adj₂ : H ⊣ I) : F ⋙ H ⊣ I ⋙ G :=
  mk (fun (X : C) (Z : E) => equiv.trans (hom_equiv adj₂ (functor.obj F X) Z) (hom_equiv adj₁ X (functor.obj I Z)))
    (unit adj₁ ≫ whisker_left F (whisker_right (unit adj₂) G) ≫ iso.inv (functor.associator F (H ⋙ I) G))
    (iso.hom (functor.associator I G (F ⋙ H)) ≫ whisker_left I (whisker_right (counit adj₁) H) ≫ counit adj₂)

/-- If `F` and `G` are left adjoints then `F ⋙ G` is a left adjoint too. -/
protected instance left_adjoint_of_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [ℰ : category E] (F : C ⥤ D) (G : D ⥤ E) [Fl : is_left_adjoint F] [Gl : is_left_adjoint G] : is_left_adjoint (F ⋙ G) :=
  is_left_adjoint.mk (is_left_adjoint.right G ⋙ is_left_adjoint.right F)
    (comp G (is_left_adjoint.right G) is_left_adjoint.adj is_left_adjoint.adj)

/-- If `F` and `G` are right adjoints then `F ⋙ G` is a right adjoint too. -/
protected instance right_adjoint_of_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [ℰ : category E] {F : C ⥤ D} {G : D ⥤ E} [Fr : is_right_adjoint F] [Gr : is_right_adjoint G] : is_right_adjoint (F ⋙ G) :=
  is_right_adjoint.mk (is_right_adjoint.left G ⋙ is_right_adjoint.left F)
    (comp (is_right_adjoint.left F) F is_right_adjoint.adj is_right_adjoint.adj)

-- Construction of a left adjoint. In order to construct a left

-- adjoint to a functor G : D → C, it suffices to give the object part

-- of a functor F : C → D together with isomorphisms Hom(FX, Y) ≃

-- Hom(X, GY) natural in Y. The action of F on morphisms can be

-- constructed from this data.

/-- Construct a left adjoint functor to `G`, given the functor's value on objects `F_obj` and
a bijection `e` between `F_obj X ⟶ Y` and `X ⟶ G.obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g`.
Dual to `right_adjoint_of_equiv`. -/
@[simp] theorem left_adjoint_of_equiv_obj {C : Type u₁} [category C] {D : Type u₂} [category D] {G : D ⥤ C} {F_obj : C → D} (e : (X : C) → (Y : D) → (F_obj X ⟶ Y) ≃ (X ⟶ functor.obj G Y)) (he : ∀ (X : C) (Y Y' : D) (g : Y ⟶ Y') (h : F_obj X ⟶ Y), coe_fn (e X Y') (h ≫ g) = coe_fn (e X Y) h ≫ functor.map G g) : ∀ (ᾰ : C), functor.obj (left_adjoint_of_equiv e he) ᾰ = F_obj ᾰ :=
  fun (ᾰ : C) => Eq.refl (functor.obj (left_adjoint_of_equiv e he) ᾰ)

/-- Show that the functor given by `left_adjoint_of_equiv` is indeed left adjoint to `G`. Dual
to `adjunction_of_equiv_right`. -/
@[simp] theorem adjunction_of_equiv_left_hom_equiv {C : Type u₁} [category C] {D : Type u₂} [category D] {G : D ⥤ C} {F_obj : C → D} (e : (X : C) → (Y : D) → (F_obj X ⟶ Y) ≃ (X ⟶ functor.obj G Y)) (he : ∀ (X : C) (Y Y' : D) (g : Y ⟶ Y') (h : F_obj X ⟶ Y), coe_fn (e X Y') (h ≫ g) = coe_fn (e X Y) h ≫ functor.map G g) (X : C) (Y : D) : hom_equiv (adjunction_of_equiv_left e he) X Y = e X Y :=
  Eq.refl (e X Y)

-- Construction of a right adjoint, analogous to the above.

/-- Construct a right adjoint functor to `F`, given the functor's value on objects `G_obj` and
a bijection `e` between `F.obj X ⟶ Y` and `X ⟶ G_obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X' Y (F.map f ≫ g) = f ≫ e X Y g`.
Dual to `left_adjoint_of_equiv`. -/
@[simp] theorem right_adjoint_of_equiv_obj {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G_obj : D → C} (e : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ G_obj Y)) (he : ∀ (X' X : C) (Y : D) (f : X' ⟶ X) (g : functor.obj F X ⟶ Y),
  coe_fn (e X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (e X Y) g) : ∀ (ᾰ : D), functor.obj (right_adjoint_of_equiv e he) ᾰ = G_obj ᾰ :=
  fun (ᾰ : D) => Eq.refl (functor.obj (right_adjoint_of_equiv e he) ᾰ)

/-- Show that the functor given by `right_adjoint_of_equiv` is indeed right adjoint to `F`. Dual
to `adjunction_of_equiv_left`. -/
@[simp] theorem adjunction_of_equiv_right_counit_app {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G_obj : D → C} (e : (X : C) → (Y : D) → (functor.obj F X ⟶ Y) ≃ (X ⟶ G_obj Y)) (he : ∀ (X' X : C) (Y : D) (f : X' ⟶ X) (g : functor.obj F X ⟶ Y),
  coe_fn (e X' Y) (functor.map F f ≫ g) = f ≫ coe_fn (e X Y) g) (Y : D) : nat_trans.app (counit (adjunction_of_equiv_right e he)) Y = coe_fn (equiv.symm (e (G_obj Y) Y)) 𝟙 :=
  Eq.refl (coe_fn (equiv.symm (e (G_obj Y) Y)) 𝟙)

/--
If the unit and counit of a given adjunction are (pointwise) isomorphisms, then we can upgrade the
adjunction to an equivalence.
-/
@[simp] theorem to_equivalence_functor {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) [(X : C) → is_iso (nat_trans.app (unit adj) X)] [(Y : D) → is_iso (nat_trans.app (counit adj) Y)] : equivalence.functor (to_equivalence adj) = F :=
  Eq.refl (equivalence.functor (to_equivalence adj))

/--
If the unit and counit for the adjunction corresponding to a right adjoint functor are (pointwise)
isomorphisms, then the functor is an equivalence of categories.
-/
@[simp] theorem is_right_adjoint_to_is_equivalence_unit_iso_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D] {G : D ⥤ C} [is_right_adjoint G] [(X : C) → is_iso (nat_trans.app (unit (of_right_adjoint G)) X)] [(Y : D) → is_iso (nat_trans.app (counit (of_right_adjoint G)) Y)] (X : D) : nat_trans.app (iso.inv is_equivalence.unit_iso) X = nat_trans.app (counit (of_right_adjoint G)) X :=
  Eq.refl (nat_trans.app (counit (of_right_adjoint G)) X)

end adjunction

namespace equivalence

/-- The adjunction given by an equivalence of categories. (To obtain the opposite adjunction,
simply use `e.symm.to_adjunction`. -/
def to_adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) : functor e ⊣ inverse e :=
  adjunction.mk_of_unit_counit (adjunction.core_unit_counit.mk (unit e) (counit e))

end equivalence

namespace functor

/-- An equivalence `E` is left adjoint to its inverse. -/
def adjunction {C : Type u₁} [category C] {D : Type u₂} [category D] (E : C ⥤ D) [is_equivalence E] : E ⊣ inv E :=
  equivalence.to_adjunction (as_equivalence E)

/-- If `F` is an equivalence, it's a left adjoint. -/
protected instance left_adjoint_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} [is_equivalence F] : is_left_adjoint F :=
  is_left_adjoint.mk (inv F) (adjunction F)

@[simp] theorem right_adjoint_of_is_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} [is_equivalence F] : right_adjoint F = inv F :=
  rfl

/-- If `F` is an equivalence, it's a right adjoint. -/
protected instance right_adjoint_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} [is_equivalence F] : is_right_adjoint F :=
  is_right_adjoint.mk (inv F) (adjunction (inv F))

@[simp] theorem left_adjoint_of_is_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} [is_equivalence F] : left_adjoint F = inv F :=
  rfl


structure Something (i: Nat) where
  n1: Nat := 1
  n2: Nat := 1 + i

def s : Something 10 := {}

example : s.n2 = 11 := rfl