/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro
-/
import Std.Tactic.Basic
import Std.Tactic.Lint.Misc

instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) :=
  inferInstanceAs <| DecidablePred fun x => p (f x)

/-! ## not -/

theorem Not.intro {a : Prop} (h : a → False) : ¬a := h

/-- Ex falso for negation. From `¬a` and `a` anything follows. This is the same as `absurd` with
the arguments flipped, but it is in the `not` namespace so that projection notation can be used. -/
def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1

theorem Not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2

theorem not_congr (h : a ↔ b) : ¬a ↔ ¬b := ⟨mt h.2, mt h.1⟩

theorem not_not_not : ¬¬¬a ↔ ¬a := ⟨mt not_not_intro, not_not_intro⟩

theorem not_not_of_not_imp : ¬(a → b) → ¬¬a := mt Not.elim

theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b := mt fun h _ => h

@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := ⟨fun h ha => h ha ha, fun h _ => h⟩

/-! ## iff -/

theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) := iff_iff_implies_and_implies ..

theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) := iff_def.trans And.comm

/-- Non-dependent eliminator for `Iff`. -/
def Iff.elim (f : (a → b) → (b → a) → α) (h : a ↔ b) : α := f h.1 h.2

theorem Eq.to_iff : a = b → (a ↔ b) | rfl => Iff.rfl

theorem iff_of_eq : a = b → (a ↔ b) := Eq.to_iff

theorem neq_of_not_iff : ¬(a ↔ b) → a ≠ b := mt Eq.to_iff

theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩

@[simp] theorem eq_iff_iff {p q : Prop} : (p = q) ↔ (p ↔ q) := iff_iff_eq.symm

theorem of_iff_true (h : a ↔ True) : a := h.2 ⟨⟩

theorem not_of_iff_false : (a ↔ False) → ¬a := Iff.mp

theorem iff_of_true (ha : a) (hb : b) : a ↔ b := ⟨fun _ => hb, fun _ => ha⟩

theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b := ⟨ha.elim, hb.elim⟩

theorem iff_true_left (ha : a) : (a ↔ b) ↔ b := ⟨fun h => h.1 ha, iff_of_true ha⟩

theorem iff_true_right (ha : a) : (b ↔ a) ↔ b := Iff.comm.trans (iff_true_left ha)

theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b := ⟨fun h => mt h.2 ha, iff_of_false ha⟩

theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_false_left ha)

theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h ⟨⟩

theorem iff_false_intro (h : ¬a) : a ↔ False := iff_of_false h id

theorem not_iff_false_intro (h : a) : ¬a ↔ False := iff_false_intro (not_not_intro h)

theorem iff_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ↔ b) ↔ (c ↔ d) :=
  ⟨fun h => h₁.symm.trans <| h.trans h₂, fun h => h₁.trans <| h.trans h₂.symm⟩

@[simp] theorem not_true : (¬True) ↔ False := iff_false_intro (not_not_intro ⟨⟩)

@[simp] theorem not_false_iff : (¬False) ↔ True := iff_true_intro not_false

theorem ne_self_iff_false (a : α) : a ≠ a ↔ False := not_iff_false_intro rfl

theorem eq_self_iff_true (a : α) : a = a ↔ True := iff_true_intro rfl

theorem heq_self_iff_true (a : α) : HEq a a ↔ True := iff_true_intro HEq.rfl

theorem iff_not_self : ¬(a ↔ ¬a) | H => let f h := H.1 h h; f (H.2 f)

@[simp] theorem not_iff_self : ¬(¬a ↔ a) | H => iff_not_self H.symm

theorem true_iff_false : (True ↔ False) ↔ False := iff_false_intro (fun h => h.1 ⟨⟩)

theorem false_iff_true : (False ↔ True) ↔ False := iff_false_intro (fun h => h.2 ⟨⟩)

theorem false_of_true_iff_false : (True ↔ False) → False := fun h => h.1 ⟨⟩

theorem false_of_true_eq_false : (True = False) → False := fun h => h ▸ trivial

theorem true_eq_false_of_false : False → (True = False) := False.elim

theorem eq_comm {a b : α} : a = b ↔ b = a := ⟨Eq.symm, Eq.symm⟩

/-! ## implies -/

@[nolint unusedArguments]
theorem imp_intro {α β : Prop} (h : α) : β → α := fun _ => h

theorem imp_imp_imp {a b c d : Prop} (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) := (h₁ ∘ · ∘ h₀)

theorem imp_iff_right {a : Prop} (ha : a) : (a → b) ↔ b := ⟨fun f => f ha, imp_intro⟩

-- This is not marked `@[simp]` because we have `implies_true : (α → True) = True` in core.
theorem imp_true_iff (α : Sort u) : (α → True) ↔ True := iff_true_intro fun _ => trivial

theorem false_imp_iff (a : Prop) : (False → a) ↔ True := iff_true_intro False.elim

theorem true_imp_iff (α : Prop) : (True → α) ↔ α := ⟨fun h => h trivial, fun h _ => h⟩

@[simp] theorem imp_self : (a → a) ↔ True := iff_true_intro id

theorem imp_false : (a → False) ↔ ¬a := Iff.rfl

theorem imp.swap : (a → b → c) ↔ (b → a → c) := ⟨flip, flip⟩

theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) := imp.swap

theorem imp_congr_left (h : a ↔ b) : (a → c) ↔ (b → c) :=
  ⟨fun hac ha => hac (h.2 ha), fun hbc ha => hbc (h.1 ha)⟩

theorem imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) :=
  ⟨fun hab ha => (h ha).1 (hab ha), fun hcd ha => (h ha).2 (hcd ha)⟩

theorem imp_congr_ctx (h₁ : a ↔ c) (h₂ : c → (b ↔ d)) : (a → b) ↔ (c → d) :=
  (imp_congr_left h₁).trans (imp_congr_right h₂)

theorem imp_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a → b) ↔ (c → d) := imp_congr_ctx h₁ fun _ => h₂

theorem imp_iff_not (hb : ¬b) : a → b ↔ ¬a := imp_congr_right fun _ => iff_false_intro hb

/-! ## and -/

/-- Non-dependent eliminator for `And`. -/
abbrev And.elim (f : a → b → α) (h : a ∧ b) : α := f h.1 h.2

theorem And.symm : a ∧ b → b ∧ a | ⟨ha, hb⟩ => ⟨hb, ha⟩

theorem And.imp (f : a → c) (g : b → d) (h : a ∧ b) : c ∧ d := ⟨f h.1, g h.2⟩

theorem And.imp_left (h : a → b) : a ∧ c → b ∧ c := .imp h id

theorem And.imp_right (h : a → b) : c ∧ a → c ∧ b := .imp id h

theorem and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : a ∧ b ↔ c ∧ d :=
  ⟨And.imp h₁.1 h₂.1, And.imp h₁.2 h₂.2⟩

theorem and_comm : a ∧ b ↔ b ∧ a := And.comm

theorem and_congr_right (h : a → (b ↔ c)) : a ∧ b ↔ a ∧ c :=
⟨fun ⟨ha, hb⟩ => ⟨ha, (h ha).1 hb⟩, fun ⟨ha, hb⟩ => ⟨ha, (h ha).2 hb⟩⟩

theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c :=
  and_comm.trans <| (and_congr_right h).trans and_comm

theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := and_congr h .rfl

theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := and_congr .rfl h

theorem and_congr_right_eq (h : a → b = c) : (a ∧ b) = (a ∧ c) :=
  propext <| and_congr_right fun hc => h hc ▸ .rfl

theorem and_congr_left_eq (h : c → a = b) : (a ∧ c) = (b ∧ c) :=
  propext <| and_congr_left fun hc => h hc ▸ .rfl

theorem and_assoc : (a ∧ b) ∧ c ↔ a ∧ (b ∧ c) :=
  ⟨fun ⟨⟨ha, hb⟩, hc⟩ => ⟨ha, hb, hc⟩, fun ⟨ha, hb, hc⟩ => ⟨⟨ha, hb⟩, hc⟩⟩

theorem and_left_comm : a ∧ (b ∧ c) ↔ b ∧ (a ∧ c) := by
  rw [← and_assoc, ← and_assoc, @and_comm a b]

theorem and_right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b := by
  simp only [and_left_comm, and_comm]

theorem and_rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a := by
  simp only [and_left_comm, and_comm]

theorem and_and_and_comm : (a ∧ b) ∧ c ∧ d ↔ (a ∧ c) ∧ b ∧ d := by
  rw [← and_assoc, @and_right_comm a, and_assoc]

theorem and_and_left : a ∧ b ∧ c ↔ (a ∧ b) ∧ a ∧ c := by
  rw [and_and_and_comm, and_self]

theorem and_and_right : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b ∧ c := by
  rw [and_and_and_comm, and_self]

theorem and_iff_left_of_imp (h : a → b) : (a ∧ b) ↔ a :=
  ⟨And.left, fun ha => ⟨ha, h ha⟩⟩

theorem and_iff_right_of_imp (h : b → a) : (a ∧ b) ↔ b :=
  ⟨And.right, fun hb => ⟨h hb, hb⟩⟩

theorem and_iff_left (hb : b) : a ∧ b ↔ a := and_iff_left_of_imp fun _ => hb

theorem and_iff_right (ha : a) : a ∧ b ↔ b := and_iff_right_of_imp fun _ => ha

@[simp] theorem and_iff_left_iff_imp : ((a ∧ b) ↔ a) ↔ (a → b) :=
  ⟨fun h ha => (h.2 ha).2, and_iff_left_of_imp⟩

@[simp] theorem and_iff_right_iff_imp : ((a ∧ b) ↔ b) ↔ (b → a) :=
  ⟨fun h ha => (h.2 ha).1, and_iff_right_of_imp⟩

@[simp] theorem iff_self_and : (p ↔ p ∧ q) ↔ (p → q) := by
  rw [@Iff.comm p, and_iff_left_iff_imp]

@[simp] theorem iff_and_self : (p ↔ q ∧ p) ↔ (p → q) := by rw [and_comm, iff_self_and]

@[simp] theorem and_congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) :=
  ⟨fun h ha => by simp [ha] at h; exact h, and_congr_right⟩

@[simp] theorem and_congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) := by
  simp only [and_comm, ← and_congr_right_iff]

@[simp] theorem and_self_left : a ∧ a ∧ b ↔ a ∧ b :=
  ⟨fun h => ⟨h.1, h.2.2⟩, fun h => ⟨h.1, h.1, h.2⟩⟩

@[simp] theorem and_self_right : (a ∧ b) ∧ b ↔ a ∧ b :=
  ⟨fun h => ⟨h.1.1, h.2⟩, fun h => ⟨⟨h.1, h.2⟩, h.2⟩⟩

theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) := mt And.left

theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) := mt And.right

@[simp] theorem and_not_self : ¬(a ∧ ¬a) | ⟨ha, hn⟩ => hn ha

@[simp] theorem not_and_self : ¬(¬a ∧ a) | ⟨hn, ha⟩ => hn ha

theorem and_not_self_iff (a : Prop) : a ∧ ¬a ↔ False := iff_false_intro and_not_self

theorem not_and_self_iff (a : Prop) : ¬a ∧ a ↔ False := iff_false_intro not_and_self

/-! ## or -/

theorem not_not_em (a : Prop) : ¬¬(a ∨ ¬a) := fun h => h (.inr (h ∘ .inl))

theorem Or.symm : a ∨ b → b ∨ a := .rec .inr .inl

theorem Or.imp (f : a → c) (g : b → d) (h : a ∨ b) : c ∨ d := h.elim (inl ∘ f) (inr ∘ g)

theorem Or.imp_left (f : a → b) : a ∨ c → b ∨ c := .imp f id

theorem Or.imp_right (f : b → c) : a ∨ b → a ∨ c := .imp id f

theorem or_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∨ b) ↔ (c ∨ d) := ⟨.imp h₁.1 h₂.1, .imp h₁.2 h₂.2⟩

theorem or_congr_left (h : a ↔ b) : a ∨ c ↔ b ∨ c := or_congr h .rfl

theorem or_congr_right (h : b ↔ c) : a ∨ b ↔ a ∨ c := or_congr .rfl h

theorem Or.comm : a ∨ b ↔ b ∨ a := ⟨Or.symm, Or.symm⟩

theorem or_comm : a ∨ b ↔ b ∨ a := Or.comm

theorem or_assoc : (a ∨ b) ∨ c ↔ a ∨ (b ∨ c) :=
  ⟨.rec (.imp_right .inl) (.inr ∘ .inr), .rec (.inl ∘ .inl) (.imp_left .inr)⟩

theorem Or.resolve_left {a b : Prop} (h: a ∨ b) (na : ¬a) : b := h.elim (absurd · na) id

theorem Or.neg_resolve_left (h : ¬a ∨ b) (ha : a) : b := h.elim (absurd ha) id

theorem Or.resolve_right {a b : Prop} (h: a ∨ b) (nb : ¬b) : a := h.elim id (absurd · nb)

theorem Or.neg_resolve_right (h : a ∨ ¬b) (nb : b) : a := h.elim id (absurd nb)

theorem or_left_comm : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) := by rw [← or_assoc, ← or_assoc, @or_comm a b]

theorem or_right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, @or_comm b]

theorem or_or_or_comm : (a ∨ b) ∨ c ∨ d ↔ (a ∨ c) ∨ b ∨ d := by
  rw [← or_assoc, @or_right_comm a, or_assoc]

theorem or_or_distrib_left : a ∨ b ∨ c ↔ (a ∨ b) ∨ a ∨ c := by rw [or_or_or_comm, or_self]

theorem or_or_distrib_right : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b ∨ c := by rw [or_or_or_comm, or_self]

theorem or_rotate : a ∨ b ∨ c ↔ b ∨ c ∨ a := by simp only [or_left_comm, Or.comm]

theorem or_iff_right_of_imp (ha : a → b) : (a ∨ b) ↔ b := ⟨Or.rec ha id, .inr⟩

theorem or_iff_left_of_imp (hb : b → a) : (a ∨ b) ↔ a := ⟨Or.rec id hb, .inl⟩

theorem not_or_intro {a b : Prop} (ha : ¬a) (hb : ¬b) : ¬(a ∨ b) := (·.elim ha hb)

