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

/-!
# Locally finite orders

This file defines locally finite orders.

A locally finite order is an order for which all bounded intervals are finite. This allows to make
sense of `Icc`/`Ico`/`Ioc`/`Ioo` as lists, multisets, or finsets.
Further, if the order is bounded above (resp. below), then we can also make sense of the
"unbounded" intervals `Ici`/`Ioi` (resp. `Iic`/`Iio`).

## Examples

Naturally occurring locally finite orders are `ℕ`, `ℤ`, `ℕ+`, `fin n`, `α × β` the product of two
locally finite orders, `α →₀ β` the finitely supported functions to a locally finite order `β`...

## Main declarations

In a `locally_finite_order`,
* `finset.Icc`: Closed-closed interval as a finset.
* `finset.Ico`: Closed-open interval as a finset.
* `finset.Ioc`: Open-closed interval as a finset.
* `finset.Ioo`: Open-open interval as a finset.
* `multiset.Icc`: Closed-closed interval as a multiset.
* `multiset.Ico`: Closed-open interval as a multiset.
* `multiset.Ioc`: Open-closed interval as a multiset.
* `multiset.Ioo`: Open-open interval as a multiset.

When it's also an `order_top`,
* `finset.Ici`: Closed-infinite interval as a finset.
* `finset.Ioi`: Open-infinite interval as a finset.
* `multiset.Ici`: Closed-infinite interval as a multiset.
* `multiset.Ioi`: Open-infinite interval as a multiset.

When it's also an `order_bot`,
* `finset.Iic`: Infinite-open interval as a finset.
* `finset.Iio`: Infinite-closed interval as a finset.
* `multiset.Iic`: Infinite-open interval as a multiset.
* `multiset.Iio`: Infinite-closed interval as a multiset.

## Instances

A `locally_finite_order` instance can be built
* for a subtype of a locally finite order. See `subtype.locally_finite_order`.
* for the product of two locally finite orders. See `prod.locally_finite_order`.
* for any fintype (but it is noncomputable). See `fintype.to_locally_finite_order`.
* from a definition of `finset.Icc` alone. See `locally_finite_order.of_Icc`.
* by pulling back `locally_finite_order β` through an order embedding `f : α →o β`. See
  `order_embedding.locally_finite_order`.

Instances for concrete types are proved in their respective files:
* `ℕ` is in `data.nat.interval`
* `ℤ` is in `data.int.interval`
* `ℕ+` is in `data.pnat.interval`
* `fin n` is in `data.fin.interval`
* `finset α` is in `data.finset.interval`
Along, you will find lemmas about the cardinality of those finite intervals.

## TODO

Provide the `locally_finite_order` instance for `lex α β` where `locally_finite_order α` and
`fintype β`.

Provide the `locally_finite_order` instance for `α →₀ β` where `β` is locally finite. Provide the
`locally_finite_order` instance for `Π₀ i, β i` where all the `β i` are locally finite.

From `linear_order α`, `no_top_order α`, `locally_finite_order α`, we can also define an
order isomorphism `α ≃ ℕ` or `α ≃ ℤ`, depending on whether we have `order_bot α` or
`no_bot_order α` and `nonempty α`. When `order_bot α`, we can match `a : α` to `(Iio a).card`.

We can provide `succ_order α` from `linear_order α` and `locally_finite_order α` using

```lean
lemma exists_min_greater [linear_order α] [locally_finite_order α] {x ub : α} (hx : x < ub) :
  ∃ lub, x < lub ∧ ∀ y, x < y → lub ≤ y :=
begin -- very non golfed
  have h : (finset.Ioc x ub).nonempty := ⟨ub, finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩⟩,
  use finset.min' (finset.Ioc x ub) h,
  split,
  { have := finset.min'_mem _ h,
    simp * at * },
  rintro y hxy,
  obtain hy | hy := le_total y ub,
  apply finset.min'_le,
  simp * at *,
  exact (finset.min'_le _ _ (finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩)).trans hy,
end
```
Note that the converse is not true. Consider `{-2^z | z : ℤ} ∪ {2^z | z : ℤ}`. Any element has a
successor (and actually a predecessor as well), so it is a `succ_order`, but it's not locally finite
as `Icc (-1) 1` is infinite.
-/

open finset function

/-- A locally finite order is an order where bounded intervals are finite. When you don't care too
much about definitional equality, you can use `locally_finite_order.of_Icc` or
`locally_finite_order.of_finite_Icc` to build a locally finite order from just `finset.Icc`. -/
class locally_finite_order (α : Type*) [preorder α] :=
(finset_Icc : α → α → finset α)
(finset_Ico : α → α → finset α)
(finset_Ioc : α → α → finset α)
(finset_Ioo : α → α → finset α)
(finset_mem_Icc : ∀ a b x : α, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b)
(finset_mem_Ico : ∀ a b x : α, x ∈ finset_Ico a b ↔ a ≤ x ∧ x < b)
(finset_mem_Ioc : ∀ a b x : α, x ∈ finset_Ioc a b ↔ a < x ∧ x ≤ b)
(finset_mem_Ioo : ∀ a b x : α, x ∈ finset_Ioo a b ↔ a < x ∧ x < b)

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order.of_Icc' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, ¬b ≤ x),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a ∧ ¬b ≤ x),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_not_le],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_not_le],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_not_le,
    lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `partial_order` but only
`decidable_eq`. -/
def locally_finite_order.of_Icc (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, x ≠ b),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, a ≠ x),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, a ≠ x ∧ x ≠ b),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_and_ne],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_and_ne],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_and_ne,
    lt_iff_le_and_ne] }

variables {α β : Type*}

/-! ### Intervals as finsets -/

namespace finset
section preorder
variables [preorder α] [locally_finite_order α]

/-- The finset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a finset.
-/
def Icc (a b : α) : finset α := locally_finite_order.finset_Icc a b

/-- The finset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a finset.
-/
def Ico (a b : α) : finset α := locally_finite_order.finset_Ico a b

/-- The finset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a finset.
-/
def Ioc (a b : α) : finset α := locally_finite_order.finset_Ioc a b

/-- The finset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a finset.
-/
def Ioo (a b : α) : finset α := locally_finite_order.finset_Ioo a b

@[simp] lemma mem_Icc {a b x : α} : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
locally_finite_order.finset_mem_Icc a b x

@[simp] lemma mem_Ico {a b x : α} : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
locally_finite_order.finset_mem_Ico a b x

@[simp] lemma mem_Ioc {a b x : α} : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
locally_finite_order.finset_mem_Ioc a b x

@[simp] lemma mem_Ioo {a b x : α} : x ∈ Ioo a b ↔ a < x ∧ x < b :=
locally_finite_order.finset_mem_Ioo a b x

@[simp, norm_cast] lemma coe_Icc (a b : α) : (Icc a b : set α) = set.Icc a b :=
by { ext, rw [mem_coe, mem_Icc, set.mem_Icc] }

@[simp, norm_cast] lemma coe_Ico (a b : α) : (Ico a b : set α) = set.Ico a b :=
by { ext, rw [mem_coe, mem_Ico, set.mem_Ico] }

@[simp, norm_cast] lemma coe_Ioc (a b : α) : (Ioc a b : set α) = set.Ioc a b :=
by { ext, rw [mem_coe, mem_Ioc, set.mem_Ioc] }

@[simp, norm_cast] lemma coe_Ioo (a b : α) : (Ioo a b : set α) = set.Ioo a b :=
by { ext, rw [mem_coe, mem_Ioo, set.mem_Ioo] }

theorem Ico_subset_Ico {a₁ b₁ a₂ b₂ : α} (ha : a₂ ≤ a₁) (hb : b₁ ≤ b₂) : Ico a₁ b₁ ⊆ Ico a₂ b₂ :=
begin
  rintro x hx,
  rw mem_Ico at ⊢ hx,
  exact ⟨ha.trans hx.1, hx.2.trans_le hb⟩,
end

end preorder

section order_top
variables [preorder α] [order_top α] [locally_finite_order α]

/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a finset. -/
def Ici (a : α) : finset α := Icc a ⊤

/-- The finset of elements `x` such that `a < x`. Basically `set.Ioi a` as a finset. -/
def Ioi (a : α) : finset α := Ioc a ⊤

lemma Ici_eq_Icc (a : α) : Ici a = Icc a ⊤ := rfl
lemma Ioi_eq_Ioc (a : α) : Ioi a = Ioc a ⊤ := rfl

@[simp, norm_cast]

@[simp, norm_cast] lemma coe_Ioi (a : α) : (Ioi a : set α) = set.Ioi a :=
by rw [Ioi, coe_Ioc, set.Ioc_top]

@[simp] lemma mem_Ici {a x : α} : x ∈ Ici a ↔ a ≤ x := by rw [←set.mem_Ici, ←coe_Ici, mem_coe]
@[simp] lemma mem_Ioi {a x : α} : x ∈ Ioi a ↔ a < x := by rw [←set.mem_Ioi, ←coe_Ioi, mem_coe]

end order_top

section order_bot
variables [preorder α] [order_bot α] [locally_finite_order α]

/-- The finset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a finset. -/
def Iic (b : α) : finset α := Icc ⊥ b

/-- The finset of elements `x` such that `x < b`. Basically `set.Iio b` as a finset. -/
def Iio (b : α) : finset α := Ico ⊥ b

lemma Iic_eq_Icc : Iic = Icc (⊥ : α) := rfl
lemma Iio_eq_Ico : Iio = Ico (⊥ : α) := rfl

@[simp, norm_cast] lemma coe_Iic (b : α) : (Iic b : set α) = set.Iic b :=
by rw [Iic, coe_Icc, set.Icc_bot]

@[simp, norm_cast] lemma coe_Iio (b : α) : (Iio b : set α) = set.Iio b :=
by rw [Iio, coe_Ico, set.Ico_bot]

@[simp] lemma mem_Iic {b x : α} : x ∈ Iic b ↔ x ≤ b := by rw [←set.mem_Iic, ←coe_Iic, mem_coe]
@[simp] lemma mem_Iio {b x : α} : x ∈ Iio b ↔ x < b := by rw [←set.mem_Iio, ←coe_Iio, mem_coe]

end order_bot
end finset

/-! ### Intervals as multisets -/

namespace multiset
section preorder
variables [preorder α] [locally_finite_order α]

/-- The multiset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a
multiset. -/
def Icc (a b : α) : multiset α := (finset.Icc a b).val

/-- The multiset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a
multiset. -/
def Ico (a b : α) : multiset α := (finset.Ico a b).val

/-- The multiset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a
multiset. -/
def Ioc (a b : α) : multiset α := (finset.Ioc a b).val

/-- The multiset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a
multiset. -/
def Ioo (a b : α) : multiset α := (finset.Ioo a b).val

@[simp] lemma mem_Icc {a b x : α} : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
by rw [Icc, ←finset.mem_def, finset.mem_Icc]

@[simp] lemma mem_Ico {a b x : α} : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
by rw [Ico, ←finset.mem_def, finset.mem_Ico]

@[simp] lemma mem_Ioc {a b x : α} : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
by rw [Ioc, ←finset.mem_def, finset.mem_Ioc]

@[simp] lemma mem_Ioo {a b x : α} : x ∈ Ioo a b ↔ a < x ∧ x < b :=
by rw [Ioo, ←finset.mem_def, finset.mem_Ioo]

end preorder

section order_top
variables [preorder α] [order_top α] [locally_finite_order α]

/-- The multiset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a multiset. -/
def Ici (a : α) : multiset α := (finset.Ici a).val

/-- The multiset of elements `x` such that `a < x`. Basically `set.Ioi a` as a multiset. -/
def Ioi (a : α) : multiset α := (finset.Ioi a).val

@[simp] lemma mem_Ici {a x : α} : x ∈ Ici a ↔ a ≤ x := by rw [Ici, ←finset.mem_def, finset.mem_Ici]
@[simp] lemma mem_Ioi {a x : α} : x ∈ Ioi a ↔ a < x := by rw [Ioi, ←finset.mem_def, finset.mem_Ioi]

end order_top

section order_bot
variables [preorder α] [order_bot α] [locally_finite_order α]

/-- The multiset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a multiset. -/
def Iic (b : α) : multiset α := (finset.Iic b).val

/-- The multiset of elements `x` such that `x < b`. Basically `set.Iio b` as a multiset. -/
def Iio (b : α) : multiset α := (finset.Iio b).val

