import .pseudominor

noncomputable theory
open set
open function

variables {E E₀ E₁ E₂ : Type*} [finite E] [finite E₀] [finite E₁] [finite E₂]
  {e f : E} {M : matroid E} {M₀ : matroid E₀} {M₁ : matroid E₁} {M₂ : matroid E₂}
  {X Y D C F B I I₀ R: set E}

namespace matroid

/-- A structure encoding the fact that `M₀` is isomorphic to a minor of `M` -/
structure minor_embedding (M₀ : matroid E₀) (M : matroid E) :=
(contr : set E)
(to_embedding : E₀ ↪ E)
(disj : disjoint (range to_embedding) contr)
(indep_iff' : ∀ X, M₀.indep X ↔ (M ⟋ contr).indep (to_embedding '' X))

namespace minor_embedding

infix ` →m ` :25 :=  minor_embedding

instance : has_coe_to_fun (minor_embedding M₀ M) (λ a, E₀ → E) := ⟨λ φ, φ.to_embedding⟩

/-- Two `minor_embedding`s are equivalent if they differ only in choice of their contract and
  delete-sets-/
def equiv (φ₁ φ₂ : M₀ →m M) :=
  (φ₁ : E₀ → E) = (φ₂ : E₀ → E)

@[simp] lemma coe_to_embedding (φ : M₀ →m M) :
  (φ.to_embedding : E₀ → E) = (φ : E₀ → E) :=
rfl

@[simp] lemma inj (φ : M₀ →m M) {x y : E₀} :
  φ x = φ y ↔ x = y :=
φ.to_embedding.injective.eq_iff

lemma injective (φ : M₀ →m M) :
  function.injective φ :=
φ.to_embedding.injective

/-- The contract-set of a `minor_embedding` -/
def C (φ : M₀ →m M) : set E :=
  φ.contr

/-- The ground set in `M` of a `minor_embedding` -/
def ground (φ : M₀ →m M) : set E :=
  set.range φ

/-- The delete-set of a `minor_embedding` --/
def D (φ : M₀ →m M) : set E :=
  (φ.C ∪ φ.ground)ᶜ

lemma mem_ground (φ : M₀ →m M) (x : E₀) :
  φ x ∈ φ.ground :=
mem_range_self _

lemma image_subset_ground (φ : M₀ →m M) (I : set E₀) :
  φ '' I ⊆ φ.ground :=
image_subset_range _ _

lemma not_mem_C (φ : M₀ →m M) (x : E₀) :
  φ x ∉ φ.C :=
λ h, φ.disj.ne_of_mem ⟨x,rfl⟩ h rfl

lemma not_mem_D (φ : M₀ →m M) (x : E₀) :
  φ x ∉ φ.D :=
not_mem_compl_iff.mpr (or.inr (φ.mem_ground _))

lemma C_disjoint_ground (φ : M₀ →m M) :
  disjoint φ.C φ.ground :=
disjoint_iff_forall_ne.mpr (by {rintro x hx _ ⟨y,rfl⟩ rfl, exact φ.not_mem_C _ hx})

lemma D_disjoint_ground (φ : M₀ →m M) :
  disjoint φ.D φ.ground :=
disjoint_iff_forall_ne.mpr (by {rintro x hx _ ⟨y,rfl⟩ rfl, exact φ.not_mem_D _ hx})

lemma indep_iff (φ : M₀ →m M) {I₀ : set E₀} :
  M₀.indep I₀ ↔ (M ⟋ φ.C).indep (φ '' I₀) :=
φ.indep_iff' I₀

lemma basis_iff (φ : M₀ →m M) {I₀ X₀ : set E₀} :
  M₀.basis I₀ X₀ ↔ (M ⟋ φ.C).basis (φ '' I₀) (φ '' X₀) :=
begin
  simp_rw [basis_iff, ←φ.indep_iff, image_subset_image_iff φ.injective],
  split,
  { rintro ⟨hi,hss,h⟩,
    refine ⟨hi,hss,λ J hJ hssJ hJss, _⟩,
    have h'J : ∃ J₀, φ '' J₀ = J,
    { rw [←subset_range_iff_exists_image_eq],
      exact hJss.trans (φ.image_subset_ground X₀)} ,
    obtain ⟨J₀,rfl⟩ := h'J,
    rw [image_subset_image_iff φ.injective] at hssJ hJss,
    rw [←φ.indep_iff] at hJ,
    rw [h _ hJ hssJ hJss]},
  rintro ⟨hi, hss, h⟩,
  refine ⟨hi, hss, λ J₀ hJ₀ hssJ₀ hJ₀ss, hssJ₀.antisymm _⟩,
  specialize h (φ '' J₀) (φ.indep_iff.mp hJ₀) ((image_subset_image_iff φ.injective).mpr hssJ₀)
    ((image_subset_image_iff φ.injective).mpr hJ₀ss),
  rw ←(image_subset_image_iff φ.injective),
  exact h.symm.subset,
end

lemma indep_project_iff (φ : M₀ →m M) (I₀ C₀ : set E₀) :
  (M₀ ⟋ C₀).indep I₀ ↔ (M ⟋ φ.C ⟋ (φ '' C₀)).indep (φ '' I₀) :=
begin
  obtain ⟨IC₀,hIC₀⟩ := M₀.exists_basis C₀,
  have h''  := φ.basis_iff.mp hIC₀,
  obtain (hI₀ | hI₀) := em (M₀.indep I₀),
  { rw [←hIC₀.project_eq_project,  ←h''.project_eq_project,
      indep.project_indep_iff h''.indep (φ.indep_iff.mp hI₀), ←image_union,
      ←φ.indep_iff, disjoint_image_iff φ.injective, indep.project_indep_iff hIC₀.indep hI₀]},

  apply iff_of_false (λ hI₀', hI₀ (indep_of_project_indep hI₀')) (λ hI₀', hI₀ _),
  have h' := indep_of_project_indep hI₀',
  rwa [←φ.indep_iff] at h',
end

/-- If `M₀` is a minor of `M₁` and `M₁` is a minor of `M₂`, then `M₀` is a minor of `M₂` -/
def trans (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  M₀ →m M₂ :=
{ contr := (φ₁₂ '' φ₀₁.C) ∪ φ₁₂.C ,
  to_embedding := φ₀₁.to_embedding.trans φ₁₂.to_embedding,
  disj := begin
    refine disjoint_iff_forall_ne.mpr _,
    simp_rw [mem_range, embedding.trans_apply, coe_to_embedding],
    rintro x ⟨x₀,rfl⟩ y (⟨x₁,hx₁,rfl⟩ | hy) he,
    { simp_rw [minor_embedding.inj] at he,
      subst he,
      exact φ₀₁.not_mem_C _ hx₁},
    subst he,
    exact φ₁₂.not_mem_C _ hy,
  end,
  indep_iff' :=
  begin
    intro X,
    simp only [embedding.trans_apply, coe_to_embedding ],
    nth_rewrite 1 ←image_image,
    dsimp only,
    rw [←project_project, project_project_comm, ←φ₁₂.indep_project_iff, φ₀₁.indep_iff],
  end }

@[simp] lemma trans_apply (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) (x : E₀) :
  (φ₀₁.trans φ₁₂) x = φ₁₂ (φ₀₁ x) :=
rfl

@[simp] lemma trans_apply_image (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) (X : set E₀) :
  (φ₀₁.trans φ₁₂) '' X = φ₁₂ '' (φ₀₁ '' X) :=
by {ext, simp only [trans_apply, mem_image, exists_exists_and_eq_and]}

@[simp] lemma trans_apply_C (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).C = (φ₁₂ '' φ₀₁.C) ∪ φ₁₂.C :=
rfl

@[simp] lemma trans_apply_ground (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).ground = φ₁₂ '' (φ₀₁.ground) :=
by {ext, simp [ground]}

/- What a mess! Should be trivial -/
@[simp] lemma trans_apply_D (φ₀₁ : M₀ →m M₁) (φ₁₂ : M₁ →m M₂) :
  (φ₀₁.trans φ₁₂).D = (φ₁₂ '' φ₀₁.D) ∪ φ₁₂.D :=
begin
  apply compl_injective,
  simp only [D, trans_apply_C, trans_apply_ground, ground, compl_compl,
    compl_union, φ₁₂.injective.compl_image, compl_inter, image_union],
  rw [inter_distrib_right, inter_eq_left_iff_subset.mpr (image_subset_range φ₁₂ _),
    compl_inter_self, union_empty, ←range_comp, inter_distrib_left, inter_distrib_right,
    inter_eq_right_iff_subset.mpr
      (subset_compl_iff_disjoint_right.mpr φ₁₂.C_disjoint_ground : φ₁₂.C ⊆ (range φ₁₂)ᶜ),
    union_eq_right_iff_subset.mpr (inter_subset_right _ _), inter_distrib_right,
    compl_inter_self, union_empty, inter_distrib_right,
    inter_eq_left_iff_subset.mpr (range_comp_subset_range _ _),
    union_distrib_right, union_distrib_left,
    union_eq_left_iff_subset.mpr (range_comp_subset_range _ _), ←union_assoc,
    union_comm φ₁₂.C, eq_comm],

  convert inter_eq_left_iff_subset.mpr (union_subset (union_subset _ (subset_union_left _ _)) _),
  { exact (image_subset_range _ _).trans (subset_union_right _ _)},
  exact (range_comp_subset_range _ _).trans (subset_union_right _ _),
end

/-- A `minor_embedding` gives rise to a dual embedding -/
def dual (φ : M₀ →m M) :
  M₀.dual →m M.dual :=
{ contr := φ.D,
  to_embedding := φ.to_embedding,
  disj := φ.D_disjoint_ground.symm,
  indep_iff' := begin
    intro X,

    -- rw [dual_indep_iff_coindep],
  end  }

/-- The scum theorem; every `minor_embedding`, has an equivalent embedding whose contract-set is
  independent and whose delete-set is coindependent -/
theorem exists_indep_coindep_embedding (φ : M₀ →m M) :
  ∃ (ψ : M₀ →m M), ψ.equiv φ ∧ M.indep ψ.C ∧ M.coindep φ.D :=
sorry

end minor_embedding

/-- `M₀` is isomorphic to a minor of `M` if there is a `minor_embedding` from `M₀` to `M` -/
def is_iso_minor (M₀ : matroid E₀) (M : matroid E) : Prop :=
  nonempty (M₀ →m M)

/-- A matroid `M₀` on a subtype is a minor of `M` if there is a `minor_embedding` whose associated
  embedding function is the inclusion map. -/
def is_minor {X : set E} (M₀ : matroid X) (M : matroid E) : Prop :=
  ∃ (φ : M₀ →m M), (φ : X → E) = coe

infix ` ≤m ` : 25 := is_iso_minor

end matroid


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u v l u_1 w x u_2 u_3

namespace Mathlib

/-- A `pequiv` is a partial equivalence, a representation of a bijection between a subset
  of `α` and a subset of `β` -/
structure pequiv (α : Type u) (β : Type v) where
  to_fun : α → Option β
  inv_fun : β → Option α
  inv : ∀ (a : α) (b : β), a ∈ inv_fun b ↔ b ∈ to_fun a

infixr:25 " ≃. " => Mathlib.pequiv

namespace pequiv

protected instance has_coe_to_fun {α : Type u} {β : Type v} : has_coe_to_fun (α ≃. β) :=
  has_coe_to_fun.mk (fun (x : α ≃. β) => α → Option β) to_fun

@[simp] theorem coe_mk_apply {α : Type u} {β : Type v} (f₁ : α → Option β) (f₂ : β → Option α)
    (h : ∀ (a : α) (b : β), a ∈ f₂ b ↔ b ∈ f₁ a) (x : α) : coe_fn (mk f₁ f₂ h) x = f₁ x :=
  rfl

theorem ext {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β}
    (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  sorry

theorem ext_iff {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β} :
    f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := congr_fun ∘ congr_arg fun {f : α ≃. β} (x : α) => coe_fn f x, mpr := ext }

protected def refl (α : Type u_1) : α ≃. α := mk some some sorry

protected def symm {α : Type u} {β : Type v} (f : α ≃. β) : β ≃. α :=
  mk (inv_fun f) (to_fun f) sorry

theorem mem_iff_mem {α : Type u} {β : Type v} (f : α ≃. β) {a : α} {b : β} :
    a ∈ coe_fn (pequiv.symm f) b ↔ b ∈ coe_fn f a :=
  inv f

theorem eq_some_iff {α : Type u} {β : Type v} (f : α ≃. β) {a : α} {b : β} :
    coe_fn (pequiv.symm f) b = some a ↔ coe_fn f a = some b :=
  inv f

protected def trans {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) : α ≃. γ :=
  mk (fun (a : α) => option.bind (coe_fn f a) ⇑g)
    (fun (a : γ) => option.bind (coe_fn (pequiv.symm g) a) ⇑(pequiv.symm f)) sorry

@[simp] theorem refl_apply {α : Type u} (a : α) : coe_fn (pequiv.refl α) a = some a := rfl

@[simp] theorem symm_refl {α : Type u} : pequiv.symm (pequiv.refl α) = pequiv.refl α := rfl

@[simp] theorem symm_symm {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.symm (pequiv.symm f) = f :=
  sorry

theorem symm_injective {α : Type u} {β : Type v} : function.injective pequiv.symm :=
  function.left_inverse.injective symm_symm

theorem trans_assoc {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} (f : α ≃. β) (g : β ≃. γ)
    (h : γ ≃. δ) : pequiv.trans (pequiv.trans f g) h = pequiv.trans f (pequiv.trans g h) :=
  ext fun (_x : α) => option.bind_assoc (coe_fn f _x) ⇑g ⇑h

theorem mem_trans {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
    c ∈ coe_fn (pequiv.trans f g) a ↔ ∃ (b : β), b ∈ coe_fn f a ∧ c ∈ coe_fn g b :=
  option.bind_eq_some'

theorem trans_eq_some {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α)
    (c : γ) :
    coe_fn (pequiv.trans f g) a = some c ↔ ∃ (b : β), coe_fn f a = some b ∧ coe_fn g b = some c :=
  option.bind_eq_some'

theorem trans_eq_none {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) (a : α) :
    coe_fn (pequiv.trans f g) a = none ↔ ∀ (b : β) (c : γ), ¬b ∈ coe_fn f a ∨ ¬c ∈ coe_fn g b :=
  sorry

@[simp] theorem refl_trans {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans (pequiv.refl α) f = f :=
  ext fun (x : α) => option.ext fun (a : β) => id (iff.refl (a ∈ coe_fn f x))

@[simp] theorem trans_refl {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans f (pequiv.refl β) = f :=
  sorry

protected theorem inj {α : Type u} {β : Type v} (f : α ≃. β) {a₁ : α} {a₂ : α} {b : β}
    (h₁ : b ∈ coe_fn f a₁) (h₂ : b ∈ coe_fn f a₂) : a₁ = a₂ :=
  sorry

theorem injective_of_forall_ne_is_some {α : Type u} {β : Type v} (f : α ≃. β) (a₂ : α)
    (h : ∀ (a₁ : α), a₁ ≠ a₂ → ↥(option.is_some (coe_fn f a₁))) : function.injective ⇑f :=
  sorry

theorem injective_of_forall_is_some {α : Type u} {β : Type v} {f : α ≃. β}
    (h : ∀ (a : α), ↥(option.is_some (coe_fn f a))) : function.injective ⇑f :=
  sorry

def of_set {α : Type u} (s : set α) [decidable_pred s] : α ≃. α :=
  mk (fun (a : α) => ite (a ∈ s) (some a) none) (fun (a : α) => ite (a ∈ s) (some a) none) sorry

theorem mem_of_set_self_iff {α : Type u} {s : set α} [decidable_pred s] {a : α} :
    a ∈ coe_fn (of_set s) a ↔ a ∈ s :=
  sorry

theorem mem_of_set_iff {α : Type u} {s : set α} [decidable_pred s] {a : α} {b : α} :
    a ∈ coe_fn (of_set s) b ↔ a = b ∧ a ∈ s :=
  sorry

@[simp] theorem of_set_eq_some_iff {α : Type u} {s : set α} {h : decidable_pred s} {a : α} {b : α} :
    coe_fn (of_set s) b = some a ↔ a = b ∧ a ∈ s :=
  mem_of_set_iff

@[simp] theorem of_set_eq_some_self_iff {α : Type u} {s : set α} {h : decidable_pred s} {a : α} :
    coe_fn (of_set s) a = some a ↔ a ∈ s :=
  mem_of_set_self_iff

@[simp] theorem of_set_symm {α : Type u} (s : set α) [decidable_pred s] :
    pequiv.symm (of_set s) = of_set s :=
  rfl

@[simp] theorem of_set_univ {α : Type u} : of_set set.univ = pequiv.refl α := rfl

@[simp] theorem of_set_eq_refl {α : Type u} {s : set α} [decidable_pred s] :
    of_set s = pequiv.refl α ↔ s = set.univ :=
  sorry

theorem symm_trans_rev {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) (g : β ≃. γ) :
    pequiv.symm (pequiv.trans f g) = pequiv.trans (pequiv.symm g) (pequiv.symm f) :=
  rfl

theorem trans_symm {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans f (pequiv.symm f) =
        of_set (set_of fun (a : α) => ↥(option.is_some (coe_fn f a))) :=
  sorry

theorem symm_trans {α : Type u} {β : Type v} (f : α ≃. β) :
    pequiv.trans (pequiv.symm f) f =
        of_set (set_of fun (b : β) => ↥(option.is_some (coe_fn (pequiv.symm f) b))) :=
  sorry

theorem trans_symm_eq_iff_forall_is_some {α : Type u} {β : Type v} {f : α ≃. β} :
    pequiv.trans f (pequiv.symm f) = pequiv.refl α ↔ ∀ (a : α), ↥(option.is_some (coe_fn f a)) :=
  sorry

protected instance has_bot {α : Type u} {β : Type v} : has_bot (α ≃. β) :=
  has_bot.mk (mk (fun (_x : α) => none) (fun (_x : β) => none) sorry)

@[simp] theorem bot_apply {α : Type u} {β : Type v} (a : α) : coe_fn ⊥ a = none := rfl

@[simp] theorem symm_bot {α : Type u} {β : Type v} : pequiv.symm ⊥ = ⊥ := rfl

@[simp] theorem trans_bot {α : Type u} {β : Type v} {γ : Type w} (f : α ≃. β) :
    pequiv.trans f ⊥ = ⊥ :=
  sorry

@[simp] theorem bot_trans {α : Type u} {β : Type v} {γ : Type w} (f : β ≃. γ) :
    pequiv.trans ⊥ f = ⊥ :=
  sorry

theorem is_some_symm_get {α : Type u} {β : Type v} (f : α ≃. β) {a : α}
    (h : ↥(option.is_some (coe_fn f a))) :
    ↥(option.is_some (coe_fn (pequiv.symm f) (option.get h))) :=
  sorry

def single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α) (b : β) : α ≃. β :=
  mk (fun (x : α) => ite (x = a) (some b) none) (fun (x : β) => ite (x = b) (some a) none) sorry

theorem mem_single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α) (b : β) :
    b ∈ coe_fn (single a b) a :=
  if_pos rfl

theorem mem_single_iff {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a₁ : α) (a₂ : α)
    (b₁ : β) (b₂ : β) : b₁ ∈ coe_fn (single a₂ b₂) a₁ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
  sorry

@[simp] theorem symm_single {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α)
    (b : β) : pequiv.symm (single a b) = single b a :=
  rfl

@[simp] theorem single_apply {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] (a : α)
    (b : β) : coe_fn (single a b) a = some b :=
  if_pos rfl

theorem single_apply_of_ne {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] {a₁ : α}
    {a₂ : α} (h : a₁ ≠ a₂) (b : β) : coe_fn (single a₁ b) a₂ = none :=
  if_neg (ne.symm h)

theorem single_trans_of_mem {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α] [DecidableEq β]
    [DecidableEq γ] (a : α) {b : β} {c : γ} {f : β ≃. γ} (h : c ∈ coe_fn f b) :
    pequiv.trans (single a b) f = single a c :=
  sorry

theorem trans_single_of_mem {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α] [DecidableEq β]
    [DecidableEq γ] {a : α} {b : β} (c : γ) {f : α ≃. β} (h : b ∈ coe_fn f a) :
    pequiv.trans f (single b c) = single a c :=
  symm_injective (single_trans_of_mem c (iff.mpr (mem_iff_mem f) h))

@[simp] theorem single_trans_single {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α]
    [DecidableEq β] [DecidableEq γ] (a : α) (b : β) (c : γ) :
    pequiv.trans (single a b) (single b c) = single a c :=
  single_trans_of_mem a (mem_single b c)

@[simp] theorem single_subsingleton_eq_refl {α : Type u} [DecidableEq α] [subsingleton α] (a : α)
    (b : α) : single a b = pequiv.refl α :=
  sorry

theorem trans_single_of_eq_none {β : Type v} {γ : Type w} {δ : Type x} [DecidableEq β]
    [DecidableEq γ] {b : β} (c : γ) {f : δ ≃. β} (h : coe_fn (pequiv.symm f) b = none) :
    pequiv.trans f (single b c) = ⊥ :=
  sorry

theorem single_trans_of_eq_none {α : Type u} {β : Type v} {δ : Type x} [DecidableEq α]
    [DecidableEq β] (a : α) {b : β} {f : β ≃. δ} (h : coe_fn f b = none) :
    pequiv.trans (single a b) f = ⊥ :=
  symm_injective (trans_single_of_eq_none a h)

theorem single_trans_single_of_ne {α : Type u} {β : Type v} {γ : Type w} [DecidableEq α]
    [DecidableEq β] [DecidableEq γ] {b₁ : β} {b₂ : β} (h : b₁ ≠ b₂) (a : α) (c : γ) :
    pequiv.trans (single a b₁) (single b₂ c) = ⊥ :=
  single_trans_of_eq_none a (single_apply_of_ne (ne.symm h) c)

protected instance partial_order {α : Type u} {β : Type v} : partial_order (α ≃. β) :=
  partial_order.mk (fun (f g : α ≃. β) => ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a)
    (preorder.lt._default fun (f g : α ≃. β) => ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a)
    sorry sorry sorry

theorem le_def {α : Type u} {β : Type v} {f : α ≃. β} {g : α ≃. β} :
    f ≤ g ↔ ∀ (a : α) (b : β), b ∈ coe_fn f a → b ∈ coe_fn g a :=
  iff.rfl

protected instance order_bot {α : Type u} {β : Type v} : order_bot (α ≃. β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_inf_bot {α : Type u} {β : Type v} [DecidableEq α] [DecidableEq β] :
    semilattice_inf_bot (α ≃. β) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    (fun (f g : α ≃. β) =>
      mk (fun (a : α) => ite (coe_fn f a = coe_fn g a) (coe_fn f a) none)
        (fun (b : β) =>
          ite (coe_fn (pequiv.symm f) b = coe_fn (pequiv.symm g) b) (coe_fn (pequiv.symm f) b) none)
        sorry)
    sorry sorry sorry

end pequiv

namespace equiv

def to_pequiv {α : Type u_1} {β : Type u_2} (f : α ≃ β) : α ≃. β :=
  pequiv.mk (some ∘ ⇑f) (some ∘ ⇑(equiv.symm f)) sorry

@[simp] theorem to_pequiv_refl {α : Type u_1} : to_pequiv (equiv.refl α) = pequiv.refl α := rfl

theorem to_pequiv_trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α ≃ β) (g : β ≃ γ) :
    to_pequiv (equiv.trans f g) = pequiv.trans (to_pequiv f) (to_pequiv g) :=
  rfl

theorem to_pequiv_symm {α : Type u_1} {β : Type u_2} (f : α ≃ β) :
    to_pequiv (equiv.symm f) = pequiv.symm (to_pequiv f) :=
  rfl

theorem to_pequiv_apply {α : Type u_1} {β : Type u_2} (f : α ≃ β) (x : α) :
    coe_fn (to_pequiv f) x = some (coe_fn f x) :=
  rfl

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.lint.default
import Mathlib.tactic.ext
import Mathlib.PostPort

universes u_1 u_4 u_2 u_3 u_5 u_6

namespace Mathlib

namespace sigma

protected instance inhabited {α : Type u_1} {β : α → Type u_4} [Inhabited α] [Inhabited (β Inhabited.default)] : Inhabited (sigma β) :=
  { default := mk Inhabited.default Inhabited.default }

protected instance decidable_eq {α : Type u_1} {β : α → Type u_4} [h₁ : DecidableEq α] [h₂ : (a : α) → DecidableEq (β a)] : DecidableEq (sigma β) :=
  sorry

@[simp] theorem mk.inj_iff {α : Type u_1} {β : α → Type u_4} {a₁ : α} {a₂ : α} {b₁ : β a₁} {b₂ : β a₂} : mk a₁ b₁ = mk a₂ b₂ ↔ a₁ = a₂ ∧ b₁ == b₂ := sorry

@[simp] theorem eta {α : Type u_1} {β : α → Type u_4} (x : sigma fun (a : α) => β a) : mk (fst x) (snd x) = x :=
  cases_on x
    fun (x_fst : α) (x_snd : β x_fst) =>
      idRhs (mk (fst (mk x_fst x_snd)) (snd (mk x_fst x_snd)) = mk (fst (mk x_fst x_snd)) (snd (mk x_fst x_snd))) rfl

theorem ext {α : Type u_1} {β : α → Type u_4} {x₀ : sigma β} {x₁ : sigma β} (h₀ : fst x₀ = fst x₁) (h₁ : snd x₀ == snd x₁) : x₀ = x₁ := sorry

theorem ext_iff {α : Type u_1} {β : α → Type u_4} {x₀ : sigma β} {x₁ : sigma β} : x₀ = x₁ ↔ fst x₀ = fst x₁ ∧ snd x₀ == snd x₁ :=
  cases_on x₀ fun (x₀_fst : α) (x₀_snd : β x₀_fst) => cases_on x₁ fun (x₁_fst : α) (x₁_snd : β x₁_fst) => mk.inj_iff

@[simp] theorem forall {α : Type u_1} {β : α → Type u_4} {p : (sigma fun (a : α) => β a) → Prop} : (∀ (x : sigma fun (a : α) => β a), p x) ↔ ∀ (a : α) (b : β a), p (mk a b) := sorry

@[simp] theorem exists {α : Type u_1} {β : α → Type u_4} {p : (sigma fun (a : α) => β a) → Prop} : (∃ (x : sigma fun (a : α) => β a), p x) ↔ ∃ (a : α), ∃ (b : β a), p (mk a b) := sorry

/-- Map the left and right components of a sigma -/
def map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} (f₁ : α₁ → α₂) (f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)) (x : sigma β₁) : sigma β₂ :=
  mk (f₁ (fst x)) (f₂ (fst x) (snd x))

end sigma

theorem sigma_mk_injective {α : Type u_1} {β : α → Type u_4} {i : α} : function.injective (sigma.mk i) := sorry

theorem function.injective.sigma_map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} {f₁ : α₁ → α₂} {f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)} (h₁ : function.injective f₁) (h₂ : ∀ (a : α₁), function.injective (f₂ a)) : function.injective (sigma.map f₁ f₂) := sorry

theorem function.surjective.sigma_map {α₁ : Type u_2} {α₂ : Type u_3} {β₁ : α₁ → Type u_5} {β₂ : α₂ → Type u_6} {f₁ : α₁ → α₂} {f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)} (h₁ : function.surjective f₁) (h₂ : ∀ (a : α₁), function.surjective (f₂ a)) : function.surjective (sigma.map f₁ f₂) := sorry