@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) :=
  ⟨fun h hb => h.1 (Or.inr hb), or_iff_left_of_imp⟩

@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) := by
  rw [or_comm, or_iff_left_iff_imp]

theorem or_iff_left (hb : ¬b) : a ∨ b ↔ a := or_iff_left_iff_imp.2 hb.elim

theorem or_iff_right (ha : ¬a) : a ∨ b ↔ b := or_iff_right_iff_imp.2 ha.elim

/-! ## distributivity -/

theorem not_imp_of_and_not : a ∧ ¬b → ¬(a → b)
  | ⟨ha, hb⟩, h => hb <| h ha

theorem imp_and {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
  ⟨fun h => ⟨fun ha => (h ha).1, fun ha => (h ha).2⟩, fun h ha => ⟨h.1 ha, h.2 ha⟩⟩

@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
  ⟨fun h ha hb => h ⟨ha, hb⟩, fun h ⟨ha, hb⟩ => h ha hb⟩

@[simp] theorem not_and : ¬(a ∧ b) ↔ (a → ¬b) := and_imp

theorem not_and' : ¬(a ∧ b) ↔ b → ¬a := not_and.trans imp_not_comm

/-- `∧` distributes over `∨` (on the left). -/
theorem and_or_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
  ⟨fun ⟨ha, hbc⟩ => hbc.imp (.intro ha) (.intro ha), Or.rec (.imp_right .inl) (.imp_right .inr)⟩

/-- `∧` distributes over `∨` (on the right). -/
theorem or_and_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) := by
  simp [and_comm, and_or_left]

/-- `∨` distributes over `∧` (on the left). -/
theorem or_and_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
  ⟨Or.rec (fun ha => ⟨.inl ha, .inl ha⟩) (.imp .inr .inr),
   And.rec <| .rec (fun _ => .inl ·) (.imp_right ∘ .intro)⟩

/-- `∨` distributes over `∧` (on the right). -/
theorem and_or_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) := by
  simp [or_comm, or_and_left]

theorem or_imp : (a ∨ b → c) ↔ (a → c) ∧ (b → c) :=
  ⟨fun h => ⟨h ∘ .inl, h ∘ .inr⟩, fun ⟨ha, hb⟩ => Or.rec ha hb⟩

theorem not_or : ¬(p ∨ q) ↔ ¬p ∧ ¬q := or_imp

theorem not_and_of_not_or_not (h : ¬a ∨ ¬b) : ¬(a ∧ b) := h.elim (mt (·.1)) (mt (·.2))

@[simp] theorem or_self_left : a ∨ a ∨ b ↔ a ∨ b := ⟨.rec .inl id, .rec .inl (.inr ∘ .inr)⟩

@[simp] theorem or_self_right : (a ∨ b) ∨ b ↔ a ∨ b := ⟨.rec id .inr, .rec (.inl ∘ .inl) .inr⟩

/-! ## exists and forall -/

section quantifiers
variable {p q : α → Prop} {b : Prop}

theorem forall_imp (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a :=
fun h' a => h a (h' a)

@[simp] theorem forall_exists_index {q : (∃ x, p x) → Prop} :
    (∀ h, q h) ↔ ∀ x (h : p x), q ⟨x, h⟩ :=
  ⟨fun h x hpx => h ⟨x, hpx⟩, fun h ⟨x, hpx⟩ => h x hpx⟩

theorem Exists.imp (h : ∀ a, p a → q a) : (∃ a, p a) → ∃ a, q a
  | ⟨a, hp⟩ => ⟨a, h a hp⟩

theorem Exists.imp' {β} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a)) :
    (∃ a, p a) → ∃ b, q b
  | ⟨_, hp⟩ => ⟨_, hpq _ hp⟩

theorem exists_imp : ((∃ x, p x) → b) ↔ ∀ x, p x → b := forall_exists_index

section forall_congr

-- Port note: this is `forall_congr` from Lean 3. In Lean 4, there is already something
-- with that name and a slightly different type.
theorem forall_congr' (h : ∀ a, p a ↔ q a) : (∀ a, p a) ↔ ∀ a, q a :=
  ⟨fun H a => (h a).1 (H a), fun H a => (h a).2 (H a)⟩

theorem exists_congr (h : ∀ a, p a ↔ q a) : (∃ a, p a) ↔ ∃ a, q a :=
  ⟨Exists.imp fun x => (h x).1, Exists.imp fun x => (h x).2⟩

variable {β : α → Sort _}
theorem forall₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
    (∀ a b, p a b) ↔ ∀ a b, q a b :=
  forall_congr' fun a => forall_congr' <| h a

theorem exists₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
    (∃ a b, p a b) ↔ ∃ a b, q a b :=
  exists_congr fun a => exists_congr <| h a

variable {γ : ∀ a, β a → Sort _}
theorem forall₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
    (∀ a b c, p a b c) ↔ ∀ a b c, q a b c :=
  forall_congr' fun a => forall₂_congr <| h a

theorem exists₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
    (∃ a b c, p a b c) ↔ ∃ a b c, q a b c :=
  exists_congr fun a => exists₂_congr <| h a

variable {δ : ∀ a b, γ a b → Sort _}
theorem forall₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
    (∀ a b c d, p a b c d) ↔ ∀ a b c d, q a b c d :=
  forall_congr' fun a => forall₃_congr <| h a

theorem exists₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
    (∃ a b c d, p a b c d) ↔ ∃ a b c d, q a b c d :=
  exists_congr fun a => exists₃_congr <| h a