@[simp] lemma mem_Iic {b x : α} : x ∈ Iic b ↔ x ≤ b := by rw [Iic, ←finset.mem_def, finset.mem_Iic]
@[simp] lemma mem_Iio {b x : α} : x ∈ Iio b ↔ x < b := by rw [Iio, ←finset.mem_def, finset.mem_Iio]

end order_bot
end multiset

/-! ### Finiteness of `set` intervals -/

namespace set
section preorder
variables [preorder α] [locally_finite_order α] (a b : α)

instance fintype_Icc : fintype (Icc a b) :=
fintype.of_finset (finset.Icc a b) (λ x, by rw [finset.mem_Icc, mem_Icc])

instance fintype_Ico : fintype (Ico a b) :=
fintype.of_finset (finset.Ico a b) (λ x, by rw [finset.mem_Ico, mem_Ico])

instance fintype_Ioc : fintype (Ioc a b) :=
fintype.of_finset (finset.Ioc a b) (λ x, by rw [finset.mem_Ioc, mem_Ioc])

instance fintype_Ioo : fintype (Ioo a b) :=
fintype.of_finset (finset.Ioo a b) (λ x, by rw [finset.mem_Ioo, mem_Ioo])

lemma finite_Icc : (Icc a b).finite := ⟨set.fintype_Icc a b⟩
lemma finite_Ico : (Ico a b).finite := ⟨set.fintype_Ico a b⟩
lemma finite_Ioc : (Ioc a b).finite := ⟨set.fintype_Ioc a b⟩
lemma finite_Ioo : (Ioo a b).finite := ⟨set.fintype_Ioo a b⟩

end preorder

section order_top
variables [preorder α] [order_top α] [locally_finite_order α] (a : α)

instance fintype_Ici : fintype (Ici a) :=
fintype.of_finset (finset.Ici a) (λ x, by rw [finset.mem_Ici, mem_Ici])

instance fintype_Ioi : fintype (Ioi a) :=
fintype.of_finset (finset.Ioi a) (λ x, by rw [finset.mem_Ioi, mem_Ioi])

lemma finite_Ici : (Ici a).finite := ⟨set.fintype_Ici a⟩
lemma finite_Ioi : (Ioi a).finite := ⟨set.fintype_Ioi a⟩

end order_top

section order_bot
variables [preorder α] [order_bot α] [locally_finite_order α] (b : α)

instance fintype_Iic : fintype (Iic b) :=
fintype.of_finset (finset.Iic b) (λ x, by rw [finset.mem_Iic, mem_Iic])

instance fintype_Iio : fintype (Iio b) :=
fintype.of_finset (finset.Iio b) (λ x, by rw [finset.mem_Iio, mem_Iio])

lemma finite_Iic : (Iic b).finite := ⟨set.fintype_Iic b⟩
lemma finite_Iio : (Iio b).finite := ⟨set.fintype_Iio b⟩

end order_bot

end set

/-! ### Instances -/

open finset

section preorder
variables [preorder α]

/-- A noncomputable constructor from the finiteness of all closed intervals. -/
noncomputable def locally_finite_order.of_finite_Icc (h : ∀ a b : α, (set.Icc a b).finite) :
  locally_finite_order α :=
@locally_finite_order.of_Icc' α _ (classical.dec_rel _)
  (λ a b, (h a b).to_finset)
  (λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc])

/-- A fintype is noncomputably a locally finite order. -/
noncomputable def fintype.to_locally_finite_order [fintype α] : locally_finite_order α :=
{ finset_Icc := λ a b, (set.finite.of_fintype (set.Icc a b)).to_finset,
  finset_Ico := λ a b, (set.finite.of_fintype (set.Ico a b)).to_finset,
  finset_Ioc := λ a b, (set.finite.of_fintype (set.Ioc a b)).to_finset,
  finset_Ioo := λ a b, (set.finite.of_fintype (set.Ioo a b)).to_finset,
  finset_mem_Icc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc],
  finset_mem_Ico := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ico],
  finset_mem_Ioc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioc],
  finset_mem_Ioo := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioo] }

instance : subsingleton (locally_finite_order α) :=
subsingleton.intro (λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIcc : h₀_finset_Icc = h₁_finset_Icc,
  { ext a b x, rw [h₀_finset_mem_Icc, h₁_finset_mem_Icc] },
  have hIco : h₀_finset_Ico = h₁_finset_Ico,
  { ext a b x, rw [h₀_finset_mem_Ico, h₁_finset_mem_Ico] },
  have hIoc : h₀_finset_Ioc = h₁_finset_Ioc,
  { ext a b x, rw [h₀_finset_mem_Ioc, h₁_finset_mem_Ioc] },
  have hIoo : h₀_finset_Ioo = h₁_finset_Ioo,
  { ext a b x, rw [h₀_finset_mem_Ioo, h₁_finset_mem_Ioo] },
  simp_rw [hIcc, hIco, hIoc, hIoo],
end)

variables [preorder β] [locally_finite_order β]