/-- Interpret a function on `Σ x : α, β x` as a dependent function with two arguments. -/
def sigma.curry {α : Type u_1} {β : α → Type u_4} {γ : (a : α) → β a → Type u_2} (f : (x : sigma β) → γ (sigma.fst x) (sigma.snd x)) (x : α) (y : β x) : γ x y :=
  f (sigma.mk x y)

/-- Interpret a dependent function with two arguments as a function on `Σ x : α, β x` -/
def sigma.uncurry {α : Type u_1} {β : α → Type u_4} {γ : (a : α) → β a → Type u_2} (f : (x : α) → (y : β x) → γ x y) (x : sigma β) : γ (sigma.fst x) (sigma.snd x) :=
  f (sigma.fst x) (sigma.snd x)

/-- Convert a product type to a Σ-type. -/
@[simp] def prod.to_sigma {α : Type u_1} {β : Type u_2} : α × β → sigma fun (_x : α) => β :=
  sorry

@[simp] theorem prod.fst_to_sigma {α : Type u_1} {β : Type u_2} (x : α × β) : sigma.fst (prod.to_sigma x) = prod.fst x :=
  prod.cases_on x fun (x_fst : α) (x_snd : β) => Eq.refl (sigma.fst (prod.to_sigma (x_fst, x_snd)))