variable {ε : ∀ a b c, δ a b c → Sort _}
theorem forall₅_congr {p q : ∀ a b c d, ε a b c d → Prop}
    (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
    (∀ a b c d e, p a b c d e) ↔ ∀ a b c d e, q a b c d e :=
  forall_congr' fun a => forall₄_congr <| h a

theorem exists₅_congr {p q : ∀ a b c d, ε a b c d → Prop}
    (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
    (∃ a b c d e, p a b c d e) ↔ ∃ a b c d e, q a b c d e :=
  exists_congr fun a => exists₄_congr <| h a

end forall_congr

@[simp] theorem not_exists : (¬∃ x, p x) ↔ ∀ x, ¬p x := exists_imp

theorem forall_not_of_not_exists (hne : ¬∃ x, p x) (x) : ¬p x | hp => hne ⟨x, hp⟩

theorem forall_and : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  ⟨fun h => ⟨fun x => (h x).1, fun x => (h x).2⟩, fun ⟨h₁, h₂⟩ x => ⟨h₁ x, h₂ x⟩⟩

theorem exists_or : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ ∃ x, q x :=
  ⟨fun | ⟨x, .inl h⟩ => .inl ⟨x, h⟩ | ⟨x, .inr h⟩ => .inr ⟨x, h⟩,
   fun | .inl ⟨x, h⟩ => ⟨x, .inl h⟩ | .inr ⟨x, h⟩ => ⟨x, .inr h⟩⟩

@[simp] theorem exists_false : ¬(∃ _a : α, False) := fun ⟨_, h⟩ => h

@[simp] theorem forall_const (α : Sort _) [i : Nonempty α] : (α → b) ↔ b :=
  ⟨i.elim, fun hb _ => hb⟩

theorem Exists.nonempty : (∃ x, p x) → Nonempty α | ⟨x, _⟩ => ⟨x⟩

/-- Extract an element from a existential statement, using `Classical.choose`. -/
-- This enables projection notation.
@[reducible] noncomputable def Exists.choose (P : ∃ a, p a) : α := Classical.choose P

/-- Show that an element extracted from `P : ∃ a, p a` using `P.choose` satisfies `p`. -/
theorem Exists.choose_spec {p : α → Prop} (P : ∃ a, p a) : p P.choose := Classical.choose_spec P

theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x, p x
  | ⟨x, hn⟩, h => hn (h x)

@[simp] theorem forall_eq {p : α → Prop} {a' : α} : (∀ a, a = a' → p a) ↔ p a' :=
  ⟨fun h => h a' rfl, fun h _ e => e.symm ▸ h⟩

@[simp] theorem forall_eq' {a' : α} : (∀ a, a' = a → p a) ↔ p a' := by simp [@eq_comm _ a']

@[simp] theorem exists_eq : ∃ a, a = a' := ⟨_, rfl⟩

@[simp] theorem exists_eq' : ∃ a, a' = a := ⟨_, rfl⟩

@[simp] theorem exists_eq_left : (∃ a, a = a' ∧ p a) ↔ p a' :=
  ⟨fun ⟨_, e, h⟩ => e ▸ h, fun h => ⟨_, rfl, h⟩⟩

@[simp] theorem exists_eq_right : (∃ a, p a ∧ a = a') ↔ p a' :=
  (exists_congr <| by exact fun a => And.comm).trans exists_eq_left

@[simp] theorem exists_and_left : (∃ x, b ∧ p x) ↔ b ∧ (∃ x, p x) :=
  ⟨fun ⟨x, h, hp⟩ => ⟨h, x, hp⟩, fun ⟨h, x, hp⟩ => ⟨x, h, hp⟩⟩

@[simp] theorem exists_and_right : (∃ x, p x ∧ b) ↔ (∃ x, p x) ∧ b := by simp [And.comm]

@[simp] theorem exists_eq_left' : (∃ a, a' = a ∧ p a) ↔ p a' := by simp [@eq_comm _ a']

-- this theorem is needed to simplify the output of `list.mem_cons_iff`
@[simp] theorem forall_eq_or_imp : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a := by
  simp only [or_imp, forall_and, forall_eq]

@[simp] theorem exists_eq_or_imp : (∃ a, (a = a' ∨ q a) ∧ p a) ↔ p a' ∨ ∃ a, q a ∧ p a := by
  simp only [or_and_right, exists_or, exists_eq_left]

@[simp] theorem exists_eq_right_right : (∃ (a : α), p a ∧ b ∧ a = a') ↔ p a' ∧ b := by
  simp [← and_assoc]

@[simp] theorem exists_eq_right_right' : (∃ (a : α), p a ∧ b ∧ a' = a) ↔ p a' ∧ b := by
  (conv in _=_ => rw [eq_comm]); simp

@[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b :=
  ⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩

@[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩

theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=
  @forall_const (q h) p ⟨h⟩

end quantifiers

/-! ## decidable -/

theorem Decidable.not_not [Decidable p] : ¬¬p ↔ p := ⟨of_not_not, not_not_intro⟩

/-- Construct a non-Prop by cases on an `Or`, when the left conjunct is decidable. -/
protected def Or.by_cases [Decidable p] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α :=
  if hp : p then h₁ hp else h₂ (h.resolve_left hp)

/-- Construct a non-Prop by cases on an `Or`, when the right conjunct is decidable. -/
protected def Or.by_cases' [Decidable q] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α :=
  if hq : q then h₂ hq else h₁ (h.resolve_right hq)

instance exists_prop_decidable {p} (P : p → Prop)
  [Decidable p] [∀ h, Decidable (P h)] : Decidable (∃ h, P h) :=
if h : p then
  decidable_of_decidable_of_iff ⟨fun h2 => ⟨h, h2⟩, fun ⟨_, h2⟩ => h2⟩
else isFalse fun ⟨h', _⟩ => h h'

instance forall_prop_decidable {p} (P : p → Prop)
  [Decidable p] [∀ h, Decidable (P h)] : Decidable (∀ h, P h) :=
if h : p then
  decidable_of_decidable_of_iff ⟨fun h2 _ => h2, fun al => al h⟩
else isTrue fun h2 => absurd h2 h

theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) ↔ p := by simp

@[simp] theorem decide_eq_false_iff_not (p : Prop) [Decidable p] : (decide p = false) ↔ ¬p :=
  ⟨of_decide_eq_false, decide_eq_false⟩

@[simp] theorem decide_eq_decide {p q : Prop} [Decidable p] [Decidable q] :
    decide p = decide q ↔ (p ↔ q) :=
  ⟨fun h => by rw [← decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]⟩

theorem Decidable.of_not_imp [Decidable a] (h : ¬(a → b)) : a :=
  byContradiction (not_not_of_not_imp h)

theorem Decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a :=
  byContradiction <| hb ∘ h

theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) :=
  ⟨not_imp_symm, not_imp_symm⟩

theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by
  have := @imp_not_self (¬a); rwa [not_not] at this

theorem Decidable.or_iff_not_imp_left [Decidable a] : a ∨ b ↔ (¬a → b) :=
  ⟨Or.resolve_left, fun h => dite _ .inl (.inr ∘ h)⟩

theorem Decidable.or_iff_not_imp_right [Decidable b] : a ∨ b ↔ (¬b → a) :=
or_comm.trans or_iff_not_imp_left

theorem Decidable.not_imp_not [Decidable a] : (¬a → ¬b) ↔ (b → a) :=
⟨fun h hb => byContradiction (h · hb), mt⟩

theorem Decidable.not_or_of_imp [Decidable a] (h : a → b) : ¬a ∨ b :=
  if ha : a then .inr (h ha) else .inl ha

theorem Decidable.imp_iff_not_or [Decidable a] : (a → b) ↔ (¬a ∨ b) :=
  ⟨not_or_of_imp, Or.neg_resolve_left⟩

theorem Decidable.imp_iff_or_not [Decidable b] : b → a ↔ a ∨ ¬b :=
  Decidable.imp_iff_not_or.trans or_comm

theorem Decidable.imp_or [Decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := by
  by_cases a <;> simp_all

theorem Decidable.imp_or' [Decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
  if h : b then by simp [h] else by
    rw [eq_false h, false_or]; exact (or_iff_right_of_imp fun hx x => (hx x).elim).symm

theorem Decidable.not_imp [Decidable a] : ¬(a → b) ↔ a ∧ ¬b :=
  ⟨fun h => ⟨of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩

theorem Decidable.peirce (a b : Prop) [Decidable a] : ((a → b) → a) → a :=
  if ha : a then fun _ => ha else fun h => h ha.elim

theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id

theorem Decidable.not_iff_not [Decidable a] [Decidable b] : (¬a ↔ ¬b) ↔ (a ↔ b) := by
  rw [@iff_def (¬a), @iff_def' a]; exact and_congr not_imp_not not_imp_not

theorem Decidable.not_iff_comm [Decidable a] [Decidable b] : (¬a ↔ b) ↔ (¬b ↔ a) := by
  rw [@iff_def (¬a), @iff_def (¬b)]; exact and_congr not_imp_comm imp_not_comm

theorem Decidable.not_iff [Decidable b] : ¬(a ↔ b) ↔ (¬a ↔ b) := by
  by_cases h : b <;> simp [h, iff_true, iff_false]

theorem Decidable.iff_not_comm [Decidable a] [Decidable b] : (a ↔ ¬b) ↔ (b ↔ ¬a) := by
  rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm

theorem Decidable.iff_iff_and_or_not_and_not [Decidable b] : (a ↔ b) ↔ (a ∧ b) ∨ (¬a ∧ ¬b) :=
  ⟨fun e => if h : b then .inl ⟨e.2 h, h⟩ else .inr ⟨mt e.1 h, h⟩,
   Or.rec (And.rec iff_of_true) (And.rec iff_of_false)⟩

theorem Decidable.iff_iff_not_or_and_or_not [Decidable a] [Decidable b] :
    (a ↔ b) ↔ (¬a ∨ b) ∧ (a ∨ ¬b) := by
  rw [iff_iff_implies_and_implies a b]; simp only [imp_iff_not_or, Or.comm]

theorem Decidable.not_and_not_right [Decidable b] : ¬(a ∧ ¬b) ↔ (a → b) :=
  ⟨fun h ha => not_imp_symm (And.intro ha) h, fun h ⟨ha, hb⟩ => hb <| h ha⟩

theorem Decidable.not_and [Decidable a] : ¬(a ∧ b) ↔ ¬a ∨ ¬b :=
  ⟨fun h => if ha : a then .inr (h ⟨ha, ·⟩) else .inl ha, not_and_of_not_or_not⟩

theorem Decidable.not_and' [Decidable b] : ¬(a ∧ b) ↔ ¬a ∨ ¬b :=
  ⟨fun h => if hb : b then .inl (h ⟨·, hb⟩) else .inr hb, not_and_of_not_or_not⟩

theorem Decidable.or_iff_not_and_not [Decidable a] [Decidable b] : a ∨ b ↔ ¬(¬a ∧ ¬b) := by
  rw [← not_or, not_not]

theorem Decidable.and_iff_not_or_not [Decidable a] [Decidable b] : a ∧ b ↔ ¬(¬a ∨ ¬b) := by
  rw [← not_and, not_not]

theorem Decidable.imp_iff_right_iff [Decidable a] : (a → b ↔ b) ↔ a ∨ b :=
  ⟨fun H => (Decidable.em a).imp_right fun ha' => H.1 fun ha => (ha' ha).elim,
   fun H => H.elim imp_iff_right fun hb => iff_of_true (fun _ => hb) hb⟩

theorem Decidable.and_or_imp [Decidable a] : a ∧ b ∨ (a → c) ↔ a → b ∨ c :=
  if ha : a then by simp only [ha, true_and, true_imp_iff]
  else by simp only [ha, false_or, false_and, false_imp_iff]

theorem Decidable.or_congr_left' [Decidable c] (h : ¬c → (a ↔ b)) : a ∨ c ↔ b ∨ c := by
  rw [or_iff_not_imp_right, or_iff_not_imp_right]; exact imp_congr_right h

theorem Decidable.or_congr_right' [Decidable a] (h : ¬a → (b ↔ c)) : a ∨ b ↔ a ∨ c := by
  rw [or_iff_not_imp_left, or_iff_not_imp_left]; exact imp_congr_right h

/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent.
**Important**: this function should be used instead of `rw` on `decidable b`, because the
kernel will get stuck reducing the usage of `propext` otherwise,
and `dec_trivial` will not work. -/
@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [Decidable a] : Decidable b :=
  decidable_of_decidable_of_iff h

/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent.
This is the same as `decidable_of_iff` but the iff is flipped. -/
@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [Decidable b] : Decidable a :=
  decidable_of_decidable_of_iff h.symm

instance Decidable.predToBool (p : α → Prop) [DecidablePred p] :
    CoeDep (α → Prop) p (α → Bool) := ⟨fun b => decide <| p b⟩

theorem Bool.ff_ne_tt : false ≠ true := fun.

/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`.
(This is sometimes taken as an alternate definition of decidability.) -/
def decidable_of_bool : ∀ (b : Bool), (b ↔ a) → Decidable a
  | true, h => isTrue (h.1 rfl)
  | false, h => isFalse (mt h.2 Bool.ff_ne_tt)

/-! ## classical logic -/

namespace Classical

/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`.
The left-to-right direction, double negation elimination (DNE),
is classically true but not constructively. -/
@[scoped simp] theorem not_not : ¬¬a ↔ a := Decidable.not_not

end Classical

/-! ## equality -/

theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩

theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : HEq hp hq := by
  cases propext (iff_of_true hp hq); rfl

@[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') :
    (@Eq.rec α a (fun α _ => β) y a' h) = y := by cases h; rfl

theorem congrArg₂ (f : α → β → γ) {x x' : α} {y y' : β}
    (hx : x = x') (hy : y = y') : f x y = f x' y' := by subst hx hy; rfl

/-! ## membership -/

section Mem
variable [Membership α β] {s t : β} {a b : α}

theorem ne_of_mem_of_not_mem (h : a ∈ s) : b ∉ s → a ≠ b := mt fun e => e ▸ h

theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => e ▸ h

end Mem

/-! ## if-then-else -/

@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial

@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id

theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl

/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/
theorem apply_dite (f : α → β) (P : Prop) [Decidable P] (x : P → α) (y : ¬P → α) :
    f (dite P x y) = dite P (fun h => f (x h)) (fun h => f (y h)) := by
  by_cases h : P <;> simp [h]

/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/
theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) :
    f (ite P x y) = ite P (f x) (f y) :=
  apply_dite f P (fun _ => x) (fun _ => y)

/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/
@[simp] theorem dite_not (P : Prop) [Decidable P]  (x : ¬P → α) (y : ¬¬P → α) :
    dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by
  by_cases h : P <;> simp [h]

/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/
@[simp] theorem ite_not (P : Prop) [Decidable P] (x y : α) : ite (¬P) x y = ite P y x :=
  dite_not P (fun _ => x) (fun _ => y)

/-! ## miscellaneous -/

attribute [simp] inline

/-- Ex falso, the nondependent eliminator for the `Empty` type. -/
def Empty.elim : Empty → C := fun.

instance : Subsingleton Empty := ⟨fun a => a.elim⟩

instance : DecidableEq Empty := fun a => a.elim

/-- Ex falso, the nondependent eliminator for the `PEmpty` type. -/
def PEmpty.elim : PEmpty → C := fun.

instance : Subsingleton PEmpty := ⟨fun a => a.elim⟩

instance : DecidableEq PEmpty := fun a => a.elim

@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim

@[simp] theorem not_nonempty_pempty : ¬Nonempty PEmpty := fun ⟨h⟩ => h.elim

instance [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) :=
  ⟨fun {..} {..} => by congr <;> apply Subsingleton.elim⟩

instance : Inhabited (Sort _) := ⟨PUnit⟩

instance : Inhabited default := ⟨PUnit.unit⟩

instance {α β} [Inhabited α] : Inhabited (PSum α β) := ⟨PSum.inl default⟩

instance {α β} [Inhabited β] : Inhabited (PSum α β) := ⟨PSum.inr default⟩

-- TODO(Mario): profile first, this is a dangerous instance
-- instance (priority := 10) {α} [Subsingleton α] : DecidableEq α
--   | a, b => isTrue (Subsingleton.elim a b)

-- @[simp] -- TODO(Mario): profile
theorem eq_iff_true_of_subsingleton [Subsingleton α] (x y : α) : x = y ↔ True :=
  iff_true_intro (Subsingleton.elim ..)

/-- If all points are equal to a given point `x`, then `α` is a subsingleton. -/
theorem subsingleton_of_forall_eq (x : α) (h : ∀ y, y = x) : Subsingleton α :=
  ⟨fun a b => h a ▸ h b ▸ rfl⟩

theorem subsingleton_iff_forall_eq (x : α) : Subsingleton α ↔ ∀ y, y = x :=
  ⟨fun _ y => Subsingleton.elim y x, subsingleton_of_forall_eq x⟩

example [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) :=
  ⟨fun ⟨x, _⟩ ⟨y, _⟩ => by congr; exact Subsingleton.elim x y⟩

theorem false_ne_true : False ≠ True := fun h => h.symm ▸ trivial

theorem Bool.eq_false_or_eq_true : (b : Bool) → b = true ∨ b = false
  | true => .inl rfl
  | false => .inr rfl

theorem Bool.eq_false_iff {b : Bool} : b = false ↔ b ≠ true :=
  ⟨ne_true_of_eq_false, eq_false_of_ne_true⟩

theorem ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨Ne.symm, Ne.symm⟩


import ring_theory.algebraic
-- import data.finset
-- import algebra.field
-- import field_theory.subfield
import field_theory.algebraic_closure
-- import order.zorn
import Rings.ToMathlib
-- import data.mv_polynomial.equiv
-- import data.equiv.fin

open classical
local attribute [instance] prop_decidable

universes u v

section nttn

variables
  (K : Type u)

@[simp] def algebra.image (L : Type v) [comm_semiring K] [semiring L] [algebra K L] : set L :=
set.range (algebra_map K L)

@[simp] def subfield_generated {L : Type v} [field K] [field L] [algebra K L] (S : set L)
  : subfield L :=
subfield.closure (S ∪ algebra.image K L)

lemma subfield_generated.subset_closure
  {K : Type u} {L : Type v} [field K] [field L] [algebra K L] {S : set L} :
  S ⊆ subfield_generated K S :=
begin
  intros _ hs,
  simp only [algebra.image, subfield_generated, set_like.mem_coe],
  apply subfield.subset_closure,
  left,
  exact hs,
end

end nttn

namespace transcendent

variables
  (K : Type u) {L : Type u} [field K] [field L] [algebra K L]

def indep (S : set L) : Prop :=
Π (n : ℕ) (f : mv_polynomial (fin n) K) (as : fin n → L),
(Π k, as k ∈ S) → mv_polynomial.eval as (f : mv_polynomial (fin n) L) = 0 → f = 0

lemma indep_subset (S T : set L) (hST : S ⊆ T) : indep K T → indep K S :=
begin
  intros hT _ f as has hf,
  have has' : Π k, as k ∈ T := λ k, hST (has k),
  exact hT _ f as has' hf,
end

lemma indep_empty : indep K (∅ : set L)
| nat.zero f as has hf :=
begin
  apply @mv_polynomial.map_injective K L (fin 0) _ _ (algebra_map K L) (ring_hom.injective _),
  simp,
  rw mv_polynomial.is_empty (fin.is_empty) (mv_polynomial.map (algebra_map K L) f) as,
  rw ← mv_polynomial.C_0,
  rw (mv_polynomial.C_inj L),
  rw ← hf,
  simp only [mv_polynomial.eval, mv_polynomial.eval_map],
  unfold_coes,
end
| (nat.succ n) f as has hf :=
begin
  exfalso,
  rw ← set.mem_empty_eq (as 0),
  {apply has},
end

lemma indep_sUnion_chain {c : set (set L)} (hchain : zorn.chain has_subset.subset c)
  (h0 : c.nonempty)
  (hc : Π (S : set L) (hS : S ∈ c), indep K S) :
  indep K ⋃₀ c :=
begin
  intros k f as has hf,
  cases zorn.fin_range_sub_mem_chain_of_sub_union hchain h0 as has with S hS,
  cases hS with hSc hS,
  apply hc S hSc _ _ as _ hf,
  exact hS,
end

def basis (B : set L) : Prop := indep K B ∧ Π (S : set L), indep K S → B ⊆ S → S = B

lemma extend_to_basis_aux (S : set L) (hindS : indep K S) :
  ∃ (B : set L) (H : B ∈ {T : set L | S ⊆ T ∧ indep K T}),
  S ⊆ B ∧ Π (T : set L), T ∈ {T : set L | S ⊆ T ∧ indep K T} → B ⊆ T → T = B :=
(@zorn.zorn_subset_nonempty L { T : set L | S ⊆ T ∧ indep K T }
  (λ c hcsub hchain hc0,
    ⟨
      -- the upper bound by taking union
      ⋃₀ c ,
      ⟨
        let hScup : S ⊆ ⋃₀ c :=
        begin
          cases hc0 with T hT,
          cases hcsub hT with hST hand,
          have hTcup : T ⊆ ⋃₀ c := λ t ht , ⟨ T , hT , ht ⟩,
          exact set.subset.trans hST hTcup,
        end in
        ⟨ -- the upper bound is in the set
          hScup ,
          indep_sUnion_chain K hchain hc0 (λ S hs, (hcsub hs).2)
        ⟩ ,
        (λ S hS s hs, ⟨ S , hS , hs ⟩) -- showing the maximal element is in the set
      ⟩
    ⟩
  )
  S -- give U for the set being non-empty
  ⟨ set.subset.refl _ , hindS ⟩)

#check is_algebraic_algebra_map

lemma subfield_mem (a : L) (K : subfield L) (haK : a ∈ K) :
  a = algebra_map K L (⟨ a , haK ⟩ : K) := rfl

lemma is_algebraic_subfield {a : L} {K : subfield L} (haK : a ∈ K) : is_algebraic K a :=
⟨
  polynomial.X - polynomial.C (⟨ a , haK ⟩ : K) ,
  polynomial.X_sub_C_ne_zero _ ,
  begin
    simp only [polynomial.aeval_X, polynomial.aeval_C, alg_hom.map_sub],
    rw ← subfield_mem a K haK,
    simp,
  end
⟩

#check ite

lemma algebraic_over_basis (B : set L) (hB : basis K B) :
  algebra.is_algebraic (subfield_generated K B) L :=
begin
  intro x,
  by_cases hind : indep K (B ∪ {x}),
  {
    have hBx := hB.2 (B ∪ {x}) hind (by simp),
    have hxBx : x ∈ subfield_generated K B,
    {apply subfield.subset_closure, left, rw ← hBx, right, exact set.mem_singleton x},
    apply is_algebraic_subfield hxBx,
  },
  {
    simp only [indep, not_forall] at hind,
    cases hind with n hind,
    cases hind with f hind,
    cases hind with as hind,
    cases hind with has hind,
    cases hind with hf hf0,
    have bs : fin n → polynomial (subfield_generated K B) :=
    λ k, @decidable.rec_on (as k ∈ B) (λ k, polynomial (subfield_generated K B)) _
      (λ _, polynomial.X)
      (λ h, polynomial.C (⟨ as k , subfield_generated.subset_closure h ⟩ : subfield_generated K B)),

    -- have p : polynomial (subfield_generated K B) := mv_polynomial.eval₂ _ _,

  }
end

variables (K) (L)

lemma extend_to_basis (S : set L) (hindS : indep K S) :
    ∃ (B : set L), S ⊆ B ∧ basis K B :=
begin
  cases extend_to_basis_aux K S hindS with B hB,
  cases hB with hmem hB,
  cases hB with hSB hbasis,
  use B,
  split,
  {exact hSB},
  {
    split,
    {exact hmem.2},
    {
      intros T hindT hBT,
      apply hbasis T _ hBT,
      exact ⟨ set.subset.trans hSB hBT , hindT ⟩,
    }
  }
end

lemma basis_ex : ∃ (B : set L), basis K B :=
begin
  cases extend_to_basis K L ∅ (indep_empty K) with B hB,
  use B,
  exact hB.2,
end

lemma basis_some : set L := @classical.some (set L) (λ S, basis K S) (basis_ex K L)

lemma degree : cardinal.{u} := cardinal.mk (basis_some K L)

end transcendent

namespace field_theory

variables
  {K L0 L1 : Type u}
  [field K] [field L0] [field L1]
  [algebra K L0] [algebra K L1]

open transcendent algebra

lemma iso_of_bij_indep (S0 : set L0) (S1 : set L1) :
  indep K S0 → indep K S1 → equiv S0 S1 →
  subfield_generated K S0 ≃+* subfield_generated K S1 :=
sorry

lemma iso_of_alg_closed_algebraic
  {K0 K1 L0 L1: Type u} [field K0] [field K1] [field L0] [field L1]
  [is_alg_closed L0] [is_alg_closed L1]
  [algebra K0 L0] [algebra K1 L1] : K0 ≃+* K1 →
  is_algebraic K0 L0 → is_algebraic K1 L1 → L0 ≃+* L1 := sorry

lemma iso_of_alg_closed_of_eq_trans_deg [is_alg_closed L0] [is_alg_closed L1]
  (B0 : set L0) (B1 : set L1) : transcendent.basis K B0 → transcendent.basis K B1 →
  equiv B0 B1
  → L0 ≃+* L1 :=
begin
  intros hB0 hB1 htdeg,
  apply iso_of_alg_closed_algebraic _
  (algebraic_over_basis K B0 hB0)
  (algebraic_over_basis K B1 hB1),
  apply iso_of_bij_indep B0 B1 hB0.1 hB1.1 htdeg,
end

end field_theory


/-
Copyright (c) 2018 Luca Gerolla. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luca Gerolla, Mario Carneiro, Kevin Buzzard
Definition of path, loop and basic properties.
-/
import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space
import analysis.real
import data.real.basic tactic.norm_num
import data.set.basic
import Topology.Material.pasting_lemma
import Topology.Material.real_results

universe u

open set filter lattice classical

noncomputable theory

namespace path

---- PATH and I01 DEFINITION
/- The following definition of path was created by Mario Carneiro -/

variables {α  : Type*} [topological_space α ]

def I01 := {x : ℝ | 0 ≤ x ∧ x ≤ 1}

instance : topological_space I01 := by unfold I01; apply_instance
instance : has_zero I01 := ⟨⟨0, le_refl _, zero_le_one⟩⟩
instance : has_one I01 := ⟨⟨1, zero_le_one, le_refl _⟩⟩

structure path (x y : α) :=
(to_fun : I01 → α)
(at_zero : to_fun 0 = x)
(at_one : to_fun 1 = y)
(cont : continuous to_fun)

instance {α} [topological_space α] (x y : α) : has_coe_to_fun (path x y) := ⟨_, path.to_fun⟩

----------

--attribute [class] path

-- PATH INTERFACE

@[simp]
lemma start_pt_path { x y : α } ( f : path x y ) : f.to_fun 0 = x := f.2

@[simp]
lemma end_pt_path { x y : α } ( f : path x y ) : f.to_fun 1 = y := f.3

-- for later paths homotopy -- checking ending points -- Can Remove
def equal_of_pts (f g : I01 → α ) : Prop := f 0 = g 0 ∧ f 1 = g 1

def equal_of_pts_path { z w x y : α } ( g1 : path x y ) ( g2 : path z w) : Prop := equal_of_pts g1 g2

def check_pts ( x y : α ) ( g : I01 → α ) := g 0 = x ∧ g 1 = y

def check_pts_of_path ( x y : α ) { z w : α } ( h : path z w ) := check_pts x y h.to_fun
------

-- For equality of path, necessary and sufficient equality of constructor
theorem path_equal { x y : α } { f g : path x y } : f = g  ↔  f.to_fun = g.to_fun :=
begin split, intro h₁, rw h₁, intro h₂, cases f, cases g, cc  end

-- for later paths homotopy
def is_path ( x y : α ) ( f : I01 → α ) : Prop := f 0 = x ∧ f 1 = y ∧ continuous f

def to_path' { x y : α} ( f : I01 → α ) ( H : is_path x y f) : path x y :=
{  to_fun := f,
   at_zero := H.left,
   at_one := H.right.left,
   cont := H.right.right
}

def to_path { x y : α} ( f : I01 → α ) ( h : is_path x y f) : path x y :=
path.mk f h.1 h.2.1 h.2.2

--- Can Remove
lemma cont_of_path { z w : α }( g : path z w ) : continuous g.to_fun := g.cont

--- Can Remove
def fun_of_path {α} [topological_space α ]  { x1 x2 : α  } ( g : path x1 x2 ) : I01 → α   := g.to_fun

--------------------

--- COMPOSITION OF PATHS

-- Unit interval is closed
lemma is_closed_I01 : is_closed I01 :=
begin exact @is_closed_int_clos 0 1 (by norm_num) end

-- Define closed subintervals of I01 = [0, 1]
definition T ( a b : ℝ ) ( Hab : a < b ) : set I01 :=  { x : I01 | a ≤ x.val ∧ x.val ≤ b }

-- Prove any T r s Hrs is closed in I01
lemma T_is_closed  { r s : ℝ } ( Hrs : r < s )  : is_closed (T r s Hrs) :=
begin
  let R := {x : ↥I01 | r ≤ x.val }, let L := {x : ↥I01 |  x.val ≤ s } ,
  have C1 : is_closed L,
    { rw is_closed_induced_iff,
    existsi {x : ℝ | 0 ≤ x ∧ x ≤ (min 1 s)},
    split,
      exact is_closed_inter (is_closed_ge' 0)  (is_closed_le' _),
      apply set.ext, intro x,
      show x.val ≤ s ↔ 0 ≤ x.val ∧ x.val ≤ min 1 s,
      split,
        intro H,
        split,
          exact x.property.1,
          apply le_min,exact x.property.2,assumption,
        intro H,
      exact le_trans H.2 (min_le_right _ _), },
  have C2 : is_closed R,
    {rw is_closed_induced_iff,
    existsi {x : ℝ | (max 0 r) ≤ x ∧ x ≤ 1},
    split,
      exact is_closed_inter (is_closed_ge' _)  (is_closed_le' 1),
      apply set.ext, intro x,
      show r ≤ x.val ↔ max 0 r ≤ x.val ∧ x.val ≤ 1,
      split,
        intro H,
        split,
          exact max_le x.2.1 H,
          exact x.2.2,
        intro H, exact (max_le_iff.1 H.1).2,  },
  have Int : T r s Hrs = set.inter R L, unfold T set.inter, simp,
  exact (is_closed_inter C2 C1),
end

-- Reparametrisation from T _ _ _ to I01
definition par {r s : ℝ} (Hrs : r < s) : T r s Hrs → I01 :=
λ x, ⟨ (x.val - r)/(s - r) ,
begin
  have D1 : 0 < (s - r) , by apply sub_pos.2 Hrs,
  have D2 : 0 < (s - r)⁻¹, by exact inv_pos D1,
  have N1 : 0 ≤ ((x.val : ℝ ) - r),
      by exact sub_nonneg.2 (x.property.1),
  have N2 : (x.val : ℝ )- r ≤ s - r,
      { have this : -r ≤ -r, trivial,
      show (x.val : ℝ ) + - r ≤ s + - r,
      exact add_le_add (x.property.2) this,},
  split,
    show 0 ≤ ((x.val : ℝ ) - r) * (s - r)⁻¹,
      by exact mul_nonneg N1 (le_of_lt D2),
    have H1 : 0 < (s - r), by exact sub_pos.2 Hrs,
    have H2 : ((x.val : ℝ ) - r) / (s - r) ≤ (s - r) / (s - r),
      by exact @div_le_div_of_le_of_pos _ _ ((x.val : ℝ ) - r) (s - r) (s - r) N2 H1,
    rwa [@div_self _ _ (s - r) (ne.symm ( @ne_of_lt _ _ 0 (s - r) H1) ) ] at H2
end ⟩

-- Continuity of reparametrisation (later employed in compositions of path/homotopy)
lemma continuous_par {r s : ℝ} (Hrs : r < s) : continuous ( par Hrs ) :=
begin
  unfold par, apply continuous_subtype_mk,
  show continuous (λ (x :  ↥(T r s Hrs)), ((x.1:ℝ ) - r) / (s - r)),
  show continuous ((λ ( y: ℝ ), (y - r) / (s - r)) ∘ (λ (x : ↥(T r s Hrs)), x.val.val)),
  have H : continuous (λ (x : ↥(T r s Hrs)), x.val.val),
    exact continuous.comp continuous_subtype_val continuous_subtype_val ,
  exact continuous.comp H (real.continuous_scale (-r) (s-r)),
end

-----------------

-- Define T1 = [0, 1/2] and  T2 = [1/2, 1]
lemma zero_lt_half : 0 < (1 / 2 : ℝ ) := by norm_num

lemma half_lt_one : (1 / 2 : ℝ ) < 1 := by norm_num

def T1 : set I01 := T 0 ( 1/2: ℝ ) ( zero_lt_half )

def T2 : set I01 := T ( 1/2: ℝ ) 1 ( half_lt_one  )

lemma T1_is_closed : is_closed T1 :=
begin unfold T1, exact T_is_closed _, end

lemma T2_is_closed : is_closed T2 :=
begin unfold T2, exact T_is_closed _, end

lemma help_T1 : (0 : I01) ∈ T 0 (1/2) zero_lt_half :=
begin unfold T, rw mem_set_of_eq, show 0 ≤ (0:ℝ)  ∧ ( 0:ℝ ) ≤ 1 / 2, norm_num,  end

lemma help_T2 : (1 : I01) ∈ T (1 / 2) 1 half_lt_one :=
begin unfold T, rw mem_set_of_eq, split, show 1/2 ≤ (1:ℝ) , norm_num, show (1:ℝ )≤ 1, norm_num,  end

lemma help_01 : (1 / 2 :ℝ) ∈ I01 := begin unfold I01, rw mem_set_of_eq, norm_num end

lemma help_02 : (1:I01) ∉ T1 :=
begin unfold T1 T,rw mem_set_of_eq, show ¬(0 ≤ (1:ℝ ) ∧ (1:ℝ) ≤ 1 / 2) , norm_num  end

lemma help_half_T1 : ( ⟨ 1/2, help_01⟩ : I01) ∈ T 0 (1/2) zero_lt_half :=
begin
  unfold T, exact set.mem_sep
    (begin dsimp [has_mem.mem, -one_div_eq_inv], unfold set.mem, norm_num, end )
    (begin norm_num end ),
end

lemma help_half_T2 : ( ⟨ 1/2, help_01⟩  : I01) ∈ T (1/2) 1 half_lt_one :=
begin
  unfold T, exact set.mem_sep
    (begin dsimp [has_mem.mem, -one_div_eq_inv], unfold set.mem, norm_num, end )
    (begin norm_num end ),
end

--- Intersection and covering of T1, T2

lemma inter_T : set.inter T1 T2 = { x : I01 | x.val = 1/2 } :=
begin
  unfold T1 T2 T set.inter, dsimp [mem_set_of_eq, -one_div_eq_inv], apply set.ext, intro x, split,
    {rw mem_set_of_eq , rw mem_set_of_eq, simp [-one_div_eq_inv], intros A B C D,
    have H : x.val < 1 / 2 ∨ x.val = 1/2, by exact lt_or_eq_of_le B,
    exact le_antisymm  B C, },
    rw mem_set_of_eq , rw mem_set_of_eq, intro H, rw H, norm_num,
end

lemma cover_I01 : T1 ∪ T2 = set.univ :=
begin
  unfold univ, unfold has_union.union , unfold T1 T2 T, apply set.ext, intro x,unfold set.union,  simp [mem_set_of_eq , -one_div_eq_inv],
    split, intro H, simp [has_mem.mem],
  intro B, simp [has_mem.mem] at B, unfold set.mem at B,
  have H : 0≤ x.val ∧ x.val ≤ 1, exact x.property, simp [or_iff_not_imp_left, -one_div_eq_inv],
  intro nL, have H2 : (1 / 2 :ℝ )< x.val, exact nL H.1, exact ⟨ le_of_lt H2, H.2 ⟩ ,
end

lemma T2_of_not_T1 { s : I01} : (s ∉ T1) → s ∈ T2 :=
begin
  intro H, have H2 : T1 ∪ T2 = @set.univ I01, exact cover_I01, unfold T1 T2 T at *, simp [-one_div_eq_inv],
  rw mem_set_of_eq at H, rw not_and at H, have H3 : 1/2 < s.val, have H4 : ¬s.val ≤ 1 / 2, exact  H (s.2.1), exact lt_of_not_ge H4,
  exact ⟨ le_of_lt H3, s.2.2⟩ ,
end

---- Lemmas to simplify evaluations of par
@[simp]
lemma eqn_start : par zero_lt_half ⟨0, help_T1⟩ = 0 :=
begin unfold par, simp [-one_div_eq_inv], exact subtype.mk_eq_mk.2 (begin exact zero_div _,  end  ), end

@[simp]
lemma eqn_1 : par zero_lt_half ⟨⟨1 / 2, begin unfold I01, rw mem_set_of_eq, norm_num end⟩, begin unfold T, rw mem_set_of_eq, show 0 ≤ (1/2 : ℝ ) ∧ (1/2 : ℝ ) ≤ 1 / 2 ,  norm_num end ⟩
= 1 :=  begin unfold par, simp [-one_div_eq_inv], exact subtype.mk_eq_mk.2 (begin exact div_self (begin norm_num, end), end) end

@[simp]
lemma eqn_2 : par half_lt_one ⟨⟨1 / 2, help_01  ⟩, begin unfold T, rw mem_set_of_eq, show 1/2 ≤ (1/2 : ℝ ) ∧ (1/2 : ℝ ) ≤ 1  ,  norm_num end⟩
= 0 := begin unfold par, simp [-one_div_eq_inv], exact subtype.mk_eq_mk.2 (by refl) end

@[simp]
lemma eqn_end : par half_lt_one ⟨1, help_T2 ⟩ = 1 :=
begin unfold par, exact subtype.mk_eq_mk.2 ( begin show ( ( 1:ℝ ) - 1 / 2) / (1 - 1 / 2) = 1,  norm_num, end ),  end

-------------------------------------

-- Definition and continuity of general / T1 / T2 reparametrisation of path function (path.to_fun)
---------- to be used with cont_of_paste for path/homotopy composition

def fgen_path { x y : α } {r s : ℝ} (Hrs : r < s) (f : path x y ) : T r s Hrs → α :=
λ t, f.to_fun ( par Hrs t)

lemma pp_cont { x y : α }{r s : ℝ} (Hrs : r < s)(f : path x y ) : continuous (fgen_path Hrs f) :=
begin unfold fgen_path, exact continuous.comp (continuous_par Hrs) f.cont, end

definition fa_path { x y : α } (f : path x y ) : T1 → α := λ t, f.to_fun (par zero_lt_half t)

lemma CA { x y : α } (f : path x y ) : continuous ( fa_path f):=
begin unfold fa_path, exact continuous.comp (continuous_par zero_lt_half ) f.cont, end

definition fb_path { x y : α } (f : path x y ) : T2 → α := λ t, f.to_fun (par half_lt_one t)

lemma CB { x y : α } (f : path x y ) :  continuous ( fb_path f):=
begin unfold fb_path, exact continuous.comp (continuous_par half_lt_one ) f.cont,
end

lemma match_lemma { x y z : α } ( f : path x y ) ( g : path y z ) :
  match_of_fun (fa_path f) (fb_path g) :=
begin
  unfold match_of_fun,  intros x B1 B2,
  have Int : x ∈ set.inter T1 T2, exact ⟨ B1 , B2 ⟩ ,
  rwa [inter_T] at Int,
  have V : x.val = 1/2, rwa [mem_set_of_eq] at Int,
  have xeq : x = (⟨ 1/2 , help_01 ⟩ : I01 ) , apply subtype.eq, rw V,
  unfold fa_path fb_path, simp [xeq, -one_div_eq_inv],
  show f.to_fun (par zero_lt_half ⟨⟨1 / 2, help_01⟩, help_half_T1⟩) =
    g.to_fun (par half_lt_one ⟨⟨1 / 2, help_01⟩, help_half_T2⟩),
  simp [eqn_1, eqn_2, -one_div_eq_inv],
end

----- Composition of Path function

definition comp_of_path  { x y z : α } ( f : path x y )( g : path y z ) : path x z :=
{   to_fun := λ t, ( paste  cover_I01 ( fa_path f ) ( fb_path g ) ) t ,

    at_zero :=
    begin unfold paste, rw dif_pos, unfold fa_path, rw eqn_start, exact f.at_zero end,

    at_one :=
    begin unfold paste, rw dif_neg, unfold fb_path,
      show g.to_fun (par half_lt_one ⟨1,  help_T2 ⟩) = z, by simp [eqn_end],
      exact help_02,
    end,

    cont :=
      cont_of_paste (T1_is_closed) (T2_is_closed) (match_lemma f g) (CA f) (CB g)

}

----------------------------------------------------

--- INVERSE OF PATH

--- Similarly to Composition of Path: define par_inv, prove continuity and create some [simp] lemmas

lemma inv_in_I01 (x : I01) : 1 - x.val ∈ I01 :=
begin unfold I01, rw mem_set_of_eq, split, simp [-sub_eq_add_neg] , exact x.2.2, simp, exact x.2.1, end

definition par_inv : I01 → I01 :=  λ x, ⟨ 1 - x.val , inv_in_I01 x ⟩

@[simp] lemma eqn_1_par_inv : par_inv 0 = 1 :=  by refl

@[simp] lemma eqn_2_par_inv : par_inv 1 = 0 := by refl

lemma help_inv (y : ℝ ) : ( 1 - y) = (-1) * y + 1 := by simp

theorem continuous_par_inv : continuous (par_inv ) :=
begin
  unfold par_inv, apply continuous_subtype_mk,
  show continuous ((λ ( y: ℝ ), 1 - y ) ∘ (λ (x : ↥I01), x.val)),
  refine continuous.comp continuous_subtype_val _, --
  conv in ( (1:ℝ)-_)
    begin
    rw help_inv,
    end ,
  exact continuous.comp (real.continuous_mul_const (-1) ) (real.continuous_add_const 1),
end

definition inv_of_path { x y : α } ( f : path x y ) : path y x :=
{   to_fun := λ t , f.to_fun ( par_inv t ) , --  or better f.to_fun ∘ par_inv

    at_zero := begin rw eqn_1_par_inv, exact f.at_one end ,

    at_one := begin rw eqn_2_par_inv, exact f.at_zero end,

    cont := by exact continuous.comp continuous_par_inv f.cont

}

------------------------------------

-- LOOP

-- function to check loop (can be removed)
def is_loop { x y : α } ( g : path x y) : Prop := x = y

def loop (x0 : α) : Type* := path x0 x0

def loop_const (x0 : α) : loop x0 :=
{   to_fun:= λ t, x0 ,
    at_zero :=  by refl ,
    at_one := by refl,
    cont := continuous_const
}

end path


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

! This file was ported from Lean 3 source module data.rat.big_operators
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Rat.Cast
import Mathbin.Algebra.BigOperators.Basic

/-! # Casting lemmas for rational numbers involving sums and products

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

open BigOperators

variable {ι α : Type _}

namespace Rat

section WithDivRing

variable [DivisionRing α] [CharZero α]

/- warning: rat.cast_list_sum -> Rat.cast_list_sum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))] (s : List.{0} Rat), Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1)))) (List.sum.{0} Rat Rat.hasAdd Rat.hasZero s)) (List.sum.{u1} α (Distrib.toHasAdd.{u1} α (Ring.toDistrib.{u1} α (DivisionRing.toRing.{u1} α _inst_1))) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (List.map.{0, u1} Rat α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1))))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))] (s : List.{0} Rat), Eq.{succ u1} α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1) (List.sum.{0} Rat Rat.instAddRat (CommMonoidWithZero.toZero.{0} Rat (CommGroupWithZero.toCommMonoidWithZero.{0} Rat Rat.commGroupWithZero)) s)) (List.sum.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (DivisionSemiring.toSemiring.{u1} α (DivisionRing.toDivisionSemiring.{u1} α _inst_1)))) (List.map.{0, u1} Rat α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1)) s))
Case conversion may be inaccurate. Consider using '#align rat.cast_list_sum Rat.cast_list_sumₓ'. -/
@[simp, norm_cast]
theorem cast_list_sum (s : List ℚ) : (↑s.Sum : α) = (s.map coe).Sum :=
  map_list_sum (Rat.castHom α) _