-- Should this be called `locally_finite_order.lift`?
/-- Given an order embedding `α ↪o β`, pulls back the `locally_finite_order` on `β` to `α`. -/
noncomputable def order_embedding.locally_finite_order (f : α ↪o β) : locally_finite_order α :=
{ finset_Icc := λ a b, (Icc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ico := λ a b, (Ico (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioc := λ a b, (Ioc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioo := λ a b, (Ioo (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_mem_Icc := λ a b x, by rw [mem_preimage, mem_Icc, f.le_iff_le, f.le_iff_le],
  finset_mem_Ico := λ a b x, by rw [mem_preimage, mem_Ico, f.le_iff_le, f.lt_iff_lt],
  finset_mem_Ioc := λ a b x, by rw [mem_preimage, mem_Ioc, f.lt_iff_lt, f.le_iff_le],
  finset_mem_Ioo := λ a b x, by rw [mem_preimage, mem_Ioo, f.lt_iff_lt, f.lt_iff_lt] }

open order_dual

variables [locally_finite_order α] (a b : α)

/-- Note we define `Icc (to_dual a) (to_dual b)` as `Icc α _ _ b a` (which has type `finset α` not
`finset (order_dual α)`!) instead of `(Icc b a).map to_dual.to_embedding` as this means the
following is defeq:
```
lemma this : (Icc (to_dual (to_dual a)) (to_dual (to_dual b)) : _) = (Icc a b : _) := rfl
```
-/
instance : locally_finite_order (order_dual α) :=
{ finset_Icc := λ a b, @Icc α _ _ (of_dual b) (of_dual a),
  finset_Ico := λ a b, @Ioc α _ _ (of_dual b) (of_dual a),
  finset_Ioc := λ a b, @Ico α _ _ (of_dual b) (of_dual a),
  finset_Ioo := λ a b, @Ioo α _ _ (of_dual b) (of_dual a),
  finset_mem_Icc := λ a b x, mem_Icc.trans (and_comm _ _),
  finset_mem_Ico := λ a b x, mem_Ioc.trans (and_comm _ _),
  finset_mem_Ioc := λ a b x, mem_Ico.trans (and_comm _ _),
  finset_mem_Ioo := λ a b x, mem_Ioo.trans (and_comm _ _) }

lemma Icc_to_dual : Icc (to_dual a) (to_dual b) = (Icc b a).map to_dual.to_embedding :=
begin
  refine eq.trans _ map_refl.symm,
  ext c,
  rw [mem_Icc, mem_Icc],
  exact and_comm _ _,
end

lemma Ico_to_dual : Ico (to_dual a) (to_dual b) = (Ioc b a).map to_dual.to_embedding :=
begin
  refine eq.trans _ map_refl.symm,
  ext c,
  rw [mem_Ico, mem_Ioc],
  exact and_comm _ _,
end

lemma Ioc_to_dual : Ioc (to_dual a) (to_dual b) = (Ico b a).map to_dual.to_embedding :=
begin
  refine eq.trans _ map_refl.symm,
  ext c,
  rw [mem_Ioc, mem_Ico],
  exact and_comm _ _,
end

lemma Ioo_to_dual : Ioo (to_dual a) (to_dual b) = (Ioo b a).map to_dual.to_embedding :=
begin
  refine eq.trans _ map_refl.symm,
  ext c,
  rw [mem_Ioo, mem_Ioo],
  exact and_comm _ _,
end

instance [decidable_rel ((≤) : α × β → α × β → Prop)] : locally_finite_order (α × β) :=
locally_finite_order.of_Icc' (α × β)
  (λ a b, (Icc a.fst b.fst).product (Icc a.snd b.snd))
  (λ a b x, by { rw [mem_product, mem_Icc, mem_Icc, and_and_and_comm], refl })

end preorder

/-!
#### `with_top`, `with_bot`

Adding a `⊤` to a locally finite `order_top` keeps it locally finite.
Adding a `⊥` to a locally finite `order_bot` keeps it locally finite.
-/

namespace with_top
variables (α) [partial_order α] [order_top α] [locally_finite_order α]

local attribute [pattern] coe
local attribute [simp] option.mem_iff

instance : locally_finite_order (with_top α) :=
{ finset_Icc := λ a b, match a, b with
    |       ⊤,       ⊤ := {⊤}
    |       ⊤, (b : α) := ∅
    | (a : α),       ⊤ := insert_none (Ici a)
    | (a : α), (b : α) := (Icc a b).map embedding.coe_option
    end,
  finset_Ico := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ici a).map embedding.coe_option
    | (a : α), (b : α) := (Ico a b).map embedding.coe_option
    end,
  finset_Ioc := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := insert_none (Ioi a)
    | (a : α), (b : α) := (Ioc a b).map embedding.coe_option
    end,
  finset_Ioo := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ioi a).map embedding.coe_option
    | (a : α), (b : α) := (Ioo a b).map embedding.coe_option
    end,
  finset_mem_Icc := λ a b x, match a, b, x with
    |       ⊤,       ⊤,       x := mem_singleton.trans (le_antisymm_iff.trans $ and_comm _ _)
    |       ⊤, (b : α),       x := iff_of_false (not_mem_empty _)
                                     (λ h, (h.1.trans h.2).not_lt $ coe_lt_top _)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    end,
  finset_mem_Ico := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_lt h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioc := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_le h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_3, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_3]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioo := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_4, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe, coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_4]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe]
    end }

variables (a b : α)

lemma Icc_coe_top : Icc (a : with_top α) ⊤ = insert_none (Ici a) := rfl
lemma Icc_coe_coe : Icc (a : with_top α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_coe_top : Ico (a : with_top α) ⊤ = (Ici a).map embedding.coe_option := rfl
lemma Ico_coe_coe : Ico (a : with_top α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_coe_top : Ioc (a : with_top α) ⊤ = insert_none (Ioi a) := rfl
lemma Ioc_coe_coe : Ioc (a : with_top α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_coe_top : Ioo (a : with_top α) ⊤ = (Ioi a).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_top α) b = (Ioo a b).map embedding.coe_option := rfl

end with_top

namespace with_bot
variables (α) [partial_order α] [order_bot α] [locally_finite_order α]

instance : locally_finite_order (with_bot α) :=
@order_dual.locally_finite_order (with_top (order_dual α)) _ _

variables (a b : α)

lemma Icc_bot_coe : Icc (⊥ : with_bot α) b = insert_none (Iic b) := rfl
lemma Icc_coe_coe : Icc (a : with_bot α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_bot_coe : Ico (⊥ : with_bot α) b = insert_none (Iio b) := rfl
lemma Ico_coe_coe : Ico (a : with_bot α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_bot_coe : Ioc (⊥ : with_bot α) b = (Iic b).map embedding.coe_option := rfl
lemma Ioc_coe_coe : Ioc (a : with_bot α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_bot_coe : Ioo (⊥ : with_bot α) b = (Iio b).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_bot α) b = (Ioo a b).map embedding.coe_option := rfl

end with_bot

/-! #### Subtype of a locally finite order -/

variables [preorder α] [locally_finite_order α] (p : α → Prop) [decidable_pred p]

instance : locally_finite_order (subtype p) :=
{ finset_Icc := λ a b, (Icc (a : α) b).subtype p,
  finset_Ico := λ a b, (Ico (a : α) b).subtype p,
  finset_Ioc := λ a b, (Ioc (a : α) b).subtype p,
  finset_Ioo := λ a b, (Ioo (a : α) b).subtype p,
  finset_mem_Icc := λ a b x, by simp_rw [finset.mem_subtype, mem_Icc, subtype.coe_le_coe],
  finset_mem_Ico := λ a b x, by simp_rw [finset.mem_subtype, mem_Ico, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioc := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioc, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioo := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioo, subtype.coe_lt_coe] }

variables (a b : subtype p)

namespace finset

lemma subtype_Icc_eq : Icc a b = (Icc (a : α) b).subtype p := rfl
lemma subtype_Ico_eq : Ico a b = (Ico (a : α) b).subtype p := rfl
lemma subtype_Ioc_eq : Ioc a b = (Ioc (a : α) b).subtype p := rfl
lemma subtype_Ioo_eq : Ioo a b = (Ioo (a : α) b).subtype p := rfl

variables (hp : ∀ ⦃a b x⦄, a ≤ x → x ≤ b → p a → p b → p x)
include hp

lemma map_subtype_embedding_Icc : (Icc a b).map (function.embedding.subtype p) = Icc (a : α) b :=
begin
  rw subtype_Icc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Icc at hx,
  exact hp hx.1 hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ico : (Ico a b).map (function.embedding.subtype p) = Ico (a : α) b :=
begin
  rw subtype_Ico_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ico at hx,
  exact hp hx.1 hx.2.le a.prop b.prop,
end

lemma map_subtype_embedding_Ioc : (Ioc a b).map (function.embedding.subtype p) = Ioc (a : α) b :=
begin
  rw subtype_Ioc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioc at hx,
  exact hp hx.1.le hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ioo : (Ioo a b).map (function.embedding.subtype p) = Ioo (a : α) b :=
begin
  rw subtype_Ioo_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioo at hx,
  exact hp hx.1.le hx.2.le a.prop b.prop,
end

end finset


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

/-!
# (Scalar) multiplication and (vector) addition as measurable equivalences

In this file we define the following measurable equivalences:

* `measurable_equiv.smul`: if a group `G` acts on `α` by measurable maps, then each element `c : G`
  defines a measurable automorphism of `α`;
* `measurable_equiv.vadd`: additive version of `measurable_equiv.smul`;
* `measurable_equiv.smul₀`: if a group with zero `G` acts on `α` by measurable maps, then each
  nonzero element `c : G` defines a measurable automorphism of `α`;
* `measurable_equiv.mul_left`: if `G` is a group with measurable multiplication, then left
  multiplication by `g : G` is a measurable automorphism of `G`;
* `measurable_equiv.add_left`: additive version of `measurable_equiv.mul_left`;
* `measurable_equiv.mul_right`: if `G` is a group with measurable multiplication, then right
  multiplication by `g : G` is a measurable automorphism of `G`;
* `measurable_equiv.add_right`: additive version of `measurable_equiv.mul_right`;
* `measurable_equiv.mul_left₀`, `measurable_equiv.mul_right₀`: versions of
  `measurable_equiv.mul_left` and `measurable_equiv.mul_right` for groups with zero;
* `measurable_equiv.inv`, `measurable_equiv.inv₀`: `has_inv.inv` as a measurable automorphism
  of a group (or a group with zero);
* `measurable_equiv.neg`: negation as a measurable automorphism of an additive group.

We also deduce that the corresponding maps are measurable embeddings.

## Tags

measurable, equivalence, group action
-/

namespace measurable_equiv

variables {G G₀ α : Type*} [measurable_space G] [measurable_space G₀] [measurable_space α]
  [group G] [group_with_zero G₀] [mul_action G α] [mul_action G₀ α]
  [has_measurable_smul G α] [has_measurable_smul G₀ α]

/-- If a group `G` acts on `α` by measurable maps, then each element `c : G` defines a measurable
automorphism of `α`. -/
@[to_additive "If an additive group `G` acts on `α` by measurable maps, then each element `c : G`
defines a measurable automorphism of `α`.", simps to_equiv apply { fully_applied := ff }]
def smul (c : G) : α ≃ᵐ α :=
{ to_equiv := mul_action.to_perm c,
  measurable_to_fun := measurable_const_smul c,
  measurable_inv_fun := measurable_const_smul c⁻¹ }

@[to_additive]
lemma _root_.measurable_embedding_const_smul (c : G) : measurable_embedding ((•) c : α → α) :=
(smul c).measurable_embedding

@[simp, to_additive]

/-- If a group with zero `G₀` acts on `α` by measurable maps, then each nonzero element `c : G₀`
defines a measurable automorphism of `α` -/
def smul₀ (c : G₀) (hc : c ≠ 0) : α ≃ᵐ α :=
measurable_equiv.smul (units.mk0 c hc)

@[simp] lemma coe_smul₀ {c : G₀} (hc : c ≠ 0) : ⇑(smul₀ c hc : α ≃ᵐ α) = (•) c := rfl

@[simp] lemma symm_smul₀ {c : G₀} (hc : c ≠ 0) :
  (smul₀ c hc : α ≃ᵐ α).symm = smul₀ c⁻¹ (inv_ne_zero hc) :=
ext rfl

lemma _root_.measurable_embedding_const_smul₀ {c : G₀} (hc : c ≠ 0) :
  measurable_embedding ((•) c : α → α) :=
(smul₀ c hc).measurable_embedding

section mul

variables [has_measurable_mul G] [has_measurable_mul G₀]

/-- If `G` is a group with measurable multiplication, then left multiplication by `g : G` is a
measurable automorphism of `G`. -/
@[to_additive "If `G` is an additive group with measurable addition, then addition of `g : G`
on the left is a measurable automorphism of `G`."]
def mul_left (g : G) : G ≃ᵐ G := smul g

@[simp, to_additive] lemma coe_mul_left (g : G) : ⇑(mul_left g) = (*) g := rfl

@[simp, to_additive] lemma symm_mul_left (g : G) : (mul_left g).symm = mul_left g⁻¹ := ext rfl

@[simp, to_additive] lemma to_equiv_mul_left (g : G) :
  (mul_left g).to_equiv = equiv.mul_left g := rfl

@[to_additive]
lemma _root_.measurable_embedding_mul_left (g : G) : measurable_embedding ((*) g) :=
(mul_left g).measurable_embedding

/-- If `G` is a group with measurable multiplication, then right multiplication by `g : G` is a
measurable automorphism of `G`. -/
@[to_additive "If `G` is an additive group with measurable addition, then addition of `g : G`
on the right is a measurable automorphism of `G`."]
def mul_right (g : G) : G ≃ᵐ G :=
{ to_equiv := equiv.mul_right g,
  measurable_to_fun := measurable_mul_const g,
  measurable_inv_fun := measurable_mul_const g⁻¹ }

@[to_additive]
lemma _root_.measurable_embedding_mul_right (g : G) : measurable_embedding (λ x, x * g) :=
(mul_right g).measurable_embedding

@[simp, to_additive] lemma coe_mul_right (g : G) : ⇑(mul_right g) = (λ x, x * g) := rfl

@[simp, to_additive] lemma symm_mul_right (g : G) : (mul_right g).symm = mul_right g⁻¹ := ext rfl

@[simp, to_additive] lemma to_equiv_mul_right (g : G) :
  (mul_right g).to_equiv = equiv.mul_right g := rfl

/-- If `G₀` is a group with zero with measurable multiplication, then left multiplication by a
nonzero element `g : G₀` is a measurable automorphism of `G₀`. -/
def mul_left₀ (g : G₀) (hg : g ≠ 0) : G₀ ≃ᵐ G₀ := smul₀ g hg

lemma _root_.measurable_embedding_mul_left₀ {g : G₀} (hg : g ≠ 0) : measurable_embedding ((*) g) :=
(mul_left₀ g hg).measurable_embedding

@[simp] lemma coe_mul_left₀ {g : G₀} (hg : g ≠ 0) : ⇑(mul_left₀ g hg) = (*) g := rfl

@[simp] lemma symm_mul_left₀ {g : G₀} (hg : g ≠ 0) :
  (mul_left₀ g hg).symm = mul_left₀ g⁻¹ (inv_ne_zero hg)  := ext rfl

@[simp] lemma to_equiv_mul_left₀ {g : G₀} (hg : g ≠ 0) :
  (mul_left₀ g hg).to_equiv = equiv.mul_left₀ g hg := rfl

/-- If `G₀` is a group with zero with measurable multiplication, then right multiplication by a
nonzero element `g : G₀` is a measurable automorphism of `G₀`. -/
def mul_right₀ (g : G₀) (hg : g ≠ 0) : G₀ ≃ᵐ G₀ :=
{ to_equiv := equiv.mul_right₀ g hg,
  measurable_to_fun := measurable_mul_const g,
  measurable_inv_fun := measurable_mul_const g⁻¹ }

lemma _root_.measurable_embedding_mul_right₀ {g : G₀} (hg : g ≠ 0) :
  measurable_embedding (λ x, x * g) :=
(mul_right₀ g hg).measurable_embedding

@[simp] lemma coe_mul_right₀ {g : G₀} (hg : g ≠ 0) : ⇑(mul_right₀ g hg) = λ x, x * g := rfl

@[simp] lemma symm_mul_right₀ {g : G₀} (hg : g ≠ 0) :
  (mul_right₀ g hg).symm = mul_right₀ g⁻¹ (inv_ne_zero hg)  := ext rfl

@[simp] lemma to_equiv_mul_right₀ {g : G₀} (hg : g ≠ 0) :
  (mul_right₀ g hg).to_equiv = equiv.mul_right₀ g hg := rfl

end mul

variables (G G₀)

/-- Inversion as a measurable automorphism of a group. -/
@[to_additive "Negation as a measurable automorphism of an additive group.",
  simps to_equiv apply { fully_applied := ff }]
def inv [has_measurable_inv G] : G ≃ᵐ G :=
{ to_equiv := equiv.inv G,
  measurable_to_fun := measurable_inv,
  measurable_inv_fun := measurable_inv }

/-- Inversion as a measurable automorphism of a group with zero. -/
@[simps to_equiv apply { fully_applied := ff }]
def inv₀ [has_measurable_inv G₀] : G₀ ≃ᵐ G₀ :=
{ to_equiv := equiv.inv₀ G₀,
  measurable_to_fun := measurable_inv,
  measurable_inv_fun := measurable_inv }

variables {G G₀}

@[simp] lemma symm_inv [has_measurable_inv G] : (inv G).symm = inv G := rfl
@[simp] lemma symm_inv₀ [has_measurable_inv G₀] : (inv₀ G₀).symm = inv₀ G₀ := rfl

end measurable_equiv


import mul_subgroup.basic

/-! Adjoining an element to a multiplicative subgroup. -/

variables {K : Type*} [field K]

namespace mul_subgroup

inductive adjoin_is_unit_carrier (T : mul_subgroup K) (x : K) (hx : is_unit x) : set K
| base (a : K) : a ∈ T → adjoin_is_unit_carrier a
| of : adjoin_is_unit_carrier x
| mul (a b : K) : adjoin_is_unit_carrier a → adjoin_is_unit_carrier b → adjoin_is_unit_carrier (a * b)
| inv (a : K) : adjoin_is_unit_carrier a → adjoin_is_unit_carrier (a⁻¹)

def adjoin_is_unit (T : mul_subgroup K) (x : K) (hx : is_unit x) : mul_subgroup K :=
{ carrier := T.adjoin_is_unit_carrier x hx,
  mul_mem' := λ a b ha hb, adjoin_is_unit_carrier.mul _ _ ha hb,
  inv_mem' := λ a ha, adjoin_is_unit_carrier.inv _ ha,
  one_mem' := adjoin_is_unit_carrier.base _ T.one_mem,
  is_unit' := begin
    intros a ha,
    induction ha,
    { apply T.is_unit_of_mem, assumption },
    { assumption },
    { apply is_unit.mul, assumption' },
    { rw is_unit_iff_ne_zero at *, apply inv_ne_zero, assumption }
  end }

def adjoin_ne_zero (T : mul_subgroup K) (x : K) (hx : x ≠ 0) : mul_subgroup K :=
T.adjoin_is_unit x (is_unit.mk0 _ hx)

lemma mem_adjoin_is_unit_of_mem (T : mul_subgroup K) (x : K) (hx : is_unit x) (a : K) (ha : a ∈ T) :
  a ∈ T.adjoin_is_unit x hx := adjoin_is_unit_carrier.base _ ha

lemma mem_adjoin_is_unit_self (T : mul_subgroup K) (x : K) (hx : is_unit x) :
  x ∈ T.adjoin_is_unit x hx := adjoin_is_unit_carrier.of

lemma mem_adjoin_ne_zero_of_mem (T : mul_subgroup K) (x : K) (hx : x ≠ 0) (a : K) (ha : a ∈ T) :
  a ∈ T.adjoin_ne_zero x hx := T.mem_adjoin_is_unit_of_mem _ _ _ ha

lemma mem_adjoin_ne_zero_self (T : mul_subgroup K) (x : K) (hx : x ≠ 0) :
  x ∈ T.adjoin_ne_zero x hx := T.mem_adjoin_is_unit_self _ _

lemma le_adjoin_is_unit (T : mul_subgroup K) (x : K) (hx : is_unit x) :
  T ≤ T.adjoin_is_unit x hx := T.mem_adjoin_is_unit_of_mem _ _

lemma le_adjoin_ne_zero (T : mul_subgroup K) (x : K) (hx : x ≠ 0) :
  T ≤ T.adjoin_ne_zero x hx := T.mem_adjoin_ne_zero_of_mem _ _

lemma adjoin_ne_zero_eq_of_mem (T : mul_subgroup K) (x : K) (hx : x ≠ 0)
  (h : x ∈ T) : T.adjoin_ne_zero x hx = T :=
begin
  ext t,
  split,
  { intro h, induction h, assumption, assumption, apply mul_mem, assumption',
    apply inv_mem, assumption },
  { intros h, apply adjoin_is_unit_carrier.base, assumption }
end

lemma adjoin_ne_zero_le (T H : mul_subgroup K) (x : K) (hx : x ≠ 0) :
  T ≤ H → x ∈ H → T.adjoin_ne_zero x hx ≤ H :=
begin
  intros h1 h2 t ht,
  induction ht,
  apply h1, assumption,
  assumption,
  apply H.mul_mem, assumption',
  apply H.inv_mem, assumption
end

inductive adjoin_carrier (T : mul_subgroup K) (S : set K) (hS : ∀ (s : K) (hs : s ∈ S), is_unit s) : set K
| base (a : K) : a ∈ T → adjoin_carrier a
| of (s : K) (hs : s ∈ S) : adjoin_carrier s
| mul (a b : K) : adjoin_carrier a → adjoin_carrier b → adjoin_carrier (a * b)
| inv (a : K) : adjoin_carrier a → adjoin_carrier (a⁻¹)

def adjoin (T : mul_subgroup K) (S : set K) (hS : ∀ (s : K) (hs : s ∈ S), is_unit s) : mul_subgroup K :=
{ carrier := T.adjoin_carrier S hS,
  mul_mem' := λ x y hx hy, adjoin_carrier.mul _ _ hx hy,
  inv_mem' := λ x hx, adjoin_carrier.inv _ hx,
  one_mem' := adjoin_carrier.base _ T.one_mem,
  is_unit' := begin
    intros x hx, induction hx,
    { apply T.is_unit_of_mem, assumption },
    { apply hS, assumption },
    { apply is_unit.mul, assumption' },
    { rw is_unit_iff_ne_zero at *, apply inv_ne_zero, assumption }
  end }

def adjoin0 (T : mul_subgroup K) (S : set K) (hS : ∀ (s : K) (hs : s ∈ S), s ≠ 0) :
  mul_subgroup K :=
T.adjoin S $ λ s h, is_unit_iff_ne_zero.mpr (hS _ h)

end mul_subgroup


import BrownCs22.Library.Tactics

variable (U : Type)

/-

# Sets in Lean

Today we'll talk about sets in Lean!

Remember that, when we take the *complement* of a set `A`,
we have to do this relative to some "universe" of objects.
Otherwise, the set of things not in `A` would be gigantic.

Lean enforces this even more strongly. Every set must be
relative to some universe. `A : set ℕ` means that
"`A` is a set of natural numbers," i.e., the universe is `ℕ`.
Similarly, `A : set U` means that the elements of `A` come
from some generic kind of objects that we call `U`.

## The set-element method

To prove that two sets are equal, one technique we saw was
to transform the equality into a universal statement about
membership : `A = B` means `∀ x : U, x ∈ A ↔ x ∈ B`.
The tactic for doing this is called `ext`, for "extensionality."
You give it a name for the variable `x`.

## Some new useful tactics

* `ext x`: if your goal is to show that two sets `A` and `B`
  are equal, `ext x` changes the goal to showing that
  `x ∈ A ↔ x ∈ B`. Remember, `split_goal` will then turn an `↔`
  statement into two implications!

* `set_simplify`: this one is fun! If you have any "set membership"
  statements, like `x ∈ Aᶜ`, in your hypothesis or goals,
  `set_simplify` will turn these statements into "logic."
  For example, `x ∈ Aᶜ` will become `¬ (x ∈ A)`.
  `x ∈ A ∩ B` will become `x ∈ A ∧ x ∈ B`.

* `rewrite`: stands for "rewrite." `rewrite` will let us substitute patterns
  in place of equivalent or equal patterns. A good example here is
  De Morgan's laws, which are logical equivalences. If we are
  ever looking to prove a goal of the form `¬ (p ∧ q)`,
  `rewrite [not_and_or]` will use De Morgan's law to change the goal to
  `¬p ∨ ¬q`. The word `not_and_or` is the name Lean gives to this form
  of De Morgan's law.

  There are lots of laws (patterns, equivalences) that we can use with
  `rewrite`. For now, we'll just use a few. More information about `rewrite`
  and a longer list of rules will come soon to the quick reference.

  You can figure out what a rule states using `#check`:

-/

#check not_and_or   -- De Morgan 1
#check not_or       -- De Morgan 2
#check not_not      -- Double negation elimination
#check or_comm      -- Changes the order of an "or"
#check and_comm     -- Changes the order of and "and"

/-

Finally, some useful keyboard shortcuts:

* `∩`: \inter, \cap
* `∪`: \union, \cup
* `ᶜ`: We use this for "complement". \^c

-/

/-

Here's a proof using the set-element method:

-/

example (A B : Set U) : (A ∩ B)ᶜ = Aᶜ ∪ Bᶜ := by
  ext x
  split_goal
  { intro hx
    set_simplify
    rewrite [not_and_or] at hx
    assumption }
  { intro hx
    set_simplify
    rewrite [not_and_or]
    assumption }

/-

Here's another. This one uses `rw` much more heavily!

The final goal has the form `p ↔ p`. The `reflexivity` tactic,
which we've seen once or twice already, closes goals like this.
`↔`, `=`, and some other relations are called *reflexive* because
for any `x`, `x ↔ x`, `x = x`, etc. are true.

-/

example (A B : Set U) : (A \ B)ᶜ = B ∪ Aᶜ := by
  ext x
  set_simplify
  rewrite [not_and_or]
  rewrite [not_not]
  rewrite [or_comm]
  reflexivity

/-

## Bonus

We mentioned "De Morgan for quantifiers" in lecture.
Here's a proof of one direction of this.
The other direction is trickier: we need a new proof technique for it.

-/

example (P : ℕ → Prop) : (¬ ∃ x, P x) ↔ (∀ x, ¬ P x)  := by
  split_goal                    -- To prove an ↔, prove both directions.

  { intro hne                   -- Suppose `¬ ∃ x, P x`.
    intro x                     -- Take an arbitrary `x`,
    intro hx                    -- and suppose for the sake of contradiction that `P x` holds.
    have hex : ∃ x, P x         -- We then know that `∃ x, P x` holds,
    { existsi x                 -- since `x` is a witness.
      assumption }
    contradiction }             -- This contradicts our original hypothesis.

  { intro hall                  -- For the other direction, suppose `∀ x, ¬ P x`.
    intro hex                   -- Suppose for the sake of contradiction `∃ x, P x`.
    eliminate hex with w hw     -- Then there is a witness `w` such that `P w` holds.
    have hnw : ¬ P w := hall w  -- But, from our first hypothesis, `¬ P w` also holds.
    contradiction }             -- Contradiction.

/-

There are even rewrite rules for "De Morgan for quantifiers":

-/

#check not_forall
#check not_exists


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

! This file was ported from Lean 3 source module data.finsupp.indicator
! leanprover-community/mathlib commit 842328d9df7e96fd90fc424e115679c15fb23a71
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Defs

/-!
# Building finitely supported functions off finsets

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

This file defines `finsupp.indicator` to help create finsupps from finsets.

## Main declarations

* `finsupp.indicator`: Turns a map from a `finset` into a `finsupp` from the entire type.
-/

noncomputable section

open Finset Function

variable {ι α : Type _}

namespace Finsupp

variable [Zero α] {s : Finset ι} (f : ∀ i ∈ s, α) {i : ι}

#print Finsupp.indicator /-
/-- Create an element of `ι →₀ α` from a finset `s` and a function `f` defined on this finset. -/
def indicator (s : Finset ι) (f : ∀ i ∈ s, α) : ι →₀ α
    where
  toFun i :=
    haveI := Classical.decEq ι
    if H : i ∈ s then f i H else 0
  support :=
    haveI := Classical.decEq α
    (s.attach.filter fun i : s => f i.1 i.2 ≠ 0).map (embedding.subtype _)
  mem_support_toFun i := by
    letI := Classical.decEq α
    rw [mem_map, dite_ne_right_iff]
    exact
      ⟨fun ⟨⟨j, hj⟩, hf, rfl⟩ => ⟨hj, (mem_filter.1 hf).2⟩, fun ⟨hi, hf⟩ =>
        ⟨⟨i, hi⟩, mem_filter.2 <| ⟨mem_attach _ _, hf⟩, rfl⟩⟩
#align finsupp.indicator Finsupp.indicator
-/

/- warning: finsupp.indicator_of_mem -> Finsupp.indicator_of_mem is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] {s : Finset.{u1} ι} {i : ι} (hi : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) (f : forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α), Eq.{succ u2} α (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (Finsupp.{u1, u2} ι α _inst_1) (fun (_x : Finsupp.{u1, u2} ι α _inst_1) => ι -> α) (Finsupp.coeFun.{u1, u2} ι α _inst_1) (Finsupp.indicator.{u1, u2} ι α _inst_1 s f) i) (f i hi)
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] {s : Finset.{u2} ι} {i : ι} (hi : Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) (f : forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) i) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} ι α _inst_1) ι (fun (_x : ι) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) _x) (Finsupp.funLike.{u2, u1} ι α _inst_1) (Finsupp.indicator.{u2, u1} ι α _inst_1 s f) i) (f i hi)
Case conversion may be inaccurate. Consider using '#align finsupp.indicator_of_mem Finsupp.indicator_of_memₓ'. -/
theorem indicator_of_mem (hi : i ∈ s) (f : ∀ i ∈ s, α) : indicator s f i = f i hi :=
  @dif_pos _ (id _) hi _ _ _
#align finsupp.indicator_of_mem Finsupp.indicator_of_mem

/- warning: finsupp.indicator_of_not_mem -> Finsupp.indicator_of_not_mem is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] {s : Finset.{u1} ι} {i : ι}, (Not (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s)) -> (forall (f : forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α), Eq.{succ u2} α (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (Finsupp.{u1, u2} ι α _inst_1) (fun (_x : Finsupp.{u1, u2} ι α _inst_1) => ι -> α) (Finsupp.coeFun.{u1, u2} ι α _inst_1) (Finsupp.indicator.{u1, u2} ι α _inst_1 s f) i) (OfNat.ofNat.{u2} α 0 (OfNat.mk.{u2} α 0 (Zero.zero.{u2} α _inst_1))))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] {s : Finset.{u2} ι} {i : ι}, (Not (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s)) -> (forall (f : forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α), Eq.{succ u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) i) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} ι α _inst_1) ι (fun (_x : ι) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) _x) (Finsupp.funLike.{u2, u1} ι α _inst_1) (Finsupp.indicator.{u2, u1} ι α _inst_1 s f) i) (OfNat.ofNat.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) i) 0 (Zero.toOfNat0.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) i) _inst_1)))
Case conversion may be inaccurate. Consider using '#align finsupp.indicator_of_not_mem Finsupp.indicator_of_not_memₓ'. -/
theorem indicator_of_not_mem (hi : i ∉ s) (f : ∀ i ∈ s, α) : indicator s f i = 0 :=
  @dif_neg _ (id _) hi _ _ _