@[simp] theorem prod.snd_to_sigma {α : Type u_1} {β : Type u_2} (x : α × β) : sigma.snd (prod.to_sigma x) = prod.snd x :=
  prod.cases_on x fun (x_fst : α) (x_snd : β) => Eq.refl (sigma.snd (prod.to_sigma (x_fst, x_snd)))

namespace psigma

/-- Nondependent eliminator for `psigma`. -/
def elim {α : Sort u_1} {β : α → Sort u_2} {γ : Sort u_3} (f : (a : α) → β a → γ) (a : psigma β) : γ :=
  cases_on a f

@[simp] theorem elim_val {α : Sort u_1} {β : α → Sort u_2} {γ : Sort u_3} (f : (a : α) → β a → γ) (a : α) (b : β a) : elim f (mk a b) = f a b :=
  rfl

protected instance inhabited {α : Sort u_1} {β : α → Sort u_2} [Inhabited α] [Inhabited (β Inhabited.default)] : Inhabited (psigma β) :=
  { default := mk Inhabited.default Inhabited.default }

protected instance decidable_eq {α : Sort u_1} {β : α → Sort u_2} [h₁ : DecidableEq α] [h₂ : (a : α) → DecidableEq (β a)] : DecidableEq (psigma β) :=
  sorry

theorem mk.inj_iff {α : Sort u_1} {β : α → Sort u_2} {a₁ : α} {a₂ : α} {b₁ : β a₁} {b₂ : β a₂} : mk a₁ b₁ = mk a₂ b₂ ↔ a₁ = a₂ ∧ b₁ == b₂ := sorry

theorem ext {α : Sort u_1} {β : α → Sort u_2} {x₀ : psigma β} {x₁ : psigma β} (h₀ : fst x₀ = fst x₁) (h₁ : snd x₀ == snd x₁) : x₀ = x₁ := sorry

theorem ext_iff {α : Sort u_1} {β : α → Sort u_2} {x₀ : psigma β} {x₁ : psigma β} : x₀ = x₁ ↔ fst x₀ = fst x₁ ∧ snd x₀ == snd x₁ :=
  cases_on x₀ fun (x₀_fst : α) (x₀_snd : β x₀_fst) => cases_on x₁ fun (x₁_fst : α) (x₁_snd : β x₁_fst) => mk.inj_iff

/-- Map the left and right components of a sigma -/
def map {α₁ : Sort u_3} {α₂ : Sort u_4} {β₁ : α₁ → Sort u_5} {β₂ : α₂ → Sort u_6} (f₁ : α₁ → α₂) (f₂ : (a : α₁) → β₁ a → β₂ (f₁ a)) : psigma β₁ → psigma β₂ :=
  sorry


import topology.opens
import topology.algebra.continuous_functions

import for_mathlib.filter
import for_mathlib.data.set.basic

open topological_space function

local notation `𝓝` x:70 := nhds x
local notation f `∘₂` g := function.bicompr f g

-- We need to think whether we could directly use the class t2_space (which is not using opens though)
definition is_hausdorff (α : Type*) [topological_space α] : Prop :=
  ∀ x y, x ≠ y → ∃ u v : opens α, x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅

open set filter

instance regular_of_discrete {α : Type*} [topological_space α] [discrete_topology α] :
  regular_space α :=
{ t1 := λ x, is_open_discrete _,
  regular :=
  begin
    intros s a s_closed a_not,
    refine ⟨s, is_open_discrete s, subset.refl s, _⟩,
    erw [← empty_in_sets_eq_bot, mem_inf_sets],
    use {a},
    rw nhds_discrete α,
    simp,
    refine ⟨s, subset.refl s, _ ⟩,
    rintro x ⟨xa, xs⟩,
    rw ← mem_singleton_iff.1 xa at a_not,
    exact a_not xs
  end }

lemma continuous_of_const {α : Type*} {β : Type*}
  [topological_space α] [topological_space β]
  {f : α → β} (h : ∀a b, f a = f b) :
  continuous f :=
λ s _, by convert @is_open_const _ _ (∃ a, f a ∈ s); exact
  set.ext (λ a, ⟨λ fa, ⟨_, fa⟩,
    λ ⟨b, fb⟩, show f a ∈ s, from h b a ▸ fb⟩)

section
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