#align rat.cast_list_sum Rat.cast_list_sum

/- warning: rat.cast_multiset_sum -> Rat.cast_multiset_sum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))] (s : Multiset.{0} Rat), Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1)))) (Multiset.sum.{0} Rat Rat.addCommMonoid s)) (Multiset.sum.{u1} α (AddCommGroup.toAddCommMonoid.{u1} α (NonUnitalNonAssocRing.toAddCommGroup.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))) (Multiset.map.{0, u1} Rat α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1))))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))] (s : Multiset.{0} Rat), Eq.{succ u1} α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1) (Multiset.sum.{0} Rat Rat.addCommMonoid s)) (Multiset.sum.{u1} α (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))) (Multiset.map.{0, u1} Rat α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1)) s))
Case conversion may be inaccurate. Consider using '#align rat.cast_multiset_sum Rat.cast_multiset_sumₓ'. -/
@[simp, norm_cast]
theorem cast_multiset_sum (s : Multiset ℚ) : (↑s.Sum : α) = (s.map coe).Sum :=
  map_multiset_sum (Rat.castHom α) _
#align rat.cast_multiset_sum Rat.cast_multiset_sum

/- warning: rat.cast_sum -> Rat.cast_sum is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : DivisionRing.{u2} α] [_inst_2 : CharZero.{u2} α (AddGroupWithOne.toAddMonoidWithOne.{u2} α (AddCommGroupWithOne.toAddGroupWithOne.{u2} α (Ring.toAddCommGroupWithOne.{u2} α (DivisionRing.toRing.{u2} α _inst_1))))] (s : Finset.{u1} ι) (f : ι -> Rat), Eq.{succ u2} α ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u2} Rat α (CoeTCₓ.coe.{1, succ u2} Rat α (Rat.castCoe.{u2} α (DivisionRing.toHasRatCast.{u2} α _inst_1)))) (Finset.sum.{0, u1} Rat ι Rat.addCommMonoid s (fun (i : ι) => f i))) (Finset.sum.{u2, u1} α ι (AddCommGroup.toAddCommMonoid.{u2} α (NonUnitalNonAssocRing.toAddCommGroup.{u2} α (NonAssocRing.toNonUnitalNonAssocRing.{u2} α (Ring.toNonAssocRing.{u2} α (DivisionRing.toRing.{u2} α _inst_1))))) s (fun (i : ι) => (fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u2} Rat α (CoeTCₓ.coe.{1, succ u2} Rat α (Rat.castCoe.{u2} α (DivisionRing.toHasRatCast.{u2} α _inst_1)))) (f i)))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))] (s : Finset.{u2} ι) (f : ι -> Rat), Eq.{succ u1} α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1) (Finset.sum.{0, u2} Rat ι Rat.addCommMonoid s (fun (i : ι) => f i))) (Finset.sum.{u1, u2} α ι (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))) s (fun (i : ι) => Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1) (f i)))
Case conversion may be inaccurate. Consider using '#align rat.cast_sum Rat.cast_sumₓ'. -/
@[simp, norm_cast]
theorem cast_sum (s : Finset ι) (f : ι → ℚ) : (↑(∑ i in s, f i) : α) = ∑ i in s, f i :=
  map_sum (Rat.castHom α) _ _