#align finsupp.indicator_of_not_mem Finsupp.indicator_of_not_mem

variable (s i)

/- warning: finsupp.indicator_apply -> Finsupp.indicator_apply is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] (s : Finset.{u1} ι) (f : forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α) (i : ι) [_inst_2 : DecidableEq.{succ u1} ι], Eq.{succ u2} α (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (Finsupp.{u1, u2} ι α _inst_1) (fun (_x : Finsupp.{u1, u2} ι α _inst_1) => ι -> α) (Finsupp.coeFun.{u1, u2} ι α _inst_1) (Finsupp.indicator.{u1, u2} ι α _inst_1 s f) i) (dite.{succ u2} α (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) (Finset.decidableMem.{u1} ι (fun (a : ι) (b : ι) => _inst_2 a b) i s) (fun (hi : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) => f i hi) (fun (hi : Not (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s)) => OfNat.ofNat.{u2} α 0 (OfNat.mk.{u2} α 0 (Zero.zero.{u2} α _inst_1))))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] (s : Finset.{u2} ι) (f : forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α) (i : ι) [_inst_2 : DecidableEq.{succ u2} ι], Eq.{succ u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) i) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} ι α _inst_1) ι (fun (_x : ι) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : ι) => α) _x) (Finsupp.funLike.{u2, u1} ι α _inst_1) (Finsupp.indicator.{u2, u1} ι α _inst_1 s f) i) (dite.{succ u1} α (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) (Finset.decidableMem.{u2} ι (fun (a : ι) (b : ι) => _inst_2 a b) i s) (fun (hi : Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) => f i hi) (fun (hi : Not (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s)) => OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align finsupp.indicator_apply Finsupp.indicator_applyₓ'. -/
@[simp]
theorem indicator_apply [DecidableEq ι] : indicator s f i = if hi : i ∈ s then f i hi else 0 := by
  convert rfl
#align finsupp.indicator_apply Finsupp.indicator_apply

/- warning: finsupp.indicator_injective -> Finsupp.indicator_injective is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] (s : Finset.{u1} ι), Function.Injective.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α) (Finsupp.{u1, u2} ι α _inst_1) (fun (f : forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α) => Finsupp.indicator.{u1, u2} ι α _inst_1 s f)
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] (s : Finset.{u2} ι), Function.Injective.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α) (Finsupp.{u2, u1} ι α _inst_1) (fun (f : forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α) => Finsupp.indicator.{u2, u1} ι α _inst_1 s f)
Case conversion may be inaccurate. Consider using '#align finsupp.indicator_injective Finsupp.indicator_injectiveₓ'. -/
theorem indicator_injective : Injective fun f : ∀ i ∈ s, α => indicator s f :=
  by
  intro a b h
  ext (i hi)
  rw [← indicator_of_mem hi a, ← indicator_of_mem hi b]
  exact congr_fun h i