def continuous₂ (f : α → β → γ) := continuous (function.uncurry' f)

lemma continuous₂_def (f : α → β → γ) : continuous₂ f ↔ continuous (function.uncurry' f) := iff.rfl

lemma continuous₂_curry (f : α × β → γ) : continuous₂ (function.curry f) ↔ continuous f :=
by rw  [←function.uncurry'_curry f] {occs := occurrences.pos [2]} ; refl

lemma continuous₂.comp {f : α → β → γ} {g : γ → δ} (hf : continuous₂ f)(hg : continuous g) :
  continuous₂ (g ∘₂ f) := hg.comp hf

section
open set filter lattice function

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

lemma continuous_of_continuous_on_of_induced (H : h ∘ f = i ∘ g) (hi : continuous_on i $ range g)
  (hg : ‹topological_space α› = induced g ‹topological_space γ›)
  (hh : ‹topological_space β› = induced h ‹topological_space δ›) : continuous f :=
begin
  rw continuous_iff_continuous_at,
  intro x,
  dsimp [continuous_at, tendsto],
  rw [hg, hh, nhds_induced, nhds_induced, ← map_le_iff_le_comap, map_comm H],
  specialize hi (g x) ⟨x, rfl⟩,
  have := calc
    nhds_within (g x) (range g) = 𝓝 g x ⊓ principal (range g) : rfl
    ... = 𝓝 g x ⊓ map g (principal univ) : by rw [← image_univ, ← map_principal]
    ... = 𝓝 g x ⊓ map g ⊤ : by rw principal_univ,
  rw [continuous_within_at, this, ← comp_app i g, ← congr_fun H x] at hi, clear this,
  have := calc
    map g (comap g 𝓝 g x) = map g (comap  g 𝓝 g x ⊓ ⊤) : by rw inf_top_eq
    ... ≤ map g (comap g 𝓝 g x) ⊓ map g ⊤ : map_inf_le
    ... ≤ 𝓝 g x ⊓ map g ⊤ : inf_le_inf map_comap_le (le_refl _),
  exact le_trans (map_mono this) hi,
end

variables  (eg : embedding g) (eh : embedding h)
include eg

lemma embedding.nhds_eq_comap (a : α) : nhds a = comap g (nhds $ g a) :=
by rw [eg.induced, nhds_induced]

include eh

lemma embedding.tendsto_iff (H : h ∘ f = i ∘ g) (a : α) : continuous_at i (g a) → continuous_at f a:=
begin
  let N := nhds a, let Nf := nhds (f a),
  let Nhf := nhds (h $ f a), let Ng := nhds (g a),
  have Neq1 : Nf = comap h Nhf, from eh.nhds_eq_comap (f a),
  have Neq2 : N = comap g Ng, from eg.nhds_eq_comap a,
  intro hyp,
  replace hyp : Ng ≤ comap i Nhf,
  { unfold continuous_at at hyp,
    rw ← show h (f a) = i (g a), from congr_fun H a at hyp,
    rwa tendsto_iff_comap at hyp },
  rw calc
      continuous_at f a ↔ tendsto f N Nf : iff.rfl
      ... ↔ N ≤ comap f Nf : tendsto_iff_comap
      ... ↔ comap g Ng ≤ comap f (comap h Nhf) : by rw [Neq1, Neq2]
      ... ↔ comap g Ng ≤ comap g (comap i Nhf) : by rw comap_comm H,
  exact comap_mono hyp
end
end
end

namespace dense_inducing
open set function filter
variables {α : Type*} {β : Type*} {δ : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space δ] [topological_space γ]

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

lemma comp (dh : dense_inducing h) (df : dense_inducing f) : dense_inducing (h ∘ f) :=
{ dense := dense_range.comp _ dh.dense df.dense dh.continuous,
  induced := (dh.to_inducing.comp df.to_inducing).induced }

lemma of_comm_square (dg : dense_inducing g) (di : dense_inducing i)
  (dh : dense_inducing h) (H : h ∘ f = i ∘ g) : dense_inducing f :=
have dhf : dense_inducing (h ∘ f),
  by {rw H, exact di.comp dg },
{ dense := begin
    intro x,
    have H := dhf.dense (h x),
    rw mem_closure_iff_nhds at H ⊢,
    intros t ht,
    rw [dh.nhds_eq_comap x, mem_comap_sets] at ht,
    rcases ht with ⟨u, hu, hinc⟩,
    rcases H u hu with ⟨v, hv1, a, rfl⟩,
    use f a,
    split, swap, apply mem_range_self,
    apply mem_of_mem_of_subset _ hinc,
    rwa mem_preimage,
  end ,
--  inj := λ a b H, dhf.inj (by {show h (f a) = _, rw H}),
  induced := by rw [dg.induced, di.induced, induced_compose, ← H, ← induced_compose, dh.induced] }
end dense_inducing

namespace dense_embedding
open set function filter
variables {α : Type*} {β : Type*} {δ : Type*} {γ : Type*}

variables [topological_space α] [topological_space β] [topological_space δ] [topological_space γ]

/-
    f
  α → β
g ↓   ↓ h
  γ → δ
    i
-/
variables {f : α → β} {g : α → γ} {i : γ → δ} {h : β → δ}

-- TODO: fix implicit argument in dense_range.comp before PRing

lemma comp (dh : dense_embedding h) (df : dense_embedding f) : dense_embedding (h ∘ f) :=
{ dense := dense_range.comp _ dh.dense df.dense dh.to_dense_inducing.continuous,
  inj :=  function.injective_comp dh.inj df.inj,
  induced := (dh.to_inducing.comp df.to_inducing).induced }

lemma of_homeo (h : α ≃ₜ β) : dense_embedding h :=
{ dense := dense_range_iff_closure_range.mpr $
             (range_iff_surjective.mpr h.to_equiv.surjective).symm ▸ closure_univ,
  inj := h.to_equiv.injective,
  induced := h.induced_eq.symm, }

lemma of_comm_square (dg : dense_embedding g) (di : dense_embedding i)
  (dh : dense_embedding h) (H : h ∘ f = i ∘ g) : dense_embedding f :=
{ inj := begin
    intros a b hab,
    have : (h ∘ f) a = (h ∘ f) b := by convert congr_arg h hab,
    rw H at this,
    exact dg.inj (di.inj this),
  end,
  ..dense_inducing.of_comm_square dg.to_dense_inducing di.to_dense_inducing dh.to_dense_inducing H }
end dense_embedding

section
open filter
variables  {α : Type*} [topological_space α] {β : Type*} [topological_space β] [discrete_topology β]

lemma continuous_into_discrete_iff (f : α → β) : continuous f ↔ ∀ b : β, is_open (f ⁻¹' {b}) :=
begin
  split,
  { intros hf b,
    exact hf _ (is_open_discrete _) },
  { intro h,
    rw continuous_iff_continuous_at,
    intro x,
    have key : f ⁻¹' {f x} ∈ nhds x,
      from mem_nhds_sets (h $ f x) (set.mem_insert (f x) ∅),
    calc map f (nhds x) ≤ pure (f x) : le_pure_iff.mpr key
        ... ≤ nhds (f x) : pure_le_nhds _ }
end

lemma discrete_iff_open_singletons : discrete_topology α ↔ ∀ x, is_open ({x} : set α) :=
⟨by introsI ; exact is_open_discrete _, λ h, ⟨eq_bot_of_singletons_open h⟩⟩

lemma discrete_iff_nhds_eq_pure {X : Type*} [topological_space X] :
  discrete_topology X ↔ ∀ x : X, nhds x = pure x :=
begin
  split,
  { introsI h,
    exact congr_fun (nhds_discrete X) },
  { intro h,
    constructor,
    apply eq_bot_of_singletons_open,
    intro x,
    change _root_.is_open {x},
    rw is_open_iff_nhds,
    simp [h] },
end

lemma discrete_of_embedding_discrete {X : Type*} {Y : Type*} [topological_space X] [topological_space Y]
  {f : X → Y} (hf : embedding f) [discrete_topology Y] : discrete_topology X :=
begin
  rw discrete_iff_nhds_eq_pure,
  intro x,
  rw [hf.to_inducing.nhds_eq_comap, nhds_discrete, comap_pure hf.inj]
end

lemma is_open_singleton_iff {X : Type*} [topological_space X] {x : X} :
  is_open ({x} : set X) ↔ {x} ∈ nhds x :=
begin
  rw is_open_iff_nhds,
  split ; intro h,
  { apply h x (mem_singleton _),
    simp },
  { intros y y_in,
    rw mem_singleton_iff at y_in,
    simp [*] },
end

end

-- tools for proving that a product of top rings is a top ring
def continuous_pi₁ {I : Type*} {R : I → Type*} {S : I → Type*}
  [∀ i, topological_space (R i)] [∀ i, topological_space (S i)]
  {f : Π (i : I), (R i) → (S i)} (Hfi : ∀ i, continuous (f i)) :
  continuous (λ rs i, f i (rs i) : (Π (i : I), R i) → Π (i : I), S i) :=
continuous_pi (λ i,  (Hfi i).comp (continuous_apply i))

def continuous_pi₂ {I : Type*} {R : I → Type*} {S : I → Type*} {T : I → Type*}
  [∀ i, topological_space (R i)] [∀ i, topological_space (S i)] [∀ i, topological_space (T i)]
  {f : Π (i : I), (R i) × (S i) → (T i)} (Hfi : ∀ i, continuous (f i)) :
continuous (λ rs i, f i ⟨rs.1 i, rs.2 i⟩ : (Π (i : I), R i) × (Π (i : I), S i) → Π (i : I), T i) :=
continuous_pi (λ i, (Hfi i).comp
  (continuous.prod_mk ((continuous_apply i).comp continuous_fst) $
                      (continuous_apply i).comp continuous_snd))

/-
The following class probably won't have global instances, but is meant to model proofs where
we implictly fix a neighborhood filter basis.
-/

class nhds_basis (α : Type*) [topological_space α] :=
(B : α → filter_basis α)
(is_nhds : ∀ x, 𝓝 x = (B x).filter)

namespace nhds_basis
open filter set

variables {α : Type*} {ι : Type*} [topological_space α] [nhds_basis α]
variables {β : Type*} [topological_space β] {δ : Type*}

lemma mem_nhds_iff (x : α) (U : set α) : U ∈ 𝓝 x ↔ ∃ V ∈ B x, V ⊆ U :=
by rw [is_nhds x, filter_basis.mem_filter]

lemma mem_nhds_of_basis {x : α} {U : set α} (U_in : U ∈ B x) : U ∈ 𝓝 x :=
(is_nhds x).symm ▸ filter_basis.mem_filter_of_mem U_in

lemma tendsto_from {f : α → δ} {x : α} {y : filter δ} :
  tendsto f (𝓝 x) y ↔ ∀ {V}, V ∈ y → ∃ U ∈ B x, U ⊆ f ⁻¹' V :=
by split ; intros h V V_in ; specialize h V_in ; rwa [← mem_nhds_iff x] at *

lemma continuous_from {f : α → β} : continuous f ↔ ∀ x, ∀ {V}, V ∈ 𝓝 f x → ∃ U ∈ B x, U ⊆ f ⁻¹' V :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_from]

lemma tendsto_into {f : δ → α} {x : filter δ} {y : α} : tendsto f x 𝓝 y ↔ ∀ U ∈ B y, f ⁻¹' U ∈ x :=
begin
  split ; intros h,
  { rintro U U_in,
    exact h (mem_nhds_of_basis U_in)  },
  { intros V V_in,
    rcases (mem_nhds_iff _ _).1 V_in with ⟨W, W_in, hW⟩,
    filter_upwards [h W W_in],
    exact preimage_mono hW }
end

lemma continuous_into {f : β → α} : continuous f ↔ ∀ x, ∀ U ∈ B (f x), f ⁻¹' U ∈ 𝓝 x :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_into]

lemma tendsto_both [nhds_basis β] {f : α → β} {x : α} {y : β} :
  tendsto f (𝓝 x) 𝓝 y ↔ ∀ U ∈ B y, ∃ V ∈ B x, V ⊆ f ⁻¹' U :=
begin
  rw tendsto_into,
  split ; introv h U_in ; specialize h U U_in ; rwa mem_nhds_iff x at *
end

lemma continuous_both [nhds_basis β] {f : α → β} :
  continuous f ↔ ∀ x, ∀ U ∈ B (f x), ∃ V ∈ B x, V ⊆ f ⁻¹' U :=
by simp [continuous_iff_continuous_at, continuous_at, tendsto_both]

end nhds_basis

lemma dense_range.mem_nhds {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  {f : α → β} (h : dense_range f) {b : β} {U : set β} (U_in : U ∈ nhds b) :
  ∃ a : α, f a ∈ U :=
begin
  rcases (mem_closure_iff_nhds.mp
    ((dense_range_iff_closure_range.mp h).symm ▸ mem_univ b : b ∈ closure (range f)) U U_in)
    with ⟨_, h, a, rfl⟩,
  exact ⟨a, h⟩
end

lemma mem_closure_union {α : Type*} [topological_space α] {s₁ s₂ : set α} {x : α}
  (h : x ∈ closure (s₁ ∪ s₂)) (h₁ : -s₁ ∈ 𝓝 x) : x ∈ closure s₂ :=
begin
  rw closure_eq_nhds at *,
  have := calc
    𝓝 x ⊓ principal (s₁ ∪ s₂) = 𝓝 x ⊓ (principal s₁ ⊔ principal s₂) : by rw sup_principal
    ... = (𝓝 x ⊓ principal s₁) ⊔ (𝓝 x ⊓ principal s₂) : by rw lattice.inf_sup_left
    ... = ⊥ ⊔ 𝓝 x ⊓ principal s₂ : by rw inf_principal_eq_bot h₁
    ... = 𝓝 x ⊓ principal s₂ : by rw lattice.bot_sup_eq,
  dsimp,
  rwa ← this
end

open lattice

lemma mem_closure_image {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f : α → β} {x : α} {s : set α} (hf : continuous_at f x) (hx : x ∈ closure s) :
  f x ∈ closure (f '' s) :=
begin
  rw [closure_eq_nhds, mem_set_of_eq] at *,
  rw ← bot_lt_iff_ne_bot,
  calc
    ⊥   < map f (𝓝 x ⊓ principal s) : bot_lt_iff_ne_bot.mpr (map_ne_bot hx)
    ... ≤ (map f 𝓝 x) ⊓ (map f $ principal s) : map_inf_le
    ... = (map f 𝓝 x) ⊓ (principal $ f '' s) : by rw map_principal
    ... ≤ 𝓝 (f x) ⊓ (principal $ f '' s) : inf_le_inf hf (le_refl _)
end

lemma continuous_at.prod_mk {α : Type*} {β : Type*} {γ : Type*} [topological_space α]
  [topological_space β] [topological_space γ] {f : γ → α} {g : γ → β} {x : γ}
  (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (λ x, prod.mk (f x) $ g x) x :=
calc
  map (λ (x : γ), (f x, g x)) (𝓝 x) ≤ (map f 𝓝 x).prod (map g 𝓝 x) : filter.map_prod_mk _ _ _
  ... ≤ (𝓝 f x).prod (𝓝 g x) : filter.prod_mono hf hg
  ... = 𝓝 (f x, g x) : by rw nhds_prod_eq

lemma continuous_at.congr_aux {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f g : α → β} {a : α}  (h : {x | f x = g x } ∈ 𝓝 a) (hf : continuous_at f a) : continuous_at g a :=
begin
  intros U U_in,
  rw show g a = f a, from (mem_of_nhds h).symm at U_in,
  let V := {x : α | g x ∈ U} ∩ {x | f x = g x},
  suffices : V ∈ 𝓝 a,
  { rw mem_map,
    exact mem_sets_of_superset this (inter_subset_left _ _) },
  have : V = {x : α | f x ∈ U} ∩ {x | f x = g x},
  { ext x,
    split ; rintros ⟨hl, hr⟩ ; rw mem_set_of_eq at hr hl ;
    [ rw ← hr at hl, rw hr at hl ] ; exact ⟨hl, hr⟩ },
  rw this,
  exact filter.inter_mem_sets (hf U_in) ‹_›
end

lemma continuous_at.congr {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  {f g : α → β} {a : α}  (h : {x | f x = g x } ∈ 𝓝 a) : continuous_at f a ↔ continuous_at g a :=
begin
  split ; intro h',
  { exact continuous_at.congr_aux h h' },
  { apply continuous_at.congr_aux _ h',
    convert h,
    ext x,
    rw eq_comm }
end


import algebra.homology.homotopy
import category_theory.limits.shapes.zero_objects

import for_mathlib.Cech.split
import for_mathlib.abelian_category

noncomputable theory

universes v u v' u'

namespace category_theory
open_locale simplicial
open category_theory.limits

namespace arrow

section contravariant
variables {P : Type u} {N : Type u'} [category.{v} P] [category.{v'} N] (M : Pᵒᵖ ⥤ N)
variables (f : arrow P)
variables [∀ n : ℕ, has_wide_pullback f.right (λ i : (fin (n+1)), f.left) (λ i, f.hom)]
variables [arrow.split f] [preadditive N]

def contracting_homotopy' : homotopy (𝟙 (f.conerve M).to_cocomplex) 0 :=
{ hom := λ i j, if h : j + 1 = i then eq_to_hom (by subst h) ≫ f.contracting_homotopy M j else 0,
  zero' := λ i j h, dif_neg h,
  comm := λ i, begin
    simp only [homological_complex.id_f, homotopy.d_next_cochain_complex,
      homological_complex.zero_f_apply, add_zero],
    rcases i with _|_|i,
    { rw [← is_contracting_homotopy_zero, homotopy.prev_d_zero_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
    { rw [← is_contracting_homotopy_one, homotopy.prev_d_succ_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
    { rw [← is_contracting_homotopy, homotopy.prev_d_succ_cochain_complex],
      simp only [eq_self_iff_true, dif_pos, eq_to_hom_refl, category.id_comp, add_zero], },
  end }

variables [has_equalizers N] [has_cokernels N] [has_images N] [has_image_maps N]

lemma conerve_to_cocomplex_homology_is_zero (i : ℕ) :
  is_zero ((f.conerve M).to_cocomplex.homology i) :=
begin
  rw is_zero_iff_id_eq_zero,
  simpa only [category_theory.functor.map_id, functor.map_zero] using
    homology_map_eq_of_homotopy (f.contracting_homotopy' M) i,
end

end contravariant

section covariant

variables {P : Type u} {N : Type u'} [category.{v} P] [category.{v'} N] (M : P ⥤ N)
variables (f : arrow P)
variables [∀ n : ℕ, has_wide_pullback f.right (λ i : (fin (n+1)), f.left) (λ i, f.hom)]
variables [arrow.split f] [preadditive N]

def covariant_contracting_homotopy' : homotopy (𝟙 (f.nerve M).to_complex) 0 :=
{ hom := λ i j, if h : i + 1 = j then
    f.covariant_contracting_homotopy M i ≫ eq_to_hom (by subst h) else 0,
  zero' := λ i j h, dif_neg h,
  comm := λ i, begin
    simp only [homological_complex.id_f, homotopy.d_next_cochain_complex,
      homological_complex.zero_f_apply, add_zero],
    rcases i with _|_|i,
    { rw [← covariant_is_contracting_homotopy_zero, homotopy.d_next_zero_chain_complex],
      simp only [eq_self_iff_true, eq_to_hom_refl, dite_eq_ite, if_true,
        homotopy.prev_d_chain_complex, category.comp_id, zero_add] },
    { rw [← covariant_is_contracting_homotopy_one, homotopy.d_next_succ_chain_complex],
      simp only [simplicial_object.augmented.to_complex_d_2, eq_self_iff_true,
        eq_to_hom_refl, category.id_comp, dite_eq_ite, if_true,
        category.comp_id, homotopy.prev_d_chain_complex],
      rw add_comm },
    { rw [← covariant_is_contracting_homotopy, homotopy.d_next_succ_chain_complex],
      simp only [simplicial_object.augmented.to_complex_d_2, eq_self_iff_true,
        eq_to_hom_refl, category.id_comp, dite_eq_ite, if_true,
        category.comp_id, homotopy.prev_d_chain_complex],
      rw add_comm },
  end }

variables [has_equalizers N] [has_cokernels N] [has_images N] [has_image_maps N]

lemma nerve_to_complex_homology_is_zero (i : ℕ) :
  is_zero ((f.nerve M).to_complex.homology i) :=
begin
  rw is_zero_iff_id_eq_zero,
  simpa only [category_theory.functor.map_id, functor.map_zero] using
    homology_map_eq_of_homotopy (f.covariant_contracting_homotopy' M) i,
end

end covariant

end arrow

end category_theory


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Group.basic
import Mathlib.data.equiv.ring
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Category instances for semiring, ring, comm_semiring, and comm_ring.

We introduce the bundled categories:
* `SemiRing`
* `Ring`
* `CommSemiRing`
* `CommRing`
along with the relevant forgetful functors between them.
-/

/-- The category of semirings. -/
def SemiRing :=
  category_theory.bundled semiring

namespace SemiRing

protected instance bundled_hom : category_theory.bundled_hom ring_hom :=
  category_theory.bundled_hom.mk ring_hom.to_fun ring_hom.id ring_hom.comp

protected instance large_category : category_theory.large_category SemiRing :=
  category_theory.bundled_hom.category ring_hom

/-- Construct a bundled SemiRing from the underlying type and typeclass. -/
def of (R : Type u) [semiring R] : SemiRing :=
  category_theory.bundled.of R

protected instance inhabited : Inhabited SemiRing :=
  { default := of PUnit }

protected instance semiring (R : SemiRing) : semiring ↥R :=
  category_theory.bundled.str R

@[simp] theorem coe_of (R : Type u) [semiring R] : ↥(of R) = R :=
  rfl

protected instance has_forget_to_Mon : category_theory.has_forget₂ SemiRing Mon :=
  category_theory.bundled_hom.mk_has_forget₂ (fun (R : Type u_1) (hR : semiring R) => monoid_with_zero.to_monoid R)
    (fun (R₁ R₂ : category_theory.bundled semiring) => ring_hom.to_monoid_hom) sorry

-- can't use bundled_hom.mk_has_forget₂, since AddCommMon is an induced category

protected instance has_forget_to_AddCommMon : category_theory.has_forget₂ SemiRing AddCommMon :=
  category_theory.has_forget₂.mk
    (category_theory.functor.mk (fun (R : SemiRing) => AddCommMon.of ↥R)
      fun (R₁ R₂ : SemiRing) (f : R₁ ⟶ R₂) => ring_hom.to_add_monoid_hom f)

end SemiRing

/-- The category of rings. -/
def Ring :=
  category_theory.bundled ring

namespace Ring

protected instance ring.to_semiring.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection ring.to_semiring :=
  category_theory.bundled_hom.parent_projection.mk

protected instance concrete_category : category_theory.concrete_category Ring :=
  category_theory.bundled_hom.category_theory.bundled.category_theory.concrete_category
    (category_theory.bundled_hom.map_hom ring_hom ring.to_semiring)

/-- Construct a bundled Ring from the underlying type and typeclass. -/
def of (R : Type u) [ring R] : Ring :=
  category_theory.bundled.of R

protected instance inhabited : Inhabited Ring :=
  { default := of PUnit }

protected instance ring (R : Ring) : ring ↥R :=
  category_theory.bundled.str R

@[simp] theorem coe_of (R : Type u) [ring R] : ↥(of R) = R :=
  rfl

protected instance has_forget_to_SemiRing : category_theory.has_forget₂ Ring SemiRing :=
  category_theory.bundled_hom.forget₂ ring_hom ring.to_semiring

-- can't use bundled_hom.mk_has_forget₂, since AddCommGroup is an induced category

protected instance has_forget_to_AddCommGroup : category_theory.has_forget₂ Ring AddCommGroup :=
  category_theory.has_forget₂.mk
    (category_theory.functor.mk (fun (R : Ring) => AddCommGroup.of ↥R)
      fun (R₁ R₂ : Ring) (f : R₁ ⟶ R₂) => ring_hom.to_add_monoid_hom f)

end Ring

/-- The category of commutative semirings. -/
def CommSemiRing :=
  category_theory.bundled comm_semiring

namespace CommSemiRing

protected instance comm_semiring.to_semiring.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection comm_semiring.to_semiring :=
  category_theory.bundled_hom.parent_projection.mk

protected instance large_category : category_theory.large_category CommSemiRing :=
  category_theory.bundled_hom.category (category_theory.bundled_hom.map_hom ring_hom comm_semiring.to_semiring)

/-- Construct a bundled CommSemiRing from the underlying type and typeclass. -/
def of (R : Type u) [comm_semiring R] : CommSemiRing :=
  category_theory.bundled.of R

protected instance inhabited : Inhabited CommSemiRing :=
  { default := of PUnit }

protected instance comm_semiring (R : CommSemiRing) : comm_semiring ↥R :=
  category_theory.bundled.str R

@[simp] theorem coe_of (R : Type u) [comm_semiring R] : ↥(of R) = R :=
  rfl

protected instance has_forget_to_SemiRing : category_theory.has_forget₂ CommSemiRing SemiRing :=
  category_theory.bundled_hom.forget₂ ring_hom comm_semiring.to_semiring

/-- The forgetful functor from commutative rings to (multiplicative) commutative monoids. -/
protected instance has_forget_to_CommMon : category_theory.has_forget₂ CommSemiRing CommMon :=
  category_theory.has_forget₂.mk' (fun (R : CommSemiRing) => CommMon.of ↥R) sorry
    (fun (R₁ R₂ : CommSemiRing) (f : R₁ ⟶ R₂) => ring_hom.to_monoid_hom f) sorry

end CommSemiRing

/-- The category of commutative rings. -/
def CommRing :=
  category_theory.bundled comm_ring

namespace CommRing

protected instance comm_ring.to_ring.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection comm_ring.to_ring :=
  category_theory.bundled_hom.parent_projection.mk

protected instance concrete_category : category_theory.concrete_category CommRing :=
  category_theory.bundled_hom.category_theory.bundled.category_theory.concrete_category
    (category_theory.bundled_hom.map_hom (category_theory.bundled_hom.map_hom ring_hom ring.to_semiring)
      comm_ring.to_ring)

/-- Construct a bundled CommRing from the underlying type and typeclass. -/
def of (R : Type u) [comm_ring R] : CommRing :=
  category_theory.bundled.of R

protected instance inhabited : Inhabited CommRing :=
  { default := of PUnit }

protected instance comm_ring (R : CommRing) : comm_ring ↥R :=
  category_theory.bundled.str R

@[simp] theorem coe_of (R : Type u) [comm_ring R] : ↥(of R) = R :=
  rfl

protected instance has_forget_to_Ring : category_theory.has_forget₂ CommRing Ring :=
  category_theory.bundled_hom.forget₂ (category_theory.bundled_hom.map_hom ring_hom ring.to_semiring) comm_ring.to_ring

/-- The forgetful functor from commutative rings to (multiplicative) commutative monoids. -/
protected instance has_forget_to_CommSemiRing : category_theory.has_forget₂ CommRing CommSemiRing :=
  category_theory.has_forget₂.mk' (fun (R : CommRing) => CommSemiRing.of ↥R) sorry
    (fun (R₁ R₂ : CommRing) (f : R₁ ⟶ R₂) => f) sorry

protected instance category_theory.forget₂.category_theory.full : category_theory.full (category_theory.forget₂ CommRing CommSemiRing) :=
  category_theory.full.mk
    fun (X Y : CommRing)
      (f :
      category_theory.functor.obj (category_theory.forget₂ CommRing CommSemiRing) X ⟶
        category_theory.functor.obj (category_theory.forget₂ CommRing CommSemiRing) Y) =>
      f

end CommRing

-- This example verifies an improvement possible in Lean 3.8.

-- Before that, to have `add_ring_hom.map_zero` usable by `simp` here,

-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.

-- Now, it just works.

namespace ring_equiv

/-- Build an isomorphism in the category `Ring` from a `ring_equiv` between `ring`s. -/
@[simp] theorem to_Ring_iso_inv {X : Type u} {Y : Type u} [ring X] [ring Y] (e : X ≃+* Y) : category_theory.iso.inv (to_Ring_iso e) = to_ring_hom (ring_equiv.symm e) :=
  Eq.refl (category_theory.iso.inv (to_Ring_iso e))

/-- Build an isomorphism in the category `CommRing` from a `ring_equiv` between `comm_ring`s. -/
def to_CommRing_iso {X : Type u} {Y : Type u} [comm_ring X] [comm_ring Y] (e : X ≃+* Y) : CommRing.of X ≅ CommRing.of Y :=
  category_theory.iso.mk (to_ring_hom e) (to_ring_hom (ring_equiv.symm e))

end ring_equiv

namespace category_theory.iso

/-- Build a `ring_equiv` from an isomorphism in the category `Ring`. -/
def Ring_iso_to_ring_equiv {X : Ring} {Y : Ring} (i : X ≅ Y) : ↥X ≃+* ↥Y :=
  ring_equiv.mk ⇑(hom i) ⇑(inv i) sorry sorry sorry sorry

/-- Build a `ring_equiv` from an isomorphism in the category `CommRing`. -/
def CommRing_iso_to_ring_equiv {X : CommRing} {Y : CommRing} (i : X ≅ Y) : ↥X ≃+* ↥Y :=
  ring_equiv.mk ⇑(hom i) ⇑(inv i) sorry sorry sorry sorry

end category_theory.iso

/-- Ring equivalences between `ring`s are the same as (isomorphic to) isomorphisms in `Ring`. -/
def ring_equiv_iso_Ring_iso {X : Type u} {Y : Type u} [ring X] [ring Y] : X ≃+* Y ≅ Ring.of X ≅ Ring.of Y :=
  category_theory.iso.mk (fun (e : X ≃+* Y) => ring_equiv.to_Ring_iso e)
    fun (i : Ring.of X ≅ Ring.of Y) => category_theory.iso.Ring_iso_to_ring_equiv i

/-- Ring equivalences between `comm_ring`s are the same as (isomorphic to) isomorphisms
in `CommRing`. -/
def ring_equiv_iso_CommRing_iso {X : Type u} {Y : Type u} [comm_ring X] [comm_ring Y] : X ≃+* Y ≅ CommRing.of X ≅ CommRing.of Y :=
  category_theory.iso.mk (fun (e : X ≃+* Y) => ring_equiv.to_CommRing_iso e)
    fun (i : CommRing.of X ≅ CommRing.of Y) => category_theory.iso.CommRing_iso_to_ring_equiv i

protected instance Ring.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget Ring) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : Ring) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget Ring) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget Ring) X ≅
          category_theory.functor.obj (category_theory.forget Ring) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget Ring) f);
      let e : ↥X ≃+* ↥Y :=
        ring_equiv.mk (ring_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (ring_equiv.to_Ring_iso e))

protected instance CommRing.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget CommRing) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : CommRing) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget CommRing) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget CommRing) X ≅
          category_theory.functor.obj (category_theory.forget CommRing) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget CommRing) f);
      let e : ↥X ≃+* ↥Y :=
        ring_equiv.mk (ring_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (ring_equiv.to_CommRing_iso e))


