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

Finite types.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.wlog
import Mathlib.data.finset.powerset
import Mathlib.data.finset.lattice
import Mathlib.data.finset.pi
import Mathlib.data.array.lemmas
import Mathlib.order.well_founded
import Mathlib.group_theory.perm.basic
import Mathlib.PostPort

universes u_4 l u_1 u_2 u v

namespace Mathlib

/-- `fintype α` means that `α` is finite, i.e. there are only
  finitely many distinct elements of type `α`. The evidence of this
  is a finset `elems` (a list up to permutation without duplicates),
  together with a proof that everything of type `α` is in the list. -/
class fintype (α : Type u_4)
where
  elems : finset α
  complete : ∀ (x : α), x ∈ elems

namespace finset

/-- `univ` is the universal finite set of type `finset α` implied from
  the assumption `fintype α`. -/
def univ {α : Type u_1} [fintype α] : finset α :=
  fintype.elems α

@[simp] theorem mem_univ {α : Type u_1} [fintype α] (x : α) : x ∈ univ :=
  fintype.complete x

@[simp] theorem mem_univ_val {α : Type u_1} [fintype α] (x : α) : x ∈ val univ :=
  mem_univ

@[simp] theorem coe_univ {α : Type u_1} [fintype α] : ↑univ = set.univ := sorry

theorem univ_nonempty_iff {α : Type u_1} [fintype α] : finset.nonempty univ ↔ Nonempty α := sorry

theorem univ_nonempty {α : Type u_1} [fintype α] [Nonempty α] : finset.nonempty univ :=
  iff.mpr univ_nonempty_iff _inst_2

theorem univ_eq_empty {α : Type u_1} [fintype α] : univ = ∅ ↔ ¬Nonempty α := sorry

theorem subset_univ {α : Type u_1} [fintype α] (s : finset α) : s ⊆ univ :=
  fun (a : α) (_x : a ∈ s) => mem_univ a

protected instance order_top {α : Type u_1} [fintype α] : order_top (finset α) :=
  order_top.mk univ partial_order.le partial_order.lt sorry sorry sorry subset_univ

protected instance boolean_algebra {α : Type u_1} [fintype α] [DecidableEq α] : boolean_algebra (finset α) :=
  boolean_algebra.mk distrib_lattice.sup distrib_lattice.le distrib_lattice.lt sorry sorry sorry sorry sorry sorry
    distrib_lattice.inf sorry sorry sorry sorry order_top.top sorry semilattice_inf_bot.bot sorry
    (fun (s : finset α) => univ \ s) has_sdiff.sdiff sorry sorry sorry

theorem compl_eq_univ_sdiff {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : sᶜ = univ \ s :=
  rfl

@[simp] theorem mem_compl {α : Type u_1} [fintype α] [DecidableEq α] {s : finset α} {x : α} : x ∈ (sᶜ) ↔ ¬x ∈ s := sorry

@[simp] theorem coe_compl {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : ↑(sᶜ) = (↑sᶜ) :=
  set.ext fun (x : α) => mem_compl

theorem eq_univ_iff_forall {α : Type u_1} [fintype α] {s : finset α} : s = univ ↔ ∀ (x : α), x ∈ s := sorry

theorem compl_ne_univ_iff_nonempty {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : sᶜ ≠ univ ↔ finset.nonempty s := sorry

@[simp] theorem univ_inter {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : univ ∩ s = s := sorry

@[simp] theorem inter_univ {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : s ∩ univ = s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (s ∩ univ = s)) (inter_comm s univ)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (univ ∩ s = s)) (univ_inter s))) (Eq.refl s))

@[simp] theorem piecewise_univ {α : Type u_1} [fintype α] [(i : α) → Decidable (i ∈ univ)] {δ : α → Sort u_2} (f : (i : α) → δ i) (g : (i : α) → δ i) : piecewise univ f g = f := sorry

theorem piecewise_compl {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) [(i : α) → Decidable (i ∈ s)] [(i : α) → Decidable (i ∈ (sᶜ))] {δ : α → Sort u_2} (f : (i : α) → δ i) (g : (i : α) → δ i) : piecewise (sᶜ) f g = piecewise s g f := sorry

theorem univ_map_equiv_to_embedding {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (e : α ≃ β) : map (equiv.to_embedding e) univ = univ := sorry

@[simp] theorem univ_filter_exists {α : Type u_1} {β : Type u_2} [fintype α] (f : α → β) [fintype β] [decidable_pred fun (y : β) => ∃ (x : α), f x = y] [DecidableEq β] : filter (fun (y : β) => ∃ (x : α), f x = y) univ = image f univ := sorry

/-- Note this is a special case of `(finset.image_preimage f univ _).symm`. -/
theorem univ_filter_mem_range {α : Type u_1} {β : Type u_2} [fintype α] (f : α → β) [fintype β] [decidable_pred fun (y : β) => y ∈ set.range f] [DecidableEq β] : filter (fun (y : β) => y ∈ set.range f) univ = image f univ :=
  univ_filter_exists f

end finset

namespace fintype

protected instance decidable_pi_fintype {α : Type u_1} {β : α → Type u_2} [(a : α) → DecidableEq (β a)] [fintype α] : DecidableEq ((a : α) → β a) :=
  fun (f g : (a : α) → β a) => decidable_of_iff (∀ (a : α), a ∈ elems α → f a = g a) sorry

protected instance decidable_forall_fintype {α : Type u_1} {p : α → Prop} [decidable_pred p] [fintype α] : Decidable (∀ (a : α), p a) :=
  decidable_of_iff (∀ (a : α), a ∈ finset.univ → p a) sorry

protected instance decidable_exists_fintype {α : Type u_1} {p : α → Prop} [decidable_pred p] [fintype α] : Decidable (∃ (a : α), p a) :=
  decidable_of_iff (∃ (a : α), ∃ (H : a ∈ finset.univ), p a) sorry

protected instance decidable_eq_equiv_fintype {α : Type u_1} {β : Type u_2} [DecidableEq β] [fintype α] : DecidableEq (α ≃ β) :=
  fun (a b : α ≃ β) => decidable_of_iff (equiv.to_fun a = equiv.to_fun b) sorry

protected instance decidable_injective_fintype {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] [fintype α] : decidable_pred function.injective :=
  fun (x : α → β) => eq.mpr sorry fintype.decidable_forall_fintype

protected instance decidable_surjective_fintype {α : Type u_1} {β : Type u_2} [DecidableEq β] [fintype α] [fintype β] : decidable_pred function.surjective :=
  fun (x : α → β) => eq.mpr sorry fintype.decidable_forall_fintype

protected instance decidable_bijective_fintype {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] [fintype α] [fintype β] : decidable_pred function.bijective :=
  fun (x : α → β) => eq.mpr sorry and.decidable

protected instance decidable_left_inverse_fintype {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α] (f : α → β) (g : β → α) : Decidable (function.right_inverse f g) :=
  (fun (this : Decidable (∀ (x : α), g (f x) = x)) => this) fintype.decidable_forall_fintype

protected instance decidable_right_inverse_fintype {α : Type u_1} {β : Type u_2} [DecidableEq β] [fintype β] (f : α → β) (g : β → α) : Decidable (function.left_inverse f g) :=
  (fun (this : Decidable (∀ (x : β), f (g x) = x)) => this) fintype.decidable_forall_fintype

/-- Construct a proof of `fintype α` from a universal multiset -/
def of_multiset {α : Type u_1} [DecidableEq α] (s : multiset α) (H : ∀ (x : α), x ∈ s) : fintype α :=
  mk (multiset.to_finset s) sorry

/-- Construct a proof of `fintype α` from a universal list -/
def of_list {α : Type u_1} [DecidableEq α] (l : List α) (H : ∀ (x : α), x ∈ l) : fintype α :=
  mk (list.to_finset l) sorry

theorem exists_univ_list (α : Type u_1) [fintype α] : ∃ (l : List α), list.nodup l ∧ ∀ (x : α), x ∈ l := sorry

/-- `card α` is the number of elements in `α`, defined when `α` is a fintype. -/
def card (α : Type u_1) [fintype α] : ℕ :=
  finset.card finset.univ

/-- If `l` lists all the elements of `α` without duplicates, then `α ≃ fin (l.length)`. -/
def equiv_fin_of_forall_mem_list {α : Type u_1} [DecidableEq α] {l : List α} (h : ∀ (x : α), x ∈ l) (nd : list.nodup l) : α ≃ fin (list.length l) :=
  equiv.mk (fun (a : α) => { val := list.index_of a l, property := sorry })
    (fun (i : fin (list.length l)) => list.nth_le l (subtype.val i) sorry) sorry sorry

/-- There is (computably) a bijection between `α` and `fin n` where
  `n = card α`. Since it is not unique, and depends on which permutation
  of the universe list is used, the bijection is wrapped in `trunc` to
  preserve computability.  -/
def equiv_fin (α : Type u_1) [DecidableEq α] [fintype α] : trunc (α ≃ fin (card α)) :=
  eq.mpr sorry
    (quot.rec_on_subsingleton (finset.val finset.univ)
      (fun (l : List α) (h : ∀ (x : α), x ∈ l) (nd : list.nodup l) => trunc.mk (equiv_fin_of_forall_mem_list h nd))
      finset.mem_univ_val sorry)

theorem exists_equiv_fin (α : Type u_1) [fintype α] : ∃ (n : ℕ), Nonempty (α ≃ fin n) :=
  Exists.intro (card α) (nonempty_of_trunc (equiv_fin α))

protected instance subsingleton (α : Type u_1) : subsingleton (fintype α) :=
  subsingleton.intro fun (_x : fintype α) => sorry

/-- Given a predicate that can be represented by a finset, the subtype
associated to the predicate is a fintype. -/
protected def subtype {α : Type u_1} {p : α → Prop} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ p x) : fintype (Subtype fun (x : α) => p x) :=
  mk (finset.mk (multiset.pmap Subtype.mk (finset.val s) sorry) sorry) sorry

theorem subtype_card {α : Type u_1} {p : α → Prop} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ p x) : card (Subtype fun (x : α) => p x) = finset.card s :=
  multiset.card_pmap Subtype.mk (finset.val s) (subtype._proof_1 s H)

theorem card_of_subtype {α : Type u_1} {p : α → Prop} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ p x) [fintype (Subtype fun (x : α) => p x)] : card (Subtype fun (x : α) => p x) = finset.card s := sorry

/-- Construct a fintype from a finset with the same elements. -/
def of_finset {α : Type u_1} {p : set α} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ x ∈ p) : fintype ↥p :=
  fintype.subtype s H

@[simp] theorem card_of_finset {α : Type u_1} {p : set α} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ x ∈ p) : card ↥p = finset.card s :=
  subtype_card s H

theorem card_of_finset' {α : Type u_1} {p : set α} (s : finset α) (H : ∀ (x : α), x ∈ s ↔ x ∈ p) [fintype ↥p] : card ↥p = finset.card s := sorry

/-- If `f : α → β` is a bijection and `α` is a fintype, then `β` is also a fintype. -/
def of_bijective {α : Type u_1} {β : Type u_2} [fintype α] (f : α → β) (H : function.bijective f) : fintype β :=
  mk (finset.map (function.embedding.mk f sorry) finset.univ) sorry

/-- If `f : α → β` is a surjection and `α` is a fintype, then `β` is also a fintype. -/
def of_surjective {α : Type u_1} {β : Type u_2} [DecidableEq β] [fintype α] (f : α → β) (H : function.surjective f) : fintype β :=
  mk (finset.image f finset.univ) sorry

/-- Given an injective function to a fintype, the domain is also a
fintype. This is noncomputable because injectivity alone cannot be
used to construct preimages. -/
def of_injective {α : Type u_1} {β : Type u_2} [fintype β] (f : α → β) (H : function.injective f) : fintype α :=
  let _inst : (p : Prop) → Decidable p := classical.dec;
  dite (Nonempty α) (fun (hα : Nonempty α) => of_surjective (function.inv_fun f) (function.inv_fun_surjective H))
    fun (hα : ¬Nonempty α) => mk ∅ sorry

/-- If `f : α ≃ β` and `α` is a fintype, then `β` is also a fintype. -/
def of_equiv {β : Type u_2} (α : Type u_1) [fintype α] (f : α ≃ β) : fintype β :=
  of_bijective (⇑f) (equiv.bijective f)

theorem of_equiv_card {α : Type u_1} {β : Type u_2} [fintype α] (f : α ≃ β) : card β = card α :=
  multiset.card_map (⇑(function.embedding.mk (⇑f) (of_bijective._proof_1 (⇑f) (equiv.bijective f))))
    (finset.val finset.univ)

theorem card_congr {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α ≃ β) : card α = card β := sorry

theorem card_eq {α : Type u_1} {β : Type u_2} [F : fintype α] [G : fintype β] : card α = card β ↔ Nonempty (α ≃ β) := sorry

/-- Subsingleton types are fintypes (with zero or one terms). -/
def of_subsingleton {α : Type u_1} (a : α) [subsingleton α] : fintype α :=
  mk (singleton a) sorry

@[simp] theorem univ_of_subsingleton {α : Type u_1} (a : α) [subsingleton α] : finset.univ = singleton a :=
  rfl

@[simp] theorem card_of_subsingleton {α : Type u_1} (a : α) [subsingleton α] : card α = 1 :=
  rfl

end fintype

namespace set

/-- Construct a finset enumerating a set `s`, given a `fintype` instance.  -/
def to_finset {α : Type u_1} (s : set α) [fintype ↥s] : finset α :=
  finset.mk (multiset.map subtype.val (finset.val finset.univ)) sorry

@[simp] theorem mem_to_finset {α : Type u_1} {s : set α} [fintype ↥s] {a : α} : a ∈ to_finset s ↔ a ∈ s := sorry

@[simp] theorem mem_to_finset_val {α : Type u_1} {s : set α} [fintype ↥s] {a : α} : a ∈ finset.val (to_finset s) ↔ a ∈ s :=
  mem_to_finset

-- We use an arbitrary `[fintype s]` instance here,

-- not necessarily coming from a `[fintype α]`.