#align finsupp.indicator_injective Finsupp.indicator_injective

/- warning: finsupp.support_indicator_subset -> Finsupp.support_indicator_subset is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] (s : Finset.{u1} ι) (f : forall (i : ι), (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i s) -> α), HasSubset.Subset.{u1} (Set.{u1} ι) (Set.hasSubset.{u1} ι) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) (Finsupp.support.{u1, u2} ι α _inst_1 (Finsupp.indicator.{u1, u2} ι α _inst_1 s f))) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) s)
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] (s : Finset.{u2} ι) (f : forall (i : ι), (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i s) -> α), HasSubset.Subset.{u2} (Set.{u2} ι) (Set.instHasSubsetSet.{u2} ι) (Finset.toSet.{u2} ι (Finsupp.support.{u2, u1} ι α _inst_1 (Finsupp.indicator.{u2, u1} ι α _inst_1 s f))) (Finset.toSet.{u2} ι s)
Case conversion may be inaccurate. Consider using '#align finsupp.support_indicator_subset Finsupp.support_indicator_subsetₓ'. -/
theorem support_indicator_subset : ((indicator s f).support : Set ι) ⊆ s :=
  by
  intro i hi
  rw [mem_coe, mem_support_iff] at hi
  by_contra
  exact hi (indicator_of_not_mem h _)
#align finsupp.support_indicator_subset Finsupp.support_indicator_subset

/- warning: finsupp.single_eq_indicator -> Finsupp.single_eq_indicator is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Zero.{u2} α] (i : ι) (b : α), Eq.{max (succ u1) (succ u2)} (Finsupp.{u1, u2} ι α _inst_1) (Finsupp.single.{u1, u2} ι α _inst_1 i b) (Finsupp.indicator.{u1, u2} ι α _inst_1 (Singleton.singleton.{u1, u1} ι (Finset.{u1} ι) (Finset.hasSingleton.{u1} ι) i) (fun (_x : ι) (_x : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) _x (Singleton.singleton.{u1, u1} ι (Finset.{u1} ι) (Finset.hasSingleton.{u1} ι) i)) => b))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Zero.{u1} α] (i : ι) (b : α), Eq.{max (succ u2) (succ u1)} (Finsupp.{u2, u1} ι α _inst_1) (Finsupp.single.{u2, u1} ι α _inst_1 i b) (Finsupp.indicator.{u2, u1} ι α _inst_1 (Singleton.singleton.{u2, u2} ι (Finset.{u2} ι) (Finset.instSingletonFinset.{u2} ι) i) (fun (_x : ι) (_x : Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) _x (Singleton.singleton.{u2, u2} ι (Finset.{u2} ι) (Finset.instSingletonFinset.{u2} ι) i)) => b))
Case conversion may be inaccurate. Consider using '#align finsupp.single_eq_indicator Finsupp.single_eq_indicatorₓ'. -/
theorem single_eq_indicator (i : ι) (b : α) : single i b = indicator {i} fun _ _ => b := by
  classical
    ext
    simp [single_apply, indicator_apply, @eq_comm _ a]
#align finsupp.single_eq_indicator Finsupp.single_eq_indicator

end Finsupp


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

/-!
# Polynomial functors

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

universe u

/--
A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/

structure pfunctor :=
(A : Type u) (B : A → Type u)

namespace pfunctor

instance : inhabited pfunctor :=
⟨⟨default, default⟩⟩

variables (P : pfunctor) {α β : Type u}

/-- Applying `P` to an object of `Type` -/
def obj (α : Type*) := Σ x : P.A, P.B x → α

/-- Applying `P` to a morphism of `Type` -/
def map {α β : Type*} (f : α → β) : P.obj α → P.obj β :=
λ ⟨a, g⟩, ⟨a, f ∘ g⟩

instance obj.inhabited [inhabited P.A] [inhabited α] : inhabited (P.obj α) :=
⟨ ⟨ default, λ _, default ⟩ ⟩
instance : functor P.obj := {map := @map P}

protected theorem map_eq {α β : Type*} (f : α → β) (a : P.A) (g : P.B a → α) :
  @functor.map P.obj _ _ _ f ⟨a, g⟩ = ⟨a, f ∘ g⟩ :=
rfl

protected theorem id_map {α : Type*} : ∀ x : P.obj α, id <$> x = id x :=
λ ⟨a, b⟩, rfl

protected theorem comp_map {α β γ : Type*} (f : α → β) (g : β → γ) :
  ∀ x : P.obj α, (g ∘ f) <$> x = g <$> (f <$> x) :=
λ ⟨a, b⟩, rfl

instance : is_lawful_functor P.obj :=
{id_map := @pfunctor.id_map P, comp_map := @pfunctor.comp_map P}

/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W := _root_.W_type P.B

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/
attribute [nolint has_inhabited_instance] W
variables {P}

/-- root element  of a W tree -/
def W.head : W P → P.A
| ⟨a, f⟩ := a

/-- children of the root of a W tree -/
def W.children : Π x : W P, P.B (W.head x) → W P
| ⟨a, f⟩ := f

/-- destructor for W-types -/
def W.dest : W P → P.obj (W P)
| ⟨a, f⟩ := ⟨a, f⟩

/-- constructor for W-types -/
def W.mk : P.obj (W P) → W P
| ⟨a, f⟩ := ⟨a, f⟩

@[simp] theorem W.dest_mk (p : P.obj (W P)) : W.dest (W.mk p) = p :=
by cases p; reflexivity

@[simp] theorem W.mk_dest (p : W P) : W.mk (W.dest p) = p :=
by cases p; reflexivity

variables (P)

/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def Idx := Σ x : P.A, P.B x

instance Idx.inhabited [inhabited P.A] [inhabited (P.B default)] : inhabited P.Idx :=
⟨ ⟨default, default⟩ ⟩

variables {P}

/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def obj.iget [decidable_eq P.A] {α} [inhabited α] (x : P.obj α) (i : P.Idx) : α :=
if h : i.1 = x.1
  then x.2 (cast (congr_arg _ h) i.2)
  else default

@[simp]
lemma fst_map {α β : Type u} (x : P.obj α) (f : α → β) :
  (f <$> x).1 = x.1 := by { cases x; refl }

@[simp]
lemma iget_map [decidable_eq P.A] {α β : Type u} [inhabited α] [inhabited β]
  (x : P.obj α) (f : α → β) (i : P.Idx)
  (h : i.1 = x.1) :
  (f <$> x).iget i = f (x.iget i) :=
by { simp only [obj.iget, fst_map, *, dif_pos, eq_self_iff_true],
     cases x, refl }

end pfunctor

/-
Composition of polynomial functors.
-/

namespace pfunctor

/-- functor composition for polynomial functors -/
def comp (P₂ P₁ : pfunctor.{u}) : pfunctor.{u} :=
⟨ Σ a₂ : P₂.1, P₂.2 a₂ → P₁.1,
  λ a₂a₁, Σ u : P₂.2 a₂a₁.1, P₁.2 (a₂a₁.2 u) ⟩

/-- constructor for composition -/
def comp.mk (P₂ P₁ : pfunctor.{u}) {α : Type} (x : P₂.obj (P₁.obj α)) : (comp P₂ P₁).obj α :=
⟨ ⟨ x.1, sigma.fst ∘ x.2 ⟩, λ a₂a₁, (x.2 a₂a₁.1).2 a₂a₁.2  ⟩

/-- destructor for composition -/
def comp.get (P₂ P₁ : pfunctor.{u}) {α : Type} (x : (comp P₂ P₁).obj α) : P₂.obj (P₁.obj α) :=
⟨ x.1.1, λ a₂, ⟨x.1.2 a₂, λ a₁, x.2 ⟨a₂,a₁⟩ ⟩ ⟩

end pfunctor

/-
Lifting predicates and relations.
-/

namespace pfunctor
variables {P : pfunctor.{u}}
open functor

theorem liftp_iff {α : Type u} (p : α → Prop) (x : P.obj α) :
  liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i, p (f i) :=
begin
  split,
  { rintros ⟨y, hy⟩, cases h : y with a f,
    refine ⟨a, λ i, (f i).val, _, λ i, (f i).property⟩,
    rw [←hy, h, pfunctor.map_eq] },
  rintros ⟨a, f, xeq, pf⟩,
  use ⟨a, λ i, ⟨f i, pf i⟩⟩,
  rw [xeq], reflexivity
end

theorem liftp_iff' {α : Type u} (p : α → Prop) (a : P.A) (f : P.B a → α) :
  @liftp.{u} P.obj _ α p ⟨a,f⟩ ↔ ∀ i, p (f i) :=
begin
  simp only [liftp_iff, sigma.mk.inj_iff]; split; intro,
  { casesm* [Exists _, _ ∧ _], subst_vars, assumption },
  repeat { constructor <|> assumption }
end

theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : P.obj α) :
  liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) :=
begin
  split,
  { rintros ⟨u, xeq, yeq⟩, cases h : u with a f,
    use [a, λ i, (f i).val.fst, λ i, (f i).val.snd],
    split, { rw [←xeq, h], refl },
    split, { rw [←yeq, h], refl },
    intro i, exact (f i).property },
  rintros ⟨a, f₀, f₁, xeq, yeq, h⟩,
  use ⟨a, λ i, ⟨(f₀ i, f₁ i), h i⟩⟩,
  split,
  { rw [xeq], refl },
  rw [yeq], refl
end

open set

theorem supp_eq {α : Type u} (a : P.A) (f : P.B a → α) :
  @supp.{u} P.obj _ α  (⟨a,f⟩ : P.obj α) = f '' univ :=