/-
Copyright (c) 2017 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Jesse Michael Han

! This file was ported from Lean 3 source module tactic.finish
! leanprover-community/mathlib commit 3c11bd771ef17197a9e9fcd4a3fabfa2804d950c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Hint

/-!
# The `finish` family of tactics

These tactics do straightforward things: they call the simplifier, split conjunctive assumptions,
eliminate existential quantifiers on the left, and look for contradictions. They rely on ematching
and congruence closure to try to finish off a goal at the end.

The procedures *do* split on disjunctions and recreate the smt state for each terminal call, so
they are only meant to be used on small, straightforward problems.

## Main definitions

We provide the following tactics:

* `finish`  -- solves the goal or fails
* `clarify` -- makes as much progress as possible while not leaving more than one goal
* `safe`    -- splits freely, finishes off whatever subgoals it can, and leaves the rest

All accept an optional list of simplifier rules, typically definitions that should be expanded.
(The equations and identities should not refer to the local context.)

-/

initialize
  registerTraceClass.1 `auto.done

initialize
  registerTraceClass.1 `auto.finish

namespace Tactic

namespace Interactive

unsafe def revert_all :=
  tactic.revert_all
#align tactic.interactive.revert_all tactic.interactive.revert_all

end Interactive

end Tactic

open Tactic Expr

namespace Auto

/-! ### Utilities -/

unsafe def whnf_reducible (e : expr) : tactic expr :=
  whnf e reducible
#align auto.whnf_reducible auto.whnf_reducible

-- stolen from interactive.lean
unsafe def add_simps : simp_lemmas → List Name → tactic simp_lemmas
  | s, [] => return s
  | s, n :: ns => do
    let s' ← s.add_simp n
    add_simps s' ns
#align auto.add_simps auto.add_simps