#align rat.cast_sum Rat.cast_sum

/- warning: rat.cast_list_prod -> Rat.cast_list_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))] (s : List.{0} Rat), Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1)))) (List.prod.{0} Rat Rat.hasMul Rat.hasOne s)) (List.prod.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α (DivisionRing.toRing.{u1} α _inst_1))) (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))) (List.map.{0, u1} Rat α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α _inst_1))))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))] (s : List.{0} Rat), Eq.{succ u1} α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1) (List.prod.{0} Rat Rat.instMulRat (NonAssocRing.toOne.{0} Rat (Ring.toNonAssocRing.{0} Rat (StrictOrderedRing.toRing.{0} Rat (LinearOrderedRing.toStrictOrderedRing.{0} Rat Rat.instLinearOrderedRingRat)))) s)) (List.prod.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))) (NonAssocRing.toOne.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1))) (List.map.{0, u1} Rat α (Rat.cast.{u1} α (DivisionRing.toRatCast.{u1} α _inst_1)) s))
Case conversion may be inaccurate. Consider using '#align rat.cast_list_prod Rat.cast_list_prodₓ'. -/
@[simp, norm_cast]
theorem cast_list_prod (s : List ℚ) : (↑s.Prod : α) = (s.map coe).Prod :=
  map_list_prod (Rat.castHom α) _
#align rat.cast_list_prod Rat.cast_list_prod

end WithDivRing

section Field

variable [Field α] [CharZero α]

/- warning: rat.cast_multiset_prod -> Rat.cast_multiset_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Field.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α (Field.toDivisionRing.{u1} α _inst_1)))))] (s : Multiset.{0} Rat), Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α (Field.toDivisionRing.{u1} α _inst_1))))) (Multiset.prod.{0} Rat Rat.commMonoid s)) (Multiset.prod.{u1} α (CommRing.toCommMonoid.{u1} α (Field.toCommRing.{u1} α _inst_1)) (Multiset.map.{0, u1} Rat α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u1} Rat α (CoeTCₓ.coe.{1, succ u1} Rat α (Rat.castCoe.{u1} α (DivisionRing.toHasRatCast.{u1} α (Field.toDivisionRing.{u1} α _inst_1)))))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Field.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α (Field.toDivisionRing.{u1} α _inst_1))))] (s : Multiset.{0} Rat), Eq.{succ u1} α (Rat.cast.{u1} α (Field.toRatCast.{u1} α _inst_1) (Multiset.prod.{0} Rat Rat.commMonoid s)) (Multiset.prod.{u1} α (CommRing.toCommMonoid.{u1} α (Field.toCommRing.{u1} α _inst_1)) (Multiset.map.{0, u1} Rat α (Rat.cast.{u1} α (Field.toRatCast.{u1} α _inst_1)) s))
Case conversion may be inaccurate. Consider using '#align rat.cast_multiset_prod Rat.cast_multiset_prodₓ'. -/
@[simp, norm_cast]
theorem cast_multiset_prod (s : Multiset ℚ) : (↑s.Prod : α) = (s.map coe).Prod :=
  map_multiset_prod (Rat.castHom α) _
#align rat.cast_multiset_prod Rat.cast_multiset_prod