@[simp] theorem to_finset_card {α : Type u_1} (s : set α) [fintype ↥s] : finset.card (to_finset s) = fintype.card ↥s :=
  multiset.card_map subtype.val (finset.val finset.univ)

@[simp] theorem coe_to_finset {α : Type u_1} (s : set α) [fintype ↥s] : ↑(to_finset s) = s :=
  ext fun (_x : α) => mem_to_finset

@[simp] theorem to_finset_inj {α : Type u_1} {s : set α} {t : set α} [fintype ↥s] [fintype ↥t] : to_finset s = to_finset t ↔ s = t := sorry

end set

theorem finset.card_univ {α : Type u_1} [fintype α] : finset.card finset.univ = fintype.card α :=
  rfl

theorem finset.eq_univ_of_card {α : Type u_1} [fintype α] (s : finset α) (hs : finset.card s = fintype.card α) : s = finset.univ := sorry

theorem finset.card_eq_iff_eq_univ {α : Type u_1} [fintype α] (s : finset α) : finset.card s = fintype.card α ↔ s = finset.univ :=
  { mp := finset.eq_univ_of_card s, mpr := fun (ᾰ : s = finset.univ) => Eq._oldrec finset.card_univ (Eq.symm ᾰ) }

theorem finset.card_le_univ {α : Type u_1} [fintype α] (s : finset α) : finset.card s ≤ fintype.card α :=
  finset.card_le_of_subset (finset.subset_univ s)

theorem finset.card_lt_iff_ne_univ {α : Type u_1} [fintype α] (s : finset α) : finset.card s < fintype.card α ↔ s ≠ finset.univ :=
  iff.trans (has_le.le.lt_iff_ne (finset.card_le_univ s)) (not_iff_not_of_iff (finset.card_eq_iff_eq_univ s))

theorem finset.card_compl_lt_iff_nonempty {α : Type u_1} [fintype α] [DecidableEq α] (s : finset α) : finset.card (sᶜ) < fintype.card α ↔ finset.nonempty s :=
  iff.trans (finset.card_lt_iff_ne_univ (sᶜ)) (finset.compl_ne_univ_iff_nonempty s)

theorem finset.card_univ_diff {α : Type u_1} [DecidableEq α] [fintype α] (s : finset α) : finset.card (finset.univ \ s) = fintype.card α - finset.card s :=
  finset.card_sdiff (finset.subset_univ s)

theorem finset.card_compl {α : Type u_1} [DecidableEq α] [fintype α] (s : finset α) : finset.card (sᶜ) = fintype.card α - finset.card s :=
  finset.card_univ_diff s

protected instance fin.fintype (n : ℕ) : fintype (fin n) :=
  fintype.mk (finset.fin_range n) finset.mem_fin_range

theorem fin.univ_def (n : ℕ) : finset.univ = finset.fin_range n :=
  rfl

@[simp] theorem fintype.card_fin (n : ℕ) : fintype.card (fin n) = n :=
  list.length_fin_range n

@[simp] theorem finset.card_fin (n : ℕ) : finset.card finset.univ = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finset.card finset.univ = n)) finset.card_univ))
    (eq.mpr (id (Eq._oldrec (Eq.refl (fintype.card (fin n) = n)) (fintype.card_fin n))) (Eq.refl n))

theorem fin.equiv_iff_eq {m : ℕ} {n : ℕ} : Nonempty (fin m ≃ fin n) ↔ m = n := sorry

/-- Embed `fin n` into `fin (n + 1)` by prepending zero to the `univ` -/
theorem fin.univ_succ (n : ℕ) : finset.univ = insert 0 (finset.image fin.succ finset.univ) := sorry

/-- Embed `fin n` into `fin (n + 1)` by appending a new `fin.last n` to the `univ` -/
theorem fin.univ_cast_succ (n : ℕ) : finset.univ = insert (fin.last n) (finset.image (⇑fin.cast_succ) finset.univ) := sorry

/-- Embed `fin n` into `fin (n + 1)` by inserting
around a specified pivot `p : fin (n + 1)` into the `univ` -/
theorem fin.univ_succ_above (n : ℕ) (p : fin (n + 1)) : finset.univ = insert p (finset.image (⇑(fin.succ_above p)) finset.univ) := sorry

instance unique.fintype {α : Type u_1} [unique α] : fintype α :=
  fintype.of_subsingleton Inhabited.default

@[simp] theorem univ_unique {α : Type u_1} [unique α] [f : fintype α] : finset.univ = singleton Inhabited.default :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finset.univ = singleton Inhabited.default)) (subsingleton.elim f unique.fintype)))
    (Eq.refl finset.univ)

protected instance empty.fintype : fintype empty :=
  fintype.mk ∅ sorry

@[simp] theorem fintype.univ_empty : finset.univ = ∅ :=
  rfl

@[simp] theorem fintype.card_empty : fintype.card empty = 0 :=
  rfl

protected instance pempty.fintype : fintype pempty :=
  fintype.mk ∅ sorry

@[simp] theorem fintype.univ_pempty : finset.univ = ∅ :=
  rfl

@[simp] theorem fintype.card_pempty : fintype.card pempty = 0 :=
  rfl

protected instance unit.fintype : fintype Unit :=
  fintype.of_subsingleton Unit.unit

theorem fintype.univ_unit : finset.univ = singleton Unit.unit :=
  rfl

theorem fintype.card_unit : fintype.card Unit = 1 :=
  rfl

protected instance punit.fintype : fintype PUnit :=
  fintype.of_subsingleton PUnit.unit

@[simp] theorem fintype.univ_punit : finset.univ = singleton PUnit.unit :=
  rfl

@[simp] theorem fintype.card_punit : fintype.card PUnit = 1 :=
  rfl

protected instance bool.fintype : fintype Bool :=
  fintype.mk (finset.mk (tt ::ₘ false ::ₘ 0) sorry) sorry

@[simp] theorem fintype.univ_bool : finset.univ = insert tt (singleton false) :=
  rfl

protected instance units_int.fintype : fintype (units ℤ) :=
  fintype.mk (insert 1 (singleton (-1))) sorry

protected instance additive.fintype {α : Type u_1} [fintype α] : fintype (additive α) :=
  id

protected instance multiplicative.fintype {α : Type u_1} [fintype α] : fintype (multiplicative α) :=
  id

@[simp] theorem fintype.card_units_int : fintype.card (units ℤ) = bit0 1 :=
  rfl

protected instance units.fintype {α : Type u_1} [monoid α] [fintype α] : fintype (units α) :=
  fintype.of_injective units.val units.ext

@[simp] theorem fintype.card_bool : fintype.card Bool = bit0 1 :=
  rfl

/-- Given a finset on `α`, lift it to being a finset on `option α`
using `option.some` and then insert `option.none`. -/
def finset.insert_none {α : Type u_1} (s : finset α) : finset (Option α) :=
  finset.mk (none ::ₘ multiset.map some (finset.val s)) sorry

@[simp] theorem finset.mem_insert_none {α : Type u_1} {s : finset α} {o : Option α} : o ∈ finset.insert_none s ↔ ∀ (a : α), a ∈ o → a ∈ s := sorry

theorem finset.some_mem_insert_none {α : Type u_1} {s : finset α} {a : α} : some a ∈ finset.insert_none s ↔ a ∈ s := sorry

protected instance option.fintype {α : Type u_1} [fintype α] : fintype (Option α) :=
  fintype.mk (finset.insert_none finset.univ) sorry

@[simp] theorem fintype.card_option {α : Type u_1} [fintype α] : fintype.card (Option α) = fintype.card α + 1 := sorry

protected instance sigma.fintype {α : Type u_1} (β : α → Type u_2) [fintype α] [(a : α) → fintype (β a)] : fintype (sigma β) :=
  fintype.mk (finset.sigma finset.univ fun (_x : α) => finset.univ) sorry

@[simp] theorem finset.univ_sigma_univ {α : Type u_1} {β : α → Type u_2} [fintype α] [(a : α) → fintype (β a)] : (finset.sigma finset.univ fun (a : α) => finset.univ) = finset.univ :=
  rfl

protected instance prod.fintype (α : Type u_1) (β : Type u_2) [fintype α] [fintype β] : fintype (α × β) :=
  fintype.mk (finset.product finset.univ finset.univ) sorry

@[simp] theorem finset.univ_product_univ {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] : finset.product finset.univ finset.univ = finset.univ :=
  rfl

@[simp] theorem fintype.card_prod (α : Type u_1) (β : Type u_2) [fintype α] [fintype β] : fintype.card (α × β) = fintype.card α * fintype.card β :=
  finset.card_product finset.univ finset.univ

/-- Given that `α × β` is a fintype, `α` is also a fintype. -/
def fintype.fintype_prod_left {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype (α × β)] [Nonempty β] : fintype α :=
  fintype.mk (finset.image prod.fst (fintype.elems (α × β))) sorry

/-- Given that `α × β` is a fintype, `β` is also a fintype. -/
def fintype.fintype_prod_right {α : Type u_1} {β : Type u_2} [DecidableEq β] [fintype (α × β)] [Nonempty α] : fintype β :=
  fintype.mk (finset.image prod.snd (fintype.elems (α × β))) sorry

protected instance ulift.fintype (α : Type u_1) [fintype α] : fintype (ulift α) :=
  fintype.of_equiv α (equiv.symm equiv.ulift)

@[simp] theorem fintype.card_ulift (α : Type u_1) [fintype α] : fintype.card (ulift α) = fintype.card α :=
  fintype.of_equiv_card (equiv.symm equiv.ulift)

theorem univ_sum_type {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] [fintype (α ⊕ β)] [DecidableEq (α ⊕ β)] : finset.univ = finset.map function.embedding.inl finset.univ ∪ finset.map function.embedding.inr finset.univ := sorry

protected instance sum.fintype (α : Type u) (β : Type v) [fintype α] [fintype β] : fintype (α ⊕ β) :=
  fintype.of_equiv (sigma fun (b : Bool) => cond b (ulift α) (ulift β))
    (equiv.trans (equiv.symm (equiv.sum_equiv_sigma_bool (ulift α) (ulift β))) (equiv.sum_congr equiv.ulift equiv.ulift))

namespace fintype

theorem card_le_of_injective {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α → β) (hf : function.injective f) : card α ≤ card β :=
  finset.card_le_card_of_inj_on f (fun (_x : α) (_x_1 : _x ∈ finset.univ) => finset.mem_univ (f _x))
    fun (_x : α) (_x_1 : _x ∈ finset.univ) (_x_2 : α) (_x_3 : _x_2 ∈ finset.univ) (h : f _x = f _x_2) => hf h

/--
The pigeonhole principle for finitely many pigeons and pigeonholes.
This is the `fintype` version of `finset.exists_ne_map_eq_of_card_lt_of_maps_to`.
-/
theorem exists_ne_map_eq_of_card_lt {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α → β) (h : card β < card α) : ∃ (x : α), ∃ (y : α), x ≠ y ∧ f x = f y := sorry

theorem card_eq_one_iff {α : Type u_1} [fintype α] : card α = 1 ↔ ∃ (x : α), ∀ (y : α), y = x := sorry

theorem card_eq_zero_iff {α : Type u_1} [fintype α] : card α = 0 ↔ α → False := sorry

/-- A `fintype` with cardinality zero is (constructively) equivalent to `pempty`. -/
def card_eq_zero_equiv_equiv_pempty {α : Type u_1} [fintype α] : card α = 0 ≃ (α ≃ pempty) :=
  equiv.mk
    (fun (h : card α = 0) => equiv.mk (fun (a : α) => false.elim sorry) (fun (a : pempty) => pempty.elim a) sorry sorry)
    sorry sorry sorry

theorem card_pos_iff {α : Type u_1} [fintype α] : 0 < card α ↔ Nonempty α := sorry

theorem card_le_one_iff {α : Type u_1} [fintype α] : card α ≤ 1 ↔ ∀ (a b : α), a = b := sorry

theorem card_le_one_iff_subsingleton {α : Type u_1} [fintype α] : card α ≤ 1 ↔ subsingleton α :=
  iff.trans card_le_one_iff (iff.symm subsingleton_iff)

theorem one_lt_card_iff_nontrivial {α : Type u_1} [fintype α] : 1 < card α ↔ nontrivial α := sorry

theorem exists_ne_of_one_lt_card {α : Type u_1} [fintype α] (h : 1 < card α) (a : α) : ∃ (b : α), b ≠ a :=
  exists_ne a

theorem exists_pair_of_one_lt_card {α : Type u_1} [fintype α] (h : 1 < card α) : ∃ (a : α), ∃ (b : α), a ≠ b :=
  exists_pair_ne α

theorem card_eq_one_of_forall_eq {α : Type u_1} [fintype α] {i : α} (h : ∀ (j : α), j = i) : card α = 1 :=
  le_antisymm (iff.mpr card_le_one_iff fun (a b : α) => Eq.trans (h a) (Eq.symm (h b)))
    (iff.mpr finset.card_pos (Exists.intro i (finset.mem_univ i)))

theorem injective_iff_surjective {α : Type u_1} [fintype α] {f : α → α} : function.injective f ↔ function.surjective f := sorry

theorem injective_iff_bijective {α : Type u_1} [fintype α] {f : α → α} : function.injective f ↔ function.bijective f := sorry

theorem surjective_iff_bijective {α : Type u_1} [fintype α] {f : α → α} : function.surjective f ↔ function.bijective f := sorry

theorem injective_iff_surjective_of_equiv {α : Type u_1} [fintype α] {β : Type u_2} {f : α → β} (e : α ≃ β) : function.injective f ↔ function.surjective f := sorry