/-- Configuration information for the auto tactics.
* `(use_simp := tt)`: call the simplifier
* `(max_ematch_rounds := 20)`: for the "done" tactic
-/
structure AutoConfig : Type where
  useSimp := true
  maxEmatchRounds := 20
  deriving DecidableEq, Inhabited
#align auto.auto_config Auto.AutoConfig

/-!
### Preprocess goal.

We want to move everything to the left of the sequent arrow. For intuitionistic logic,
we replace the goal `p` with `∀ f, (p → f) → f` and introduce.
-/

theorem by_contradiction_trick (p : Prop) (h : ∀ f : Prop, (p → f) → f) : p :=
  h p id
#align auto.by_contradiction_trick Auto.by_contradiction_trick

unsafe def preprocess_goal : tactic Unit := do
  repeat (intro1 >> skip)
  let tgt ← target >>= whnf_reducible
  if ¬is_false tgt then ((mk_mapp `` by_contradiction [some tgt] >>= apply) >> intro1) >> skip
    else skip
#align auto.preprocess_goal auto.preprocess_goal

/-!
### Normalize hypotheses

Bring conjunctions to the outside (for splitting),
bring universal quantifiers to the outside (for ematching). The classical normalizer
eliminates `a → b` in favor of `¬ a ∨ b`.

For efficiency, we push negations inwards from the top down. (For example, consider
simplifying `¬ ¬ (p ∨ q)`.)
-/

section

universe u

variable {α : Type u}

variable (p q : Prop)

variable (s : α → Prop)

attribute [local instance] Classical.propDecidable

theorem not_not_eq : (¬¬p) = p :=
  propext Classical.not_not
#align auto.not_not_eq Auto.not_not_eq

theorem not_and_eq : (¬(p ∧ q)) = (¬p ∨ ¬q) :=
  propext not_and_or
#align auto.not_and_eq Auto.not_and_eq

theorem not_or_eq : (¬(p ∨ q)) = (¬p ∧ ¬q) :=
  propext not_or
#align auto.not_or_eq Auto.not_or_eq

theorem not_forall_eq : (¬∀ x, s x) = ∃ x, ¬s x :=
  propext not_forall
#align auto.not_forall_eq Auto.not_forall_eq

theorem not_exists_eq : (¬∃ x, s x) = ∀ x, ¬s x :=
  propext not_exists
#align auto.not_exists_eq Auto.not_exists_eq

theorem not_implies_eq : (¬(p → q)) = (p ∧ ¬q) :=
  propext not_imp
#align auto.not_implies_eq Auto.not_implies_eq

theorem Classical.implies_iff_not_or : p → q ↔ ¬p ∨ q :=
  imp_iff_not_or
#align auto.classical.implies_iff_not_or Auto.Classical.implies_iff_not_or

end

def commonNormalizeLemmaNames : List Name :=
  [`` bex_def, `` forall_and, `` exists_imp, `` or_assoc, `` or_comm, `` or_left_comm, `` and_assoc,
    `` and_comm, `` and_left_comm]
#align auto.common_normalize_lemma_names Auto.commonNormalizeLemmaNames

def classicalNormalizeLemmaNames : List Name :=
  commonNormalizeLemmaNames ++ [`` classical.implies_iff_not_or]
#align auto.classical_normalize_lemma_names Auto.classicalNormalizeLemmaNames