begin
  ext, simp only [supp, image_univ, mem_range, mem_set_of_eq],
  split; intro h,
  { apply @h (λ x, ∃ (y : P.B a), f y = x),
    rw liftp_iff', intro, refine ⟨_,rfl⟩ },
  { simp only [liftp_iff'], cases h, subst x,
    tauto }
end

end pfunctor


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.geometry.euclidean.basic
import Mathlib.tactic.interval_cases
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Triangles

This file proves basic geometrical results about distances and angles
in (possibly degenerate) triangles in real inner product spaces and
Euclidean affine spaces.  More specialized results, and results
developed for simplices in general rather than just for triangles, are
in separate files.  Definitions and results that make sense in more
general affine spaces rather than just in the Euclidean case go under
`linear_algebra.affine_space`.

## Implementation notes

Results in this file are generally given in a form with only those
non-degeneracy conditions needed for the particular result, rather
than requiring affine independence of the points of a triangle
unnecessarily.

## References

* https://en.wikipedia.org/wiki/Pythagorean_theorem
* https://en.wikipedia.org/wiki/Law_of_cosines
* https://en.wikipedia.org/wiki/Pons_asinorum
* https://en.wikipedia.org/wiki/Sum_of_angles_of_a_triangle

-/

namespace inner_product_geometry

/-!
### Geometrical results on triangles in real inner product spaces

This section develops some results on (possibly degenerate) triangles
in real inner product spaces, where those definitions and results can
most conveniently be developed in terms of vectors and then used to
deduce corresponding results for Euclidean affine spaces.
-/

/-- Pythagorean theorem, if-and-only-if vector angle form. -/
theorem norm_add_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) : norm (x + y) * norm (x + y) = norm x * norm x + norm y * norm y ↔ angle x y = real.pi / bit0 1 := sorry

/-- Pythagorean theorem, vector angle form. -/
theorem norm_add_square_eq_norm_square_add_norm_square' {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) (h : angle x y = real.pi / bit0 1) : norm (x + y) * norm (x + y) = norm x * norm x + norm y * norm y :=
  iff.mpr (norm_add_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two x y) h

/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) : norm (x - y) * norm (x - y) = norm x * norm x + norm y * norm y ↔ angle x y = real.pi / bit0 1 := sorry

/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square' {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) (h : angle x y = real.pi / bit0 1) : norm (x - y) * norm (x - y) = norm x * norm x + norm y * norm y :=
  iff.mpr (norm_sub_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two x y) h

/-- Law of cosines (cosine rule), vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square_sub_two_mul_norm_mul_norm_mul_cos_angle {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) : norm (x - y) * norm (x - y) = norm x * norm x + norm y * norm y - bit0 1 * norm x * norm y * real.cos (angle x y) := sorry