theorem nonempty_equiv_of_card_eq {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (h : card α = card β) : Nonempty (α ≃ β) := sorry

theorem bijective_iff_injective_and_card {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α → β) : function.bijective f ↔ function.injective f ∧ card α = card β := sorry

theorem bijective_iff_surjective_and_card {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α → β) : function.bijective f ↔ function.surjective f ∧ card α = card β := sorry

end fintype

theorem fintype.coe_image_univ {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} : ↑(finset.image f finset.univ) = set.range f := sorry

protected instance list.subtype.fintype {α : Type u_1} [DecidableEq α] (l : List α) : fintype (Subtype fun (x : α) => x ∈ l) :=
  fintype.of_list (list.attach l) (list.mem_attach l)

protected instance multiset.subtype.fintype {α : Type u_1} [DecidableEq α] (s : multiset α) : fintype (Subtype fun (x : α) => x ∈ s) :=
  fintype.of_multiset (multiset.attach s) (multiset.mem_attach s)

protected instance finset.subtype.fintype {α : Type u_1} (s : finset α) : fintype (Subtype fun (x : α) => x ∈ s) :=
  fintype.mk (finset.attach s) (finset.mem_attach s)

protected instance finset_coe.fintype {α : Type u_1} (s : finset α) : fintype ↥↑s :=
  finset.subtype.fintype s

@[simp] theorem fintype.card_coe {α : Type u_1} (s : finset α) : fintype.card ↥↑s = finset.card s :=
  finset.card_attach

theorem finset.attach_eq_univ {α : Type u_1} {s : finset α} : finset.attach s = finset.univ :=
  rfl

theorem finset.card_le_one_iff {α : Type u_1} {s : finset α} : finset.card s ≤ 1 ↔ ∀ {x y : α}, x ∈ s → y ∈ s → x = y := sorry

/-- A `finset` of a subsingleton type has cardinality at most one. -/
theorem finset.card_le_one_of_subsingleton {α : Type u_1} [subsingleton α] (s : finset α) : finset.card s ≤ 1 :=
  iff.mpr finset.card_le_one_iff fun (_x _x_1 : α) (_x_2 : _x ∈ s) (_x_3 : _x_1 ∈ s) => subsingleton.elim _x _x_1

theorem finset.one_lt_card_iff {α : Type u_1} {s : finset α} : 1 < finset.card s ↔ ∃ (x : α), ∃ (y : α), x ∈ s ∧ y ∈ s ∧ x ≠ y := sorry

protected instance plift.fintype (p : Prop) [Decidable p] : fintype (plift p) :=
  fintype.mk (dite p (fun (h : p) => singleton (plift.up h)) fun (h : ¬p) => ∅) sorry

protected instance Prop.fintype : fintype Prop :=
  fintype.mk (finset.mk (True ::ₘ False ::ₘ 0) sorry) sorry

protected instance subtype.fintype {α : Type u_1} (p : α → Prop) [decidable_pred p] [fintype α] : fintype (Subtype fun (x : α) => p x) :=
  fintype.subtype (finset.filter p finset.univ) sorry

/-- A set on a fintype, when coerced to a type, is a fintype. -/
def set_fintype {α : Type u_1} [fintype α] (s : set α) [decidable_pred s] : fintype ↥s :=
  subtype.fintype fun (x : α) => x ∈ s

namespace function.embedding

/-- An embedding from a `fintype` to itself can be promoted to an equivalence. -/
def equiv_of_fintype_self_embedding {α : Type u_1} [fintype α] (e : α ↪ α) : α ≃ α :=
  equiv.of_bijective ⇑e sorry

@[simp] theorem equiv_of_fintype_self_embedding_to_embedding {α : Type u_1} [fintype α] (e : α ↪ α) : equiv.to_embedding (equiv_of_fintype_self_embedding e) = e :=
  ext fun (x : α) => Eq.refl (coe_fn (equiv.to_embedding (equiv_of_fintype_self_embedding e)) x)

end function.embedding

@[simp] theorem finset.univ_map_embedding {α : Type u_1} [fintype α] (e : α ↪ α) : finset.map e finset.univ = finset.univ := sorry

namespace fintype

/-- Given for all `a : α` a finset `t a` of `δ a`, then one can define the
finset `fintype.pi_finset t` of all functions taking values in `t a` for all `a`. This is the
analogue of `finset.pi` where the base finset is `univ` (but formally they are not the same, as
there is an additional condition `i ∈ finset.univ` in the `finset.pi` definition). -/
def pi_finset {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_4} (t : (a : α) → finset (δ a)) : finset ((a : α) → δ a) :=
  finset.map (function.embedding.mk (fun (f : (a : α) → a ∈ finset.univ → δ a) (a : α) => f a (finset.mem_univ a)) sorry)
    (finset.pi finset.univ t)

@[simp] theorem mem_pi_finset {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_4} {t : (a : α) → finset (δ a)} {f : (a : α) → δ a} : f ∈ pi_finset t ↔ ∀ (a : α), f a ∈ t a := sorry

theorem pi_finset_subset {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_4} (t₁ : (a : α) → finset (δ a)) (t₂ : (a : α) → finset (δ a)) (h : ∀ (a : α), t₁ a ⊆ t₂ a) : pi_finset t₁ ⊆ pi_finset t₂ :=
  fun (g : (a : α) → δ a) (hg : g ∈ pi_finset t₁) => iff.mpr mem_pi_finset fun (a : α) => h a (iff.mp mem_pi_finset hg a)

theorem pi_finset_disjoint_of_disjoint {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_4} [(a : α) → DecidableEq (δ a)] (t₁ : (a : α) → finset (δ a)) (t₂ : (a : α) → finset (δ a)) {a : α} (h : disjoint (t₁ a) (t₂ a)) : disjoint (pi_finset t₁) (pi_finset t₂) := sorry

end fintype

/-! ### pi -/

/-- A dependent product of fintypes, indexed by a fintype, is a fintype. -/
protected instance pi.fintype {α : Type u_1} {β : α → Type u_2} [DecidableEq α] [fintype α] [(a : α) → fintype (β a)] : fintype ((a : α) → β a) :=
  fintype.mk (fintype.pi_finset fun (_x : α) => finset.univ) sorry

@[simp] theorem fintype.pi_finset_univ {α : Type u_1} {β : α → Type u_2} [DecidableEq α] [fintype α] [(a : α) → fintype (β a)] : (fintype.pi_finset fun (a : α) => finset.univ) = finset.univ :=
  rfl

protected instance d_array.fintype {n : ℕ} {α : fin n → Type u_1} [(n : fin n) → fintype (α n)] : fintype (d_array n α) :=
  fintype.of_equiv ((i : fin n) → α i) (equiv.symm (equiv.d_array_equiv_fin α))

protected instance array.fintype {n : ℕ} {α : Type u_1} [fintype α] : fintype (array n α) :=
  d_array.fintype

protected instance vector.fintype {α : Type u_1} [fintype α] {n : ℕ} : fintype (vector α n) :=
  fintype.of_equiv (fin n → α) (equiv.symm (equiv.vector_equiv_fin α n))

protected instance quotient.fintype {α : Type u_1} [fintype α] (s : setoid α) [DecidableRel has_equiv.equiv] : fintype (quotient s) :=
  fintype.of_surjective quotient.mk sorry

protected instance finset.fintype {α : Type u_1} [fintype α] : fintype (finset α) :=
  fintype.mk (finset.powerset finset.univ) sorry

@[simp] theorem fintype.card_finset {α : Type u_1} [fintype α] : fintype.card (finset α) = bit0 1 ^ fintype.card α :=
  finset.card_powerset finset.univ

@[simp] theorem set.to_finset_univ {α : Type u_1} [fintype α] : set.to_finset set.univ = finset.univ := sorry

@[simp] theorem set.to_finset_empty {α : Type u_1} [fintype α] : set.to_finset ∅ = ∅ := sorry

theorem fintype.card_subtype_le {α : Type u_1} [fintype α] (p : α → Prop) [decidable_pred p] : fintype.card (Subtype fun (x : α) => p x) ≤ fintype.card α := sorry

theorem fintype.card_subtype_lt {α : Type u_1} [fintype α] {p : α → Prop} [decidable_pred p] {x : α} (hx : ¬p x) : fintype.card (Subtype fun (x : α) => p x) < fintype.card α := sorry

protected instance psigma.fintype {α : Type u_1} {β : α → Type u_2} [fintype α] [(a : α) → fintype (β a)] : fintype (psigma fun (a : α) => β a) :=
  fintype.of_equiv (sigma fun (a : α) => β a) (equiv.symm (equiv.psigma_equiv_sigma fun (a : α) => β a))

protected instance psigma.fintype_prop_left {α : Prop} {β : α → Type u_1} [Decidable α] [(a : α) → fintype (β a)] : fintype (psigma fun (a : α) => β a) :=
  dite α (fun (h : α) => fintype.of_equiv (β h) (equiv.mk (fun (x : β h) => psigma.mk h x) psigma.snd sorry sorry))
    fun (h : ¬α) => fintype.mk ∅ sorry

protected instance psigma.fintype_prop_right {α : Type u_1} {β : α → Prop} [(a : α) → Decidable (β a)] [fintype α] : fintype (psigma fun (a : α) => β a) :=
  fintype.of_equiv (Subtype fun (a : α) => β a)
    (equiv.mk (fun (_x : Subtype fun (a : α) => β a) => sorry) (fun (_x : psigma fun (a : α) => β a) => sorry) sorry
      sorry)

protected instance psigma.fintype_prop_prop {α : Prop} {β : α → Prop} [Decidable α] [(a : α) → Decidable (β a)] : fintype (psigma fun (a : α) => β a) :=
  dite (∃ (a : α), β a) (fun (h : ∃ (a : α), β a) => fintype.mk (singleton (psigma.mk sorry sorry)) sorry)
    fun (h : ¬∃ (a : α), β a) => fintype.mk ∅ sorry

protected instance set.fintype {α : Type u_1} [fintype α] : fintype (set α) :=
  fintype.mk (finset.map (function.embedding.mk coe finset.coe_injective) (finset.powerset finset.univ)) sorry

protected instance pfun_fintype (p : Prop) [Decidable p] (α : p → Type u_1) [(hp : p) → fintype (α hp)] : fintype ((hp : p) → α hp) :=
  dite p
    (fun (hp : p) =>
      fintype.of_equiv (α hp) (equiv.mk (fun (a : α hp) (_x : p) => a) (fun (f : (hp : p) → α hp) => f hp) sorry sorry))
    fun (hp : ¬p) => fintype.mk (singleton fun (h : p) => false.elim (hp h)) sorry

@[simp] theorem finset.univ_pi_univ {α : Type u_1} {β : α → Type u_2} [DecidableEq α] [fintype α] [(a : α) → fintype (β a)] : (finset.pi finset.univ fun (a : α) => finset.univ) = finset.univ := sorry

theorem mem_image_univ_iff_mem_range {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} {b : β} : b ∈ finset.image f finset.univ ↔ b ∈ set.range f := sorry

theorem card_lt_card_of_injective_of_not_mem {α : Type u_1} {β : Type u_2} [fintype α] [fintype β] (f : α → β) (h : function.injective f) {b : β} (w : ¬b ∈ set.range f) : fintype.card α < fintype.card β := sorry

/-- An auxiliary function for `quotient.fin_choice`.  Given a
collection of setoids indexed by a type `ι`, a (finite) list `l` of
indices, and a function that for each `i ∈ l` gives a term of the
corresponding quotient type, then there is a corresponding term in the
quotient of the product of the setoids indexed by `l`. -/
def quotient.fin_choice_aux {ι : Type u_1} [DecidableEq ι] {α : ι → Type u_2} [S : (i : ι) → setoid (α i)] (l : List ι) : ((i : ι) → i ∈ l → quotient (S i)) → quotient Mathlib.pi_setoid :=
  sorry

theorem quotient.fin_choice_aux_eq {ι : Type u_1} [DecidableEq ι] {α : ι → Type u_2} [S : (i : ι) → setoid (α i)] (l : List ι) (f : (i : ι) → i ∈ l → α i) : (quotient.fin_choice_aux l fun (i : ι) (h : i ∈ l) => quotient.mk (f i h)) = quotient.mk f := sorry

/-- Given a collection of setoids indexed by a fintype `ι` and a
function that for each `i : ι` gives a term of the corresponding
quotient type, then there is corresponding term in the quotient of the
product of the setoids. -/
def quotient.fin_choice {ι : Type u_1} [DecidableEq ι] [fintype ι] {α : ι → Type u_2} [S : (i : ι) → setoid (α i)] (f : (i : ι) → quotient (S i)) : quotient Mathlib.pi_setoid :=
  quotient.lift_on
    (quotient.rec_on (finset.val finset.univ)
      (fun (l : List ι) => quotient.fin_choice_aux l fun (i : ι) (_x : i ∈ l) => f i) sorry)
    (fun (f : (i : ι) → i ∈ finset.val finset.univ → α i) => quotient.mk fun (i : ι) => f i (finset.mem_univ i)) sorry

theorem quotient.fin_choice_eq {ι : Type u_1} [DecidableEq ι] [fintype ι] {α : ι → Type u_2} [(i : ι) → setoid (α i)] (f : (i : ι) → α i) : (quotient.fin_choice fun (i : ι) => quotient.mk (f i)) = quotient.mk f := sorry

/-- Given a list, produce a list of all permutations of its elements. -/
def perms_of_list {α : Type u_1} [DecidableEq α] : List α → List (equiv.perm α) :=
  sorry

theorem length_perms_of_list {α : Type u_1} [DecidableEq α] (l : List α) : list.length (perms_of_list l) = nat.factorial (list.length l) := sorry

theorem mem_perms_of_list_of_mem {α : Type u_1} [DecidableEq α] {l : List α} {f : equiv.perm α} (h : ∀ (x : α), coe_fn f x ≠ x → x ∈ l) : f ∈ perms_of_list l := sorry

theorem mem_of_mem_perms_of_list {α : Type u_1} [DecidableEq α] {l : List α} {f : equiv.perm α} : f ∈ perms_of_list l → ∀ {x : α}, coe_fn f x ≠ x → x ∈ l := sorry

theorem mem_perms_of_list_iff {α : Type u_1} [DecidableEq α] {l : List α} {f : equiv.perm α} : f ∈ perms_of_list l ↔ ∀ {x : α}, coe_fn f x ≠ x → x ∈ l :=
  { mp := mem_of_mem_perms_of_list, mpr := mem_perms_of_list_of_mem }

theorem nodup_perms_of_list {α : Type u_1} [DecidableEq α] {l : List α} (hl : list.nodup l) : list.nodup (perms_of_list l) := sorry

/-- Given a finset, produce the finset of all permutations of its elements. -/
def perms_of_finset {α : Type u_1} [DecidableEq α] (s : finset α) : finset (equiv.perm α) :=
  quotient.hrec_on (finset.val s)
    (fun (l : List α) (hl : multiset.nodup (quotient.mk l)) => finset.mk ↑(perms_of_list l) sorry) sorry (finset.nodup s)

theorem mem_perms_of_finset_iff {α : Type u_1} [DecidableEq α] {s : finset α} {f : equiv.perm α} : f ∈ perms_of_finset s ↔ ∀ {x : α}, coe_fn f x ≠ x → x ∈ s :=
  finset.cases_on s
    fun (s_val : multiset α) (hs : multiset.nodup s_val) =>
      quot.induction_on s_val (fun (l : List α) (hs : multiset.nodup (Quot.mk setoid.r l)) => mem_perms_of_list_iff) hs

theorem card_perms_of_finset {α : Type u_1} [DecidableEq α] (s : finset α) : finset.card (perms_of_finset s) = nat.factorial (finset.card s) :=
  finset.cases_on s
    fun (s_val : multiset α) (hs : multiset.nodup s_val) =>
      quot.induction_on s_val (fun (l : List α) (hs : multiset.nodup (Quot.mk setoid.r l)) => length_perms_of_list l) hs

/-- The collection of permutations of a fintype is a fintype. -/
def fintype_perm {α : Type u_1} [DecidableEq α] [fintype α] : fintype (equiv.perm α) :=
  fintype.mk (perms_of_finset finset.univ) sorry

protected instance equiv.fintype {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] [fintype α] [fintype β] : fintype (α ≃ β) :=
  dite (fintype.card β = fintype.card α)
    (fun (h : fintype.card β = fintype.card α) =>
      trunc.rec_on_subsingleton (fintype.equiv_fin α)
        fun (eα : α ≃ fin (fintype.card α)) =>
          trunc.rec_on_subsingleton (fintype.equiv_fin β)
            fun (eβ : β ≃ fin (fintype.card β)) =>
              fintype.of_equiv (equiv.perm α)
                (equiv.equiv_congr (equiv.refl α) (equiv.trans eα (eq.rec_on h (equiv.symm eβ)))))
    fun (h : ¬fintype.card β = fintype.card α) => fintype.mk ∅ sorry

theorem fintype.card_perm {α : Type u_1} [DecidableEq α] [fintype α] : fintype.card (equiv.perm α) = nat.factorial (fintype.card α) :=
  subsingleton.elim fintype_perm equiv.fintype ▸ card_perms_of_finset finset.univ

theorem fintype.card_equiv {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] [fintype α] [fintype β] (e : α ≃ β) : fintype.card (α ≃ β) = nat.factorial (fintype.card α) :=
  fintype.card_congr (equiv.equiv_congr (equiv.refl α) e) ▸ fintype.card_perm

theorem univ_eq_singleton_of_card_one {α : Type u_1} [fintype α] (x : α) (h : fintype.card α = 1) : finset.univ = singleton x := sorry

namespace fintype

/-- Given a fintype `α` and a predicate `p`, associate to a proof that there is a unique element of
`α` satisfying `p` this unique element, as an element of the corresponding subtype. -/
def choose_x {α : Type u_1} [fintype α] (p : α → Prop) [decidable_pred p] (hp : exists_unique fun (a : α) => p a) : Subtype fun (a : α) => p a :=
  { val := finset.choose p finset.univ sorry, property := sorry }

/-- Given a fintype `α` and a predicate `p`, associate to a proof that there is a unique element of
`α` satisfying `p` this unique element, as an element of `α`. -/
def choose {α : Type u_1} [fintype α] (p : α → Prop) [decidable_pred p] (hp : exists_unique fun (a : α) => p a) : α :=
  ↑(choose_x p hp)

theorem choose_spec {α : Type u_1} [fintype α] (p : α → Prop) [decidable_pred p] (hp : exists_unique fun (a : α) => p a) : p (choose p hp) :=
  subtype.property (choose_x p hp)

/-- `
`bij_inv f` is the unique inverse to a bijection `f`. This acts
  as a computable alternative to `function.inv_fun`. -/
def bij_inv {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} (f_bij : function.bijective f) (b : β) : α :=
  choose (fun (a : α) => f a = b) sorry

theorem left_inverse_bij_inv {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} (f_bij : function.bijective f) : function.left_inverse (bij_inv f_bij) f :=
  fun (a : α) =>
    and.left f_bij (bij_inv f_bij (f a)) a (choose_spec (fun (a' : α) => f a' = f a) (bij_inv._proof_1 f_bij (f a)))

theorem right_inverse_bij_inv {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} (f_bij : function.bijective f) : function.right_inverse (bij_inv f_bij) f :=
  fun (b : β) => choose_spec (fun (a' : α) => f a' = b) (bij_inv._proof_1 f_bij b)

theorem bijective_bij_inv {α : Type u_1} {β : Type u_2} [fintype α] [DecidableEq β] {f : α → β} (f_bij : function.bijective f) : function.bijective (bij_inv f_bij) :=
  { left := function.right_inverse.injective (right_inverse_bij_inv f_bij),
    right := function.left_inverse.surjective (left_inverse_bij_inv f_bij) }

theorem well_founded_of_trans_of_irrefl {α : Type u_1} [fintype α] (r : α → α → Prop) [is_trans α r] [is_irrefl α r] : well_founded r := sorry

theorem preorder.well_founded {α : Type u_1} [fintype α] [preorder α] : well_founded Less :=
  well_founded_of_trans_of_irrefl Less

instance linear_order.is_well_order {α : Type u_1} [fintype α] [linear_order α] : is_well_order α Less :=
  is_well_order.mk preorder.well_founded

end fintype

/-- A type is said to be infinite if it has no fintype instance. -/
class infinite (α : Type u_4)
where
  not_fintype : fintype α → False

@[simp] theorem not_nonempty_fintype {α : Type u_1} : ¬Nonempty (fintype α) ↔ infinite α := sorry

theorem finset.exists_minimal {α : Type u_1} [preorder α] (s : finset α) (h : finset.nonempty s) : ∃ (m : α), ∃ (H : m ∈ s), ∀ (x : α), x ∈ s → ¬x < m := sorry

theorem finset.exists_maximal {α : Type u_1} [preorder α] (s : finset α) (h : finset.nonempty s) : ∃ (m : α), ∃ (H : m ∈ s), ∀ (x : α), x ∈ s → ¬m < x :=
  finset.exists_minimal s h

namespace infinite

theorem exists_not_mem_finset {α : Type u_1} [infinite α] (s : finset α) : ∃ (x : α), ¬x ∈ s :=
  iff.mp not_forall fun (h : ∀ (x : α), x ∈ s) => not_fintype (fintype.mk s h)

protected instance nontrivial (α : Type u_1) [H : infinite α] : nontrivial α :=
  nontrivial.mk sorry

theorem nonempty (α : Type u_1) [infinite α] : Nonempty α :=
  nontrivial.to_nonempty

theorem of_injective {α : Type u_1} {β : Type u_2} [infinite β] (f : β → α) (hf : function.injective f) : infinite α :=
  mk fun (I : fintype α) => not_fintype (fintype.of_injective f hf)

theorem of_surjective {α : Type u_1} {β : Type u_2} [infinite β] (f : α → β) (hf : function.surjective f) : infinite α :=
  mk fun (I : fintype α) => not_fintype (fintype.of_surjective f hf)

/-- Embedding of `ℕ` into an infinite type. -/
def nat_embedding (α : Type u_1) [infinite α] : ℕ ↪ α :=
  function.embedding.mk (nat_embedding_aux α) (nat_embedding_aux_injective α)

theorem exists_subset_card_eq (α : Type u_1) [infinite α] (n : ℕ) : ∃ (s : finset α), finset.card s = n := sorry

end infinite

theorem not_injective_infinite_fintype {α : Type u_1} {β : Type u_2} [infinite α] [fintype β] (f : α → β) : ¬function.injective f :=
  fun (hf : function.injective f) => (fun (H : fintype α) => infinite.not_fintype H) (fintype.of_injective f hf)

/--
The pigeonhole principle for infinitely many pigeons in finitely many
pigeonholes.  If there are infinitely many pigeons in finitely many
pigeonholes, then there are at least two pigeons in the same
pigeonhole.

See also: `fintype.exists_ne_map_eq_of_card_lt`, `fintype.exists_infinite_fiber`.
-/
theorem fintype.exists_ne_map_eq_of_infinite {α : Type u_1} {β : Type u_2} [infinite α] [fintype β] (f : α → β) : ∃ (x : α), ∃ (y : α), x ≠ y ∧ f x = f y := sorry

/--
The strong pigeonhole principle for infinitely many pigeons in
finitely many pigeonholes.  If there are infinitely many pigeons in
finitely many pigeonholes, then there is a pigeonhole with infinitely
many pigeons.

See also: `fintype.exists_ne_map_eq_of_infinite`
-/
theorem fintype.exists_infinite_fiber {α : Type u_1} {β : Type u_2} [infinite α] [fintype β] (f : α → β) : ∃ (y : β), infinite ↥(f ⁻¹' singleton y) := sorry

theorem not_surjective_fintype_infinite {α : Type u_1} {β : Type u_2} [fintype α] [infinite β] (f : α → β) : ¬function.surjective f :=
  fun (hf : function.surjective f) =>
    (fun (H : infinite α) => infinite.not_fintype infer_instance) (infinite.of_surjective f hf)

protected instance nat.infinite : infinite ℕ :=
  infinite.mk fun (_x : fintype ℕ) => sorry

protected instance int.infinite : infinite ℤ :=
  infinite.of_injective Int.ofNat fun (_x _x_1 : ℕ) => int.of_nat.inj

/--
For `s : multiset α`, we can lift the existential statement that `∃ x, x ∈ s` to a `trunc α`.
-/
def trunc_of_multiset_exists_mem {α : Type u_1} (s : multiset α) : (∃ (x : α), x ∈ s) → trunc α :=
  quotient.rec_on_subsingleton s fun (l : List α) (h : ∃ (x : α), x ∈ quotient.mk l) => sorry

/--
A `nonempty` `fintype` constructively contains an element.
-/
def trunc_of_nonempty_fintype (α : Type u_1) [Nonempty α] [fintype α] : trunc α :=
  trunc_of_multiset_exists_mem (finset.val finset.univ) sorry

/--
A `fintype` with positive cardinality constructively contains an element.
-/
def trunc_of_card_pos {α : Type u_1} [fintype α] (h : 0 < fintype.card α) : trunc α :=
  let _inst : Nonempty α := sorry;
  trunc_of_nonempty_fintype α

/--
By iterating over the elements of a fintype, we can lift an existential statement `∃ a, P a`
to `trunc (Σ' a, P a)`, containing data.
-/
def trunc_sigma_of_exists {α : Type u_1} [fintype α] {P : α → Prop} [decidable_pred P] (h : ∃ (a : α), P a) : trunc (psigma fun (a : α) => P a) :=
  trunc_of_nonempty_fintype (psigma fun (a : α) => P a)


import .lemmas .dickson
open classical nat function prod set subtype

noncomputable theory

definition inj_from_to {A B: Type} (f : A → B) (S1 : set A) (S2 : set B) := maps_to f S1 S2 ∧ inj_on f S1

theorem inj_from_to_id {A : Type} (S1 : set A) : (∀ a, a ∈ S1 → id a ∈ S1) ∧ ∀ a₁ a₂, a₁ ∈ S1 → a₂ ∈ S1 → id a₁ = id a₂ → a₁ = a₂ :=
begin split, intros, simp, assumption, intros; assumption end

theorem inj_from_to_compose {A B C : Type} {g : B → C} {f : A → B} {S1 : set A} {S2 : set B} {S3 : set C}
  (Hg : inj_from_to g S2 S3) (Hf : inj_from_to f S1 S2) : inj_from_to (g ∘ f) S1 S3 :=
have Hl : ∀ a, a ∈ S1 → g (f a) ∈ S3, from λ a Ha, Hg^.left (Hf^.left Ha),
have ∀ a₁ a₂, a₁ ∈ S1 → a₂ ∈ S1 → g (f a₁) = g (f a₂) → a₁ = a₂, from
  λ  a₁ a₂ Ha₁ Ha₂ Heq,
  have in1 : f a₁ ∈ S2, from Hf^.left Ha₁,
  have in2 : f a₂ ∈ S2, from Hf^.left Ha₂,
  have f a₁ = f a₂, from Hg^.right in1 in2 Heq,
  Hf^.right Ha₁ Ha₂ this,
⟨Hl, this⟩

theorem gt_of_gt_pred {a b : ℕ} (H : pred b < a) : b ≤ a :=
by_cases
(suppose b = 0, by simp [this,zero_le])
(suppose b ≠ 0,
 have ∃ k, b = succ k, from exists_eq_succ_of_ne_zero this,
 let ⟨k,hk⟩ := this in
 have pred (succ k) < a, by rw hk at H;exact H,
 have k < a, by super,
 have succ k ≤ a, from succ_le_of_lt this,
 by simp [this, hk])

theorem sub_gt_of_gt_ge {a b c : ℕ} (H1 : a > b) (H2 : b ≥ c) : a - c > b - c :=
have c ≤ a, from le_of_lt (lt_of_le_of_lt H2 H1),
have eq₁ : a - c + c = a, from nat.sub_add_cancel this,
have eq₂ : b - c + c = b, from nat.sub_add_cancel H2,
have b ≤ a, from le_of_lt H1,
have b - c ≤ a - c, from nat.sub_le_sub_right this c,
or.elim (nat.lt_or_eq_of_le this)
(assume Hl, Hl)
(assume Hr, have refl : a > a, by super,
 absurd refl (lt_irrefl a))

theorem lt_pred_nonzero_self {n : ℕ} (H : n ≠ 0) : pred n < n :=
have ∃ k, n = succ k, from exists_eq_succ_of_ne_zero H,
let ⟨k,hk⟩ := this in begin simp [hk, self_lt_succ] end

-- theorem ne_empty_of_mem {X : Type} {s : set X} {x : X} (H : x ∈ s) : s ≠ ∅ :=
-- begin intro Hs, rw Hs at H, apply set.not_mem_empty _ H end

theorem image_nonempty {A B : Type} {f : A → B} {S : set A} (H : S ≠ ∅) : image f  S ≠ ∅ :=
have ∃ s, s ∈ S, from exists_mem_of_ne_empty H,
let ⟨s,h⟩ := this in
have f s ∈ image f S, from ⟨s, ⟨h,rfl⟩⟩,
set.ne_empty_of_mem this

theorem not_mem_singleton {A : Type} (x a : A) (H : x ≠ a) : x ∉ insert a (∅ : set A) :=
suppose x ∈ insert a ∅, H (eq_of_mem_singleton this)

theorem refl_of_diff_of_ins_singleton {A : Type} {a : A} {S : set A} (H : a ∉ S) : S = (insert a S) \ insert a ∅ :=
subset.antisymm
(λ x h, ⟨or.inr h,(λ neg, have x = a, from eq_of_mem_singleton neg,by super)⟩)
(λ x ⟨hl,hr⟩, or.elim hl (λ l,
have x ∈ insert a (∅ : set A), begin rw l, apply mem_singleton end,
by contradiction) (λ r,r))

namespace kruskal

#check good_pairs

section
-- Given a countable set of objects A (which is ordered by f), and assuming that there exists a bad sequence (i.e., f ∘ g) of these objects, we can find a (sub)sequence (f ∘ h) which is bad and ∀ i, h 0 ≤ h i.
parameter {A : Type}
parameter f : ℕ → A
parameter g : ℕ → ℕ
parameter o : A → A → Prop
parameter H : ¬ is_good (f ∘ g) o

definition ran_g : set ℕ := {x : ℕ | ∃ i, g i = x}

theorem ne_empty_ran : ran_g ≠ ∅ := set.ne_empty_of_mem ⟨0,rfl⟩

private definition min : ℕ := least ran_g ne_empty_ran

definition index_of_min : ℕ :=
have min ∈ ran_g, from least_is_mem ran_g ne_empty_ran,
some this

theorem minimality_of_min (n : ℕ) : g index_of_min ≤ g n :=
have H1 : g index_of_min = min, from some_spec (least_is_mem ran_g ne_empty_ran),
have least ran_g ne_empty_ran ≤ g n, from minimality _ (g n) ⟨n,rfl⟩,
begin simp [H1], exact this end

private definition h (n : ℕ) : ℕ := g (index_of_min + n)

theorem exists_sub_bad : ∃ h : ℕ → ℕ, ¬ is_good (f ∘ h) o ∧ ∀ i : ℕ, h 0 ≤ h i :=
have badness : ¬ is_good (f ∘ h) o, from
   suppose is_good (f ∘ h) o,
   let ⟨i,j,hij⟩ := this in
   have index_of_min + i < index_of_min + j, from add_lt_add_left (and.left hij) _,
   have is_good (f ∘ g) o, from ⟨index_of_min + i,⟨index_of_min + j,⟨this,hij^.right⟩⟩⟩,
   H this,
have ∀ i : ℕ, h 0 ≤ h i, from λ i, minimality_of_min (index_of_min + i),
⟨h,⟨badness,this⟩⟩

end

definition finite_subsets (Q : Type) : Type := {x : set Q // finite x}

definition non_descending {Q : Type} (A B : finite_subsets Q) (o : Q → Q → Prop) (f : Q → Q) := ∀ a : Q, a ∈ A.1 → o a (f a) ∧ f a ∈ B.1

definition star {Q : Type} (o : Q → Q → Prop) (A B : finite_subsets Q) := ∃ f, inj_from_to f A.1 B.1 ∧ non_descending A B o f

definition extends_at {A : Type} (n : ℕ) (f : ℕ → A) (g : ℕ → A) : Prop := ∀ m ≤ n, g m = f m

theorem extends_at.refl {A : Type} {n : ℕ} {f : ℕ → A} : extends_at n f f := λ m H, rfl

theorem extends_at.trans {A : Type} {n m : ℕ} {f g h: ℕ → A} (H1 : extends_at n f g) (H2 : extends_at m g h) (H3 : n ≤ m) :
  extends_at n f h := λ k H,
have g k = f k, from H1 k H,
have k ≤ m, from nat.le_trans H H3,
have h k = g k, from H2 k this,
by super

-- definition induced_set_of_exists {A : Type} {P : A → Prop} (H : ∃ x, P x) : set A := {x | P x}

-- theorem nonempty_induced_set {A : Type} {P : A → Prop} (H : ∃ x, P x) : induced_set_of_exists H ≠ ∅ := let ⟨a,h⟩ := H in set.ne_empty_of_mem h

-- theorem property_of_induced_set {A : Type} {P : A → Prop} (H : ∃ x, P x) : ∀ s, s ∈ induced_set_of_exists H → P s :=
-- λ s h, h

theorem least_seq_at_n {S : set (ℕ → ℕ)} (H : S ≠ ∅) (n : ℕ) : ∃ f, f ∈ S ∧ ∀ g, g ∈ S → f n ≤ g n :=
let T : set ℕ := {x | ∃ f, f ∈ S ∧ f n = x} in
have ∃ f, f ∈ S, from exists_mem_of_ne_empty H,
let ⟨f,h⟩ := this in
have nemp : T ≠ ∅, from set.ne_empty_of_mem ⟨f,⟨h,rfl⟩⟩,
let a := least T nemp in
have a ∈ T, from least_is_mem T nemp,
let ⟨f',h⟩ := this in
have ∀ g, g ∈ S → f' n ≤ g n, from λ g Hg,
  have a ≤ g n, from minimality _ _ ⟨g,⟨Hg,rfl⟩⟩,
  by super,
⟨f',⟨h^.left, this⟩⟩

section
-- given an n, take an f from {f | P f} such that |f n| is as small as possible.
parameter {A : Type}
parameter {P : (ℕ → A) → Prop}
parameter g : A → ℕ -- a function which calculates the cardinality of a : A in some sense.
parameter H : ∃ f : ℕ → A, P f

-- definition card_of_f (f : ℕ → A) (n : ℕ) : ℕ := g (f n)

definition colle : set (ℕ → A) := {f | P f}

lemma nonempty_colle : colle ≠ ∅ :=  let ⟨a,h⟩ := H in set.ne_empty_of_mem h

definition S : set (ℕ → ℕ) := image (λ f, g ∘ f) colle

lemma nonempty_S : S ≠ ∅ := image_nonempty nonempty_colle

theorem exists_min_func (n : ℕ) : ∃ f, f ∈ S ∧ ∀ g, g ∈ S → f n ≤ g n := least_seq_at_n nonempty_S n

-- let ⟨l,r⟩ := some_spec (exists_min_func n) does not work
definition min_func (n : ℕ) : ℕ → A :=
let fc := some (exists_min_func n) in
have fc ∈ S ∧ ∀ g, g ∈ S → fc n ≤ g n, from (some_spec (exists_min_func n)),
some this^.left

theorem min_func_property (n : ℕ) : P (min_func n) :=
let fc := some (exists_min_func n) in
let ⟨l,r⟩ := some_spec (exists_min_func n) in
have min_func n ∈ colle ∧ (λ f, g ∘ f) (min_func n) = fc, from some_spec l ,
this^.left

-- For every f satisfying P, we have the inequality. Intuitively, it says that |(min_func n) n| is always less than or equal to |f n|.
theorem min_func_minimality (f : ℕ → A) (Hp : P f) (n : ℕ) : g (min_func n n) ≤ g (f n) :=
let fc := some (exists_min_func n) in
let ⟨l,r⟩ := some_spec (exists_min_func n) in
have min_func n ∈ colle ∧ (λ f, g ∘ f) (min_func n) = fc, from some_spec l,
have (λ f, g ∘ f) (min_func n) = fc, from this^.right,
have eq2 : (λ f, g ∘ f) (min_func n) n = fc n, by rw this,
have Hr : ∀ g, g ∈ S → fc n ≤ g n, from (some_spec (exists_min_func n))^.right,
have le : fc n ≤ (λ f, g ∘ f) f n, from Hr _ ⟨f,⟨Hp,rfl⟩⟩,
-- have (λ f, g ∘ f) (min_func n) n = g (min_func n n), from rfl,
-- have (λ f, g ∘ f) f n = g (f n), from rfl,
have (λ f, g ∘ f) (min_func n) n ≤ (λ f, g ∘ f) f n, by rw -eq2 at le;exact le,
by super

end

section

parameter {A : Type}
parameter {P : (ℕ → A) → Prop} -- some property about f
parameter g : A → ℕ -- a measure of cardinality of A
parameter H : ∃ f, P f

-- construct a sequence of functions with property P such that each one extends its predecessor and is the minimal one at n.
noncomputable definition mbs_helper (n : ℕ) : {f : ℕ → A // P f} :=
nat.rec_on n
(let f₀ := min_func g H 0 in
 have P f₀, from min_func_property g H 0,
 ⟨f₀,this⟩)
(λ pred h',
let f' := h'.1 in
have H1 : extends_at pred f' f', from extends_at.refl,
have H2 : P f', from h'.2,
have HP : ∃ f, extends_at pred f' f ∧ P f, from ⟨f',⟨H1,H2⟩⟩,
let fn := min_func g HP (succ pred) in
have extends_at pred f' fn ∧ P fn, from min_func_property g HP (succ pred),
have P fn, from this^.right,
⟨fn,this⟩)

  section
  parameter n : ℕ
  definition helper_elt := (mbs_helper n).1
  definition helper_succ := (mbs_helper (succ n)).1
  lemma helper_ext_refl : extends_at n helper_elt helper_elt := extends_at.refl
  lemma helper_has_property : P helper_elt := (mbs_helper n).2
  lemma helper_inner_hyp : ∃ g, extends_at n helper_elt g ∧ P g := ⟨helper_elt, ⟨helper_ext_refl, helper_has_property⟩⟩
  theorem succ_ext_of_mbs_helper : extends_at n helper_elt helper_succ := (min_func_property g helper_inner_hyp (succ n))^.left
  end

theorem ext_of_mbs_helper (n : ℕ) : ∀ m, m ≤ n → extends_at m  (mbs_helper m).1 (mbs_helper n).1 :=
nat.rec_on n
(take m, assume H,
have eq : m = 0, from eq_zero_of_le_zero H,
have extends_at 0 (mbs_helper 0).1 (mbs_helper 0).1, from extends_at.refl,
by simp [eq,this])
(λ a IH m H,
by_cases
(suppose m = succ a,
have extends_at m (mbs_helper (succ a)).1 (mbs_helper (succ a)).1, from extends_at.refl, by super)
(suppose m ≠ succ a,
have m < succ a, from lt_of_le_of_ne H this,
have Hle : m ≤ a, from (iff.mp (lt_succ_iff_le m a)) this,
have H1 : extends_at m (mbs_helper m).1 (mbs_helper a).1, from IH m Hle,
have extends_at a (mbs_helper a).1 (mbs_helper (succ a)).1, from succ_ext_of_mbs_helper a,
extends_at.trans H1 this Hle))

theorem congruence_of_mbs_helper {n m : ℕ} (H : m ≤ n) : (mbs_helper n).1 m = (mbs_helper m).1 m :=
have extends_at m (mbs_helper m).1 (mbs_helper n).1, from ext_of_mbs_helper n m H,
this m (nat.le_refl m)

end

section
-- construction and properties of mbs.
parameter {A : Type}
parameter {o : A → A → Prop}
parameter g : A → ℕ
parameter H : ∃ f : ℕ → A, ¬ is_good f o

noncomputable definition seq_of_bad_seq (n : ℕ) : {f : ℕ → A // ¬ is_good f o} := mbs_helper g H n

definition minimal_bad_seq (n : ℕ) : A :=  (seq_of_bad_seq n).1 n

definition ext_of_seq_of_bad_seq := ext_of_mbs_helper g H

definition congruence_of_seq_of_bad_seq {n m : ℕ} (Hnm : m ≤ n) := congruence_of_mbs_helper g H Hnm

definition bad_seq_elt := helper_elt g H

definition bad_seq_inner_hyp := helper_inner_hyp g H

theorem badness_of_mbs : ¬ is_good minimal_bad_seq o :=
suppose is_good minimal_bad_seq o,
let ⟨i,j,h⟩ := this in
have i ≤ j, from le_of_lt_or_eq (or.inl h^.left),
have ext : extends_at i (seq_of_bad_seq i).1 (seq_of_bad_seq j).1, from ext_of_seq_of_bad_seq j i this,
have i ≤ i, from nat.le_refl i,
have (seq_of_bad_seq j).1 i = (minimal_bad_seq i), from ext i this,
have o ((seq_of_bad_seq j).1 i) (minimal_bad_seq j), by rw this; exact h^.right,
have i < j ∧ o ((seq_of_bad_seq j).1 i) ((seq_of_bad_seq j).1 j), from ⟨h^.left, this⟩,
have good : is_good (seq_of_bad_seq j).1 o, from ⟨i,⟨j, this⟩⟩,
have ¬ is_good (seq_of_bad_seq j).1 o, from (seq_of_bad_seq j).2,
this good

theorem minimality_of_mbs_0 (f : ℕ → A) (Hf : ¬ is_good f o) : g (minimal_bad_seq 0) ≤ g (f 0) := min_func_minimality g H f Hf 0

theorem minimality_of_mbs (n : ℕ) (f : ℕ → A) (H1 : extends_at n minimal_bad_seq f ∧ ¬ is_good f o) : g (minimal_bad_seq (succ n)) ≤ g (f (succ n)) :=
have Hl : ∀ m, m ≤ n →  f m = (bad_seq_elt n) m, from
  λ m Hle, have f m = minimal_bad_seq m, from H1^.left m Hle,
  have bad_seq_elt n m = minimal_bad_seq m, from congruence_of_seq_of_bad_seq Hle,
  by super, --by+ simp,
have ins_P : extends_at n (bad_seq_elt n) f ∧ ¬ is_good f o, from ⟨Hl, H1^.right⟩,
have ineq : g (min_func g (bad_seq_inner_hyp n) (succ n) (succ n)) ≤ g (f (succ n)), from min_func_minimality g (bad_seq_inner_hyp n) f ins_P (succ n),
-- have minimal_bad_seq (succ n) = min_func g (bad_seq_inner_hyp n) (succ n) (succ n), from rfl,
-- by+ rw (eq.symm this) at ineq; exact ineq
by super

end

section

-- Given two sequences f and g, a function h which modifies indices so that h 0 is the break point, construct a new sequence 'combined_seq' by concatenating f and g at (h 0).

parameter {Q :Type}
parameter {o : Q → Q → Prop}
parameters f g : ℕ → Q
parameter h : ℕ → ℕ
parameter Hh : ∀ i, h 0 ≤ h i
parameter Hf : ¬ is_good f o
parameter Hg : ¬ is_good g o
-- in Higman's lemma in Williams 1963, h is f, g is the bad sequence B ∘ f
parameter H : ∀ i j, o (f i) (g (j - h 0)) → o (f i) (f (h (j - h 0)))

-- definition comb (n : ℕ) : Q := if h 0 ≠ 0 ∧ n ≤ pred (h 0) then f n else g (n - (h 0))

-- -- def comb' (n : ℕ) : Q := if n < h 0 then f n else g (n - (h 0))

-- -- theorem g_part_of_comb' (H : (h 0) = 0) : ∀ x, comb' x = g x :=
-- -- λ n, have ¬ n < h 0, by rw H; apply not_lt_zero ,
-- -- have comb' n = g (n - (h 0)), from if_neg this,
-- -- by simp [this, H]

-- theorem g_part_of_comb (H : (h 0) = 0) : ∀ x, comb x = g x :=
-- take n, have ¬ (h 0) ≠ 0, from not_not_intro H,
-- have ¬ ((h 0) ≠ 0 ∧ n ≤ pred (h 0)), from not_and_of_not_left (n ≤ pred (h 0)) this,
-- have comb n = g (n - (h 0)), from if_neg this,
-- by simp [this, H]

-- theorem badness_of_comb : ¬ is_good comb o :=
-- λ good,
-- let ⟨i,j,hw⟩ := good in
-- by_cases
-- (suppose (h 0) = 0,
-- have comb = g, begin apply funext, apply g_part_of_comb, exact this end,
-- have is_good g o, by rw this at good;exact good,
-- Hg this)
-- (assume ne,
--   by_cases
--   (assume Hposi : i ≤ pred (h 0),
--    have eq1i : comb i = f i, from if_pos ⟨ne, Hposi⟩,
--    by_cases
--      (suppose j ≤ pred (h 0),
--       have eq1j : comb j = f j, from if_pos ⟨ne, this⟩,
--       have o (comb i) (comb j), from hw^.right,
--       have o (comb i) (f j), by rw eq1j at this; exact this,
--       have o (f i) (f j), begin rw -eq1i, exact this end,
--       have is_good f o, from ⟨i, ⟨j,⟨hw^.left,this⟩⟩⟩,
--       show _, from Hf this)
--      (suppose ¬ j ≤ pred (h 0),
--       have ¬ ((h 0) ≠ 0 ∧ j ≤ pred (h 0)), from not_and_of_not_right ((h 0) ≠ 0) this,
--       have eq2j : comb j = g (j - (h 0)), from if_neg this,
--       have o (f i) (g (j - (h 0))), begin rw [-eq2j,-eq1i], exact hw^.right end,
--      have Hr : o (f i) (f (h (j - (h 0)))), from H _ _ this,
--      have i < h (j - (h 0)), from
--        have ilth0 : i < h 0, from lt_of_le_of_lt Hposi (lt_pred_nonzero_self ne),
--        have h 0 ≤ h (j - h 0), from Hh (j - h 0),
--        show _, from lt_of_lt_of_le ilth0 this,
--      have is_good f o, from ⟨i, ⟨h (j - h 0), ⟨this, Hr⟩⟩⟩,
--      show _, from Hf this))
--   (assume Hnegi,
--    have iht : pred (h 0) < i, from lt_of_not_ge Hnegi,
--    have ¬ (h 0 ≠ 0 ∧ i ≤ pred (h 0)), from not_and_of_not_right (h 0 ≠ 0) Hnegi,
--    have eq2i : comb i = g (i - h 0), from if_neg this,
--    by_cases
--    (assume Hposj : j ≤ pred (h 0),
--     have j < i, from lt_of_le_of_lt Hposj iht,
--     show _, from (not_lt_of_gt hw^.left) this)
--    (assume Hnegj,
--     have pred (h 0) < j, from lt_of_not_ge Hnegj,
--     have ¬ (h 0 ≠ 0 ∧ j ≤ pred (h 0)), from not_and_of_not_right (h 0 ≠ 0) Hnegj,
--     have eq2j : comb j = g (j - h 0), from if_neg this,
--     have o (comb i) (comb j), from hw^.right,
--     have o (comb i) (g (j - h 0)), begin rw -eq2j, exact this end, --by simp,
--     have Hr2 : o (g (i - h 0)) (g (j - h 0)), begin rw -eq2i, exact this end,-- by simp,
--     have ige : h 0 ≤ i, from gt_of_gt_pred iht,
--     have jgt : h 0 < j, from lt_of_le_of_lt ige hw^.left,
--     have i - h 0 < j - h 0, from
--      or.elim (lt_or_eq_of_le ige)
--      (assume hl, sub_gt_of_gt hw^.left hl)
--      (assume hr, have 0 < j - h 0, from nat.sub_pos_of_lt jgt,
--       have i - h 0 = 0, begin rw hr, apply nat.sub_self end,
--       begin rw this, assumption end),
--       have is_good g o, from ⟨(i - h 0), ⟨(j - h 0),⟨this, Hr2⟩⟩⟩,
--      show _, from Hg this)))

-- new comb --
definition comb (n : ℕ) : Q := if n < h 0 then f n else g (n - h 0)

theorem g_part_of_comb (H : (h 0) = 0) : ∀ x, comb x = g x :=
λ n, have ¬ n < h 0, by rw H; apply not_lt_zero ,
have comb n = g (n - (h 0)), from if_neg this,
by simp [this, H]

include Hh

theorem badness_of_comb : ¬ is_good comb o :=
λ good, let ⟨i,j,hw⟩ := good in
by_cases
(assume Hposi : i < h 0,
  have eq1i : comb i = f i, from if_pos Hposi,
  by_cases
  (suppose j < h 0,
    have eq1j : comb j = f j, from if_pos this,
    have o (f i) (f j),by rw [-eq1j,-eq1i]; exact hw^.right,
    have is_good f o, from ⟨i, ⟨j,⟨hw^.left,this⟩⟩⟩,
    show _, from Hf this)
  (suppose ¬ j < h 0,
    have eq2j : comb j = g (j - (h 0)), from if_neg this,
    have o (f i) (g (j - (h 0))), by rw [-eq2j,-eq1i]; exact hw^.right,
    have Hr : o (f i) (f (h (j - (h 0)))), from H _ _ this,
    have i < h (j - (h 0)), from lt_of_lt_of_le Hposi (Hh _),
    have is_good f o, from ⟨i, ⟨h (j - h 0), ⟨this, Hr⟩⟩⟩,
    show _, from Hf this))
(assume Hnegi,
  have eq2i : comb i = g (i - h 0), from if_neg Hnegi,
  by_cases
  (suppose j < h 0,
    have j < i, from lt_of_lt_of_le this (le_of_not_gt Hnegi),
    show _, from (not_lt_of_gt hw^.left) this)
  (suppose ¬ j < h 0,
    have eq2j : comb j = g (j - h 0), from if_neg this,
    have Hr2 : o (g (i - h 0)) (g (j - h 0)), by rw [-eq2i,-eq2j]; exact hw^.right,
    have i - h 0 < j - h 0, from sub_gt_of_gt_ge hw^.left (le_of_not_gt Hnegi),
    have is_good g o, from ⟨(i - h 0), ⟨(j - h 0),⟨this, Hr2⟩⟩⟩,
    show _, from Hg this))

end

section
-- further assume that f is a minimal bad sequence and card (g 0) < card (f (h 0))
-- In other words, this section says, assuming that there is a bad sequence of Q, if g is a bad sequence such that H holds, then there is a contradiction.
parameter {Q :Type}
parameter {o : Q → Q → Prop}
parameters {g : ℕ → Q}
parameter h : ℕ → ℕ
parameter m : Q → ℕ -- a measure of cardinality
parameter Hh : ∀ i, h 0 ≤ h i
parameter Hex : ∃ f, ¬ is_good f o
parameter Hg : ¬ is_good g o
parameter H : ∀ i j, o (minimal_bad_seq m Hex i) (g (j - h 0)) → o (minimal_bad_seq m Hex i) ((minimal_bad_seq m Hex) (h (j - h 0)))
parameter Hbp : m (g 0) < m (minimal_bad_seq m Hex (h 0))

definition comb_seq_with_mbs := comb (minimal_bad_seq m Hex) g h

theorem g_part_of_comb_seq_with_mbs (H1 : (h 0) = 0) : ∀ x, comb_seq_with_mbs x = g x :=
begin apply g_part_of_comb, assumption end

theorem badness_of_comb_seq_with_mbs : ¬ is_good comb_seq_with_mbs o :=
badness_of_comb (minimal_bad_seq m Hex) g h Hh (badness_of_mbs m Hex) Hg H

-- theorem comb_seq_extends_mbs_at_pred_bp (H : h 0 ≠ 0): extends_at (pred (h 0)) (minimal_bad_seq m Hex) comb_seq_with_mbs :=
-- λ m Hm, if_pos ⟨H, Hm⟩

theorem lt_of_le_pred' {n m : ℕ} : n ≤ pred m →  n < m ∨ n = 0 :=
nat.rec_on m (λ h, or.elim (lt_or_eq_of_le h) (λ l, by super) (λ r, or.inr r))
(λ a ih h, or.inl (lt_succ_of_le h))

theorem lt_of_le_pred {n m : ℕ} : n ≤ pred m →  n < m ∨ m = 0 :=
nat.rec_on m (λ h, or.inr rfl) (λ a ih h, or.inl (lt_succ_of_le h))

theorem comb_seq_extends_mbs_at_pred_bp (H : h 0 ≠ 0): extends_at (pred (h 0)) (minimal_bad_seq m Hex) comb_seq_with_mbs :=
λ m Hm, if_pos (or_resolve_left (lt_of_le_pred Hm) H)

#check succ_le_succ

lemma comb_seq_h0 : comb_seq_with_mbs (h 0) = g 0 :=
have comb_seq_with_mbs (h 0) = g (h 0 - h 0), begin apply if_neg, rw lt_self_iff_false, trivial end,
by simp [this,nat.sub_self]
-- by_cases
-- (suppose h 0 = 0,
-- have comb_seq_with_mbs (h 0) = g (h 0), from g_part_of_comb_seq_with_mbs this (h 0),
-- by super)
-- (suppose h 0 ≠ 0,
-- have pred (h 0) < h 0, from lt_pred_nonzero_self this,
-- have ¬ h 0 ≤ pred (h 0), from not_le_of_gt this,
-- have ¬ ((h 0) ≠ 0 ∧ h 0 ≤ pred (h 0)), from not_and_of_not_right ((h 0) ≠ 0) this,
-- have comb_seq_with_mbs (h 0) = g (h 0 - h 0), from if_neg this,
-- by simp [this,nat.sub_self])

include Hbp Hex

theorem local_contra_of_comb_seq_with_mbs : false :=
by_cases
(suppose eq0 : h 0 = 0,
have eq : comb_seq_with_mbs 0 = g 0, begin apply g_part_of_comb_seq_with_mbs, assumption end,
have m (comb_seq_with_mbs 0) < m (minimal_bad_seq m Hex (h 0)), by rw -eq at Hbp;exact Hbp,
have le : m (comb_seq_with_mbs 0) < m (minimal_bad_seq m Hex 0), by super,
have m (minimal_bad_seq m Hex 0) ≤ m (comb_seq_with_mbs 0), from minimality_of_mbs_0 m Hex comb_seq_with_mbs badness_of_comb_seq_with_mbs,
(not_le_of_gt le) this)
(assume Hneg,
-- have le : m (minimal_bad_seq m Hex (succ (pred (h 0)))) ≤  m (comb_seq_with_mbs (succ (pred (h 0)))), begin apply minimality_of_mbs, split, end,
have le : m (minimal_bad_seq m Hex (succ (pred (h 0)))) ≤  m (comb_seq_with_mbs (succ (pred (h 0)))), from minimality_of_mbs m _ _ _ ⟨begin apply comb_seq_extends_mbs_at_pred_bp, exact Hneg end,badness_of_comb_seq_with_mbs⟩,
have h 0 > 0, from nat.pos_of_ne_zero Hneg,
have succ (pred (h 0)) = h 0, from succ_pred_of_pos this,
have m (minimal_bad_seq m Hex (h 0)) ≤ m (comb_seq_with_mbs (h 0)), by rw this at le;exact le,
have m (minimal_bad_seq m Hex (h 0)) ≤ m (g 0), by rw comb_seq_h0 at this;exact this,
have ¬ m (g 0) < m (minimal_bad_seq m Hex (h 0)), from not_lt_of_ge this,
this Hbp)

end

-- #check local_contra_of_comb_seq_with_mbs

section
parameter {Q : Type}
parameter [o : wqo Q]

definition sub := @star Q o.le

theorem sub_refl (q : finite_subsets Q) : sub q q :=
have ∀ a : Q, a ∈ q.1 → a ≤ (id a) ∧ id a ∈ q.1, begin intros, split, simp, apply quasiorder.refl, simp, assumption end,
⟨id, ⟨inj_from_to_id q.1,this⟩⟩

theorem sub_trans (a b c : finite_subsets Q) (H1 : sub a b) (H2 : sub b c) : sub a c :=
let ⟨f,hf⟩ := H1, ⟨g,hg⟩ := H2 in
have inj : inj_from_to (g ∘ f) a.1 c.1, from inj_from_to_compose hg^.left hf^.left,
have ∀ q : Q, q ∈ a.1 → q ≤ ((g ∘ f) q) ∧ (g ∘ f) q ∈ c.1, from
  λ q Hq,
  have le1 : q ≤ (f q), from (hf^.right q Hq)^.left,
  have fqin : f q ∈ b.1, from (hf^.right q Hq)^.right,
  have le2 : (f q) ≤ ((g ∘ f) q), from (hg^.right (f q) fqin)^.left,
  have qle : q ≤ ((g ∘ f) q), from quasiorder.trans le1 le2,
  have (g ∘ f) q ∈ c.1, from (hg^.right (f q) fqin)^.right,
  ⟨qle, this⟩,
⟨g ∘ f,⟨inj,this⟩⟩

parameter H : ∃ f : ℕ → finite_subsets Q, ¬ is_good f sub

definition card_of_finite_subsets {A : Type} (s : finite_subsets A) := card s.1

definition Higman's_mbs (n : ℕ) : finite_subsets Q := minimal_bad_seq card_of_finite_subsets H n

theorem badness_of_Higman's_mbs : ¬ is_good Higman's_mbs sub := badness_of_mbs card_of_finite_subsets H

theorem nonempty_mem_of_mbs (n : ℕ) : (Higman's_mbs n).1 ≠ ∅ :=
suppose (Higman's_mbs n).1 = ∅,
have lt : n < succ n, from lt_succ_self n,
have nond : ∀ a : Q, a ∈ (Higman's_mbs n).1 → a ≤ (id a) ∧ id a ∈ (Higman's_mbs (succ n)).1, from
  λ a, λ H, have a ∉ (∅ : set Q), from set.not_mem_empty a, by super,
have sub (Higman's_mbs n) (Higman's_mbs (succ n)),
from ⟨id, ⟨⟨λ a Ha,((nond a Ha)^.right),λ b Hb h1 h2 h3,by assumption⟩,nond⟩⟩,
have is_good Higman's_mbs sub, from ⟨n, ⟨succ n,⟨lt,this⟩⟩⟩,
badness_of_Higman's_mbs this

definition B_pairs (n : ℕ) : Q × finite_subsets Q :=
have ∃ a : Q, a ∈ (Higman's_mbs n).1, from exists_mem_of_ne_empty (nonempty_mem_of_mbs n),
let q := some this in
let b := (Higman's_mbs n).1 \ insert q ∅ in
have finite (Higman's_mbs n).1, from (Higman's_mbs n).2,
have finite b, from @finite_diff _ _ _ this,
(q, ⟨b,this⟩)

private definition B (n : ℕ) : finite_subsets Q := (B_pairs n).2

definition qn (n : ℕ) : Q := (B_pairs n).1

theorem qn_in_mbs (n : ℕ) : qn n ∈ (Higman's_mbs n).val :=
some_spec (exists_mem_of_ne_empty (nonempty_mem_of_mbs n))

theorem qn_not_in_Bn (n : ℕ) : ¬ set.mem (qn n) (B n).val :=
suppose qn n ∈ (B n).val, this^.right (mem_singleton (qn n))

theorem ins_B_pairs (n : ℕ) : insert (qn n) (B n).val = (Higman's_mbs n).val :=
have ∃ a : Q, a ∈ (Higman's_mbs n).val, from exists_mem_of_ne_empty (nonempty_mem_of_mbs n),
have qnin : qn n ∈ (Higman's_mbs n).val, from some_spec this,
have (B n).val = (Higman's_mbs n).val \ insert (qn n) ∅, from rfl,
begin apply subset.antisymm, intros x H1, apply or.elim H1,
intro h, simph, intro h1, rw this at h1, exact h1^.left,
intros x h2, cases (decidable.em (x = qn H n)) with H3 H4,
apply or.inl,exact H3,
apply or.inr, rw this,apply and.intro, exact h2,
apply not_mem_singleton, exact H4
end

theorem sub_B_mbs (n : ℕ) : (B n).val ⊆ (Higman's_mbs n).val :=
by intros; intro; rw -ins_B_pairs; apply or.inr; assumption

theorem trans_of_B (i j : ℕ) (H1 : sub (Higman's_mbs i) (B j)) : sub (Higman's_mbs i) (Higman's_mbs j) :=
let ⟨f,hf⟩ := H1 in
have inj_from_to f (Higman's_mbs i).val (B j).val, from and.left hf,
have Hl : ∀ a, a ∈ (Higman's_mbs i).val → f a ∈ (Higman's_mbs j).val, from
  λ a Ha, have f a ∈ (B j).val, from this^.left Ha,
  (sub_B_mbs j) this,
have inj : inj_from_to f (Higman's_mbs i).val (Higman's_mbs j).val, from ⟨Hl, hf^.left^.right⟩,
have non_descending (Higman's_mbs i) (Higman's_mbs j) o.le f, from
  λ a Ha, have Hl : a ≤ (f a), from (hf^.right a Ha)^.left,
  have f a ∈ (B j).val, from (hf^.right a Ha)^.right,
  have fain : f a ∈ insert (qn j) (B j).val, from or.inr this,
  have insert (qn j) (B j).val =  (Higman's_mbs j).val, from ins_B_pairs j,
  have f a ∈ (Higman's_mbs j).val, by rw this at fain;exact fain,
  ⟨Hl, this⟩,
⟨f, ⟨inj, this⟩⟩

section
parameter Hg : ∃ g : ℕ → ℕ, ¬ is_good (B ∘ g) sub ∧ ∀ i : ℕ, g 0 ≤ g i

private definition g := some Hg

theorem Higman's_Hg : ¬ is_good (B ∘ g) sub :=
let ⟨l,r⟩ := some_spec Hg in l

theorem Higman's_Hex : ∃ f, ¬ is_good f sub := ⟨(B ∘ g),Higman's_Hg⟩

theorem Higman's_Hh : ∀ i : ℕ, g 0 ≤ g i := (some_spec Hg)^.right

theorem Higman's_H : ∀ i j, sub (Higman's_mbs i) ((B ∘ g) (j - g 0)) → sub (Higman's_mbs i) (Higman's_mbs (g (j - g 0))) :=
λ i j, λ H1, trans_of_B i (g (j - g 0)) H1

definition Higman's_comb_seq (n : ℕ) : finite_subsets Q :=
@comb_seq_with_mbs _ sub (B ∘ g) g card_of_finite_subsets Higman's_Hex n

theorem card_B_lt_mbs (n : ℕ) : card (B n).val < card (Higman's_mbs n).val :=
have finite (B n).val, from (B n).2,
have eq : card (insert (qn n) (B n).val) = card (B n).val + 1, from @card_insert_of_not_mem _ _ _ this (qn_not_in_Bn n),
have card (B n).val < card (B n).val + 1, from lt_succ_self (card (B n).val),
have card (B n).val < card (insert (qn n) (B n).1), begin rw eq, exact this end,-- by simp,
have insert (qn n) ((B n).val) = (Higman's_mbs n).val, from ins_B_pairs n,
by super

theorem Higman's_Hbp : card_of_finite_subsets (B (g 0)) < card_of_finite_subsets (Higman's_mbs (g 0)) := card_B_lt_mbs (g 0)

theorem Higman's_local_contradition : false :=
local_contra_of_comb_seq_with_mbs g card_of_finite_subsets Higman's_Hh Higman's_Hex Higman's_Hg Higman's_H Higman's_Hbp

end

-- #check Higman's_local_contradition

definition ClassB : Type := {x : finite_subsets Q // ∃ i, B i = x}

definition oB (b1 : ClassB) (b2 : ClassB) : Prop := sub b1.val b2.val

theorem oB_refl (q : ClassB) : oB q q := sub_refl q.val

theorem oB_trans (a b c : ClassB) (H1 : oB a b) (H2 : oB b c) : oB a c :=
sub_trans _ _ _ H1 H2

    section
    -- Suppose there exists a bad sequence of objects in ClassB. We show that we can construct a g : ℕ → ℕ such that ¬ is_good (B ∘ g) o. Then we can apply 'exists_sub_bad'. We cannot directly apply this theorem because ClassB is a type distinct from finite_subsets Q.
    parameter HfB : ∃ f, ¬ is_good f oB

    private definition f' : ℕ → ClassB := some HfB

    private theorem bad_f' : ¬ is_good f' oB := some_spec HfB

    private definition g' (n : ℕ) := (f' n).val

    theorem exists_bad_B_seq : ¬ is_good g' sub :=
    suppose is_good g' sub,
    let ⟨i,j,hg'⟩ := this in
    have is_good f' oB, from ⟨i, ⟨j, ⟨hg'^.left, hg'^.right⟩⟩⟩,
    bad_f' this

    private definition g (n : ℕ) : ℕ :=
    have ∃ i, B i = g' n, from (f' n).2,
    some this

    private theorem comp_eq_g' : B ∘ g = g' :=
    have ∀ x, B (g x) = g' x, from λ x, some_spec (f' x).2,
    funext this

    private theorem bad_comp : ¬ is_good (B ∘ g) sub :=
    have ¬ is_good g' sub, from exists_bad_B_seq,
    by rw -comp_eq_g' at this;exact this

    theorem exists_sub_bad_B_seq : ∃ h : ℕ → ℕ, ¬ is_good (B ∘ h) sub ∧ ∀ i : ℕ, h 0 ≤ h i := exists_sub_bad B g sub bad_comp

    end

theorem oB_is_good : ∀ f, is_good f oB :=
by_contradiction
(suppose ¬ ∀ f, is_good f oB,
have ∃ f, ¬ is_good f oB, from classical.exists_not_of_not_forall this,
have ∃ h : ℕ → ℕ, ¬ is_good (B ∘ h) sub ∧ ∀ i : ℕ, h 0 ≤ h i, from exists_sub_bad_B_seq this,
Higman's_local_contradition this)

instance wqo_ClassB : wqo ClassB := wqo.mk (quasiorder.mk (has_le.mk oB) oB_refl oB_trans) oB_is_good

instance wqo_prod_Q_ClassB : wqo (Q × ClassB) := wqo_prod

theorem good_prod_Q_ClassB : ∀ f : ℕ → Q × ClassB, is_good f (prod_order o.le oB) := wqo.is_good

lemma B_refl (n : ℕ) : ∃ i, B i = B n := ⟨n, rfl⟩

definition fB (n : ℕ) : ClassB := ⟨B n,B_refl n⟩

private definition p (n : ℕ) : Q × ClassB := (qn n, fB n)

theorem good_p : is_good p (prod_order o.le oB) := good_prod_Q_ClassB p

theorem Hij : ∃ i j, i < j ∧ ((qn i) ≤ (qn j) ∧ oB (fB i) (fB j)) := good_p

theorem exists_embeds : ∃ i j, i < j ∧ sub (Higman's_mbs i) (Higman's_mbs j) :=
let ⟨i,j,hij⟩ := good_p in
have oB (fB i) (fB j), from hij^.right^.right,
let ⟨f₁,⟨injf₁,rhf1⟩⟩ := this in
let f₂ (q : Q) : Q := if q = qn i then qn j else f₁ q in
have nond : ∀ a : Q, a ∈ (Higman's_mbs i).val →  a ≤ (f₂ a) ∧ f₂ a ∈ (Higman's_mbs j).val, from λ a Ha,
  have Hor : a = qn i ∨ a ∈ (B i).val, by rw -(ins_B_pairs H i) at Ha;exact Ha,
  or.elim (em (a = qn i))
(λ l, have eqf₂a : f₂ a = qn j, from if_pos l, ⟨begin rw [eqf₂a,l], exact hij^.right^.left end, begin rw [eqf₂a], apply qn_in_mbs end⟩)
(λ r,have f₂ a=f₁ a, from if_neg r,
 have conj : a ≤ (f₂ a) ∧ f₂ a ∈ (B j).val, begin rw this, apply rhf1, super end,
⟨conj^.left,begin apply sub_B_mbs, exact conj^.right end⟩),
have Hmapsto : ∀ a, a ∈ (Higman's_mbs i).val → f₂ a ∈ (Higman's_mbs j).val, from
  λ a Ha, and.right (nond a Ha),
have ∀ a₁ a₂, a₁ ∈ (Higman's_mbs i).val → a₂ ∈ (Higman's_mbs i).val → f₂ a₁ = f₂ a₂ → a₁ = a₂, from
  λ a₁ a₂ Ha₁ Ha₂ Heq,
  have Hora₁ : a₁ = qn i ∨ a₁ ∈ (B i).val, by rw -(ins_B_pairs H i) at Ha₁;exact Ha₁,
  have Hora₂ : a₂ = qn i ∨ a₂ ∈ (B i).val, by rw -(ins_B_pairs H i) at Ha₂;exact Ha₂,
  by_cases
  (assume Hpos : a₁ = qn i, -- level-1 subcase // pos
   have eq21j : f₂ a₁ = qn j, from if_pos Hpos,
   by_contradiction
   (suppose a₁ ≠ a₂,
    have neq : qn i ≠ a₂, by rw Hpos at this;exact this,
    have eq2212 : f₂ a₂ = f₁ a₂, from if_neg (ne.symm neq),
    have qn j ∈ (B j).val, begin rw [-eq21j, Heq, eq2212], apply and.left injf₁,
    exact or_resolve_right Hora₂ (ne.symm neq) end,
    (qn_not_in_Bn j) this))
  (assume Hneg, -- level-1 subcase // neg
   have eq2111 : f₂ a₁ = f₁ a₁, from if_neg Hneg,
   have a1inBi :  a₁ ∈ (B i).val, from or_resolve_right Hora₁ Hneg,
   by_cases
     (assume Hposa₂ : a₂ = qn i, -- level-2 subcase // pos
      have eq21j : f₂ a₂ = qn j, from if_pos Hposa₂,
      by_contradiction
      (suppose a₁ ≠ a₂,
       have neq2 : a₁ ≠ qn i, by rw Hposa₂ at this;exact this,
       have eq2111 : f₂ a₁ = f₁ a₁, from if_neg neq2,
       have qn j ∈ (B j).val,
       begin rw [-eq21j, -Heq, eq2111], apply and.left injf₁,
       exact or_resolve_right Hora₁ neq2 end,
       (qn_not_in_Bn j) this))
     (assume Hnega₂, -- level-2 subcase // neg
      have eq2212 : f₂ a₂ = f₁ a₂, from if_neg Hnega₂,
      have f₁ a₁ = f₂ a₂, by rw eq2111 at Heq;exact Heq,
      have eq1112 : f₁ a₁ = f₁ a₂, from eq.trans this eq2212,
      have a₂ ∈ (B i).val, from or_resolve_right Hora₂ Hnega₂,
      (and.right injf₁) a1inBi this eq1112)),
have inj_from_to f₂ (Higman's_mbs i).val (Higman's_mbs j).val, from ⟨Hmapsto, this⟩,
have sub (Higman's_mbs i) (Higman's_mbs j), from ⟨f₂,⟨this, nond⟩⟩,
⟨i,⟨j, ⟨hij^.left, this⟩⟩⟩

theorem goodness_of_Higman's_mbs : is_good Higman's_mbs sub := exists_embeds

theorem Higman's_contradiction : false := badness_of_Higman's_mbs goodness_of_Higman's_mbs

end

-- #check Higman's_contradiction

variable {Q : Type}
variable [wqo Q]

theorem good_star : ∀ f : ℕ → finite_subsets Q , is_good f sub :=
by_contradiction
(suppose ¬ ∀ f, is_good f sub,
have ∃ f, ¬ is_good f sub, from classical.exists_not_of_not_forall this,
Higman's_contradiction this)

def wqo_finite_subsets : wqo (finite_subsets Q) :=
⟨⟨⟨sub⟩,sub_refl,sub_trans⟩,good_star⟩

#check wqo_finite_subsets.is_good
-- example : wqo.le (finite_subsets Q) _ = sub := rfl

-- #check wqo_finite_subsets

end kruskal


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

! This file was ported from Lean 3 source module analysis.special_functions.japanese_bracket
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Integrals
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.MeasureTheory.Integral.Layercake
import Mathbin.Tactic.Positivity

/-!
# Japanese Bracket

In this file, we show that Japanese bracket $(1 + \|x\|^2)^{1/2}$ can be estimated from above
and below by $1 + \|x\|$.
The functions $(1 + \|x\|^2)^{-r/2}$ and $(1 + |x|)^{-r}$ are integrable provided that `r` is larger
than the dimension.

## Main statements

* `integrable_one_add_norm`: the function $(1 + |x|)^{-r}$ is integrable
* `integrable_jap` the Japanese bracket is integrable

-/

noncomputable section

open BigOperators NNReal Filter Topology ENNReal

open Asymptotics Filter Set Real MeasureTheory FiniteDimensional

variable {E : Type _} [NormedAddCommGroup E]

theorem sqrt_one_add_norm_sq_le (x : E) : Real.sqrt (1 + ‖x‖ ^ 2) ≤ 1 + ‖x‖ :=
  by
  refine' le_of_pow_le_pow 2 (by positivity) two_pos _
  simp [sq_sqrt (zero_lt_one_add_norm_sq x).le, add_pow_two]
#align sqrt_one_add_norm_sq_le sqrt_one_add_norm_sq_le

theorem one_add_norm_le_sqrt_two_mul_sqrt (x : E) : 1 + ‖x‖ ≤ Real.sqrt 2 * sqrt (1 + ‖x‖ ^ 2) :=
  by
  suffices (sqrt 2 * sqrt (1 + ‖x‖ ^ 2)) ^ 2 - (1 + ‖x‖) ^ 2 = (1 - ‖x‖) ^ 2
    by
    refine' le_of_pow_le_pow 2 (by positivity) (by norm_num) _
    rw [← sub_nonneg, this]
    positivity
  rw [mul_pow, sq_sqrt (zero_lt_one_add_norm_sq x).le, add_pow_two, sub_pow_two]
  norm_num
  ring
#align one_add_norm_le_sqrt_two_mul_sqrt one_add_norm_le_sqrt_two_mul_sqrt

theorem rpow_neg_one_add_norm_sq_le {r : ℝ} (x : E) (hr : 0 < r) :
    (1 + ‖x‖ ^ 2) ^ (-r / 2) ≤ 2 ^ (r / 2) * (1 + ‖x‖) ^ (-r) :=
  by
  have h1 : 0 ≤ (2 : ℝ) := by positivity
  have h3 : 0 < sqrt 2 := by positivity
  have h4 : 0 < 1 + ‖x‖ := by positivity
  have h5 : 0 < sqrt (1 + ‖x‖ ^ 2) := by positivity
  have h6 : 0 < sqrt 2 * sqrt (1 + ‖x‖ ^ 2) := mul_pos h3 h5
  rw [rpow_div_two_eq_sqrt _ h1, rpow_div_two_eq_sqrt _ (zero_lt_one_add_norm_sq x).le, ←
    inv_mul_le_iff (rpow_pos_of_pos h3 _), rpow_neg h4.le, rpow_neg (sqrt_nonneg _), ← mul_inv, ←
    mul_rpow h3.le h5.le, inv_le_inv (rpow_pos_of_pos h6 _) (rpow_pos_of_pos h4 _),
    rpow_le_rpow_iff h4.le h6.le hr]
  exact one_add_norm_le_sqrt_two_mul_sqrt _
#align rpow_neg_one_add_norm_sq_le rpow_neg_one_add_norm_sq_le

theorem le_rpow_one_add_norm_iff_norm_le {r t : ℝ} (hr : 0 < r) (ht : 0 < t) (x : E) :
    t ≤ (1 + ‖x‖) ^ (-r) ↔ ‖x‖ ≤ t ^ (-r⁻¹) - 1 :=
  by
  rw [le_sub_iff_add_le', neg_inv]
  exact (Real.le_rpow_inv_iff_of_neg (by positivity) ht (neg_lt_zero.mpr hr)).symm
#align le_rpow_one_add_norm_iff_norm_le le_rpow_one_add_norm_iff_norm_le

variable (E)

theorem closedBall_rpow_sub_one_eq_empty_aux {r t : ℝ} (hr : 0 < r) (ht : 1 < t) :
    Metric.closedBall (0 : E) (t ^ (-r⁻¹) - 1) = ∅ :=
  by
  rw [Metric.closedBall_eq_empty, sub_neg]
  exact Real.rpow_lt_one_of_one_lt_of_neg ht (by simp only [hr, Right.neg_neg_iff, inv_pos])
#align closed_ball_rpow_sub_one_eq_empty_aux closedBall_rpow_sub_one_eq_empty_aux

variable [NormedSpace ℝ E] [FiniteDimensional ℝ E]

variable {E}

theorem finite_integral_rpow_sub_one_pow_aux {r : ℝ} (n : ℕ) (hnr : (n : ℝ) < r) :
    (∫⁻ x : ℝ in Ioc 0 1, ENNReal.ofReal ((x ^ (-r⁻¹) - 1) ^ n)) < ∞ :=
  by
  have hr : 0 < r := lt_of_le_of_lt n.cast_nonneg hnr
  have h_int :
    ∀ (x : ℝ) (hx : x ∈ Ioc (0 : ℝ) 1),
      ENNReal.ofReal ((x ^ (-r⁻¹) - 1) ^ n) ≤ ENNReal.ofReal (x ^ (-(r⁻¹ * n))) :=
    by
    intro x hx
    have hxr : 0 ≤ x ^ (-r⁻¹) := rpow_nonneg_of_nonneg hx.1.le _
    apply ENNReal.ofReal_le_ofReal
    rw [← neg_mul, rpow_mul hx.1.le, rpow_nat_cast]
    refine' pow_le_pow_of_le_left _ (by simp only [sub_le_self_iff, zero_le_one]) n
    rw [le_sub_iff_add_le', add_zero]
    refine' Real.one_le_rpow_of_pos_of_le_one_of_nonpos hx.1 hx.2 _
    rw [Right.neg_nonpos_iff, inv_nonneg]
    exact hr.le
  refine' lt_of_le_of_lt (set_lintegral_mono (by measurability) (by measurability) h_int) _
  refine' integrable_on.set_lintegral_lt_top _
  rw [← intervalIntegrable_iff_integrable_Ioc_of_le zero_le_one]
  apply intervalIntegral.intervalIntegrableRpow'
  rwa [neg_lt_neg_iff, inv_mul_lt_iff' hr, one_mul]
#align finite_integral_rpow_sub_one_pow_aux finite_integral_rpow_sub_one_pow_aux

theorem finite_integral_one_add_norm [MeasureSpace E] [BorelSpace E]
    [(@volume E _).IsAddHaarMeasure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
    (∫⁻ x : E, ENNReal.ofReal ((1 + ‖x‖) ^ (-r))) < ∞ :=
  by
  have hr : 0 < r := lt_of_le_of_lt (finrank ℝ E).cast_nonneg hnr
  -- We start by applying the layer cake formula
  have h_meas : Measurable fun ω : E => (1 + ‖ω‖) ^ (-r) := by measurability
  have h_pos : ∀ x : E, 0 ≤ (1 + ‖x‖) ^ (-r) :=
    by
    intro x
    positivity
  rw [lintegral_eq_lintegral_meas_le volume h_pos h_meas]
  -- We use the first transformation of the integrant to show that we only have to integrate from
  -- 0 to 1 and from 1 to ∞
  have h_int :
    ∀ (t : ℝ) (ht : t ∈ Ioi (0 : ℝ)),
      (volume { a : E | t ≤ (1 + ‖a‖) ^ (-r) } : ENNReal) =
        volume (Metric.closedBall (0 : E) (t ^ (-r⁻¹) - 1)) :=
    by
    intro t ht
    congr 1
    ext x
    simp only [mem_set_of_eq, mem_closedBall_zero_iff]
    exact le_rpow_one_add_norm_iff_norm_le hr (mem_Ioi.mp ht) x
  rw [set_lintegral_congr_fun measurableSet_Ioi (ae_of_all volume <| h_int)]
  have hIoi_eq : Ioi (0 : ℝ) = Ioc (0 : ℝ) 1 ∪ Ioi 1 := (Set.Ioc_union_Ioi_eq_Ioi zero_le_one).symm
  have hdisjoint : Disjoint (Ioc (0 : ℝ) 1) (Ioi 1) := by simp [disjoint_iff]
  rw [hIoi_eq, lintegral_union measurableSet_Ioi hdisjoint, ENNReal.add_lt_top]
  have h_int' :
    ∀ (t : ℝ) (ht : t ∈ Ioc (0 : ℝ) 1),
      (volume (Metric.closedBall (0 : E) (t ^ (-r⁻¹) - 1)) : ENNReal) =
        ENNReal.ofReal ((t ^ (-r⁻¹) - 1) ^ FiniteDimensional.finrank ℝ E) *
          volume (Metric.ball (0 : E) 1) :=
    by
    intro t ht
    refine' volume.add_haar_closed_ball (0 : E) _
    rw [le_sub_iff_add_le', add_zero]
    exact Real.one_le_rpow_of_pos_of_le_one_of_nonpos ht.1 ht.2 (by simp [hr.le])
  have h_meas' : Measurable fun a : ℝ => ENNReal.ofReal ((a ^ (-r⁻¹) - 1) ^ finrank ℝ E) := by
    measurability
  constructor
  -- The integral from 0 to 1:
  · rw [set_lintegral_congr_fun measurableSet_Ioc (ae_of_all volume <| h_int'),
      lintegral_mul_const _ h_meas', ENNReal.mul_lt_top_iff]
    left
    -- We calculate the integral
    exact ⟨finite_integral_rpow_sub_one_pow_aux (finrank ℝ E) hnr, measure_ball_lt_top⟩
  -- The integral from 1 to ∞ is zero:
  have h_int'' :
    ∀ (t : ℝ) (ht : t ∈ Ioi (1 : ℝ)),
      (volume (Metric.closedBall (0 : E) (t ^ (-r⁻¹) - 1)) : ENNReal) = 0 :=
    fun t ht => by rw [closedBall_rpow_sub_one_eq_empty_aux E hr ht, measure_empty]
  -- The integral over the constant zero function is finite:
  rw [set_lintegral_congr_fun measurableSet_Ioi (ae_of_all volume <| h_int''), lintegral_const 0,
    MulZeroClass.zero_mul]
  exact WithTop.zero_lt_top
#align finite_integral_one_add_norm finite_integral_one_add_norm

theorem integrableOneAddNorm [MeasureSpace E] [BorelSpace E] [(@volume E _).IsAddHaarMeasure]
    {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) : Integrable fun x : E => (1 + ‖x‖) ^ (-r) :=
  by
  refine' ⟨by measurability, _⟩
  -- Lower Lebesgue integral
  have : (∫⁻ a : E, ‖(1 + ‖a‖) ^ (-r)‖₊) = ∫⁻ a : E, ENNReal.ofReal ((1 + ‖a‖) ^ (-r)) :=
    lintegral_nnnorm_eq_of_nonneg fun _ => rpow_nonneg_of_nonneg (by positivity) _
  rw [has_finite_integral, this]
  exact finite_integral_one_add_norm hnr
#align integrable_one_add_norm integrableOneAddNorm

theorem integrableRpowNegOneAddNormSq [MeasureSpace E] [BorelSpace E]
    [(@volume E _).IsAddHaarMeasure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
    Integrable fun x : E => (1 + ‖x‖ ^ 2) ^ (-r / 2) :=
  by
  have hr : 0 < r := lt_of_le_of_lt (finrank ℝ E).cast_nonneg hnr
  refine'
    ((integrableOneAddNorm hnr).const_mul <| 2 ^ (r / 2)).mono (by measurability)
      (eventually_of_forall fun x => _)
  have h1 : 0 ≤ (1 + ‖x‖ ^ 2) ^ (-r / 2) := by positivity
  have h2 : 0 ≤ (1 + ‖x‖) ^ (-r) := by positivity
  have h3 : 0 ≤ (2 : ℝ) ^ (r / 2) := by positivity
  simp_rw [norm_mul, norm_eq_abs, abs_of_nonneg h1, abs_of_nonneg h2, abs_of_nonneg h3]
  exact rpow_neg_one_add_norm_sq_le _ hr
#align integrable_rpow_neg_one_add_norm_sq integrableRpowNegOneAddNormSq