-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- optionally returns an equivalent expression and proof of equivalence -/ private unsafe
  def
    transform_negation_step
    ( cfg : AutoConfig ) ( e : expr ) : tactic ( Option ( expr × expr ) )
    :=
      do
        let e ← whnf_reducible e
          match
            e
            with
            |
                q( ¬ $ ( Ne ) )
                =>
                do
                  let ne ← whnf_reducible Ne
                    match
                      Ne
                      with
                      |
                          q( ¬ $ ( a ) )
                          =>
                          do let pr ← mk_app ` ` not_not_eq [ a ] return ( some ( a , pr ) )
                        |
                          q( $ ( a ) ∧ $ ( b ) )
                          =>
                          do
                            let pr ← mk_app ` ` not_and_eq [ a , b ]
                              return ( some ( q( ¬ $ ( a ) ∨ ¬ $ ( b ) ) , pr ) )
                        |
                          q( $ ( a ) ∨ $ ( b ) )
                          =>
                          do
                            let pr ← mk_app ` ` not_or_eq [ a , b ]
                              return ( some ( q( ¬ $ ( a ) ∧ ¬ $ ( b ) ) , pr ) )
                        |
                          q( Exists $ ( p ) )
                          =>
                          do
                            let pr ← mk_app ` ` not_exists_eq [ p ]
                              let q( $ ( _ ) = $ ( e' ) ) ← infer_type pr
                              return ( some ( e' , pr ) )
                        |
                          pi n bi d p
                          =>
                          if
                            p
                            then
                            do
                              let
                                  pr
                                    ←
                                    mk_app
                                      ` ` not_forall_eq [ lam n bi d ( expr.abstract_local p n ) ]
                                let q( $ ( _ ) = $ ( e' ) ) ← infer_type pr
                                return ( some ( e' , pr ) )
                            else
                            do
                              let pr ← mk_app ` ` not_implies_eq [ d , p ]
                                let q( $ ( _ ) = $ ( e' ) ) ← infer_type pr
                                return ( some ( e' , pr ) )
                        | _ => return none
              | _ => return none
#align auto.transform_negation_step auto.transform_negation_step

/-- given an expr `e`, returns a new expression and a proof of equality -/
private unsafe def transform_negation (cfg : AutoConfig) : expr → tactic (Option (expr × expr)) :=
  fun e => do
  let opr ← transform_negation_step cfg e
  match opr with
    | some (e', pr) => do
      let opr' ← transform_negation e'
      match opr' with
        | none => return (some (e', pr))
        | some (e'', pr') => do
          let pr'' ← mk_eq_trans pr pr'
          return (some (e'', pr''))
    | none => return none
#align auto.transform_negation auto.transform_negation

unsafe def normalize_negations (cfg : AutoConfig) (h : expr) : tactic Unit := do
  let t ← infer_type h
  let (_, e, pr) ←
    simplify_top_down ()
        (fun _ => fun e => do
          let oepr ← transform_negation cfg e
          match oepr with
            | some (e', pr) => return ((), e', pr)
            | none => do
              let pr ← mk_eq_refl e
              return ((), e, pr))
        t
  replace_hyp h e pr
  skip
#align auto.normalize_negations auto.normalize_negations

unsafe def normalize_hyp (cfg : AutoConfig) (simps : simp_lemmas) (h : expr) : tactic Unit :=
  (do
      let (h, _) ← simp_hyp simps [] h
      try (normalize_negations cfg h)) <|>
    try (normalize_negations cfg h)
#align auto.normalize_hyp auto.normalize_hyp

unsafe def normalize_hyps (cfg : AutoConfig) : tactic Unit := do
  let simps ← add_simps simp_lemmas.mk classicalNormalizeLemmaNames
  local_context >>= Monad.mapM' (normalize_hyp cfg simps)
#align auto.normalize_hyps auto.normalize_hyps

/-!
### Eliminate existential quantifiers
-/

/-- eliminate an existential quantifier if there is one -/
unsafe def eelim : tactic Unit := do
  let ctx ← local_context
  first <|
      ctx fun h => do
        let t ← infer_type h >>= whnf_reducible
        guard (is_app_of t `` Exists)
        let tgt ← target
        to_expr ``(@Exists.elim _ _ $(tgt) $(h)) >>= apply
        intros
        clear h
#align auto.eelim auto.eelim

/-- eliminate all existential quantifiers, fails if there aren't any -/
unsafe def eelims : tactic Unit :=
  eelim >> repeat eelim
#align auto.eelims auto.eelims

/-!
### Substitute if there is a hypothesis `x = t` or `t = x`
-/

-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- carries out a subst if there is one, fails otherwise -/ unsafe
  def
    do_subst
    : tactic Unit
    :=
      do
        let ctx ← local_context
          first
            <|
            ctx
              fun
                h
                  =>
                  do
                    let t ← infer_type h >>= whnf_reducible
                      match t with | q( $ ( a ) = $ ( b ) ) => subst h | _ => failed
#align auto.do_subst auto.do_subst

unsafe def do_substs : tactic Unit :=
  do_subst >> repeat do_subst
#align auto.do_substs auto.do_substs

/-!
### Split all conjunctions
-/

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Assumes `pr` is a proof of `t`. Adds the consequences of `t` to the context
       and returns `tt` if anything nontrivial has been added. -/
    unsafe
  def
    add_conjuncts
    : expr → expr → tactic Bool
    :=
      fun
        pr t
          =>
          let
            assert_consequences e t := condM ( add_conjuncts e t ) skip ( note_anon t e >> skip )
            do
              let t' ← whnf_reducible t
                match
                  t'
                  with
                  |
                      q( $ ( a ) ∧ $ ( b ) )
                      =>
                      do
                        let e₁ ← mk_app ` ` And.left [ pr ]
                          assert_consequences e₁ a
                          let e₂ ← mk_app ` ` And.right [ pr ]
                          assert_consequences e₂ b
                          return tt
                    | q( True ) => do return tt
                    | _ => return ff
#align auto.add_conjuncts auto.add_conjuncts

/-- return `tt` if any progress is made -/
unsafe def split_hyp (h : expr) : tactic Bool := do
  let t ← infer_type h
  condM (add_conjuncts h t) (clear h >> return tt) (return ff)
#align auto.split_hyp auto.split_hyp

/-- return `tt` if any progress is made -/
unsafe def split_hyps_aux : List expr → tactic Bool
  | [] => return false
  | h :: hs => do
    let b₁ ← split_hyp h
    let b₂ ← split_hyps_aux hs
    return (b₁ || b₂)
#align auto.split_hyps_aux auto.split_hyps_aux

/-- fail if no progress is made -/
unsafe def split_hyps : tactic Unit :=
  local_context >>= split_hyps_aux >>= guardb
#align auto.split_hyps auto.split_hyps

/-!
### Eagerly apply all the preprocessing rules
-/

/-- Eagerly apply all the preprocessing rules -/
unsafe def preprocess_hyps (cfg : AutoConfig) : tactic Unit := do
  repeat (intro1 >> skip)
  preprocess_goal
  normalize_hyps cfg
  repeat (do_substs <|> split_hyps <|> eelim)
#align auto.preprocess_hyps auto.preprocess_hyps

/-!
### Terminal tactic
-/

--<|> self_simplify_hyps
/-- The terminal tactic, used to try to finish off goals:
- Call the contradiction tactic.
- Open an SMT state, and use ematching and congruence closure, with all the universal
  statements in the context.

TODO(Jeremy): allow users to specify attribute for ematching lemmas?
-/
unsafe def mk_hinst_lemmas : List expr → smt_tactic hinst_lemmas
  | [] =>-- return hinst_lemmas.mk
  do
    get_hinst_lemmas_for_attr `ematch
  | h :: hs => do
    let his ← mk_hinst_lemmas hs
    let t ← infer_type h
    match t with
      | pi _ _ _ _ => do
        let t' ← infer_type t
        if t' = q(Prop) then
            (do
                let new_lemma ← hinst_lemma.mk h
                return (hinst_lemmas.add his new_lemma)) <|>
              return his
          else return his
      | _ => return his
#align auto.mk_hinst_lemmas auto.mk_hinst_lemmas

private unsafe def report_invalid_em_lemma {α : Type} (n : Name) : smt_tactic α :=
  fail f! "invalid ematch lemma '{n}'"
#align auto.report_invalid_em_lemma auto.report_invalid_em_lemma

private unsafe def add_hinst_lemma_from_name (md : Transparency) (lhs_lemma : Bool) (n : Name)
    (hs : hinst_lemmas) (ref : pexpr) : smt_tactic hinst_lemmas := do
  let p ← resolve_name n
  match p with
    | expr.const n _ =>
      (do
          let h ← hinst_lemma.mk_from_decl_core md n lhs_lemma
          tactic.save_const_type_info n ref
          return <| hs h) <|>
        (do
            let hs₁ ← smt_tactic.mk_ematch_eqn_lemmas_for_core md n
            tactic.save_const_type_info n ref
            return <| hs hs₁) <|>
          report_invalid_em_lemma n
    | _ =>
      (do
          let e ← to_expr p
          let h ← hinst_lemma.mk_core md e lhs_lemma
          try (tactic.save_type_info e ref)
          return <| hs h) <|>
        report_invalid_em_lemma n
#align auto.add_hinst_lemma_from_name auto.add_hinst_lemma_from_name

private unsafe def add_hinst_lemma_from_pexpr (md : Transparency) (lhs_lemma : Bool)
    (hs : hinst_lemmas) : pexpr → smt_tactic hinst_lemmas
  | p@(expr.const c []) => add_hinst_lemma_from_name md lhs_lemma c hs p
  | p@(expr.local_const c _ _ _) => add_hinst_lemma_from_name md lhs_lemma c hs p
  | p => do
    let new_e ← to_expr p
    let h ← hinst_lemma.mk_core md new_e lhs_lemma
    return <| hs h
#align auto.add_hinst_lemma_from_pexpr auto.add_hinst_lemma_from_pexpr

private unsafe def add_hinst_lemmas_from_pexprs (md : Transparency) (lhs_lemma : Bool)
    (ps : List pexpr) (hs : hinst_lemmas) : smt_tactic hinst_lemmas :=
  List.foldlM (add_hinst_lemma_from_pexpr md lhs_lemma) hs ps
#align auto.add_hinst_lemmas_from_pexprs auto.add_hinst_lemmas_from_pexprs

/-- `done` first attempts to close the goal using `contradiction`. If this fails, it creates an
SMT state and will repeatedly use `ematch` (using `ematch` lemmas in the environment,
universally quantified assumptions, and the supplied lemmas `ps`) and congruence closure.
-/
unsafe def done (ps : List pexpr) (cfg : AutoConfig := { }) : tactic Unit := do
  trace_state_if_enabled `auto.done "entering done"
  contradiction <|>
      solve1 do
        revert_all
        using_smt do
            smt_tactic.intros
            let ctx ← local_context
            let hs ← mk_hinst_lemmas ctx
            let hs' ← add_hinst_lemmas_from_pexprs reducible ff ps hs
            smt_tactic.iterate_at_most cfg
                (smt_tactic.ematch_using hs' >> smt_tactic.try smt_tactic.close)
#align auto.done auto.done

/-!
### Tactics that perform case splits
-/

inductive CaseOption
  | force-- fail unless all goals are solved

  | at_most_one-- leave at most one goal

  | accept
  deriving DecidableEq, Inhabited
#align auto.case_option Auto.CaseOption

-- leave as many goals as necessary
private unsafe def case_cont (s : CaseOption) (cont : CaseOption → tactic Unit) : tactic Unit := do
  match s with
    | case_option.force => cont case_option.force >> cont case_option.force
    |
    case_option.at_most_one =>-- if the first one succeeds, commit to it, and try the second
          condM
          (cont case_option.force >> return tt) (cont case_option.at_most_one) skip <|>
        (-- otherwise, try the second
            swap >>
            cont case_option.force) >>
          cont case_option.at_most_one
    | case_option.accept => focus' [cont case_option.accept, cont case_option.accept]
#align auto.case_cont auto.case_cont

-- failed to format: unknown constant 'term.pseudo.antiquot'
unsafe
  def
    case_hyp
    ( h : expr ) ( s : CaseOption ) ( cont : CaseOption → tactic Unit ) : tactic Bool
    :=
      do
        let t ← infer_type h
          match
            t
            with
            | q( $ ( a ) ∨ $ ( b ) ) => ( cases h >> case_cont s cont ) >> return tt
              | _ => return ff
#align auto.case_hyp auto.case_hyp

unsafe def case_some_hyp_aux (s : CaseOption) (cont : CaseOption → tactic Unit) :
    List expr → tactic Bool
  | [] => return false
  | h :: hs => condM (case_hyp h s cont) (return true) (case_some_hyp_aux hs)
#align auto.case_some_hyp_aux auto.case_some_hyp_aux

unsafe def case_some_hyp (s : CaseOption) (cont : CaseOption → tactic Unit) : tactic Bool :=
  local_context >>= case_some_hyp_aux s cont
#align auto.case_some_hyp auto.case_some_hyp

/-!
### The main tactics
-/

/-- `safe_core s ps cfg opt` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `s`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `ps`) and congruence closure.

`safe_core` is complete for propositional logic. Depending on the form of `opt`
it will:

- (if `opt` is `case_option.force`) fail if it does not close the goal,
- (if `opt` is `case_option.at_most_one`) fail if it produces more than one goal, and
- (if `opt` is `case_option.accept`) ignore the number of goals it produces.
-/
unsafe def safe_core (s : simp_lemmas × List Name) (ps : List pexpr) (cfg : AutoConfig) :
    CaseOption → tactic Unit := fun co =>
  focus1 do
    trace_state_if_enabled `auto.finish "entering safe_core"
    if cfg then do
        trace_if_enabled `auto.finish "simplifying hypotheses"
        simp_all s.1 s.2 { failIfUnchanged := ff }
        trace_state_if_enabled `auto.finish "result:"
      else skip
    tactic.done <|> do
        trace_if_enabled `auto.finish "preprocessing hypotheses"
        preprocess_hyps cfg
        trace_state_if_enabled `auto.finish "result:"
        done ps cfg <|>
            condM (case_some_hyp co safe_core) skip
              (match co with
              | case_option.force => done ps cfg
              | case_option.at_most_one => try (done ps cfg)
              | case_option.accept => try (done ps cfg))
#align auto.safe_core auto.safe_core

/-- `clarify` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.at_most_one`.
-/
unsafe def clarify (s : simp_lemmas × List Name) (ps : List pexpr) (cfg : AutoConfig := { }) :
    tactic Unit :=
  safe_core s ps cfg CaseOption.at_most_one
#align auto.clarify auto.clarify

/-- `safe` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.accept`.
-/
unsafe def safe (s : simp_lemmas × List Name) (ps : List pexpr) (cfg : AutoConfig := { }) :
    tactic Unit :=
  safe_core s ps cfg CaseOption.accept
#align auto.safe auto.safe

/-- `finish` is `safe_core`, but with the `(opt : case_option)`
parameter fixed at `case_option.force`.
-/
unsafe def finish (s : simp_lemmas × List Name) (ps : List pexpr) (cfg : AutoConfig := { }) :
    tactic Unit :=
  safe_core s ps cfg CaseOption.force
#align auto.finish auto.finish

end Auto

/-! ### interactive versions -/

open Auto

namespace Tactic

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `clarify [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`clarify` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`clarify` will fail if it produces more than one goal.
-/
unsafe def clarify (hs : parse simp_arg_list)
    (ps : parse (parser.optional (tk "using" *> pexpr_list_or_texpr))) (cfg : AutoConfig := { }) :
    tactic Unit := do
  let s ← mk_simp_set false [] hs
  auto.clarify s (ps []) cfg
#align tactic.interactive.clarify tactic.interactive.clarify

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `safe [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`safe` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`safe` ignores the number of goals it produces, and should never fail.
-/
unsafe def safe (hs : parse simp_arg_list)
    (ps : parse (parser.optional (tk "using" *> pexpr_list_or_texpr))) (cfg : AutoConfig := { }) :
    tactic Unit := do
  let s ← mk_simp_set false [] hs
  auto.safe s (ps []) cfg
#align tactic.interactive.safe tactic.interactive.safe

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `finish [h1,...,hn] using [e1,...,en]` negates the goal, normalizes hypotheses
(by splitting conjunctions, eliminating existentials, pushing negations inwards,
and calling `simp` with the supplied lemmas `h1,...,hn`), and then tries `contradiction`.

If this fails, it will create an SMT state and repeatedly use `ematch`
(using `ematch` lemmas in the environment, universally quantified assumptions,
and the supplied lemmas `e1,...,en`) and congruence closure.

`finish` is complete for propositional logic.

Either of the supplied simp lemmas or the supplied ematch lemmas are optional.

`finish` will fail if it does not close the goal.
-/
unsafe def finish (hs : parse simp_arg_list)
    (ps : parse (parser.optional (tk "using" *> pexpr_list_or_texpr))) (cfg : AutoConfig := { }) :
    tactic Unit := do
  let s ← mk_simp_set false [] hs
  auto.finish s (ps []) cfg
#align tactic.interactive.finish tactic.interactive.finish

add_hint_tactic finish

/--
These tactics do straightforward things: they call the simplifier, split conjunctive assumptions,
eliminate existential quantifiers on the left, and look for contradictions. They rely on ematching
and congruence closure to try to finish off a goal at the end.

The procedures *do* split on disjunctions and recreate the smt state for each terminal call, so
they are only meant to be used on small, straightforward problems.

* `finish`:  solves the goal or fails
* `clarify`: makes as much progress as possible while not leaving more than one goal
* `safe`:    splits freely, finishes off whatever subgoals it can, and leaves the rest

All accept an optional list of simplifier rules, typically definitions that should be expanded.
(The equations and identities should not refer to the local context.) All also accept an optional
list of `ematch` lemmas, which must be preceded by `using`.
-/
add_tactic_doc
  { Name := "finish / clarify / safe"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.finish, `tactic.interactive.clarify, `tactic.interactive.safe]
    tags := ["logic", "finishing"] }

end Interactive

end Tactic


import data.list.pairwise
import data.list
import data.list.sort
import data.vector
import data.finset
import data.array.lemmas
import data.equiv.list
import data.equiv.fin
import data.equiv.fintype
import order.lexicographic
import data.hash_map
import data.nat.log

def arg_list (i n : ℕ) := {v : vector (fin i) n // v.to_list.nodup}

def arg_list.to_vector {i n} (a : arg_list i n) := a.val
def arg_list.to_list {i n} (a : arg_list i n) := a.to_vector.to_list
def arg_list.to_nodup {i n} (a : arg_list i n) : a.to_list.nodup := a.prop

inductive rcmd (i : ℕ) : Type
| tog (arg : fin i) : rcmd
-- | swap : fin 4 → fin 4 → cmd
| cnot (args : arg_list i 2) : rcmd
| toffoli : arg_list i 3 → rcmd
| fredkin : arg_list i 3 → rcmd

open rcmd
def rcmd.rank {i} : rcmd i → ℕ
  | (tog _) := 1
  | (cnot _) := 2
  | (toffoli _) := 3
  | (fredkin _) := 4

def rcmd4.repr : rcmd 4 → string
  | (tog a) :=
    "n" ++ repr a.val
  | (cnot a) :=
    "c" ++ repr a.to_vector.head ++ repr a.to_vector.tail.head
  | (toffoli a) :=
    "t" ++ repr a.to_vector.head ++ repr a.to_vector.tail.head ++ repr a.to_vector.tail.tail.head
  | (fredkin a) :=
    "f" ++ repr a.to_vector.head ++ repr a.to_vector.tail.head ++ repr a.to_vector.tail.tail.head

instance : has_repr (rcmd 4) := {
  repr := rcmd4.repr
}

@[simp] lemma rcmd.rank_tog (size : ℕ) (i : fin size) : rcmd.rank (tog i) = 1 := rfl
@[simp] lemma rcmd.rank_cnot (size : ℕ) (i) : rcmd.rank (cnot i : rcmd size) = 2 := rfl
@[simp] lemma rcmd.rank_toffoli (size : ℕ) (i) : rcmd.rank (toffoli i : rcmd size) = 3 := rfl
@[simp] lemma rcmd.rank_fredkin (size : ℕ) (i) : rcmd.rank (fredkin i : rcmd size) = 4 := rfl

def rcmd.args {i} : rcmd i → list (fin i)
  | (tog a) := [a]
  | (cnot a) := a.to_list
  | (toffoli a) := a.to_list
  | (fredkin a) := a.to_list

open function

def rcmd.to_nat_list {i} (x : rcmd i) : list ℕ := x.rank :: x.args.map (λ x, x.1)
def rcmd.le {i} (x y : rcmd i) := x.to_nat_list ≤ y.to_nat_list
lemma rcmd.le_refl {i} (x : rcmd i) : x.le x := le_refl x.to_nat_list
lemma rcmd.le_trans {i} (x y z : rcmd i) : x.le y → y.le z → x.le z :=
  @le_trans _ _ x.to_nat_list y.to_nat_list z.to_nat_list
lemma rcmd.to_pair_injective {i} (x y : rcmd i) : x.to_nat_list = y.to_nat_list → x = y := by {
  cases x; cases y; cases x; cases y; unfold rcmd.to_nat_list rcmd.args arg_list.to_list; simp; intros h;
    apply vector.eq; exact list.map_injective_iff.mpr fin.coe_injective h,
}
lemma rcmd.le_antisymm {i} (x y : rcmd i) : x.le y → y.le x → x = y := by {
  intros xy yx,
  apply rcmd.to_pair_injective x y,
  unfold rcmd.le at xy yx,
  apply le_antisymm; assumption,
}

def rcmd.le_decidable {i} : decidable_rel (rcmd.le : rcmd i → rcmd i → Prop) := fun x y,
  if h : x.to_nat_list ≤ y.to_nat_list
    then is_true h
    else is_false h

lemma rcmd.le_total {i} (x y : rcmd i) : x.le y ∨ y.le x := le_total x.to_nat_list y.to_nat_list

instance {i} : linear_order (rcmd i) := {
  le := rcmd.le,
  le_refl := rcmd.le_refl,
  le_trans := rcmd.le_trans,
  le_antisymm := rcmd.le_antisymm,
  decidable_le := rcmd.le_decidable,
  le_total := rcmd.le_total,
}

lemma nodup_tail {α} {x : α} {xs} : list.nodup (x :: xs) → list.nodup xs := list.nodup_of_nodup_cons
lemma nodup_3 {α} {x y z: α} [decidable_eq α] : [x,y,z].nodup ↔ (x ≠ y ∧ x ≠ z ∧ y ≠ z) := by {
  simp,
  rw ← and_assoc,
  have : (¬(x = y ∨ x = z) ∧ ¬y = z) = ((¬x = y ∧ ¬x = z) ∧ ¬y = z),
  {
    congr,
    apply propext,
    split; intros hyp_iff,
    split; intros hyp_not; apply hyp_iff,
    {left, exact hyp_not},
    {right, exact hyp_not},
    intros hyp_not,
    cases hyp_not,
    exact hyp_iff.left hyp_not,
    exact hyp_iff.right hyp_not,
  },
  rw this,
}

def rcmd.run {size : ℕ} : rcmd size → array size bool → array size bool
  | (tog i) := λ arr, arr.write i (not (arr.read i))
  | (cnot {val := ⟨[control, target], _⟩, property := _}) := λ arr,
    if arr.read control then (tog target).run arr else arr
  | (toffoli {val := ⟨[control_a, control_b, target], _⟩, property := d} ) := λ arr,
    if (arr.read control_a)
      then
        let d' := by {apply list.nodup_of_nodup_cons d} in
        (cnot ⟨⟨[control_b, target], rfl⟩, d'⟩ ).run arr
      else arr
  | (fredkin {val := ⟨[control, target_a, target_b], _⟩, property := _}) := λ arr,
    if arr.read control
      then (arr.write target_a (arr.read target_b)).write target_b (arr.read target_a)
      else arr
  using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf rcmd.rank⟩]}

lemma arr_write_read_neq
  (size : ℕ) (i : fin size) {α} (arr : array size α) {x : α} :
  (arr.write i x).read i = x := by {
    exact array.read_write arr i x
}

lemma rcmd.run_self (size : ℕ) : ∀ (c : rcmd size) (arr), c.run (c.run arr) = arr
  | (rcmd.tog c) := λ arr, by {
    unfold rcmd.run,
    simp,
    ext,
    have : decidable (c = i) := by apply_instance,
    cases this,
    {
      rw array.read_write_of_ne,
      rw array.read_write_of_ne,
      all_goals {apply this},
    },
    {
      rw this,
      rw array.read_write,
    }
  }
  | (cnot {val := ⟨[control, target], p⟩, property := p2}) := λ arr, by {
    have : (cnot {val := ⟨[control, target], p⟩, property := p2}).run =
      λ arr, if arr.read control then (rcmd.tog target).run arr else arr := by {
        unfold rcmd.run
      },
    rw this, clear this,
    have : decidable (arr.read control) := by apply_instance,
    cases this,
    {
      simp_rw if_neg this,
      rw if_neg,
      exact this,
    },
    {
      simp at p2,
      simp_rw if_pos this,
      rw if_pos,
      apply rcmd.run_self,
      unfold rcmd.run,
      rw array.read_write_of_ne,
      exact this,
      symmetry,
      exact p2,
    },
  }
  | (toffoli {val := ⟨[control, control_b, target], p⟩, property := d}) := λ arr, by {
    have : (toffoli {val := ⟨[control, control_b, target], p⟩, property := d}).run =
      λ arr,
        if (arr.read control)
          then
            let d' := by {apply list.nodup_of_nodup_cons d} in
            (cnot ⟨⟨[control_b, target], rfl⟩, d'⟩ ).run arr
          else arr
      := by unfold rcmd.run,
    simp at this,
    rw this, clear this,
    have : decidable (arr.read control) := by apply_instance,
    cases this,
    {
      simp_rw if_neg this,
      rw if_neg,
      exact this,
    },
    {
      simp at d,
      simp_rw if_pos this,
      simp_rw rcmd.run_self,
      have : (((cnot {val := ⟨[control_b, target], _⟩, property := _}).run arr).read control),
      {
        have : ∀ p₁ p₂,
          (((cnot {val := ⟨[control_b, target], p₁⟩, property := p₂}).run arr).read control)
            = arr.read control,
        {
          intros,
          unfold rcmd.run,
          split_ifs,
          apply array.read_write_of_ne,
          intros hyp,
          apply d.left,
          right,
          symmetry,
          assumption,
          refl,
        },
        rw this,
        clear this,
        exact this,
      },
      rw if_pos this,
    },
  }
  | (fredkin {val := ⟨[control, target_a, target_b], _⟩, property := d}) := λ arr, by {
    unfold vector.to_list at d,
    rw nodup_3 at d,
    obtain ⟨contro_ne_target_a, control_ne_target_b, target_a_ne_target_b⟩ := d,
    unfold rcmd.run,
    have : ((arr.write target_a (arr.read target_b)).write target_b (arr.read target_a)).read control =
      arr.read control,
    {
      rw array.read_write_of_ne,
      rw array.read_write_of_ne,
      symmetry,
      assumption,
      symmetry,
      assumption,
    },
    split_ifs; try {rw this}; clear this,
    {
      ext,
      have eq_a : decidable (i = target_a) := by apply_instance,
      cases eq_a with ne_a eq_a,
      {
        have eq_b : decidable (i = target_b) := by apply_instance,
        cases eq_b with ne_b eq_b,
        {
          repeat {rw array.read_write_of_ne},
          all_goals {symmetry, assumption},
        },
        {
          rw eq_b, clear ne_a eq_b i,
          rw array.read_write,
          rw array.read_write_of_ne _ _ target_a_ne_target_b.symm,
          rw array.read_write,
        }
      },
      {
          rw eq_a, clear eq_a i,
          rw array.read_write,
          rw array.read_write_of_ne _ _ target_a_ne_target_b.symm,
          rw array.read_write,
      }
    },
    {
      exfalso,
      apply h_1,
      rw array.read_write_of_ne,
      rw array.read_write_of_ne,
      exact h,
      all_goals {symmetry, assumption}
    },
    refl,
  }
  using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf rcmd.rank⟩]}

instance : monad_fail list := {
  fail := λ _ _, []
}

def mk_arg_list {i : ℕ} {m} [monad m] [monad_fail m] (get : m (fin i)) : ∀ {n : ℕ}, m (arg_list i n)
  | 0 := pure ⟨vector.nil, list.nodup_nil⟩
  | (k + 1) :=
    do
    x <- get,
    ⟨xs, p⟩ <- (mk_arg_list : m (arg_list i k)),
    if h : x ∈ xs.to_list
      then monad_fail.fail "duplicate argument -> cull"
      else pure ⟨x ::ᵥ xs, by {
        rw vector.to_list_cons x xs,
        apply list.nodup_cons.mpr ⟨h, p⟩
      }⟩

def list_out (α) [fintype α] [linear_order α] : list α :=
  multiset.sort (≤) (fintype.elems α).val

lemma mem_list_out (α) [fintype α] [linear_order α] (x : α) : x ∈ list_out α := by {
  unfold list_out,
  rw multiset.mem_sort,
  rw ← finset.mem_def,
  exact fintype.complete x
}

lemma list.mem_bind_op {α β} {b : β} {l : list α} {f : α → list β} :
  b ∈ (l >>= f) ↔ ∃ a ∈ l, b ∈ f a := by {
  unfold has_bind.bind,
  apply list.mem_bind
}

def mem_mk_arg_list {i n} {a : arg_list i n} :
  a ∈ (mk_arg_list (list_out (fin i)) : list (arg_list i n)) := by {
    obtain ⟨⟨l, l_length⟩, l_nodup⟩ := a,
    revert l l_length l_nodup,
    induction n; intros,
    {
      rw list.length_eq_zero at l_length,
      cases l,
      unfold mk_arg_list,
      rw list.mem_pure,
      refl,
      {cases l_length}
    },
    {
      unfold mk_arg_list,
      simp_rw list.mem_bind_op,
      cases l,
      {cases l_length},
      use l_hd,
      split,
      {apply mem_list_out},
      use l_tl,
      {
        rw list.length_cons at *,
        exact nat.succ.inj l_length
      },
      {exact list.nodup_of_nodup_cons l_nodup},
      {
        split,
        apply n_ih,
        unfold mk_arg_list._match_1,
        rw dif_neg,
        rw list.mem_pure,
        congr,
        simp at *,
        exact l_nodup.left,
      }
    },
  }

def list.sort {α} [linear_order α] : list α → list α := list.merge_sort (≤)
def multiset.sort' {α} [linear_order α] : multiset α → list α := multiset.sort (≤)

def rcmd.elems' {i} : ℕ → list (rcmd i)
  | 1 := (list_out (fin i)).map tog
  | 2 := cnot <$> (mk_arg_list (list_out (fin i)))
  | 3 := toffoli <$> (mk_arg_list (list_out (fin i)))
  | 4 := fredkin <$> (mk_arg_list (list_out (fin i)))
  | n := monad_fail.fail "ignore"

def rcmd.elems {i} : list (rcmd i) :=
  rcmd.elems' 1 ++ rcmd.elems' 2 ++ rcmd.elems' 3 ++ rcmd.elems' 4

lemma rcmd.mem_elems {i} (c : rcmd i) : c ∈ (rcmd.elems : list (rcmd i)) := by {
  cases c; unfold rcmd.elems,
  {
    repeat {apply list.mem_append_left},
    unfold rcmd.elems',
    rw list.mem_map,
    use c,
    split,
    apply mem_list_out,
    refl,
  },
  {
    apply list.mem_append_left,
    apply list.mem_append_left,
    apply list.mem_append_right,
    unfold rcmd.elems',
    rw list.map_eq_map,
    rw list.mem_map,
    use c,
    split,
    apply mem_mk_arg_list,
    refl
  },
  {
    apply list.mem_append_left,
    apply list.mem_append_right,
    unfold rcmd.elems',
    rw list.map_eq_map,
    rw list.mem_map,
    use c,
    split,
    apply mem_mk_arg_list,
    refl
  },
  {
    apply list.mem_append_right,
    unfold rcmd.elems',
    rw list.map_eq_map,
    rw list.mem_map,
    use c,
    split,
    apply mem_mk_arg_list,
    refl
  },
}

instance (i : ℕ) : fintype (rcmd i) := {
  elems := rcmd.elems.to_finset,
  complete := λ c, by { rw list.mem_to_finset, exact rcmd.mem_elems c},
}

-- this is just a type restricted version of function.comp
infix `∘∘`:90 := λ {i}, ((∘) : (array i bool → array i bool) → (array i bool → array i bool) → (array i bool → array i bool))

def list.run {i} := list.foldl (λ a (b : rcmd i), a ∘∘ b.run) id

def encode_bit_list : list bool → (ℕ → ℕ) :=
  flip (list.foldl (λ n (b : bool), if b then bit1 n else bit0 n))

def list_array : ∀ {i}, list (array i bool)
  | 0 := [array.nil]
  | (n+1) := do
    arr ← (list_array : list (array n bool)),
    value ← [tt, ff],
    pure $ array.push_back arr value

def encode_array_fun {i} : (array i bool → array i bool) → (ℕ → ℕ) :=
  λ f, encode_bit_list $
    do
    arr <- list_array,
    (f arr).read <$> list_out (fin i)

def pr_hash_map (i : ℕ) (n : fin 12) : Type := hash_map ℕ (λ _, vector (rcmd i) n)
def pr_hash_map.insert {i n} : pr_hash_map i n → vector (rcmd i) n → pr_hash_map i n
  | h v := hash_map.insert h (encode_array_fun v.to_list.run 0) v

def programs2 : pr_hash_map 4 2 :=
  list.foldl pr_hash_map.insert (mk_hash_map (2 ^ 16)) $ do
    (c0 : rcmd 4) <- rcmd.elems,
    (c1 : rcmd 4) <- rcmd.elems,
    pure ⟨[c0, c1], rfl⟩

def can_go_infront1' (c : rcmd 4) : list (rcmd 4) := (λ v : vector _ 2, v.head) <$>
  list.filter (λ v : vector _ 2, v.tail.head = c) ((λ s : Σ _ : ℕ, vector (rcmd 4) 2, s.2) <$> programs2.entries)

def can_go_infront : hash_map (rcmd 4) (λ _, list (rcmd 4)) :=
  hash_map.insert_all ((λ c, ⟨c, can_go_infront1' c⟩) <$> rcmd.elems) (mk_hash_map 64)

def programs3 : pr_hash_map 4 3 :=
  let p := programs2.entries in
  list.foldl pr_hash_map.insert (mk_hash_map (2 ^ 16)) $ do
    ⟨_, (p1 : vector (rcmd 4) 2)⟩ <- p,
    ⟨_, (p2 : vector (rcmd 4) 2)⟩ <- p,
    if p2.head = p1.tail.head
      then pure (p1.head ::ᵥ p2)
      else []

set_option profiler true
set_option timeout 0

#eval (rcmd.elems : list (rcmd 4)).length

#eval programs2.entries.length
#eval programs3.entries.length

def programs5 : pr_hash_map 4 5 :=
  list.foldl pr_hash_map.insert (mk_hash_map (2 ^ 16)) $ do
    ⟨_, (p2 : vector (rcmd 4) 2)⟩ <- programs2.entries,
    ⟨_, (p3 : vector (rcmd 4) 3)⟩ <- programs3.entries,
    pure (p2.append p3)

def programs10 : pr_hash_map 4 10 :=
  list.foldl pr_hash_map.insert (mk_hash_map (2 ^ 16)) $ do
    ⟨_, (p2 : vector (rcmd 4) 5)⟩ <- programs5.entries,
    ⟨_, (p3 : vector (rcmd 4) 5)⟩ <- programs5.entries,
    pure (p2.append p3)

#eval programs10.entries.length

#check pr_hash_map 4 11

def programs11 : pr_hash_map 4 (11 : fin 12) :=
  list.foldl pr_hash_map.insert (mk_hash_map (2 ^ 16)) $ do
    (c : rcmd 4) <- rcmd.elems,
    ⟨_, (p : vector (rcmd 4) 10)⟩ <- programs10.entries,
    pure (c ::ᵥ p)