/-- Pons asinorum, vector angle form. -/
theorem angle_sub_eq_angle_sub_rev_of_norm_eq {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (h : norm x = norm y) : angle x (x - y) = angle y (y - x) := sorry

/-- Converse of pons asinorum, vector angle form. -/
theorem norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (h : angle x (x - y) = angle y (y - x)) (hpi : angle x y ≠ real.pi) : norm x = norm y := sorry

/-- The cosine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : real.cos (angle x (x - y) + angle y (y - x)) = -real.cos (angle x y) := sorry

/-- The sine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem sin_angle_sub_add_angle_sub_rev_eq_sin_angle {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : real.sin (angle x (x - y) + angle y (y - x)) = real.sin (angle x y) := sorry

/-- The cosine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem cos_angle_add_angle_sub_add_angle_sub_eq_neg_one {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : real.cos (angle x y + angle x (x - y) + angle y (y - x)) = -1 := sorry

/-- The sine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem sin_angle_add_angle_sub_add_angle_sub_eq_zero {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : real.sin (angle x y + angle x (x - y) + angle y (y - x)) = 0 := sorry

/-- The sum of the angles of a possibly degenerate triangle (where the
two given sides are nonzero), vector angle form. -/
theorem angle_add_angle_sub_add_angle_sub_eq_pi {V : Type u_1} [inner_product_space ℝ V] {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : angle x y + angle x (x - y) + angle y (y - x) = real.pi := sorry

end inner_product_geometry

namespace euclidean_geometry

/-!
### Geometrical results on triangles in Euclidean affine spaces

This section develops some geometrical definitions and results on
(possible degenerate) triangles in Euclidean affine spaces.
-/

/-- Pythagorean theorem, if-and-only-if angle-at-point form. -/
theorem dist_square_eq_dist_square_add_dist_square_iff_angle_eq_pi_div_two {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (p1 : P) (p2 : P) (p3 : P) : dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔ angle p1 p2 p3 = real.pi / bit0 1 := sorry

/-- Law of cosines (cosine rule), angle-at-point form. -/
theorem dist_square_eq_dist_square_add_dist_square_sub_two_mul_dist_mul_dist_mul_cos_angle {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (p1 : P) (p2 : P) (p3 : P) : dist p1 p3 * dist p1 p3 =
  dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 - bit0 1 * dist p1 p2 * dist p3 p2 * real.cos (angle p1 p2 p3) := sorry

/-- Pons asinorum, angle-at-point form. -/
theorem angle_eq_angle_of_dist_eq {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P} (h : dist p1 p2 = dist p1 p3) : angle p1 p2 p3 = angle p1 p3 p2 := sorry

/-- Converse of pons asinorum, angle-at-point form. -/
theorem dist_eq_of_angle_eq_angle_of_angle_ne_pi {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P} (h : angle p1 p2 p3 = angle p1 p3 p2) (hpi : angle p2 p1 p3 ≠ real.pi) : dist p1 p2 = dist p1 p3 := sorry

/-- The sum of the angles of a possibly degenerate triangle (where the
given vertex is distinct from the others), angle-at-point. -/
theorem angle_add_angle_add_angle_eq_pi {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P} (h2 : p2 ≠ p1) (h3 : p3 ≠ p1) : angle p1 p2 p3 + angle p2 p3 p1 + angle p3 p1 p2 = real.pi := sorry


import GMLInit.Data.Nat

structure Pos where
  protected toNat : Nat
  protected ne_zero : toNat ≠ 0

namespace Pos

protected theorem eq : {x y : Pos} → x.toNat = y.toNat → x = y
| ⟨_,_⟩, ⟨_,_⟩, rfl => rfl

protected theorem eta (x : Pos) : x = ⟨x.toNat, x.ne_zero⟩ := Pos.eq rfl

@[match_pattern, inline]
protected def succ (n : Nat) : Pos := ⟨n.succ, Nat.noConfusion⟩

@[simp] theorem sizeOf_succ (n : Nat) : sizeOf (Pos.succ n) = 1 + (n + 1) := rfl

theorem is_pos : (x : Pos) → x.toNat > 0
| .succ n => Nat.zero_lt_succ n

instance (x : Pos) : Nat.IsPos x.toNat := ⟨x.is_pos⟩

protected def ofNat? : Nat → Option Pos
| 0 => none
| n+1 => some (.succ n)

protected def ofNat (n : Nat) [Nat.IsPos n] : Pos := ⟨n, n.is_nonzero⟩

protected abbrev one : Pos := .succ 0
instance : OfNat Pos (nat_lit 1) := ⟨Pos.one⟩

protected abbrev add (x y : Pos) : Pos := ⟨x.toNat + y.toNat, Nat.is_nonzero _⟩
instance : Add Pos := ⟨Pos.add⟩

protected abbrev mul (x y : Pos) : Pos := ⟨x.toNat * y.toNat, Nat.is_nonzero _⟩
instance : Mul Pos := ⟨Pos.mul⟩

protected abbrev pow (x : Pos) (y : Nat) : Pos := ⟨x.toNat ^ y, Nat.is_nonzero _⟩
instance : Pow Pos Nat := ⟨Pos.pow⟩

protected def le (x y : Pos) : Prop := x.toNat ≤ y.toNat
instance : LE Pos := ⟨Pos.le⟩

protected def lt (x y : Pos) : Prop := x.toNat < y.toNat
instance : LT Pos := ⟨Pos.lt⟩

@[clean] theorem one_eq : Pos.one = 1 := rfl

@[clean] theorem add_eq (x y : Pos) : Pos.add x y = x + y := rfl

@[clean] theorem mul_eq (x y : Pos) : Pos.mul x y = x * y := rfl

@[clean] theorem pow_eq (x : Pos) (y : Nat) : Pos.pow x y = x ^ y := rfl

@[clean] theorem le_eq (x y : Pos) : Pos.le x y = (x ≤ y) := rfl

@[clean] theorem lt_eq (x y : Pos) : Pos.lt x y = (x < y) := rfl

instance (n : Nat) : OfNat Pos n.succ := ⟨.succ n⟩

unif_hint (x : Pos) (y : Nat) where
  x =?= OfNat.ofNat y.succ ⊢ x + 1 =?= OfNat.ofNat y.succ.succ

@[eliminator] protected def recAux {motive : Pos → Sort _} (one : motive 1) (succ : (x : Pos) → motive x → motive (x+1)) : (x : Pos) → motive x
| .succ 0 => one
| .succ (n+1) => succ _ (Pos.recAux one succ (.succ n))

protected def recAuxOn {motive : Pos → Sort _} (x : Pos) (one : motive 1) (succ : (x : Pos) → motive x → motive (x+1)) : motive x :=
  Pos.recAux one succ x

protected def casesAuxOn {motive : Pos → Sort _} (x : Pos) (one : motive 1) (succ : (x : Pos) → motive (x+1)) : motive x :=
  Pos.recAux one (fun x _ => succ x) x

protected def recDiagAux.{u} {motive : Pos → Pos → Sort u}
  (left : (x : Pos) → motive x 1)
  (right : (y : Pos) → motive 1 y)
  (diag : (x y : Pos) → motive x y → motive (x + 1) (y + 1)) :
  (x y : Pos) → motive x y :=
  Pos.recAux (motive := fun x => (y : Pos) → motive x y) right succ
where
  succ (x : Pos) (h : (y : Pos) → motive x y) (y : Pos) : motive (x+1) y :=
    Pos.casesAuxOn y (left (x+1)) (fun y => diag x y (h y))

protected def recDiagAuxOn.{u} {motive : Pos → Pos → Sort u} (x y : Pos)
  (left : (x : Pos) → motive x 1)
  (right : (y : Pos) → motive 1 y)
  (diag : (x y : Pos) → motive x y → motive (x + 1) (y + 1)) :
  motive x y := Pos.recDiagAux left right diag x y

protected def casesDiagAuxOn.{u} {motive : Pos → Pos → Sort u} (x y : Pos)
  (left : (x : Pos) → motive x 1)
  (right : (y : Pos) → motive 1 y)
  (diag : (x y : Pos) → motive (x + 1) (y + 1)) :
  motive x y := Pos.recDiagAux left right (fun x y _ => diag x y) x y

@[local eliminator] protected def recDiag.{u} {motive : Pos → Pos → Sort u}
  (one_one : motive 1 1)
  (succ_one : (x : Pos) → motive x 1 → motive (x + 1) 1)
  (one_succ : (y : Pos) → motive 1 y → motive 1 (y + 1))
  (succ_succ : (x y : Pos) → motive x y → motive (x + 1) (y + 1)) :
  (x y : Pos) → motive x y :=
  Pos.recDiagAux left right succ_succ
where
  left (x : Pos) : motive x 1 := Pos.recAuxOn (motive := fun x => motive x 1) x one_one succ_one
  right (y : Pos) : motive 1 y := Pos.recAuxOn y one_one one_succ

protected def recDiagOn.{u} {motive : Pos → Pos → Sort u} (x y : Pos)
  (one_one : motive 1 1)
  (succ_one : (x : Pos) → motive x 1 → motive (x + 1) 1)
  (one_succ : (y : Pos) → motive 1 y → motive 1 (y + 1))
  (succ_succ : (x y : Pos) → motive x y → motive (x + 1) (y + 1)) :
  motive x y := Pos.recDiag one_one succ_one one_succ succ_succ x y

protected def casesDiagOn.{u} {motive : Pos → Pos → Sort u} (x y : Pos)
  (one_one : motive 1 1)
  (succ_one : (x : Pos) → motive (x + 1) 1)
  (one_succ : (y : Pos) → motive 1 (y + 1))
  (succ_succ : (x y : Pos) → motive (x + 1) (y + 1)) :
  motive x y := Pos.recDiag one_one (fun x _ => succ_one x) (fun y _ => one_succ y) (fun x y _ => succ_succ x y) x y

theorem toNat_one : (1:Pos).toNat = 1 := rfl

theorem toNat_add (x y : Pos) : (x + y).toNat = x.toNat + y.toNat := rfl

theorem toNat_mul (x y : Pos) : (x * y).toNat = x.toNat * y.toNat := rfl

theorem toNat_pow (x : Pos) (y : Nat) : (x ^ y).toNat = x.toNat ^ y := rfl

theorem toNat_eq (x y : Pos) : x = y ↔ x.toNat = y.toNat := ⟨congrArg Pos.toNat, Pos.eq⟩

theorem toNat_ne (x y : Pos) : x ≠ y ↔ x.toNat ≠ y.toNat := Iff.mt (toNat_eq x y).symm

theorem toNat_le (x y : Pos) : x ≤ y ↔ x.toNat ≤ y.toNat := Iff.rfl

theorem toNat_ge (x y : Pos) : x ≥ y ↔ x.toNat ≥ y.toNat := Iff.rfl

theorem toNat_lt (x y : Pos) : x < y ↔ x.toNat < y.toNat := Iff.rfl

theorem toNat_gt (x y : Pos) : x > y ↔ x.toNat > y.toNat := Iff.rfl

local macro "by_toNat" : tactic => `(tactic| simp only [toNat_eq, toNat_ge, toNat_gt, toNat_le, toNat_lt, toNat_ne, toNat_one, toNat_add, toNat_mul, toNat_pow])

protected theorem succ_ne_one (x : Pos) : x + 1 ≠ 1 := by
  by_toNat; intro h; absurd (Nat.succ.inj h); exact Nat.is_nonzero _

@[simp] protected theorem one_add_eq_add_one (x : Pos) : 1 + x = x + 1 := by
  by_toNat; exact Nat.one_add _

@[simp] protected theorem add_succ (x y : Pos) : x + (y + 1) = (x + y) + 1 := by
  by_toNat; exact Nat.add_succ ..

@[simp] protected theorem succ_add (x y : Pos) : (x + 1) + y = (x + y) + 1 := by
  by_toNat; exact Nat.succ_add ..

protected theorem add_assoc (x y z : Pos) : (x + y) + z = x + (y + z) := by
  by_toNat; exact Nat.add_assoc ..

protected theorem add_comm (x y : Pos) : x + y = y + x := by
  by_toNat; exact Nat.add_comm ..

protected theorem add_left_comm (x y z : Pos) : x + (y + z) = y + (x + z) := by
  by_toNat; exact Nat.add_left_comm ..

protected theorem add_right_comm (x y z : Pos) : (x + y) + z = (x + z) + y := by
  by_toNat; exact Nat.add_right_comm ..

protected theorem add_left_cancel {x y z : Pos} : x + y = x + z → y = z := by
  by_toNat; exact Nat.add_left_cancel

protected theorem add_right_cancel {x y z : Pos} : x + y = z + y → x = z := by
  by_toNat; exact Nat.add_right_cancel

protected theorem ne_add_self_left (x y : Pos) : x ≠ y + x := by
  induction x with
  | one =>
    symmetry
    exact Pos.succ_ne_one y
  | succ x H =>
    intro h
    rw [Pos.add_succ] at h
    apply H
    exact Pos.add_right_cancel h

protected theorem ne_add_self_right (x y : Pos) : x ≠ x + y := by
  induction x with
  | one =>
    symmetry
    rw [Pos.one_add_eq_add_one]
    exact Pos.succ_ne_one y
  | succ x H =>
    intro h
    rw [Pos.succ_add] at h
    apply H
    exact Pos.add_right_cancel h

@[simp] protected theorem one_mul (x : Pos) : 1 * x = x := by
  by_toNat; exact Nat.one_mul _

@[simp] protected theorem mul_one (x : Pos) : x * 1 = x := by
  by_toNat; exact Nat.mul_one _

protected theorem succ_mul (x y : Pos) : (x + 1) * y = x * y + y := by
  by_toNat; exact Nat.succ_mul ..

protected theorem mul_succ (x y : Pos) : x * (y + 1) = x * y + x := by
  by_toNat; exact Nat.mul_succ ..

protected theorem mul_assoc (x y z : Pos) : (x * y) * z = x * (y * z) := by
  by_toNat; exact Nat.mul_assoc ..

protected theorem mul_comm (x y : Pos) : x * y = y * x := by
  by_toNat; exact Nat.mul_comm ..

protected theorem mul_left_comm (x y z : Pos) : x * (y * z) = y * (x * z) := by
  by_toNat; exact Nat.mul_left_comm ..

protected theorem mul_right_comm (x y z : Pos) : (x * y) * z = (x * z) * y := by
  by_toNat; exact Nat.mul_right_comm ..

protected theorem left_distrib (x y z : Pos) : x * (y + z) = x * y + x * z := by
  by_toNat; exact Nat.left_distrib ..

protected theorem right_distrib (x y z : Pos) : (x + y) * z = x * z + y * z := by
  by_toNat; exact Nat.right_distrib ..

protected theorem mul_left_cancel {x y z : Pos} : x * y = x * z → y = z := by
  intro h
  induction y, z with
  | one_one => rfl
  | one_succ z _ =>
    rw [Pos.mul_one, Pos.mul_succ] at h
    absurd h
    apply Pos.ne_add_self_left
  | succ_one y _ =>
    rw [Pos.mul_one, Pos.mul_succ] at h
    absurd h.symm
    apply Pos.ne_add_self_left
  | succ_succ y z H =>
    rw [Pos.mul_succ, Pos.mul_succ] at h
    rw [H (Pos.add_right_cancel h)]

protected theorem mul_right_cancel {x y z : Pos} : x * y = z * y → x = z := by
  intro h
  induction x, z with
  | one_one => rfl
  | one_succ x _ =>
    rw [Pos.one_mul, Pos.succ_mul] at h
    absurd h
    apply Pos.ne_add_self_left
  | succ_one z _ =>
    rw [Pos.one_mul, Pos.succ_mul] at h
    absurd h.symm
    apply Pos.ne_add_self_left
  | succ_succ x z H =>
    rw [Pos.succ_mul, Pos.succ_mul] at h
    rw [H (Pos.add_right_cancel h)]

protected theorem pow_zero (x : Pos) : x ^ (0:Nat) = 1 := by
  by_toNat; exact Nat.pow_zero _

protected theorem pow_one (x : Pos) : x ^ (1:Nat) = x := by
  by_toNat; exact Nat.pow_one ..

protected theorem one_pow (x : Nat) : (1 : Pos) ^ x = 1 := by
  by_toNat; exact Nat.one_pow ..

protected theorem pow_succ (x : Pos) (y : Nat) : x ^ (y + 1) = x ^ y * x := by
  by_toNat; exact Nat.pow_succ ..

protected theorem pow_add (x : Pos) (y z : Nat) : x ^ (y + z) = x ^ y * x ^ z := by
  by_toNat; exact Nat.pow_add ..

protected theorem mul_pow (x y : Pos) (z : Nat) : (x * y) ^ z = x ^ z * y ^ z := by
  by_toNat; exact Nat.mul_pow ..

protected theorem pow_assoc (x : Pos) (y z : Nat) : (x ^ y) ^ z = x ^ (y * z) := by
  by_toNat; exact Nat.pow_assoc ..

protected theorem le_refl (x : Pos) : x ≤ x := by
  by_toNat; exact Nat.le_refl ..
instance : Relation.Reflexive (α:=Pos) (.≤.) := ⟨Pos.le_refl⟩

protected theorem le_trans {x y z : Pos} : x ≤ y → y ≤ z → x ≤ z := by
  by_toNat; exact Nat.le_trans
instance : Relation.Transitive (α:=Pos) (.≤.) := ⟨Pos.le_trans⟩

protected theorem le_antisymm {x y : Pos} : x ≤ y → y ≤ x → x = y := by
  by_toNat; exact Nat.le_antisymm
instance : Relation.Antisymmetric (α:=Pos) (.≤.) := ⟨Pos.le_antisymm⟩

protected theorem lt_irrefl (x : Pos) : ¬(x < x) := by
  by_toNat; exact Nat.lt_irrefl _
instance : Relation.Irreflexive (α:=Pos) (.<.) := ⟨Pos.lt_irrefl⟩

protected theorem lt_trans {x y z : Pos} : x < y → y < z → x < z := by
  by_toNat; exact Nat.lt_trans
instance : Relation.Transitive (α:=Pos) (.<.) := ⟨Pos.lt_trans⟩

protected theorem lt_of_le_of_lt {x y z : Pos} : x ≤ y → y < z → x < z := by
  by_toNat; exact Nat.lt_of_le_of_lt
instance : Relation.HTransitive (α:=Pos) (β:=Pos) (γ:=Pos) (.≤.) (.<.) (.<.) := ⟨Pos.lt_of_le_of_lt⟩

protected theorem lt_of_lt_of_le {x y z : Pos} : x < y → y ≤ z → x < z := by
  by_toNat; exact Nat.lt_of_lt_of_le
instance : Relation.HTransitive (α:=Pos) (β:=Pos) (γ:=Pos) (.<.) (.≤.) (.<.) := ⟨Pos.lt_of_lt_of_le⟩

protected theorem le_of_eq {x y : Pos} : x = y → x ≤ y := by
  by_toNat; exact Nat.le_of_eq

protected theorem le_of_lt {x y : Pos} : x < y → x ≤ y := by
  by_toNat; exact Nat.le_of_lt

protected theorem ne_of_lt {x y : Pos} : x < y → x ≠ y := by
  by_toNat; exact Nat.ne_of_lt

protected theorem lt_of_le_of_ne {x y : Pos} : x ≤ y → x ≠ y → x < y := by
  by_toNat; exact Nat.lt_of_le_of_ne

protected theorem le_of_not_gt {x y : Pos} : ¬ x > y → x ≤ y := by
  by_toNat; exact Nat.le_of_not_gt

protected theorem lt_of_not_ge {x y : Pos} : ¬ x ≥ y → x < y := by
  by_toNat; exact Nat.gt_of_not_le

protected theorem not_le_of_gt {x y : Pos} : x > y → ¬ x ≤ y := by
  by_toNat; exact Nat.not_le_of_gt

protected theorem not_lt_of_ge {x y : Pos} : x ≥ y → ¬ x < y := by
  by_toNat; exact Nat.not_lt_of_ge

protected theorem not_le_iff_gt (x y : Pos) : ¬ x ≤ y ↔ x > y :=
  Iff.intro Pos.lt_of_not_ge Pos.not_le_of_gt

protected theorem lt_iff_not_ge (x y : Pos) : x < y ↔ ¬ x ≥ y :=
  Iff.intro Pos.not_le_of_gt Pos.lt_of_not_ge

protected theorem not_lt_iff_ge (x y : Pos) : ¬ x < y ↔ x ≥ y :=
  Iff.intro Pos.le_of_not_gt Pos.not_lt_of_ge

protected theorem le_iff_not_gt (x y : Pos) : x ≤ y ↔ ¬ x > y :=
  Iff.intro Pos.not_lt_of_ge Pos.le_of_not_gt

protected theorem eq_or_lt_of_le {x y : Pos} : x ≤ y → x = y ∨ x < y := by
  by_toNat; exact Nat.eq_or_lt_of_le

protected abbrev le_total (x y : Pos) : x ≤ y ∨ x ≥ y := by
  by_toNat; exact Nat.le_total ..

protected theorem lt_or_ge (x y : Pos) : x < y ∨ x ≥ y := by
  by_toNat; exact Nat.lt_or_ge ..

protected theorem one_le (x : Pos) : 1 ≤ x := by
  by_toNat; apply Nat.succ_le_of_lt; exact Nat.is_pos _

protected theorem not_lt_one (x : Pos) : ¬(x < 1) := by
  by_toNat; intro h; absurd h; apply Nat.not_lt_of_ge; apply Nat.succ_le_of_lt; exact Nat.is_pos _

protected theorem one_lt_succ (x : Pos) : 1 < x + 1 := by
  by_toNat; apply Nat.succ_lt_succ; exact Nat.is_pos _

protected theorem not_succ_le_one (x : Pos) : ¬(x + 1 ≤ 1) := by
  by_toNat; intro h; absurd h; apply Nat.not_le_of_gt; apply Nat.succ_lt_succ; exact Nat.is_pos _

protected abbrev eq_one_of_le_one {x : Pos} : x ≤ 1 → x = 1 := by
  by_toNat; intro h; antisymmetry using LE.le; exact h; apply Nat.succ_le_of_lt; exact Nat.is_pos _

protected theorem le_succ_self (x : Pos) : x ≤ x + 1 := by
  by_toNat; exact Nat.le_add_right ..

protected theorem lt_succ_self (x : Pos) : x < x + 1 := by
  by_toNat; exact Nat.lt_succ_self ..

protected theorem not_succ_le_self (x : Pos) : ¬(x + 1 ≤ x) := by
  by_toNat; exact Nat.not_succ_le_self _

protected theorem not_succ_lt_self (x : Pos) : ¬(x + 1 < x) := by
  by_toNat; apply Nat.not_lt_of_ge; exact Nat.le_add_right ..

protected theorem le_of_lt_succ {x y : Pos} : x < y + 1 → x ≤ y := by
  by_toNat; exact Nat.le_of_lt_succ

protected theorem lt_succ_of_le {x y : Pos} : x ≤ y → x < y + 1 := by
  by_toNat; exact Nat.lt_succ_of_le

protected theorem lt_of_succ_le {x y : Pos} : x + 1 ≤ y → x < y := by
  by_toNat; exact Nat.lt_of_succ_le

protected theorem succ_le_of_lt {x y : Pos} : x < y → x + 1 ≤ y := by
  by_toNat; exact Nat.succ_le_of_lt

protected theorem le_succ_of_le {x y : Pos} : x ≤ y → x ≤ y + 1 := by
  by_toNat; exact Nat.le_succ_of_le

protected theorem le_of_succ_le {x y : Pos} : x + 1 ≤ y → x ≤ y := by
  by_toNat; exact Nat.le_of_succ_le

protected theorem succ_le_succ {x y : Pos} : x ≤ y → x + 1 ≤ y + 1 := by
  by_toNat; exact Nat.succ_le_succ

protected theorem le_of_succ_le_succ {x y : Pos} : x + 1 ≤ y + 1 → x ≤ y := by
  by_toNat; exact Nat.le_of_succ_le_succ

protected theorem succ_lt_succ {x y : Pos} : x < y → x + 1 < y + 1 := by
  by_toNat; exact Nat.succ_lt_succ

protected theorem lt_of_succ_lt_succ {x y : Pos} : x + 1 < y + 1 → x < y := by
  by_toNat; exact Nat.lt_of_succ_lt_succ

protected theorem lt_add_right (x y : Pos) : x < x + y := by
  induction y with
  | one => exact Pos.lt_succ_self x
  | succ y H => apply Pos.lt_trans H; rw [Pos.add_succ]; exact Pos.lt_succ_self (x + y)

protected theorem lt_add_left (x y : Pos) : x < y + x := by
  induction y with
  | one => rw [Pos.one_add_eq_add_one]; exact Pos.lt_succ_self x
  | succ y H => apply Pos.lt_trans H; rw [Pos.succ_add]; exact Pos.lt_succ_self (y + x)

protected theorem add_le_add_left {x y : Pos} : x ≤ y → ∀ z, z + x ≤ z + y := by
  by_toNat; intro h z; apply Nat.add_le_add_left h

protected theorem add_le_add_right {x y : Pos} : x ≤ y → ∀ z, x + z ≤ y + z := by
  by_toNat; intro h z; apply Nat.add_le_add_right h

protected theorem le_of_add_le_add_left {x y z : Pos} : z + x ≤ z + y → x ≤ y := by
  by_toNat; exact Nat.le_of_add_le_add_left

protected theorem le_of_add_le_add_right {x y z : Pos} : x + z ≤ y + z → x ≤ y := by
  by_toNat; exact Nat.le_of_add_le_add_right

protected theorem add_le_add {x₁ y₁ x₂ y₂ : Pos} : x₁ ≤ y₁ → x₂ ≤ y₂ → x₁ + x₂ ≤ y₁ + y₂ := by
  by_toNat; exact Nat.add_le_add

protected theorem add_lt_add_left {x y : Pos} : x < y → ∀ z, z + x < z + y := by
  by_toNat; intro h z; apply Nat.add_lt_add_left h

protected theorem add_lt_add_right {x y : Pos} : x < y → ∀ z, x + z < y + z := by
  by_toNat; intro h z; apply Nat.add_lt_add_right h

protected theorem lt_of_add_lt_add_left {x y z : Pos} : z + x < z + y → x < y := by
  by_toNat; exact Nat.lt_of_add_lt_add_left

protected theorem lt_of_add_lt_add_right {x y z : Pos} : x + z < y + z → x < y := by
  by_toNat; exact Nat.lt_of_add_lt_add_right

protected theorem add_lt_add {x₁ y₁ x₂ y₂ : Pos} : x₁ < y₁ → x₂ < y₂ → x₁ + x₂ < y₁ + y₂ := by
  by_toNat; exact Nat.add_lt_add

protected theorem mul_le_mul_left {x y : Pos} : x ≤ y → ∀ z, z * x ≤ z * y := by
  by_toNat; intro h z; apply Nat.mul_le_mul_left _ h

protected theorem mul_le_mul_right {x y : Pos} : x ≤ y → ∀ z, x * z ≤ y * z := by
  by_toNat; intro h z; apply Nat.mul_le_mul_right _ h

protected theorem le_of_mul_le_mul_left {x y z : Pos} : z * x ≤ z * y → x ≤ y := by
  by_toNat; intro h; exact Nat.le_of_mul_le_mul_of_pos_left (Nat.is_pos _) h

protected theorem le_of_mul_le_mul_right {x y z : Pos} : x * z ≤ y * z → x ≤ y := by
  by_toNat; intro h; exact Nat.le_of_mul_le_mul_of_pos_right (Nat.is_pos _) h

protected theorem mul_le_mul {x₁ y₁ x₂ y₂ : Pos} : x₁ ≤ y₁ → x₂ ≤ y₂ → x₁ * x₂ ≤ y₁ * y₂ := by
  by_toNat; exact Nat.mul_le_mul

protected theorem mul_lt_mul_left {x y : Pos} : x < y → ∀ z, z * x < z * y := by
  by_toNat; intro h z; apply Nat.mul_lt_mul_of_pos_left h; exact Nat.is_pos _

protected theorem mul_lt_mul_right {x y : Pos} : x < y → ∀ z, x * z < y * z := by
  by_toNat; intro h z; apply Nat.mul_lt_mul_of_pos_right h; exact Nat.is_pos _

protected theorem lt_of_mul_lt_mul_left {x y z : Pos} : z * x < z * y → x < y := by
  by_toNat; exact Nat.lt_of_mul_lt_mul_left _

protected theorem lt_of_mul_lt_mul_right {x y z : Pos} : x * z < y * z → x < y := by
  by_toNat; exact Nat.lt_of_mul_lt_mul_right _

protected theorem mul_lt_mul_of_lt_of_lt {x₁ y₁ x₂ y₂ : Pos} : x₁ < y₁ → x₂ < y₂ → x₁ * x₂ < y₁ * y₂ := by
  by_toNat; exact Nat.mul_lt_mul_of_lt_of_lt

protected theorem pow_le_pow_left {x y : Nat} : x ≤ y → (z : Pos) → z ^ x ≤ z ^ y := by
  by_toNat; intro h z; exact Nat.pow_le_pow_of_pos_left h (Nat.is_pos z.toNat)

protected theorem pow_le_pow_right {x y : Pos} : x ≤ y → (z : Nat) → x ^ z ≤ y ^ z := by
  by_toNat; exact Nat.pow_le_pow_left

protected theorem pow_lt_pow_of_pos_left {x y : Pos} : x < y → {z : Nat} → z > 0 → x ^ z < y ^ z := by
  by_toNat; exact Nat.pow_lt_pow_of_pos_right

protected theorem lt.dest {x y : Pos} : x < y → ∃ z, x + z = y := by
  intro h
  induction x, y with
  | one_one =>
    absurd h
    exact Pos.not_lt_one 1
  | one_succ y =>
    exists y
    exact Pos.one_add_eq_add_one y
  | succ_one x =>
    absurd h
    exact Pos.not_lt_one (x+1)
  | succ_succ x y H =>
    match H (Pos.lt_of_succ_lt_succ h) with
    | ⟨z, hz⟩ =>
      exists z
      rw [Pos.succ_add, hz]

protected theorem lt.intro {x y z : Pos} : x + z = y → x < y := by
  intro h; rw [←h]; exact Pos.lt_add_right x z

protected inductive asInd
| one : Pos.asInd
| succ : Pos.asInd → Pos.asInd
deriving Repr

protected def toInd : Pos → Pos.asInd
| .succ 0 => .one
| .succ (n+1) => .succ (Pos.toInd (.succ n))

theorem toInd_one : (1 : Pos).toInd = asInd.one := rfl
theorem toInd_succ (n : Pos) : (n + 1).toInd = n.toInd.succ := by
  match n with
  | .succ n => simp only [Pos.one, Pos.succ, HAdd.hAdd, Add.add, Pos.add, OfNat.ofNat, Nat.succ_eq, Nat.add_eq, Pos.toInd]

protected def asInd.toNat : Pos.asInd → Nat
| .one => 1
| .succ n => asInd.toNat n + 1

theorem asInd.toNat_one : asInd.one.toNat = 1 := rfl
theorem asInd.toNat_succ (n : Pos.asInd) : n.succ.toNat = n.toNat + 1 := rfl

protected def ofInd (n : Pos.asInd) : Pos where
  toNat := n.toNat
  ne_zero :=
    match n with
    | .one => Nat.noConfusion
    | .succ n => Nat.succ_ne_zero n.toNat

theorem ofInd_one : Pos.ofInd asInd.one = 1 := rfl
theorem ofInd_succ (n : Pos.asInd) : Pos.ofInd n.succ = Pos.ofInd n + 1 := rfl

theorem toInd_ofInd (n : Pos.asInd) : Pos.toInd (Pos.ofInd n) = n := by
  induction n with
  | one => rfl
  | succ n ih =>
    rw [ofInd_succ]
    rw [toInd_succ]
    rw [ih]

theorem ofInd_toInd (n : Pos) : Pos.ofInd n.toInd = n := by
  induction n with
  | one => rfl
  | succ n ih =>
    rw [toInd_succ]
    rw [ofInd_succ]
    rw [ih]

theorem asIndEquiv : Equiv Pos Pos.asInd where
  fwd := Pos.toInd
  rev := Pos.ofInd
  spec := by
    intros
    constr
    · intro | rfl => exact ofInd_toInd ..
    · intro | rfl => exact toInd_ofInd ..

protected inductive asBin
| one : Pos.asBin
| bit0 : Pos.asBin → Pos.asBin
| bit1 : Pos.asBin → Pos.asBin
deriving Repr

protected def asBin.toNat : Pos.asBin → Nat
| one => 1
| bit0 n => 2 * asBin.toNat n
| bit1 n => 2 * asBin.toNat n + 1

theorem asBin.toNat_one : asBin.one.toNat = 1 := rfl
theorem asBin.toNat_bit0 (n : Pos.asBin) : n.bit0.toNat = 2 * n.toNat := rfl
theorem asBin.toNat_bit1 (n : Pos.asBin) : n.bit1.toNat = 2 * n.toNat + 1 := rfl

theorem asBin.toNat_ne_zero (n : Pos.asBin) : n.toNat ≠ 0 := by
  induction n with
  | one => exact Nat.one_ne_zero
  | bit0 n ih =>
    rw [←Nat.mul_zero 2, asBin.toNat_bit0]
    intro h
    absurd ih
    exact Nat.eq_of_mul_eq_mul_left (Nat.is_pos 2) h
  | bit1 n _ => exact Nat.succ_ne_zero (2 * n.toNat)

def ofBin (n : Pos.asBin) : Pos := ⟨n.toNat, n.toNat_ne_zero⟩

def div2 : Nat → Nat × Fin 2
| 0 => (0,0)
| 1 => (0,1)
| n+2 => match div2 n with | (q,r) => (q+1,r)

theorem div2_eq : (n : Nat) → 2 * (div2 n).fst + (div2 n).snd.val = n
| 0 => rfl
| 1 => rfl
| n+2 => by
  simp only [div2]
  rw [Nat.mul_succ]
  rw [Nat.add_right_comm]
  congr
  exact div2_eq n

def toBin (n : Pos) : Pos.asBin :=
  match h : div2 n.toNat with
  | (0,0) => absurd n.is_pos $ by
      rw [←div2_eq n.toNat, h]
      intro; contradiction
  | (0,1) => .one
  | (q+1,0) =>
    have : q + 1 < n.toNat := by
      rw [←div2_eq n.toNat, h]
      rw [Nat.mul_succ, Nat.two_mul]
      apply Nat.add_lt_add_right
      apply Nat.lt_succ_of_le
      apply Nat.le_add_right
    .bit0 (toBin (Pos.succ q))
  | (q+1,1) =>
    have : q + 1 < n.toNat := by
      rw [←div2_eq n.toNat, h]
      rw [Nat.mul_succ, Nat.two_mul]
      apply Nat.add_lt_add_right
      apply Nat.lt_succ_of_le
      rw [Nat.add_eq, Nat.add_assoc]
      apply Nat.le_add_right
    .bit1 (toBin (Pos.succ q))
termination_by _ => n.toNat

end Pos