/- warning: rat.cast_prod -> Rat.cast_prod is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : Type.{u2}} [_inst_1 : Field.{u2} α] [_inst_2 : CharZero.{u2} α (AddGroupWithOne.toAddMonoidWithOne.{u2} α (AddCommGroupWithOne.toAddGroupWithOne.{u2} α (Ring.toAddCommGroupWithOne.{u2} α (DivisionRing.toRing.{u2} α (Field.toDivisionRing.{u2} α _inst_1)))))] (s : Finset.{u1} ι) (f : ι -> Rat), Eq.{succ u2} α ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u2} Rat α (CoeTCₓ.coe.{1, succ u2} Rat α (Rat.castCoe.{u2} α (DivisionRing.toHasRatCast.{u2} α (Field.toDivisionRing.{u2} α _inst_1))))) (Finset.prod.{0, u1} Rat ι Rat.commMonoid s (fun (i : ι) => f i))) (Finset.prod.{u2, u1} α ι (CommRing.toCommMonoid.{u2} α (Field.toCommRing.{u2} α _inst_1)) s (fun (i : ι) => (fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Rat α (HasLiftT.mk.{1, succ u2} Rat α (CoeTCₓ.coe.{1, succ u2} Rat α (Rat.castCoe.{u2} α (DivisionRing.toHasRatCast.{u2} α (Field.toDivisionRing.{u2} α _inst_1))))) (f i)))
but is expected to have type
  forall {ι : Type.{u2}} {α : Type.{u1}} [_inst_1 : Field.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (Ring.toAddGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α (Field.toDivisionRing.{u1} α _inst_1))))] (s : Finset.{u2} ι) (f : ι -> Rat), Eq.{succ u1} α (Rat.cast.{u1} α (Field.toRatCast.{u1} α _inst_1) (Finset.prod.{0, u2} Rat ι Rat.commMonoid s (fun (i : ι) => f i))) (Finset.prod.{u1, u2} α ι (CommRing.toCommMonoid.{u1} α (Field.toCommRing.{u1} α _inst_1)) s (fun (i : ι) => Rat.cast.{u1} α (Field.toRatCast.{u1} α _inst_1) (f i)))
Case conversion may be inaccurate. Consider using '#align rat.cast_prod Rat.cast_prodₓ'. -/
@[simp, norm_cast]
theorem cast_prod (s : Finset ι) (f : ι → ℚ) : (↑(∏ i in s, f i) : α) = ∏ i in s, f i :=
  map_prod (Rat.castHom α) _ _
#align rat.cast_prod Rat.cast_prod

end Field

end Rat


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

import Flows.Term

open Classical

set_option codegen false

def Subst (α : Type u) (β : Type u) := { f : β → Term α β // finite { x : β // f x ≠ Term.Var x } }

private theorem comp_carrier {f g : β → Term α β} {x : β} :
  ((f * g) x ≠ Term.Var x) → f x ≠ Term.Var x ∨ g x ≠ Term.Var x := by
  rw [← Decidable.not_and_iff_or_not]
  apply contrapose
  exact λ ⟨ h₁, h₂ ⟩ => by simp [HMul.hMul, Mul.mul, comp, map_reduce, h₁, h₂]

private def carriers_arrow (f g : β → Term α β) : ({ x : β // (f * g) x ≠ Term.Var x }) →
  { x // f x ≠ Term.Var x } ⊕ { x // g x ≠ Term.Var x } :=
  λ ⟨ x, p ⟩ =>
    if hf : f x ≠ Term.Var x then Sum.inl ⟨ x, hf ⟩
    else if hg : g x ≠ Term.Var x then Sum.inr ⟨ x, hg ⟩
    else False.elim <| match comp_carrier p with
    | Or.inl p => hf p
    | Or.inr p => hg p

private theorem carriers_arrow_inj (f g : β → Term α β) (x y : {x // (f * g) x ≠ Term.Var x})
  (h : carriers_arrow f g x = carriers_arrow f g y) : x = y := by
  revert x y
  intro ⟨ x, hx ⟩ ⟨ y, hy ⟩ h
  apply Subtype.eq
  simp [carriers_arrow] at h
  have x_nontriv : {P : Prop} → ¬ f x ≠ Term.Var x → ¬ g x ≠ Term.Var x → P :=
    λ p q => False.elim <| match comp_carrier hx with | Or.inl r => p r | Or.inr r => q r
  have y_nontriv : {P : Prop} → ¬ f y ≠ Term.Var y → ¬ g y ≠ Term.Var y → P :=
    λ p q => False.elim <| match comp_carrier hy with | Or.inl r => p r | Or.inr r => q r
  by_cases p₁ : f x ≠ Term.Var x <;> by_cases p₂ : g x ≠ Term.Var x
    <;> by_cases p₃ : f y ≠ Term.Var y <;> by_cases p₄ : g y ≠ Term.Var y
    <;> simp [dif_pos p₁, dif_neg p₁, dif_pos p₂, dif_neg p₂,
      dif_pos p₃, dif_neg p₃, dif_pos p₄, dif_neg p₄] at h
    <;> first
      | assumption
      | apply x_nontriv; assumption; assumption
      | apply y_nontriv; assumption; assumption

instance : Monoid (Subst α β) where
  one := ⟨ Term.Var, ⟨ [], λ ⟨ _, p ⟩ => False.elim <| p rfl ⟩ ⟩
  mul := λ ⟨ f, pf ⟩ ⟨ g, pg ⟩ =>
    ⟨ f * g, invimage_finite_of_inj (sum_finite pf pg) (carriers_arrow_inj f g) ⟩
  one_mul := λ ⟨ _, _ ⟩ => rfl
  mul_one := λ ⟨ _, _ ⟩ => Subtype.eq <| fun_monoid.mul_one _
  mul_assoc := λ ⟨ _, _ ⟩ ⟨ _, _ ⟩ ⟨ _, _ ⟩ => Subtype.eq <| fun_monoid.mul_assoc _ _ _

instance subst_self_action : RAction (Subst α β) (Subst α β) := self_action _

instance subst_term_action : RAction (Term α β) (Subst α β) where
  smul := λ x ⟨ f, hf ⟩ => x • f
  smul_one := term_action.smul_one
  smul_mul := λ _ ⟨ _, _ ⟩ ⟨ _, _ ⟩ => term_action.smul_mul _ _ _

def Subst.ext {θ φ : Subst α β} : θ = φ
  ↔ ∀ x, (Term.Var x : Term α β) • θ = (Term.Var x : Term α β) • φ := by
  apply Iff.intro (by intro h _; rw [h])
  intro h
  match θ with
  | ⟨ θ, _ ⟩ => match φ with
    | ⟨ φ, _ ⟩ =>
      apply Subtype.eq
      funext x
      exact h x

def Subst.elementary {x : β} {u : Term α β} (h : Term.Var x ≠ u) : Subst α β :=
  ⟨ λ z => if z = x then u else Term.Var z, by
    apply Exists.intro [⟨ x, by simp [h.symm] ⟩]
    intro ⟨ z, hz ⟩
    rw [List.mem_head_or_mem_tail]
    apply Or.inl
    apply Subtype.eq
    apply byContradiction
    intro h'
    simp [h'] at hz ⟩

theorem Subst.elementary_spec₁ {x : β} {u : Term α β} (h : Term.Var x ≠ u) :
  (Term.Var x : Term α β) • (elementary h : Subst α β) = u := by
  simp [RSMul.smul, elementary, map_reduce]

theorem Subst.elementary_spec₂ {x z : β} {u : Term α β} (h : Term.Var x ≠ u) (h' : z ≠ x) :
  (Term.Var z : Term α β) • (elementary h : Subst α β) = Term.Var z := by
  simp [RSMul.smul, elementary, map_reduce, h']

def subst_simple (x : β) (u : Term α β) :=
  if p : Term.Var x = u then 1
  else Subst.elementary p

@[simp]
theorem subst_simple_spec {x y : β} {u : Term α β} :
  Term.Var y • subst_simple x u =
    if y = x then u
    else Term.Var y :=
  if h₁ : Term.Var x = u then
    if h₂ : y = x then by
      simp [subst_simple, h₁, h₂, RAction.smul_one]
    else by
      simp [subst_simple, h₁, h₂, RAction.smul_one]
  else
    if h₂ : y = x then by
      simp only [h₂, subst_simple, h₁]
      exact Subst.elementary_spec₁ h₁
    else by
      simp only [subst_simple, h₁, h₂]
      exact Subst.elementary_spec₂ h₁ h₂

@[simp]
theorem subst_simple_trivial {x : β} : subst_simple x (Term.Var x : Term α β) = 1 := by
  simp [subst_simple]

@[simp]
theorem subst_cons {u v : Term α β} {θ : Subst α β} :
  Term.Cons u v • θ = Term.Cons (u • θ) (v • θ) := by
  cases θ; rfl

def carrier (θ : Subst α β) : Fintype β :=
  match θ with
  | ⟨ θ, h ⟩ =>
    let π : {x // θ x ≠ Term.Var x} → β := λ ⟨ x, _ ⟩ => x
    Fintype.mk <| List.map π (epsilon <| λ l => ∀ a, a ∈ l)

def carrier_spec {θ : Subst α β} {y : β} :
  y ∈ carrier θ ↔ (Term.Var y : Term α β) • θ ≠ Term.Var y :=
  match θ with
  | ⟨ θ, hθ ⟩ => by
    apply Iff.intro
    focus
      intro h
      let ⟨ ⟨ x, hx ⟩, ⟨ _, h₂ ⟩ ⟩ := List.mem_map_iff_image.1 h
      exact h₂ ▸ hx
    focus
      let π : {x // θ x ≠ Term.Var x} → β := λ ⟨ x, _ ⟩ => x
      intro h'
      rw [show y = π ⟨ y, h' ⟩ from rfl]
      apply List.mem_map
      apply epsilon_spec hθ

theorem is_one_iff_empty_carrier {θ : Subst α β} : θ = 1 ↔ carrier θ = ∅ := by
  apply Iff.intro
  focus
    intro h
    rw [h, Fintype.ext]
    intro x
    apply Iff.intro _ (False.elim ∘ Fintype.not_mem_empty _)
    rw [carrier_spec]
    exact λ h => False.elim <| h rfl
  focus
    intro h
    rw [Subst.ext]
    intro x
    apply byContradiction
    intro h'
    apply Fintype.not_mem_empty x
    rw [← h, carrier_spec]
    exact h'

theorem carrier_one : carrier (1 : Subst α β) = ∅ :=
  is_one_iff_empty_carrier.1 rfl

theorem is_one_iff_not_modifying (θ : Subst α β) :
  θ = 1 ↔ ∀ x, (Term.Var x : Term α β) • θ = Term.Var x := Subst.ext

theorem not_one_iff_modifying (θ : Subst α β) :
  θ ≠ 1 ↔ ∃ x, (Term.Var x : Term α β) • θ ≠ Term.Var x := by
  apply Iff.intro
  focus
    intro h
    apply byContradiction
    intro h'
    apply h
    rw [Subst.ext]
    intro x
    apply byContradiction
    intro h''
    exact h' ⟨ x, h'' ⟩
  focus
    intro ⟨ x, h ⟩ h'
    rw [is_one_iff_not_modifying] at h'
    exact h (h' x)

theorem elementary_carrier {x : β} {u : Term α β} {h : Term.Var x ≠ u} :
  carrier (Subst.elementary h : Subst α β) = Fintype.mk [x] := by
  apply Fintype.ext.2
  intro y
  rw [carrier_spec]
  apply Iff.intro
  focus
    by_cases p : y = x
    focus
      rw [p]
      intro _
      simp [Fintype.mem_mk_iff]
      apply List.Mem.head
    focus
      intro h'
      apply False.elim ∘ h'
      simp [Subst.elementary, RSMul.smul, map_reduce, p]
  focus
    rw [Fintype.mem_mk_iff]
    intro p
    rw [show y = x by cases p <;> trivial, Subst.elementary_spec₁]
    exact Ne.symm h

theorem carrier_cons (θ φ : Subst α β) : carrier (θ * φ) ⊆ carrier θ ∪ carrier φ := by
  intro x
  rw [Fintype.mem_union_iff]
  simp only [carrier_spec]
  match θ with
  | ⟨ θ, _ ⟩ => match φ with
    | ⟨ φ, _ ⟩ => exact comp_carrier


example : Int → Nat
| (_ : Nat)     => 0
| Int.negSucc n => 0

protected theorem Int.add_comm : ∀ a b : Int, a + b = b + a
| (n : Nat), (m : Nat)         => sorry
| (_ : Nat), Int.negSucc _     => rfl
| Int.negSucc _, (_ : Nat)     => rfl
| Int.negSucc _, Int.negSucc _ => sorry


import .preterm
--..simp_omega
..logic

namespace int

@[derive has_reflect]
inductive form
| eq  : preterm → preterm → form
| le  : preterm → preterm → form
| not : form → form
| or  : form → form → form
| and : form → form → form

notation x `=*` y := form.eq x y
notation x `≤*` y := form.le x y
notation `¬*` p := form.not p
notation p `∨*` q := form.or p q
notation p `∧*` q := form.and p q

-- | (t =* s) :=
-- | (t ≤* s) :=
-- | (¬* p)   :=
-- | (p ∨* q) :=
-- | (p ∧* q) :=

def valuation.cons (i : int) (v : nat → int) : nat → int
| 0     := i
| (k+1) := v k

notation i `::` v := valuation.cons i v

open tactic

namespace form

@[omega] def holds (v : nat → int) : form → Prop
| (t =* s) := t.val v = s.val v
| (t ≤* s) := t.val v ≤ s.val v
| (¬* p)   := ¬ p.holds
| (p ∨* q) := p.holds ∨ q.holds
| (p ∧* q) := p.holds ∧ q.holds

end form

@[omega] def uniclo (p : form) : (nat → int) → nat → Prop
| v 0     := p.holds v
| v (k+1) := ∀ i : int, uniclo (i::v) k

namespace form

def fresh_idx : form → nat
| (t =* s) := max t.fresh_idx s.fresh_idx
| (t ≤* s) := max t.fresh_idx s.fresh_idx
| (¬* p)   := p.fresh_idx
| (p ∨* q) := max p.fresh_idx q.fresh_idx
| (p ∧* q) := max p.fresh_idx q.fresh_idx

--def uniclo (p : form) : Prop :=
--uniclo_core p p.fresh_idx (λ _, 0)

def valid (p : form) : Prop :=
∀ v, holds v p

def sat (p : form) : Prop :=
∃ v, holds v p

def implies (p q : form) : Prop :=
∀ v, (holds v p → holds v q)

def equiv (p q : form) : Prop :=
∀ v, (holds v p ↔ holds v q)

lemma sat_of_implies_of_sat {p q} :
  implies p q → sat p → sat q :=
begin intros h1 h2, apply exists_of_exists h1 h2 end

lemma sat_or {p q : form} :
  sat (p ∨* q) ↔ sat p ∨ sat q :=
begin
  constructor; intro h1,
  { cases h1 with v h1, cases h1 with h1 h1;
    [left,right]; refine ⟨v,_⟩; assumption },
  { cases h1 with h1 h1; cases h1 with v h1;
    refine ⟨v,_⟩; [left,right]; assumption }
end

def unsat (p : form) : Prop := ¬ sat p

def repr : form → string
| (t =* s) := "(" ++ t.repr ++ " = " ++ s.repr ++ ")"
| (t ≤* s) := "(" ++ t.repr ++ " ≤ " ++ s.repr ++ ")"
| (¬* p)   := "¬" ++ p.repr
| (p ∨* q) := "(" ++ p.repr ++ " ∨  " ++ q.repr ++ ")"
| (p ∧* q) := "(" ++ p.repr ++ " ∧ " ++ q.repr ++ ")"

instance has_repr : has_repr form := ⟨repr⟩
meta instance has_to_format : has_to_format form := ⟨λ x, x.repr⟩

end form

lemma uniclo_of_valid {p : form} :
  ∀ {m v}, p.valid → uniclo p v m
| 0 v h1     := h1 _
| (m+1) v h1 := λ i, uniclo_of_valid h1

--lemma uniclo_of_valid {p : form} (h : p.valid) : p.uniclo :=
--uniclo_core_of_valid h

lemma valid_of_unsat_not {p : form} : (¬*p).unsat → p.valid :=
begin
  simp only [form.sat, form.unsat, form.valid, form.holds],
  rw classical.not_exists_not, intro h, assumption
end

meta def form.induce (t : tactic unit := skip) : tactic unit :=
`[ intro p, induction p with t s t s p ih p q ihp ihq p q ihp ihq; t]

end int


import Mathlib.Data.Fintype.Basic
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.Linarith

abbrev DecidableSet.{u} {α : Type u} (r : Set α) := (a : α) → Decidable (a ∈ r)
instance {α} (s : Set α) [DecidableSet s] : DecidableSet s.compl := λ _ => show Decidable (¬_) from inferInstance
instance {α} [DecidableEq α] (j : α) : DecidableSet {j} := λ _ => show Decidable (_ = _) from inferInstance

noncomputable
def Set.size {α} [i : Fintype α] [DecidableEq α] (s : Set α) [DecidableSet s] : Nat :=
  (i.elems.filter (decide $ . ∈ s)).toList.length

structure SimpleGraph (α) [Fintype α] [DecidableEq α] where
  isEdge : α → α → Bool

section
  variable {α} [Fintype α] [DecidableEq α]
  -- instance : ∀ i j, Decidable (graph.isEdge i j) := graph.decidable_isEdge
  -- instance : ∀ i, DecidableSet (graph.isEdge i) := graph.decidable_isEdge

  namespace SimpleGraph
  section
    variable (graph : SimpleGraph α)
    abbrev nodesOutOf (i : α) : Set α := (graph.isEdge i . = true)
    abbrev nodesInto (j : α) : Set α := (graph.isEdge . j = true)
    -- def degreeOutOf (i) := (graph.nodesOutOf i).size
    -- def degreeInto (i) := (graph.nodesInto i).size
    -- def IsLeaf (i) := graph.degreeOutOf i = 1

    def induce (s : Set α) [DecidableSet s] : SimpleGraph { x : α // x ∈ s } where
      isEdge | ⟨i, _⟩, ⟨j, _⟩ => graph.isEdge i j
  end

  variable (graph : SimpleGraph α) in
  inductive Walk : α → α → Type where
  | nil (i) : Walk i i -- path with 0 moves from i to i. Not a path with 1 move along edge i->i
  | cons (i k) (w : Walk i k) (j) (h : graph.isEdge k j = true) : Walk i j

  def WalkIn (graph : SimpleGraph α) (s : Set α) [DecidableSet s] (i j : { x : α // x ∈ s }) :=
    (graph.induce s).Walk i j
  def WalkNotIn (graph : SimpleGraph α) (s : Set α) [DecidableSet s] := graph.WalkIn s.compl

  section
    variable {graph : SimpleGraph α}
    namespace Walk
    def length {i j} : graph.Walk i j → Nat
      | nil i => 0
      | cons i k w j h => w.length + 1

    def nodeList {i j} : graph.Walk i j → List α
      | nil i => [i]
      | cons i k w j h => j :: w.nodeList

    def nodes {i j} : graph.Walk i j → Set α
      | nil i => {i}
      | cons i k w j h => w.nodes ∪ {j}

    theorem first_mem_nodeList {i j} (w : graph.Walk i j) : i ∈ w.nodeList :=
      match w with
      | nil _ => List.Mem.head []
      | cons _ _ w _ _ => List.Mem.tail _ w.first_mem_nodeList
    theorem last_mem_nodeList {i j} (w : graph.Walk i j) : j ∈ w.nodeList :=
      match w with
      | nil _ => List.Mem.head []
      | cons _ _ _ _ _ => List.Mem.head _
    def WalkNotIn_of_notIn_nodeList {i j} (w : graph.Walk i j) {a} (h : a ∉ w.nodeList) :=
      graph.WalkNotIn {a}
        ⟨i, λ c => by subst c; exact h w.first_mem_nodeList⟩
        ⟨j, λ c => by subst c; exact h w.last_mem_nodeList⟩
    def to_WalkNotIn_of_notIn_nodeList {i j} (w : graph.Walk i j) {a} (h : a ∉ w.nodeList)
      : w.WalkNotIn_of_notIn_nodeList h :=
      match w, h with
      | Walk.nil _, h => Walk.nil _
      | Walk.cons _ k w _ hks, h =>
        let r := (to_WalkNotIn_of_notIn_nodeList w λ c => h $ List.mem_cons.mpr $ Or.inr c)
        Walk.cons _ _ r _ hks
    theorem to_WalkNotIn_of_notIn_nodeList_preserves_nodeList {i j} (w : graph.Walk i j) {a} (h : a ∉ w.nodeList)
      : (w.to_WalkNotIn_of_notIn_nodeList h).nodeList.map Subtype.val = w.nodeList :=
      match w, h with
      | Walk.nil _, h => rfl
      | Walk.cons i k w j hks, h =>
        congrArg (List.cons j) $
        to_WalkNotIn_of_notIn_nodeList_preserves_nodeList w λ c => h $ List.mem_cons.mpr $ Or.inr c

    theorem first_mem_nodes {i j} (w : graph.Walk i j) : i ∈ w.nodes :=
      match w with
      | nil _ => rfl
      | cons _ k w _ h => Or.inl w.first_mem_nodes
    theorem last_mem_nodes {i j} (w : graph.Walk i j) : j ∈ w.nodes :=
      match w with
      | nil _ => rfl
      | cons _ k w _ h => Or.inr rfl
    def to_WalkIn_of_Subset {i j} (w : graph.Walk i j) {s} [DecidableSet s] (h : w.nodes ⊆ s)
      : graph.WalkIn s ⟨i, h w.first_mem_nodes⟩ ⟨j, h w.last_mem_nodes⟩ :=
      match w, h with
      | Walk.nil _, h => Walk.nil _
      | Walk.cons _ k w _ hks, h =>
        let r := w.to_WalkIn_of_Subset λ _ hx => h (Or.inl hx)
        Walk.cons _ _ r _ hks
    theorem to_WalkIn_of_Subset_preserves {i j} (w : graph.Walk i j) {s} [DecidableSet s] (h : w.nodes ⊆ s)
      : (w.to_WalkIn_of_Subset h).nodes = sorry := sorry

    end Walk

  end

  def Path (graph : SimpleGraph α) (i j) := { w : graph.Walk i j // List.Nodup w.nodeList }

  def Path2 (graph : SimpleGraph α) (i j) := { w : graph.Walk i j // ∀ i, i ∈ w.nodes → False }
  #exit

  section
    variable {graph : SimpleGraph α}
    namespace Path
    def cons  {i k : α} (p : graph.Path i k) {j : α} (h : graph.isEdge k j = true) (hj : j ∉ p.val.nodeList)
      : graph.Path i j :=
      ⟨Walk.cons _ _ p.val _ h, List.nodup_cons.mpr ⟨hj, p.property⟩⟩

    def to_PathNotIn_of_notIn_nodeList {i j} (p : graph.Path i j) {a} (h : a ∉ p.val.nodeList)
      : (graph.induce (Set.compl {a})).Path
          ⟨i, λ c => by subst c; exact h p.val.first_mem_nodeList⟩
          ⟨j, λ c => by subst c; exact h p.val.last_mem_nodeList⟩ :=
      match i, j, p, h with
      | _, _, ⟨Walk.nil _, _⟩, h => ⟨Walk.nil _, List.nodup_singleton _⟩
      | i, j, ⟨Walk.cons _ k w _ hks, hn⟩, h =>
        have hn := List.nodup_cons.mp hn
        let wr : Walk .. := (w.to_WalkNotIn_of_notIn_nodeList λ c => h $ List.mem_cons.mpr $ Or.inr c)
        have hr : wr.nodeList.map _ = w.nodeList := w.to_WalkNotIn_of_notIn_nodeList_preserves_nodeList _
        have : List.Nodup wr.nodeList := sorry -- from hn, via hr using the fact that map is injective
        let r : Path .. := ⟨wr, this⟩
        r.cons hks $ show _ ∉ wr.nodeList from sorry -- from hn using hr

    def to_PathIn_of_Subset {i j} (p : graph.Path i j) {s} [DecidableSet s] (h : p.val.nodes ⊆ s)
      : (graph.induce s).Path ⟨i, h p.val.first_mem_nodes⟩ ⟨j, h p.val.last_mem_nodes⟩ :=
      match i, j, p, h with
      | _, _, ⟨Walk.nil _, _⟩, h => ⟨Walk.nil _, List.nodup_singleton _⟩
      | i, j, ⟨Walk.cons _ k w _ hks, hn⟩, h =>
      sorry

#exit

    end Path
  end

  example (a : List α) (b : List β) (f : α → β) (hf : f.Injective) (h : a.map f = b) (ha : a.Nodup) : b.Nodup :=
    sorry

  #exit

  section
    variable (graph : SimpleGraph α)

    def Connected := ∀ i j, Nonempty (graph.Walk i j)
    def Cycle (i) := { w : graph.Walk i i // w.length ≠ 0 }
    def Acyclic := ∀ i, graph.Cycle i → False

    theorem exists_nil_Walk_iff (i j) : (∃ w : graph.Walk i j, w.length = 0) ↔ i = j :=
      ⟨λ ⟨w, _⟩ => match w with | Walk.nil i => rfl, λ h => h ▸ ⟨Walk.nil i, rfl⟩⟩

    theorem exists_Walk_iff (i j) (m)
      : (∃ w : graph.Walk i j, w.length = m + 1) ↔ ∃ k, (∃ w : graph.Walk i k, w.length = m) ∧ graph.isEdge k j :=
    ⟨λ ⟨Walk.cons i k w _ hkj, hw⟩ => ⟨k, ⟨⟨w, Nat.succ.inj hw⟩, hkj⟩⟩
    , λ ⟨k, ⟨⟨w, hw⟩, hkj⟩⟩ => ⟨Walk.cons i k w j hkj, congrArg (. + 1) hw⟩⟩

    def decidable_exists_nonnil_Walk (i j) (m : Nat) : Decidable (∃ w : graph.Walk i j, w.length = m + 1) := by
        rw [graph.exists_Walk_iff i j m]
        suffices ∀ k, Decidable ((∃ w : graph.Walk i k, w.length = m) ∧ graph.isEdge k j) from Fintype.decidableExistsFintype
        intro k
        match m with
        | 0 => rw [graph.exists_nil_Walk_iff]; infer_instance
        | m + 1 => let _ := decidable_exists_nonnil_Walk i k m; infer_instance

    def decidable_exists_Walk (i j) (m : Nat) : Decidable (∃ w : graph.Walk i j, w.length = m) := match m with
      | 0 => by rw [graph.exists_nil_Walk_iff i j]; infer_instance
      | m  + 1 => graph.decidable_exists_nonnil_Walk i j m

    -- use the fact that graph is finite so there must be a finite length walk that explores all possibilities
    def decidable_Nonempty_Walk (i j) : Decidable $ Nonempty (graph.Walk i j) :=
        sorry

    -- theorem exists_nil_Path_iff (i j) : (∃ w : graph.Walk i j, w.length = 0) ↔ i = j :=
    --   ⟨λ ⟨w, _⟩ => match w with | Walk.nil i => rfl, λ h => h ▸ ⟨Walk.nil i, rfl⟩⟩

    theorem exists_Path_iff (i j) (m)
      : (∃ w : graph.Path i j, w.val.length = m + 1) ↔ ∃ k, (∃ w : graph.Path i k, j ∉ w.val.nodeList ∧ w.val.length = m) ∧ graph.isEdge k j :=
    ⟨λ ⟨⟨Walk.cons i k w _ hkj, pw⟩, hw⟩ =>
      have pw := List.nodup_cons.mp pw
      ⟨k, ⟨⟨⟨w, pw.2⟩, ⟨pw.1, Nat.succ.inj hw⟩⟩, hkj⟩⟩
    , λ ⟨k, ⟨⟨w, ⟨pw, hw⟩⟩, hkj⟩⟩ =>
      have pw := List.nodup_cons.mpr ⟨pw, w.prop⟩
      ⟨⟨Walk.cons i k w.val j hkj, pw⟩, congrArg (. + 1) hw⟩⟩

    theorem exists_Path_iff2 (i j) (m)
      : (∃ w : graph.Path i j, w.val.length = m + 1) ↔ ∃ k, (∃ w : (graph.cutNodes {j}).Path ⟨i, sorry⟩ ⟨k, sorry⟩, w.val.length = m) ∧ graph.isEdge k j :=
    ⟨λ ⟨⟨Walk.cons i k w _ hkj, pw⟩, hw⟩ =>
      have pw := List.nodup_cons.mp pw
      ⟨k, ⟨⟨⟨sorry, sorry⟩, sorry⟩, hkj⟩⟩,
    sorry⟩

    def decidable_exists_nonnil_Path {α} [Fintype α] [DecidableEq α] (graph : SimpleGraph α)
      (i j) (m : Nat) : Decidable (∃ w : graph.Path i j, w.val.length = m + 1) := by
        rw [graph.exists_Path_iff i j m]
        suffices ∀ k, Decidable ((∃ w : graph.Path i k, j ∉ w.val.nodeList ∧ w.val.length = m) ∧ graph.isEdge k j) from Fintype.decidableExistsFintype
        intro k
        match m with
        | 0 => sorry
        | m + 1 =>
          let g := graph.cutNodes {j}
          let inst := decidable_exists_nonnil_Path g ⟨i, sorry⟩ ⟨k, sorry⟩ m
          -- infer_instance
          sorry

    -- theorem degreeInto_ge_1_of_Connected_and_ge_2 (hn : n ≥ 2) (hc : graph.Connected) (i : Fin n)
    --   : graph.degreeInto i ≥ 1 :=
    --   let j : Fin n := if i = ⟨0, by linarith⟩ then ⟨1, by linarith⟩ else ⟨0, by linarith⟩
    --   have : i.1 ≠ j.1 := sorry
    --   match (hc j i).some with
    --   | .cons _ k w i h => sorry

    -- def findLeaf (hn : n ≥ 2) (hc : graph.Connected) (ha : graph.Acyclic) : Fin n :=
    --   match n, hn with
    --   | 2, _ => 0
    --   | n + 1, _ =>
    --     sorry
  end
  end SimpleGraph
end


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import data.fintype.card

/-!
# Specification of Oracle Access For a Computation

This file defines a type to represent the set of oracles available to a computation.
The `oracle_spec` type specifies an indexing set for the available oracles,
and input and output types for each oracle. We also require that the range of the oracle
is nonempty so it has at least one possible output, and that the range of the oracle
is finite so that each *particular* oracle has a finite number of outputs.

We choose to include `decidable_eq` assumptions for the types in the structure rather than
as further typeclasses on `oracle_spec` for simplicity, but generally these could be seperated.

We also define a number of basic constructions for common oracles:
- `singleton_spec` represents a single oracle with a specified input and output type.
- `empty_spec` represents a lack of any oracles.
- `append` represents bringing together two sets of oracles into one combined set of oracles.
- `coin_spec` represents access to a coin flipping oracle
- `uniform_selecting` represents access to a uniformly random oracle on a numeric range.
-/

/-- Specification of the various oracles available to a computation.
`ι` is an indexing set of oracles (i.e. `ι := ℕ` gives a different oracle for each `n : ℕ`).
`domain range : ι → Type` give the input and output types of the oracle corresponding to an index.
We also require for the output types to be nonempty (ensuring `oracle_comp.support` is nonempty).
`decidable_eq` and `fintype` instances are also required for each oracle index, in order
to define things like `fin_support`. Note that this is only required *per index*, the
total number of oracle outputs may be infinite, it must only be finite for any *specific* index. -/
structure oracle_spec : Type 1 :=
(ι : Type)
(domain range : ι → Type)
(range_inhabited (i : ι) : inhabited $ range i)
(ι_decidable_eq : decidable_eq ι)
(domain_decidable_eq (i : ι) : decidable_eq $ domain i)
(range_decidable_eq (i : ι) : decidable_eq $ range i)
(range_fintype (i : ι) : fintype $ range i)

/-- Example of a simple `oracle_spec` for a pair of oracles,
each taking a natural `n : ℕ` as input, returning a value of type `fin 100` or `bool` respectively.
In practice the instances like `range_inhabited` will usually be derived automatically,
but we expand them here to show the explicit definitions.  -/
example : oracle_spec :=
{ ι := unit ⊕ unit,
  domain := λ _, ℕ,
  range := λ x, match x with | (sum.inl ()) := fin 100 | (sum.inr ()) := bool end,
  range_inhabited := λ x, match x with
  | (sum.inl ()) := fin.inhabited
  | (sum.inr ()) := bool.inhabited
  end,
  ι_decidable_eq := sum.decidable_eq unit unit,
  domain_decidable_eq := λ _, nat.decidable_eq,
  range_decidable_eq := λ x, match x with
  | (sum.inl ()) := fin.decidable_eq 100
  | (sum.inr ()) := bool.decidable_eq
  end,
  range_fintype := λ x, match x with
  | (sum.inl ()) := fin.fintype 100
  | (sum.inr ()) := bool.fintype
  end }

namespace oracle_spec

section instances

instance range.inhabited {spec : oracle_spec} (i : spec.ι) : inhabited (spec.range i) :=
spec.range_inhabited i

variables (spec : oracle_spec)

instance ι.decidable_eq' : decidable_eq spec.ι := spec.ι_decidable_eq

instance domain.decidable_eq' (i : spec.ι) :
  decidable_eq (spec.domain i) := spec.domain_decidable_eq i

instance range.decidable_eq' (i : spec.ι) :
  decidable_eq (spec.range i) := spec.range_decidable_eq i

instance range.fintype' (i : spec.ι) :
  fintype (spec.range i) := spec.range_fintype i

end instances

section singleton_spec

/-- `oracle_spec` representing access to a single oracle with input type `T` and output type `U`.
We use the `unit` type as the index since there is exactly one unique oracle available. -/
@[simps] def singleton_spec (T U : Type) [hU : inhabited U] [hT : decidable_eq T]
  [hU' : decidable_eq U] [hU'' : fintype U] : oracle_spec :=
{ ι := unit,
  domain := λ _, T,
  range := λ _, U,
  range_inhabited := λ _, hU,
  ι_decidable_eq := punit.decidable_eq,
  domain_decidable_eq := λ _, hT,
  range_decidable_eq := λ _, hU',
  range_fintype := λ _, hU'' }

infixl` ↦ₒ `:25 := singleton_spec

variables (T U : Type) [inhabited U] [decidable_eq T] [decidable_eq U] [fintype U]

instance singleton_spec_ι_subsingleton : subsingleton (T ↦ₒ U).ι := punit.subsingleton

end singleton_spec

section empty_spec

/-- No access to any oracles. Represented by an empty indexing set via the `empty` type.
Since `empty` is uninhabited, it isn't possible to construct a query to this oracle,
and therefore any computation with this `oracle_spec` can be evaluated explicitly (`run_comp`). -/
@[simps] def empty_spec : oracle_spec :=
{ ι := empty,
  domain := λ _, unit,
  range := λ _, unit,
  range_inhabited := λ _, by apply_instance,
  ι_decidable_eq := empty.decidable_eq,
  domain_decidable_eq := λ i, i.elim,
  range_decidable_eq := λ i, i.elim,
  range_fintype := λ i, i.elim }

notation `[]ₒ` := empty_spec

instance empty_spec_ι_subsingleton : subsingleton empty_spec.ι := empty.subsingleton

-- instance empty_spec_domain_unique (i : empty_spec.ι) : unique (empty_spec.domain i) := punit.unique

-- instance empty_spec_range_unique (i : empty_spec.ι) : unique (empty_spec.range i) := punit.unique

end empty_spec

instance inhabited : inhabited oracle_spec := ⟨[]ₒ⟩

section append

/-- Combine two specifications using a `sum` type to index the different specs.
Given `spec spec' : oracle_spec`, `spec ++ spec'` gives access to the combined set of oracles,
with `sum.inl` corresponding to the left oracle and `sum.inr` corresponding to the right oracle. -/
instance has_append : has_append oracle_spec :=
{ append := λ spec spec',
  { ι := spec.ι ⊕ spec'.ι,
    domain := sum.elim spec.domain spec'.domain,
    range := sum.elim spec.range spec'.range,
    range_inhabited := λ i, by induction i; simp; apply_instance,
    ι_decidable_eq := sum.decidable_eq spec.ι spec'.ι,
    domain_decidable_eq := λ i, sum.rec_on i spec.domain_decidable_eq spec'.domain_decidable_eq,
    range_decidable_eq := λ i, sum.rec_on i spec.range_decidable_eq spec'.range_decidable_eq,
    range_fintype := λ i, sum.rec_on i spec.range_fintype spec'.range_fintype } }

variables (spec spec' : oracle_spec)

@[simp] lemma append.domain_inl (i : spec.ι) :
  (spec ++ spec').domain (sum.inl i) = spec.domain i := rfl

@[simp] lemma append.domain_inr (i : spec'.ι) :
  (spec ++ spec').domain (sum.inr i) = spec'.domain i := rfl

@[simp] lemma append.range_inl (i : spec.ι) :
  (spec ++ spec').range (sum.inl i) = spec.range i := rfl

@[simp] lemma append.range_inr (i : spec'.ι) :
  (spec ++ spec').range (sum.inr i) = spec'.range i := rfl

end append

section coin_spec

/-- Access to a single oracle, returning a `bool` to each oracle query.
The probability distribution associated to the oracle will eventually be 50/50 for `tt` and `ff`,
representing oracle access to a fair coin flip. -/
@[simps] def coin_spec : oracle_spec := unit ↦ₒ bool

@[simp] lemma card_range_coin_spec (i : unit) : fintype.card (coin_spec.range i) = 2 := rfl

end coin_spec

section uniform_selecting

/-- Access to a `fin n` oracle for each `n : ℕ`, representing an oracle for evenly sampling
from a range of numbers. The output of the `n` query is actually in `fin (n + 1)`,
avoiding a return type of the empty `fin 0` type. -/
@[simps] def uniform_selecting : oracle_spec :=
{ ι := ℕ,
  domain := λ n, unit,
  range := λ n, fin (n + 1),
  range_inhabited := λ n, ⟨0⟩,
  ι_decidable_eq := nat.decidable_eq,
  domain_decidable_eq := λ _, punit.decidable_eq,
  range_decidable_eq := λ n, fin.decidable_eq (n + 1),
  range_fintype := λ n, fin.fintype (n + 1) }

@[simp] lemma card_range_uniform_selecting (n : ℕ) :
  fintype.card (uniform_selecting.range n) = n + 1 := finset.card_fin (n + 1)

end uniform_selecting

end oracle_spec


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.category
import data.equiv.functor

/-!
# Functions functorial with respect to equivalences

An `equiv_functor` is a function from `Type → Type` equipped with the additional data of
coherently mapping equivalences to equivalences.

In categorical language, it is an endofunctor of the "core" of the category `Type`.
-/

universes u₀ u₁ u₂ v₀ v₁ v₂

open function

/--
An `equiv_functor` is only functorial with respect to equivalences.

To construct an `equiv_functor`, it suffices to supply just the function `f α → f β` from
an equivalence `α ≃ β`, and then prove the functor laws. It's then a consequence that
this function is part of an equivalence, provided by `equiv_functor.map_equiv`.
-/
class equiv_functor (f : Type u₀ → Type u₁) :=
(map : Π {α β}, (α ≃ β) → (f α → f β))
(map_refl' : Π α, map (equiv.refl α) = @id (f α) . obviously)
(map_trans' : Π {α β γ} (k : α ≃ β) (h : β ≃ γ),
  map (k.trans h) = (map h) ∘ (map k) . obviously)

restate_axiom equiv_functor.map_refl'
restate_axiom equiv_functor.map_trans'
attribute [simp] equiv_functor.map_refl

namespace equiv_functor

section
variables (f : Type u₀ → Type u₁) [equiv_functor f] {α β : Type u₀} (e : α ≃ β)

/-- An `equiv_functor` in fact takes every equiv to an equiv. -/
def map_equiv :
  f α ≃ f β :=
{ to_fun := equiv_functor.map e,
  inv_fun := equiv_functor.map e.symm,
  left_inv := λ x, by { convert (congr_fun (equiv_functor.map_trans e e.symm) x).symm, simp, },
  right_inv := λ y, by { convert (congr_fun (equiv_functor.map_trans e.symm e) y).symm, simp, }, }

@[simp] lemma map_equiv_apply (x : f α) :
  map_equiv f e x = equiv_functor.map e x := rfl

lemma map_equiv_symm_apply (y : f β) :
  (map_equiv f e).symm y = equiv_functor.map e.symm y := rfl

@[simp] lemma map_equiv_refl (α) :
  map_equiv f (equiv.refl α) = equiv.refl (f α) :=
by simpa [equiv_functor.map_equiv]

@[simp] lemma map_equiv_symm :
  (map_equiv f e).symm = map_equiv f e.symm :=
equiv.ext $ map_equiv_symm_apply f e

/--
The composition of `map_equiv`s is carried over the `equiv_functor`.
For plain `functor`s, this lemma is named `map_map` when applied
or `map_comp_map` when not applied.
-/
@[simp] lemma map_equiv_trans {γ : Type u₀} (ab : α ≃ β) (bc : β ≃ γ) :
  (map_equiv f ab).trans (map_equiv f bc) = map_equiv f (ab.trans bc) :=
equiv.ext $ λ x, by simp [map_equiv, map_trans']

end

@[priority 100]
instance of_is_lawful_functor
  (f : Type u₀ → Type u₁) [functor f] [is_lawful_functor f] : equiv_functor f :=
{ map := λ α β e, functor.map e,
  map_refl' := λ α, by { ext, apply is_lawful_functor.id_map, },
  map_trans' := λ α β γ k h, by { ext x, apply (is_lawful_functor.comp_map k h x), } }

lemma map_equiv.injective
  (f : Type u₀ → Type u₁) [applicative f] [is_lawful_applicative f] {α β : Type u₀}
  (h : ∀ γ, function.injective (pure : γ → f γ)) :
  function.injective (@equiv_functor.map_equiv f _ α β) :=
λ e₁ e₂ H, equiv.ext $ λ x, h β (by simpa [equiv_functor.map] using equiv.congr_fun H (pure x))

end equiv_functor


import tactic
import lib.attempt

open function

theorem challenge4 (X Y Z : Type) (f : X → Y) (g : Y → Z) : surjective (g ∘ f) → surjective g :=
attempt begin
  unfold surjective,
  intros h b,
  cases h b with a hh,
  use f a,
  exact hh,
end $
λ h b, let ⟨ a, h ⟩ := h b in ⟨ f a, h ⟩