/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module group_theory.group_action.group
! leanprover-community/mathlib commit ba2245edf0c8bb155f1569fd9b9492a9b384cde6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Aut
import Mathlib.GroupTheory.GroupAction.Units

/-!
# Group actions applied to various types of group

This file contains lemmas about `SMul` on `GroupWithZero`, and `Group`.
-/

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

section MulAction

/-- `Monoid.toMulAction` is faithful on cancellative monoids. -/
@[to_additive " `AddMonoid.toAddAction` is faithful on additive cancellative monoids. "]
instance RightCancelMonoid.faithfulSMul [RightCancelMonoid α] : FaithfulSMul α α :=
  ⟨fun h => mul_right_cancel (h 1)⟩
#align right_cancel_monoid.to_has_faithful_smul RightCancelMonoid.faithfulSMul
#align add_right_cancel_monoid.to_has_faithful_vadd AddRightCancelMonoid.faithfulVAdd

section Group

variable [Group α] [MulAction α β]

@[to_additive (attr := simp)]
theorem inv_smul_smul (c : α) (x : β) : c⁻¹ • c • x = x := by rw [smul_smul, mul_left_inv, one_smul]
#align inv_smul_smul inv_smul_smul
#align neg_vadd_vadd neg_vadd_vadd

@[to_additive (attr := simp)]
theorem smul_inv_smul (c : α) (x : β) : c • c⁻¹ • x = x := by
  rw [smul_smul, mul_right_inv, one_smul]
#align smul_inv_smul smul_inv_smul
#align vadd_neg_vadd vadd_neg_vadd

/-- Given an action of a group `α` on `β`, each `g : α` defines a permutation of `β`. -/
@[to_additive (attr := simps)]
def MulAction.toPerm (a : α) : Equiv.Perm β :=
  ⟨fun x => a • x, fun x => a⁻¹ • x, inv_smul_smul a, smul_inv_smul a⟩
#align mul_action.to_perm MulAction.toPerm
#align add_action.to_perm AddAction.toPerm
#align add_action.to_perm_apply AddAction.toPerm_apply
#align mul_action.to_perm_apply MulAction.toPerm_apply
#align add_action.to_perm_symm_apply AddAction.toPerm_symm_apply
#align mul_action.to_perm_symm_apply MulAction.toPerm_symm_apply

/-- Given an action of an additive group `α` on `β`, each `g : α` defines a permutation of `β`. -/
add_decl_doc AddAction.toPerm

/-- `MulAction.toPerm` is injective on faithful actions. -/
@[to_additive "`AddAction.toPerm` is injective on faithful actions."]
theorem MulAction.toPerm_injective [FaithfulSMul α β] :
    Function.Injective (MulAction.toPerm : α → Equiv.Perm β) :=
  (show Function.Injective (Equiv.toFun ∘ MulAction.toPerm) from smul_left_injective').of_comp
#align mul_action.to_perm_injective MulAction.toPerm_injective
#align add_action.to_perm_injective AddAction.toPerm_injective

variable (α) (β)

/-- Given an action of a group `α` on a set `β`, each `g : α` defines a permutation of `β`. -/
@[simps]
def MulAction.toPermHom : α →* Equiv.Perm β where
  toFun := MulAction.toPerm
  map_one' := Equiv.ext <| one_smul α
  map_mul' u₁ u₂ := Equiv.ext <| mul_smul (u₁ : α) u₂
#align mul_action.to_perm_hom MulAction.toPermHom
#align mul_action.to_perm_hom_apply MulAction.toPermHom_apply

/-- Given an action of a additive group `α` on a set `β`, each `g : α` defines a permutation of
`β`. -/
@[simps!]
def AddAction.toPermHom (α : Type _) [AddGroup α] [AddAction α β] :
    α →+ Additive (Equiv.Perm β) :=
  MonoidHom.toAdditive'' <| MulAction.toPermHom (Multiplicative α) β
#align add_action.to_perm_hom AddAction.toPermHom

/-- The tautological action by `Equiv.Perm α` on `α`.

This generalizes `Function.End.applyMulAction`.-/
instance Equiv.Perm.applyMulAction (α : Type _) : MulAction (Equiv.Perm α) α where
  smul f a := f a
  one_smul _ := rfl
  mul_smul _ _ _ := rfl
#align equiv.perm.apply_mul_action Equiv.Perm.applyMulAction

@[simp]
protected theorem Equiv.Perm.smul_def {α : Type _} (f : Equiv.Perm α) (a : α) : f • a = f a :=
  rfl
#align equiv.perm.smul_def Equiv.Perm.smul_def

/-- `Equiv.Perm.applyMulAction` is faithful. -/
instance Equiv.Perm.applyFaithfulSMul (α : Type _) : FaithfulSMul (Equiv.Perm α) α :=
  ⟨Equiv.ext⟩
#align equiv.perm.apply_has_faithful_smul Equiv.Perm.applyFaithfulSMul

variable {α} {β}

@[to_additive]
theorem inv_smul_eq_iff {a : α} {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
  (MulAction.toPerm a).symm_apply_eq
#align inv_smul_eq_iff inv_smul_eq_iff
#align neg_vadd_eq_iff neg_vadd_eq_iff

@[to_additive]
theorem eq_inv_smul_iff {a : α} {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
  (MulAction.toPerm a).eq_symm_apply
#align eq_inv_smul_iff eq_inv_smul_iff
#align eq_neg_vadd_iff eq_neg_vadd_iff

theorem smul_inv [Group β] [SMulCommClass α β β] [IsScalarTower α β β] (c : α) (x : β) :
    (c • x)⁻¹ = c⁻¹ • x⁻¹ := by
  rw [inv_eq_iff_mul_eq_one, smul_mul_smul, mul_right_inv, mul_right_inv, one_smul]
#align smul_inv smul_inv

theorem smul_zpow [Group β] [SMulCommClass α β β] [IsScalarTower α β β] (c : α) (x : β) (p : ℤ) :
    (c • x) ^ p = c ^ p • x ^ p := by
  cases p <;>
  simp [smul_pow, smul_inv]
#align smul_zpow smul_zpow

@[simp]
theorem Commute.smul_right_iff [Mul β] [SMulCommClass α β β] [IsScalarTower α β β] {a b : β}
    (r : α) : Commute a (r • b) ↔ Commute a b :=
  ⟨fun h => inv_smul_smul r b ▸ h.smul_right r⁻¹, fun h => h.smul_right r⟩
#align commute.smul_right_iff Commute.smul_right_iff

@[simp]
theorem Commute.smul_left_iff [Mul β] [SMulCommClass α β β] [IsScalarTower α β β] {a b : β}
    (r : α) : Commute (r • a) b ↔ Commute a b := by
  rw [Commute.symm_iff, Commute.smul_right_iff, Commute.symm_iff]
#align commute.smul_left_iff Commute.smul_left_iff

@[to_additive]
protected theorem MulAction.bijective (g : α) : Function.Bijective ((· • ·) g : β → β) :=
  (MulAction.toPerm g).bijective
#align mul_action.bijective MulAction.bijective
#align add_action.bijective AddAction.bijective

@[to_additive]
protected theorem MulAction.injective (g : α) : Function.Injective ((· • ·) g : β → β) :=
  (MulAction.bijective g).injective
#align mul_action.injective MulAction.injective
#align add_action.injective AddAction.injective

@[to_additive]
protected theorem MulAction.surjective (g : α) : Function.Surjective ((· • ·) g : β → β) :=
  (MulAction.bijective g).surjective
#align mul_action.surjective MulAction.surjective
#align add_action.surjective AddAction.surjective

@[to_additive]
theorem smul_left_cancel (g : α) {x y : β} (h : g • x = g • y) : x = y :=
  MulAction.injective g h
#align smul_left_cancel smul_left_cancel
#align vadd_left_cancel vadd_left_cancel

@[to_additive (attr := simp)]
theorem smul_left_cancel_iff (g : α) {x y : β} : g • x = g • y ↔ x = y :=
  (MulAction.injective g).eq_iff
#align smul_left_cancel_iff smul_left_cancel_iff
#align vadd_left_cancel_iff vadd_left_cancel_iff

@[to_additive]
theorem smul_eq_iff_eq_inv_smul (g : α) {x y : β} : g • x = y ↔ x = g⁻¹ • y :=
  (MulAction.toPerm g).apply_eq_iff_eq_symm_apply
#align smul_eq_iff_eq_inv_smul smul_eq_iff_eq_inv_smul
#align vadd_eq_iff_eq_neg_vadd vadd_eq_iff_eq_neg_vadd

end Group

/-- `Monoid.toMulAction` is faithful on nontrivial cancellative monoids with zero. -/
instance CancelMonoidWithZero.faithfulSMul [CancelMonoidWithZero α] [Nontrivial α] :
    FaithfulSMul α α :=
  ⟨fun h => mul_left_injective₀ one_ne_zero (h 1)⟩
#align cancel_monoid_with_zero.to_has_faithful_smul CancelMonoidWithZero.faithfulSMul

section Gwz

variable [GroupWithZero α] [MulAction α β] {a : α}

@[simp]
theorem inv_smul_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
  inv_smul_smul (Units.mk0 c hc) x
#align inv_smul_smul₀ inv_smul_smul₀

@[simp]
theorem smul_inv_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c • c⁻¹ • x = x :=
  smul_inv_smul (Units.mk0 c hc) x
#align smul_inv_smul₀ smul_inv_smul₀

theorem inv_smul_eq_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
  ⟨fun h => by rw [← h, smul_inv_smul₀ ha], fun h => by rw [h, inv_smul_smul₀ ha]⟩
#align inv_smul_eq_iff₀ inv_smul_eq_iff₀

theorem eq_inv_smul_iff₀ {a : α} (ha : a ≠ 0) {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
  (MulAction.toPerm (Units.mk0 a ha)).eq_symm_apply
#align eq_inv_smul_iff₀ eq_inv_smul_iff₀

@[simp]
theorem Commute.smul_right_iff₀ [Mul β] [SMulCommClass α β β] [IsScalarTower α β β] {a b : β}
    {c : α} (hc : c ≠ 0) : Commute a (c • b) ↔ Commute a b :=
  Commute.smul_right_iff (Units.mk0 c hc)
#align commute.smul_right_iff₀ Commute.smul_right_iff₀

@[simp]
theorem Commute.smul_left_iff₀ [Mul β] [SMulCommClass α β β] [IsScalarTower α β β] {a b : β} {c : α}
    (hc : c ≠ 0) : Commute (c • a) b ↔ Commute a b :=
  Commute.smul_left_iff (Units.mk0 c hc)
#align commute.smul_left_iff₀ Commute.smul_left_iff₀

protected theorem MulAction.bijective₀ (ha : a ≠ 0) : Function.Bijective ((· • ·) a : β → β) :=
  MulAction.bijective <| Units.mk0 a ha
#align mul_action.bijective₀ MulAction.bijective₀

protected theorem MulAction.injective₀ (ha : a ≠ 0) : Function.Injective ((· • ·) a : β → β) :=
  (MulAction.bijective₀ ha).injective
#align mul_action.injective₀ MulAction.injective₀

protected theorem MulAction.surjective₀ (ha : a ≠ 0) : Function.Surjective ((· • ·) a : β → β) :=
  (MulAction.bijective₀ ha).surjective
#align mul_action.surjective₀ MulAction.surjective₀

end Gwz

end MulAction

section DistribMulAction

section Group

variable [Group α] [AddMonoid β] [DistribMulAction α β]

variable (β)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `MulAction.toPerm`. -/
@[simps (config := { simpRhs := true })]
def DistribMulAction.toAddEquiv (x : α) : β ≃+ β :=
  { DistribMulAction.toAddMonoidHom β x, MulAction.toPermHom α β x with }
#align distrib_mul_action.to_add_equiv DistribMulAction.toAddEquiv
#align distrib_mul_action.to_add_equiv_apply DistribMulAction.toAddEquiv_apply
#align distrib_mul_action.to_add_equiv_symm_apply DistribMulAction.toAddEquiv_symm_apply

variable (α)

/-- Each element of the group defines an additive monoid isomorphism.

This is a stronger version of `MulAction.toPermHom`. -/
@[simps]
def DistribMulAction.toAddAut : α →* AddAut β where
  toFun := DistribMulAction.toAddEquiv β
  map_one' := AddEquiv.ext (one_smul _)
  map_mul' _ _ := AddEquiv.ext (mul_smul _ _)
#align distrib_mul_action.to_add_aut DistribMulAction.toAddAut
#align distrib_mul_action.to_add_aut_apply DistribMulAction.toAddAut_apply

variable {α β}

theorem smul_eq_zero_iff_eq (a : α) {x : β} : a • x = 0 ↔ x = 0 :=
  ⟨fun h => by rw [← inv_smul_smul a x, h, smul_zero], fun h => h.symm ▸ smul_zero _⟩
#align smul_eq_zero_iff_eq smul_eq_zero_iff_eq

theorem smul_ne_zero_iff_ne (a : α) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
  not_congr <| smul_eq_zero_iff_eq a
#align smul_ne_zero_iff_ne smul_ne_zero_iff_ne

end Group

section Gwz

variable [GroupWithZero α] [AddMonoid β] [DistribMulAction α β]

theorem smul_eq_zero_iff_eq' {a : α} (ha : a ≠ 0) {x : β} : a • x = 0 ↔ x = 0 :=
  show Units.mk0 a ha • x = 0 ↔ x = 0 from smul_eq_zero_iff_eq _
#align smul_eq_zero_iff_eq' smul_eq_zero_iff_eq'

theorem smul_ne_zero_iff_ne' {a : α} (ha : a ≠ 0) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
  show Units.mk0 a ha • x ≠ 0 ↔ x ≠ 0 from smul_ne_zero_iff_ne _
#align smul_ne_zero_iff_ne' smul_ne_zero_iff_ne'

end Gwz

end DistribMulAction

section MulDistribMulAction

variable [Group α] [Monoid β] [MulDistribMulAction α β]

variable (β)

/-- Each element of the group defines a multiplicative monoid isomorphism.

This is a stronger version of `MulAction.toPerm`. -/
@[simps (config := { simpRhs := true })]
def MulDistribMulAction.toMulEquiv (x : α) : β ≃* β :=
  { MulDistribMulAction.toMonoidHom β x, MulAction.toPermHom α β x with }
#align mul_distrib_mul_action.to_mul_equiv MulDistribMulAction.toMulEquiv
#align mul_distrib_mul_action.to_mul_equiv_symm_apply MulDistribMulAction.toMulEquiv_symm_apply
#align mul_distrib_mul_action.to_mul_equiv_apply MulDistribMulAction.toMulEquiv_apply

variable (α)

/-- Each element of the group defines an multiplicative monoid isomorphism.

This is a stronger version of `MulAction.toPermHom`. -/
@[simps]
def MulDistribMulAction.toMulAut : α →* MulAut β where
  toFun := MulDistribMulAction.toMulEquiv β
  map_one' := MulEquiv.ext (one_smul _)
  map_mul' _ _ := MulEquiv.ext (mul_smul _ _)
#align mul_distrib_mul_action.to_mul_aut MulDistribMulAction.toMulAut
#align mul_distrib_mul_action.to_mul_aut_apply MulDistribMulAction.toMulAut_apply

variable {α β}

end MulDistribMulAction

section Arrow

/-- If `G` acts on `A`, then it acts also on `A → B`, by `(g • F) a = F (g⁻¹ • a)`. -/
@[to_additive (attr := simps) arrowAddAction
      "If `G` acts on `A`, then it acts also on `A → B`, by `(g +ᵥ F) a = F (g⁻¹ +ᵥ a)`"]
def arrowAction {G A B : Type _} [DivisionMonoid G] [MulAction G A] : MulAction G (A → B) where
  smul g F a := F (g⁻¹ • a)
  one_smul := by
    intro f
    show (fun x => f ((1 : G)⁻¹ • x)) = f
    simp only [inv_one, one_smul]
  mul_smul := by
    intros x y f
    show (fun a => f ((x*y)⁻¹ • a)) = (fun a => f (y⁻¹ • x⁻¹ • a))
    simp only [mul_smul, mul_inv_rev]
#align arrow_action arrowAction
#align arrow_add_action arrowAddAction

attribute [local instance] arrowAction

/-- When `B` is a monoid, `ArrowAction` is additionally a `MulDistribMulAction`. -/
def arrowMulDistribMulAction {G A B : Type _} [Group G] [MulAction G A] [Monoid B] :
    MulDistribMulAction G (A → B) where
  smul_one _ := rfl
  smul_mul _ _ _ := rfl
#align arrow_mul_distrib_mul_action arrowMulDistribMulAction

attribute [local instance] arrowMulDistribMulAction

/-- Given groups `G H` with `G` acting on `A`, `G` acts by
  multiplicative automorphisms on `A → H`. -/
@[simps!]
def mulAutArrow {G A H} [Group G] [MulAction G A] [Monoid H] : G →* MulAut (A → H) :=
  MulDistribMulAction.toMulAut _ _
#align mul_aut_arrow mulAutArrow
#align mul_aut_arrow_apply_apply mulAutArrow_apply_apply
#align mul_aut_arrow_apply_symm_apply mulAutArrow_apply_symm_apply

end Arrow

namespace IsUnit

section MulAction

variable [Monoid α] [MulAction α β]

@[to_additive]
theorem smul_left_cancel {a : α} (ha : IsUnit a) {x y : β} : a • x = a • y ↔ x = y :=
  let ⟨u, hu⟩ := ha
  hu ▸ smul_left_cancel_iff u
#align is_unit.smul_left_cancel IsUnit.smul_left_cancel
#align is_add_unit.vadd_left_cancel IsAddUnit.vadd_left_cancel

end MulAction

section DistribMulAction

variable [Monoid α] [AddMonoid β] [DistribMulAction α β]

@[simp]
theorem smul_eq_zero {u : α} (hu : IsUnit u) {x : β} : u • x = 0 ↔ x = 0 :=
  (Exists.elim hu) fun u hu => hu ▸ show u • x = 0 ↔ x = 0 from smul_eq_zero_iff_eq u
#align is_unit.smul_eq_zero IsUnit.smul_eq_zero

end DistribMulAction

end IsUnit

section SMul

variable [Group α] [Monoid β]

@[simp]
theorem isUnit_smul_iff [MulAction α β] [SMulCommClass α β β] [IsScalarTower α β β] (g : α)
    (m : β) : IsUnit (g • m) ↔ IsUnit m :=
  ⟨fun h => inv_smul_smul g m ▸ h.smul g⁻¹, IsUnit.smul g⟩
#align is_unit_smul_iff isUnit_smul_iff

theorem IsUnit.smul_sub_iff_sub_inv_smul [AddGroup β] [DistribMulAction α β] [IsScalarTower α β β]
    [SMulCommClass α β β] (r : α) (a : β) : IsUnit (r • (1 : β) - a) ↔ IsUnit (1 - r⁻¹ • a) := by
  rw [← isUnit_smul_iff r (1 - r⁻¹ • a), smul_sub, smul_inv_smul]
#align is_unit.smul_sub_iff_sub_inv_smul IsUnit.smul_sub_iff_sub_inv_smul

end SMul


import Mathlib.Init.Data.Option.Instances
import Mathlib.Init.Data.List.Lemmas
import Mathlib.Logic.Basic
import Mathlib.Logic.Function.Basic
import Mathlib.Data.Nat.Basic
import Mathlib.Data.Option.Basic
import Mathlib.Data.List.Defs
import Lean

open Function

namespace List

theorem concat_eq_append : ∀ (l : List α) a, concat l a = l ++ [a]
| [], a => (append_nil _).symm
| x::xs, a => by simp only [concat, cons_append, concat_eq_append xs]

theorem get_cons_drop : ∀ (l : List α) i,
  List.get l i :: List.drop (i + 1) l = List.drop i l
| _::_, ⟨0, h⟩ => rfl
| _::_, ⟨i+1, h⟩ => get_cons_drop _ ⟨i, _⟩

theorem drop_eq_nil_of_le : ∀ {l : List α} {k : Nat} (h : l.length ≤ k), l.drop k = []
| [], k, _ => by cases k <;> rfl
| a::l, 0, h => by cases h
| a::l, k+1, h => by have h0 : length (a :: l) = length l + 1 := rfl
                     have h1 : length l ≤ k := by rw [h0] at h
                                                   exact Nat.le_of_succ_le_succ h
                     exact drop_eq_nil_of_le (l := l) h1

theorem join_nil : join ([] : List (List α)) = [] := rfl

theorem join_cons : join (a :: l : List (List α)) = a ++ join l := rfl

/-!
# Basic properties of Lists
-/

-- instance : is_left_id (List α) has_append.append [] :=
-- ⟨ nil_append ⟩

-- instance : is_right_id (List α) has_append.append [] :=
-- ⟨ append_nil ⟩

-- instance : is_associative (List α) has_append.append :=
-- ⟨ append_assoc ⟩

theorem cons_ne_nil (a : α) (l : List α) : a::l ≠ [] := by intro h; cases h

theorem cons_ne_self (a : α) (l : List α) : a::l ≠ l :=
  mt (congr_arg length) (Nat.succ_ne_self _)

theorem head_eq_of_cons_eq {h₁ h₂ : α} {t₁ t₂ : List α} :
      (h₁::t₁) = (h₂::t₂) → h₁ = h₂ :=
fun Peq => List.noConfusion Peq fun Pheq Pteq => Pheq

theorem tail_eq_of_cons_eq {h₁ h₂ : α} {t₁ t₂ : List α} :
      (h₁::t₁) = (h₂::t₂) → t₁ = t₂ :=
fun Peq => List.noConfusion Peq (fun Pheq Pteq => Pteq)

-- @[simp] theorem cons_injective {a : α} : injective (cons a) :=
-- assume l₁ l₂, assume Pe, tail_eq_of_cons_eq Pe

-- theorem cons_inj (a : α) {l l' : List α} : a::l = a::l' ↔ l = l' :=
-- cons_injective.eq_iff

theorem exists_cons_of_ne_nil {l : List α} (h : l ≠ nil) : ∃ b L, l = b :: L := by
  induction l with
    | nil          => contradiction
    | cons c l' ih => exact ⟨c, l', rfl⟩

/-! ### mem -/

theorem mem_singleton_self (a : α) : a ∈ [a] := mem_cons_self _ _

theorem eq_of_mem_singleton {a b : α} (h : a ∈ [b]) : a = b :=
  (eq_or_mem_of_mem_cons h).elim
    (fun heq : a = b => heq)
    (fun hin : a ∈ [] => absurd hin (not_mem_nil a))

@[simp 1100] theorem mem_singleton {a b : α} : a ∈ [b] ↔ a = b :=
⟨eq_of_mem_singleton, by simp⟩

theorem mem_of_mem_cons_of_mem {a b : α} {l : List α} : a ∈ b::l → b ∈ l → a ∈ l :=
  fun ainbl binl =>
    (eq_or_mem_of_mem_cons ainbl).elim
      (fun heq : a = b => heq ▸ binl)
      (fun hin : a ∈ l => hin)

theorem eq_or_ne_mem_of_mem {a b : α} {l : List α} (h' : a ∈ b :: l) : a = b ∨ (a ≠ b ∧ a ∈ l) :=
  open Classical in if h : a = b then Or.inl h else Or.inr ⟨h, (mem_cons.1 h').resolve_left h⟩

theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
mt mem_append.1 $ (not_or _ _).mpr ⟨h₁, h₂⟩

theorem ne_nil_of_mem {a : α} {l : List α} (h : a ∈ l) : l ≠ [] := by intro e; rw [e] at h; cases h

theorem mem_constructor {a : α} {l : List α} (h : a ∈ l) : ∃ s t : List α, l = s ++ a :: t := by
  induction l with
  | nil => cases h --exact ⟨[], l, rfl⟩
  | cons b l ih =>
      cases h with
      | head => exact ⟨[], l, rfl⟩
      | tail _ hmem =>
        match ih hmem with
        | ⟨s, t, h'⟩ =>
          refine ⟨b::s, t, ?_⟩
          rw [h', cons_append]

theorem mem_of_ne_of_mem {a y : α} {l : List α} (h₁ : a ≠ y) (h₂ : a ∈ y :: l) : a ∈ l :=
Or.elim (eq_or_mem_of_mem_cons h₂) (fun e => absurd e h₁) (fun r => r)

theorem ne_of_not_mem_cons {a b : α} {l : List α} : (a ∉ b::l) → a ≠ b :=
fun nin aeqb => absurd (aeqb ▸ Mem.head ..) nin

theorem not_mem_of_not_mem_cons {a b : α} {l : List α} : (a ∉ b::l) → a ∉ l :=
fun nin nainl => absurd (Mem.tail _ nainl) nin

theorem not_mem_cons_of_ne_of_not_mem {a y : α} {l : List α} : a ≠ y → (a ∉ l) → (a ∉ y::l) :=
fun p1 p2 => fun Pain => absurd (eq_or_mem_of_mem_cons Pain) ((not_or _ _).mpr ⟨p1, p2⟩)

theorem ne_and_not_mem_of_not_mem_cons {a y : α} {l : List α} : (a ∉ y::l) → a ≠ y ∧ a ∉ l :=
fun p => And.intro (ne_of_not_mem_cons p) (not_mem_of_not_mem_cons p)

theorem mem_map_of_mem (f : α → β) {a : α} {l : List α} (h : a ∈ l) : f a ∈ map f l := by
  induction l with
  | nil => cases h
  | cons b l' ih =>
    cases h with constructor
    | tail _ h' => exact ih h'

theorem exists_of_mem_map {f : α → β} {b : β} {l : List α} (h : b ∈ List.map f l) :
    ∃ a, a ∈ l ∧ f a = b := by
  induction l with
  | nil => cases h
  | cons c l' ih =>
    cases eq_or_mem_of_mem_cons h with
    | inl h => exact ⟨c, mem_cons_self _ _, h.symm⟩
    | inr h =>
      match ih h with
      | ⟨a, ha₁, ha₂⟩ => exact ⟨a, mem_cons_of_mem _ ha₁, ha₂⟩

theorem mem_map {f : α → β} {b} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ b = f a
| [] => by simp
| b :: l => by
  rw [map_cons, mem_cons, mem_map];
  exact ⟨fun | Or.inl h => ⟨_, Mem.head .., h⟩
             | Or.inr ⟨l, h₁, h₂⟩ => ⟨l, Mem.tail _ h₁, h₂⟩,
         fun | ⟨_, Mem.head .., h⟩ => Or.inl h
             | ⟨l, Mem.tail _ h₁, h₂⟩ => Or.inr ⟨l, h₁, h₂⟩⟩

theorem mem_map_of_injective {f : α → β} (H : injective f) {a : α} {l : List α} :
  f a ∈ map f l ↔ a ∈ l :=
⟨fun m => let ⟨a', m', e⟩ := exists_of_mem_map m
          H e ▸ m', mem_map_of_mem _⟩

lemma forall_mem_map_iff {f : α → β} {l : List α} {P : β → Prop} :
  (∀ i ∈ l.map f, P i) ↔ ∀ j ∈ l, P (f j) := by
  constructor
  { intros H j hj; exact H (f j) (mem_map_of_mem f hj) }
    intros H i hi
    match mem_map.1 hi with
    | ⟨j, hj, ji⟩ => rw [ji]; exact H j hj

@[simp] lemma map_eq_nil {f : α → β} {l : List α} : List.map f l = [] ↔ l = [] := by
  constructor
  { cases l with
    | nil => intro _; rfl
    | cons b l => intro h; exact List.noConfusion h }
  { intro h; rw [h]; rfl }

theorem mem_join {a} : ∀ {L : List (List α)}, a ∈ L.join ↔ ∃ l, l ∈ L ∧ a ∈ l
| [] => by simp
| b :: l => by
  simp only [join, mem_append, mem_join]
  exact ⟨fun | Or.inl h => ⟨_, Mem.head .., h⟩
             | Or.inr ⟨l, h₁, h₂⟩ => ⟨l, Mem.tail _ h₁, h₂⟩,
         fun | ⟨_, Mem.head .., h⟩ => Or.inl h
             | ⟨l, Mem.tail _ h₁, h₂⟩ => Or.inr ⟨l, h₁, h₂⟩⟩

theorem exists_of_mem_join {a : α} {L : List (List α)} : a ∈ join L → ∃ l, l ∈ L ∧ a ∈ l :=
mem_join.1

theorem mem_join_of_mem {a : α} {L : List (List α)} {l} (lL : l ∈ L) (al : a ∈ l) : a ∈ join L :=
mem_join.2 ⟨l, lL, al⟩

theorem mem_bind {f : α → List β} {b} {l : List α} : b ∈ l.bind f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
  simp [List.bind, mem_map, mem_join]
  exact ⟨fun ⟨_, ⟨a, h₁, rfl⟩, h₂⟩ => ⟨a, h₁, h₂⟩, fun ⟨a, h₁, h₂⟩ => ⟨_, ⟨a, h₁, rfl⟩, h₂⟩⟩

theorem exists_of_mem_bind {b : β} {l : List α} {f : α → List β} :
  b ∈ List.bind l f → ∃ a, a ∈ l ∧ b ∈ f a :=
mem_bind.1

theorem mem_bind_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
  b ∈ List.bind l f :=
mem_bind.2 ⟨a, al, h⟩

lemma bind_map {g : α → List β} {f : β → γ} :
  ∀(l : List α), List.map f (l.bind g) = l.bind (fun a => (g a).map f)
| [] => rfl
| a::l => by simp only [cons_bind, map_append, bind_map l]

/-! ### length -/

-- @[simp] lemma length_tail (l : list α) : length (tail l) = length l - 1 :=
-- by cases l; refl

-- -- TODO(Leo): cleanup proof after arith dec proc
-- @[simp] lemma length_drop : ∀ (i : ℕ) (l : list α), length (drop i l) = length l - i
-- | 0 l         := rfl
-- | (succ i) [] := eq.symm (nat.zero_sub (succ i))
-- | (succ i) (x::l) := calc
--   length (drop (succ i) (x::l))
--           = length l - i             : length_drop i l
--       ... = succ (length l) - succ i : (nat.succ_sub_succ_eq_sub (length l) i).symm

theorem length_eq_zero {l : List α} : length l = 0 ↔ l = [] :=
⟨eq_nil_of_length_eq_zero, fun h => by rw [h]; rfl⟩

@[simp 1100] lemma length_singleton (a : α) : length [a] = 1 := rfl

theorem length_pos_of_mem {a : α} : ∀ {l : List α}, a ∈ l → 0 < length l
| nil,  h => by cases h
| b::l, _ => by rw [length_cons]; exact Nat.zero_lt_succ _

theorem exists_mem_of_length_pos : ∀ {l : List α}, 0 < length l → ∃ a, a ∈ l
| nil,    h => by cases h
| b::l, _   => ⟨b, mem_cons_self _ _⟩

theorem length_pos_iff_exists_mem {l : List α} : 0 < length l ↔ ∃ a, a ∈ l :=
⟨exists_mem_of_length_pos, fun  ⟨a, h⟩ => length_pos_of_mem h⟩

theorem ne_nil_of_length_pos {l : List α} : 0 < length l → l ≠ [] :=
fun h1 h2 => Nat.lt_irrefl 0 ((length_eq_zero.2 h2).subst h1)

theorem length_pos_of_ne_nil {l : List α} : l ≠ [] → 0 < length l :=
fun h => Nat.pos_iff_ne_zero.2 $ fun h0 => h $ length_eq_zero.1 h0

theorem length_pos_iff_ne_nil {l : List α} : 0 < length l ↔ l ≠ [] :=
⟨ne_nil_of_length_pos, length_pos_of_ne_nil⟩

lemma exists_mem_of_ne_nil (l : List α) (h : l ≠ []) : ∃ x, x ∈ l :=
exists_mem_of_length_pos (length_pos_of_ne_nil h)

theorem length_eq_one {l : List α} : length l = 1 ↔ ∃ a, l = [a] := by
  constructor
  · intro h
    match l with
    | nil => contradiction
    | [a] => exact ⟨_, rfl⟩
    | a::b::l => simp at h
  · intro ⟨a, leq⟩; rw [leq]; simp

lemma exists_of_length_succ {n} :
  ∀ l : List α, l.length = n + 1 → ∃ h t, l = h :: t
| [], H => absurd H.symm $ Nat.succ_ne_zero n
| (h :: t), H => ⟨h, t, rfl⟩

-- @[simp] lemma length_injective_iff : injective (List.length : List α → ℕ) ↔ subsingleton α :=
-- begin
--   constructor,
--   { intro h, refine ⟨fun  x y, _⟩, suffices : [x] = [y], { simpa using this }, apply h, refl },
--   { intros hα l1 l2 hl, induction l1 generalizing l2; cases l2,
--     { refl }, { cases hl }, { cases hl },
--     congr, exactI subsingleton.elim _ _, apply l1_ih, simpa using hl }
-- end

-- @[simp] lemma length_injective [subsingleton α] : injective (length : List α → ℕ) :=
-- length_injective_iff.mpr $ by apply_instance

/-! ### set-theoretic notation of Lists -/

lemma empty_eq : (∅ : List α) = [] := by rfl
--lemma singleton_eq (x : α) : ({x} : List α) = [x] := rfl
--lemma insert_neg [DecidableEq α] {x : α} {l : List α} (h : x ∉ l) :
--  has_insert.insert x l = x :: l :=
--if_neg h
--lemma insert_pos [DecidableEq α] {x : α} {l : List α} (h : x ∈ l) :
--  has_insert.insert x l = l :=
--if_pos h
-- lemma doubleton_eq [DecidableEq α] {x y : α} (h : x ≠ y) : ({x, y} : List α) = [x, y] := by
--   rw [insert_neg, singleton_eq]; rwa [singleton_eq, mem_singleton]

/-! ### bounded quantifiers over Lists -/

theorem forall_mem_nil (p : α → Prop) : ∀ x∈ @nil α, p x := fun x h => by cases h

theorem forall_mem_cons : ∀ {p : α → Prop} {a : α} {l : List α},
  (∀ x ∈ a :: l, p x) ↔ p a ∧ ∀ x ∈ l, p x :=
ball_cons _ _ _

theorem forall_mem_of_forall_mem_cons {p : α → Prop} {a : α} {l : List α}
    (h : ∀ x, x ∈ a :: l → p x) :
  ∀ x, x ∈ l → p x :=
(forall_mem_cons.1 h).2

theorem forall_mem_singleton {p : α → Prop} {a : α} : (∀ x ∈ [a], p x) ↔ p a := by
  simp only [mem_singleton, forall_eq]; rfl

theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} :
  (∀ x ∈ l₁ ++ l₂, p x) ↔ (∀ x ∈ l₁, p x) ∧ (∀ x ∈ l₂, p x) :=
by simp only [mem_append, or_imp_distrib, forall_and_distrib]; rfl

theorem not_exists_mem_nil (p : α → Prop) : ¬ ∃ x ∈ @nil α, p x
  | ⟨_, ⟨h, _⟩⟩ => by cases h

theorem exists_mem_cons_of {p : α → Prop} {a : α} (l : List α) (h : p a) :
  ∃ x ∈ a :: l, p x :=
⟨a, (mem_cons_self _ _), h⟩

theorem exists_mem_cons_of_exists {p : α → Prop} {a : α} {l : List α} :
    (∃ x ∈ l, p x) → ∃ x ∈ a :: l, p x
| ⟨x, h, px⟩ => ⟨x, Mem.tail _ h, px⟩

theorem or_exists_of_exists_mem_cons {p : α → Prop} {a : α} {l : List α} :
    (∃ x ∈ a :: l, p x) → p a ∨ ∃ x ∈ l, p x
| ⟨x, xal, px⟩ => by
  cases xal with
  | head => exact Or.inl px
  | tail _ h => exact Or.inr ⟨x, h, px⟩

theorem exists_mem_cons_iff (p : α → Prop) (a : α) (l : List α) :
  (∃ x ∈ a :: l, p x) ↔ p a ∨ ∃ x ∈ l, p x :=
Iff.intro or_exists_of_exists_mem_cons
  (fun h => Or.elim h (exists_mem_cons_of l) exists_mem_cons_of_exists)

/-! ### List subset -/

theorem subset_def {l₁ l₂ : List α} : l₁ ⊆ l₂ ↔ ∀ {a : α}, a ∈ l₁ → a ∈ l₂ := Iff.rfl

theorem subset_append_of_subset_left (l l₁ l₂ : List α) : l ⊆ l₁ → l ⊆ l₁++l₂ :=
fun s => subset.trans s $ subset_append_left _ _

theorem subset_append_of_subset_right (l l₁ l₂ : List α) : l ⊆ l₂ → l ⊆ l₁++l₂ :=
fun s => subset.trans s $ subset_append_right _ _

@[simp] theorem cons_subset {a : α} {l m : List α} :
    a::l ⊆ m ↔ a ∈ m ∧ l ⊆ m := by
  simp only [subset_def, mem_cons, or_imp_distrib, forall_and_distrib, forall_eq]; rfl

theorem cons_subset_of_subset_of_mem {a : α} {l m : List α}
  (ainm : a ∈ m) (lsubm : l ⊆ m) : a::l ⊆ m :=
cons_subset.2 ⟨ainm, lsubm⟩

theorem append_subset_of_subset_of_subset {l₁ l₂ l : List α} (l₁subl : l₁ ⊆ l) (l₂subl : l₂ ⊆ l) :
  l₁ ++ l₂ ⊆ l :=
fun {a} h => (mem_append.1 h).elim (@l₁subl _) (@l₂subl _)

@[simp] theorem append_subset_iff {l₁ l₂ l : List α} :
    l₁ ++ l₂ ⊆ l ↔ l₁ ⊆ l ∧ l₂ ⊆ l := by
  constructor
  { intro h; simp only [subset_def] at *
    constructor
    { intros; apply h; apply mem_append_left; assumption }
    { intros; apply h; apply mem_append_right; assumption } }
  { intro h; match h with | ⟨h1, h2⟩ => apply append_subset_of_subset_of_subset h1 h2 }

theorem eq_nil_of_subset_nil : ∀ {l : List α}, l ⊆ [] → l = []
| [],     s => rfl
| (a::l), s => nomatch s $ mem_cons_self a l

theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] ↔ ∀ a, a ∉ l :=
  have : l = [] ↔ l ⊆ [] := ⟨fun e => e ▸ subset.refl _, eq_nil_of_subset_nil⟩
  by simp [subset_def] at this; exact this

theorem map_subset {l₁ l₂ : List α} (f : α → β) (H : l₁ ⊆ l₂) : map f l₁ ⊆ map f l₂ :=
fun {x} => by simp only [mem_map, not_and, exists_imp_distrib, and_imp]
              exact fun a h e => ⟨a, H h, e⟩

-- theorem map_subset_iff {l₁ l₂ : List α} (f : α → β) (h : injective f) :
--   map f l₁ ⊆ map f l₂ ↔ l₁ ⊆ l₂ :=
-- begin
--   refine ⟨_, map_subset f⟩, intros h2 x hx,
--   rcases mem_map.1 (h2 (mem_map_of_mem f hx)) with ⟨x', hx', hxx'⟩,
--   cases h hxx', exact hx'
-- end

@[simp] theorem mem_reverseAux (x : α) : ∀ as bs, x ∈ reverseAux as bs ↔ x ∈ as ∨ x ∈ bs
  | [], bs => by simp [reverseAux]
  | a :: as, bs => by simp [reverseAux, mem_reverseAux]; rw [←or_assoc, @or_comm (x = a)]

@[simp] theorem mem_reverse (x : α) (as : List α) : x ∈ reverse as ↔ x ∈ as := by simp [reverse]

-- TODO: better automation needed
theorem mem_filterAux (x : α) (p : α → Bool) :
    ∀ as bs, x ∈ filterAux p as bs ↔ (x ∈ as ∧ p x) ∨ x ∈ bs
  | [], bs => by simp [filterAux]
  | (a :: as), bs => by
    simp [filterAux]
    cases pa : p a with
    | true =>
      simp [mem_filterAux x p as (a :: bs)]
      constructor
      · intro
        | Or.inl h'' => exact Or.inl ⟨Or.inr h''.1, h''.2⟩
        | Or.inr (Or.inl h₃) => exact Or.inl ⟨Or.inl h₃, h₃ ▸ pa⟩
        | Or.inr (Or.inr h₃) => exact Or.inr h₃
      · intro
        | Or.inl ⟨Or.inl h₃, _⟩ => exact Or.inr (Or.inl h₃)
        | Or.inl ⟨Or.inr h₃, h''⟩ => exact Or.inl ⟨h₃, h''⟩
        | Or.inr h'' => exact Or.inr (Or.inr h'')
    | false =>
      simp [mem_filterAux x p as bs]
      constructor
      · intro
        | Or.inl h'' => exact Or.inl ⟨Or.inr h''.1, h''.2⟩
        | Or.inr h'' => exact Or.inr h''
      · intro
        | Or.inl ⟨Or.inl h₃, h''⟩ => rw [← h₃, h''] at pa; contradiction
        | Or.inl ⟨Or.inr h₃, h''⟩ => exact Or.inl ⟨h₃, h''⟩
        | Or.inr h'' => exact Or.inr h''

theorem mem_filter (as : List α) (p : α → Bool) (x : α) :
    x ∈ filter p as ↔ x ∈ as ∧ p x = true := by simp [filter, mem_filterAux]

/-! ### append -/

lemma append_eq_has_append {L₁ L₂ : List α} : List.append L₁ L₂ = L₁ ++ L₂ := rfl

@[simp 1100] lemma singleton_append {x : α} {l : List α} : [x] ++ l = x :: l := rfl

@[simp] lemma append_eq_nil {p q : List α} : (p ++ q) = [] ↔ p = [] ∧ q = [] := by
  cases p <;> simp

theorem append_ne_nil_of_ne_nil_left (s t : List α) : s ≠ [] → s ++ t ≠ [] := by simp_all

theorem append_ne_nil_of_ne_nil_right (s t : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all

@[simp] lemma nil_eq_append_iff {a b : List α} : [] = a ++ b ↔ a = [] ∧ b = [] :=
by rw [eq_comm, append_eq_nil]

lemma append_ne_nil_of_left_ne_nil (a b : List α) (h0 : a ≠ []) : a ++ b ≠ [] := by simp [*]

lemma append_eq_cons_iff {a b c : List α} {x : α} :
  a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃a', a = x :: a' ∧ c = a' ++ b) := by
  cases a with simp | cons a as => ?_
  exact ⟨fun h => ⟨as, by simp [h]⟩, fun ⟨a', ⟨aeq, aseq⟩, h⟩ => ⟨aeq, by rw [aseq, h]⟩⟩

lemma cons_eq_append_iff {a b c : List α} {x : α} :
    (x :: c : List α) = a ++ b ↔ (a = [] ∧ b = x :: c) ∨ (∃a', a = x :: a' ∧ c = a' ++ b) := by
  rw [eq_comm, append_eq_cons_iff]

-- theorem append_eq_append_iff {a b c d : List α} :
--   a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
--   induction a generalizing c with
--   | nil =>
--     rw [nil_append]; constructor
--     · rintro rfl; left; exact ⟨_, rfl, rfl⟩
--     · rintro (⟨a', rfl, rfl⟩ | ⟨a', H, rfl⟩); {rfl}; rw [←append_assoc, ←H]; rfl
--   | cons a as ih =>
--     cases c
--     · simp only [cons_append, nil_append, false_and, exists_false, false_or, exists_eq_left']
--       exact eq_comm
--     · simp only [cons_append, @eq_comm _ a, ih, and_assoc, and_or_distrib_left,
--         exists_and_distrib_left]

-- @[simp] theorem split_at_eq_take_drop : ∀ (n : ℕ) (l : List α), split_at n l = (take n l, drop n l)
-- | 0, a => rfl
-- | n+1, [] => rfl
-- | n+1, x :: xs => by simp only [split_at, split_at_eq_take_drop n xs, take, drop]

@[simp] theorem take_append_drop : ∀ (n : ℕ) (l : List α), take n l ++ drop n l = l
| 0, a => rfl
| n+1, [] => rfl
| n+1, x :: xs => congr_arg (cons x) $ take_append_drop n xs

-- TODO(Leo): cleanup proof after arith dec proc
theorem append_inj :
  ∀ {s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ → length s₁ = length s₂ → s₁ = s₂ ∧ t₁ = t₂
| [], [], t₁, t₂, h, hl => ⟨rfl, h⟩
| a :: s₁, [], t₁, t₂, h, hl => List.noConfusion $ eq_nil_of_length_eq_zero hl
| [], b :: s₂, t₁, t₂, h, hl => List.noConfusion $ eq_nil_of_length_eq_zero hl.symm
| a :: s₁, b :: s₂, t₁, t₂, h, hl => List.noConfusion h fun ab hap =>
  let ⟨e1, e2⟩ := @append_inj _ s₁ s₂ t₁ t₂ hap (Nat.succ.inj hl)
  by rw [ab, e1, e2] <;> exact ⟨rfl, rfl⟩

theorem append_inj_right {s₁ s₂ t₁ t₂ : List α} (h : s₁ ++ t₁ = s₂ ++ t₂)
  (hl : length s₁ = length s₂) : t₁ = t₂ :=
(append_inj h hl).right

theorem append_inj_left {s₁ s₂ t₁ t₂ : List α} (h : s₁ ++ t₁ = s₂ ++ t₂)
  (hl : length s₁ = length s₂) : s₁ = s₂ :=
(append_inj h hl).left

theorem append_inj' {s₁ s₂ t₁ t₂ : List α} (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) :
  s₁ = s₂ ∧ t₁ = t₂ :=
append_inj h $ @Nat.add_right_cancel _ (length t₁) _ $
let hap := congr_arg length h; by simp only [length_append] at hap; rwa [← hl] at hap

theorem append_inj_right' {s₁ s₂ t₁ t₂ : List α} (h : s₁ ++ t₁ = s₂ ++ t₂)
  (hl : length t₁ = length t₂) : t₁ = t₂ :=
(append_inj' h hl).right

theorem append_inj_left' {s₁ s₂ t₁ t₂ : List α} (h : s₁ ++ t₁ = s₂ ++ t₂)
  (hl : length t₁ = length t₂) : s₁ = s₂ :=
(append_inj' h hl).left

theorem append_left_cancel {s t₁ t₂ : List α} (h : s ++ t₁ = s ++ t₂) : t₁ = t₂ :=
append_inj_right h rfl

theorem append_right_cancel {s₁ s₂ t : List α} (h : s₁ ++ t = s₂ ++ t) : s₁ = s₂ :=
append_inj_left' h rfl

theorem append_right_injective (s : List α) : injective fun t => s ++ t :=
fun _ _ => append_left_cancel

theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
(@append_right_injective _ s).eq_iff

theorem append_left_injective (t : List α) : injective fun s => s ++ t :=
fun _ _ => append_right_cancel

theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
(append_left_injective t).eq_iff

theorem map_eq_append_split {f : α → β} {l : List α} {s₁ s₂ : List β}
  (h : map f l = s₁ ++ s₂) : ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = s₁ ∧ map f l₂ = s₂ := by
  have := h
  rw [← take_append_drop (length s₁) l] at this ⊢
  rw [map_append] at this
  refine' ⟨_, _, rfl, append_inj this _⟩
  rw [length_map, length_take, min_eq_left]
  rw [←length_map l f, h, length_append]
  apply Nat.le_add_right

/-! ### repeat -/

theorem repeat'_succ (a : α) n : repeat' a (n+1) = a :: repeat' a n := rfl

theorem mem_repeat' {a b : α} : ∀ {n}, b ∈ repeat' a n ↔ n ≠ 0 ∧ b = a
| 0 => by simp
| n+1 => by simp [mem_repeat']

theorem eq_of_mem_repeat' {a b : α} {n} (h : b ∈ repeat' a n) : b = a :=
  (mem_repeat'.1 h).2

/-! ### getLast -/

theorem getLast_cons {a : α} {l : List α} : ∀ (h₁ : a :: l ≠ nil) (h₂ : l ≠ nil),
  getLast (a :: l) h₁ = getLast l h₂ := by
  induction l <;> intros; {contradiction}; rfl

@[simp] theorem getLast_append {a : α} : ∀ (l : List α) (h : l ++ [a] ≠ []), getLast (l ++ [a]) h = a
| [], _ => rfl
| a::t, h => by
  show getLast (_ :: (_ ++ _)) _ = _
  rw [getLast_cons _ fun H => cons_ne_nil _ _ (append_eq_nil.1 H).2, getLast_append t]

theorem getLast_concat {a : α} (l : List α) : (h : concat l a ≠ []) → getLast (concat l a) h = a := by
  rw [concat_eq_append]; apply getLast_append

/-! ### nth element -/

theorem get_of_mem : ∀ {a} {l : List α}, a ∈ l → ∃ n, get l n = a
| a, _ :: l, Mem.head .. => ⟨⟨0, Nat.succ_pos _⟩, rfl⟩
| a, b :: l, Mem.tail _ m =>
  let ⟨⟨n, h⟩, e⟩ := get_of_mem m
  ⟨⟨n+1, Nat.succ_lt_succ h⟩, e⟩

theorem get?_eq_get : ∀ {l : List α} {n} h, l.get? n = some (get l ⟨n, h⟩)
| a :: l, 0, h => rfl
| a :: l, n+1, h => @get?_eq_get _ l n _

theorem get?_len_le : ∀ {l : List α} {n}, length l ≤ n → l.get? n = none
| [], n, h => rfl
| a :: l, n+1, h => @get?_len_le _ l n $ Nat.le_of_succ_le_succ h

theorem get?_eq_some {l : List α} {n a} : l.get? n = some a ↔ ∃ h, get l ⟨n, h⟩ = a :=
  ⟨fun e =>
      have h : n < length l := lt_of_not_ge fun hn => by
        rw [get?_len_le hn] at e; contradiction
      ⟨h, by rw [get?_eq_get h] at e; injection e with e; exact e⟩,
    fun ⟨h, e⟩ => e ▸ get?_eq_get _⟩

@[simp] theorem get?_eq_none_iff {l : List α} {n} : l.get? n = none ↔ length l ≤ n := by
  constructor
  · intro h
    by_contra h'
    have h₂ : ∃ h , l.get ⟨n, h⟩ = l.get ⟨n, lt_of_not_ge h'⟩ := ⟨lt_of_not_ge h', rfl⟩
    rw [← get?_eq_some, h] at h₂
    cases h₂
  · exact get?_len_le

theorem get?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n, l.get? n = some a :=
  let ⟨⟨n, h⟩, e⟩ := get_of_mem h
  ⟨n,
    by
      rw [get?_eq_get, e]⟩

theorem get_mem : ∀ (l : List α) n h, get l ⟨n, h⟩ ∈ l
| a :: l, 0, h => mem_cons_self _ _
| a :: l, n+1, h => mem_cons_of_mem _ (get_mem l _ _)

theorem get?_mem {l : List α} {n a} (e : l.get? n = some a) : a ∈ l :=
  let ⟨h, e⟩ := get?_eq_some.1 e
  e ▸ get_mem _ _ _

theorem mem_iff_get {a} {l : List α} : a ∈ l ↔ ∃ n, get l n = a :=
  ⟨get_of_mem, fun ⟨_, e⟩ => e ▸ get_mem _ _ _⟩

theorem Fin.exists_iff (p : Fin n → Prop) : (∃ i, p i) ↔ ∃ i h, p ⟨i, h⟩ :=
  ⟨fun ⟨i, h⟩ => ⟨i.1, i.2, h⟩, fun ⟨i, hi, h⟩ => ⟨⟨i, hi⟩, h⟩⟩

theorem mem_iff_get? {a} {l : List α} : a ∈ l ↔ ∃ n, l.get? n = some a := by
  simp [get?_eq_some, Fin.exists_iff, mem_iff_get]

theorem get?_zero (l : List α) : l.get? 0 = l.head? := by cases l <;> rfl

theorem get?_injective {α : Type u} {xs : List α} {i j : ℕ}
  (h₀ : i < xs.length)
  (h₁ : Nodup xs)
  (h₂ : xs.get? i = xs.get? j) : i = j := by
  induction xs generalizing i j with
  | nil => cases h₀
  | cons x xs ih =>
    match i, j with
    | 0, 0 => rfl
    | i+1, j+1 => simp; cases h₁ with
      | cons ha h₁ => exact ih (Nat.lt_of_succ_lt_succ h₀) h₁ h₂
    | i+1, 0 => ?_ | 0, j+1 => ?_
    all_goals
      simp at h₂
      cases h₁; rename_i h' h
      have := h x ?_ rfl; cases this
      rw [mem_iff_get?]
    exact ⟨_, h₂⟩; exact ⟨_ , h₂.symm⟩

@[simp] theorem get?_map (f : α → β) : ∀ l n, (map f l).get? n = (l.get? n).map f
| [], n => rfl
| a :: l, 0 => rfl
| a :: l, n+1 => get?_map f l n

@[simp]
theorem get_map (f : α → β) {l n} : get (map f l) n = f (get l ⟨n, length_map l f ▸ n.2⟩) :=
  Option.some.inj $ by
    rw [←get?_eq_get, get?_map, get?_eq_get]; rfl

/-- If one has `get L i hi` in a formula and `h : L = L'`, one can not `rw h` in the formula as
`hi` gives `i < L.length` and not `i < L'.length`. The lemma `get_of_eq` can be used to make
such a rewrite, with `rw (get_of_eq h)`. -/
theorem get_of_eq {L L' : List α} (h : L = L') (i : Fin  L.length) :
  get L i = get L' ⟨i, h ▸ i.2⟩ := by cases h; rfl

@[simp] theorem get_singleton (a : α) (n : Fin 1) : get [a] n = a := by
  have hn0 : n.1 = 0 := Nat.le_zero_iff.1 (Nat.le_of_lt_succ n.2)
  cases n
  subst hn0; rfl

theorem get_zero [Inhabited α] {L : List α} (h : 0 < L.length) : L.get ⟨0, h⟩ = L.head? := by
  cases L; {cases h}; simp

theorem get_append : ∀ {l₁ l₂ : List α} (n : ℕ) (h : n < l₁.length),
    (l₁ ++ l₂).get ⟨n, id (length_append .. ▸ Nat.lt_add_right _ _ _ h)⟩ = l₁.get ⟨n, h⟩
| a :: l, _, 0, h => rfl
| a :: l, _, n+1, h => by
  simp only [get, cons_append] <;> exact get_append _ _

theorem get?_append_right : ∀ {l₁ l₂ : List α} {n : ℕ} (hn : l₁.length ≤ n),
  (l₁ ++ l₂).get? n = l₂.get? (n - l₁.length)
| [], _, n, h₁ => rfl
| a :: l, _, n+1, h₁ => by
  rw [cons_append]; simp
  rw [Nat.add_sub_add_right, get?_append_right (Nat.lt_succ_iff.mp h₁)]

theorem get_append_right_aux {l₁ l₂ : List α} {n : ℕ}
  (h₁ : l₁.length ≤ n) (h₂ : n < (l₁ ++ l₂).length) : n - l₁.length < l₂.length := by
  rw [length_append] at h₂
  exact Nat.sub_lt_left_of_lt_add h₁ h₂

theorem get_append_right' {l₁ l₂ : List α} {n : ℕ} (h₁ : l₁.length ≤ n) (h₂) :
    (l₁ ++ l₂).get ⟨n, h₂⟩ = l₂.get ⟨n - l₁.length, id <| get_append_right_aux h₁ h₂⟩ :=
Option.some.inj $ by rw [← get?_eq_get, ← get?_eq_get, get?_append_right h₁]

@[simp] theorem get_repeat' (a : α) {n : ℕ} (m : Fin _) : (List.repeat' a n).get m = a :=
  eq_of_mem_repeat' (get_mem _ _ _)

theorem get?_append {l₁ l₂ : List α} {n : ℕ} (hn : n < l₁.length) :
  (l₁ ++ l₂).get? n = l₁.get? n := by
  have hn' : n < (l₁ ++ l₂).length := Nat.lt_of_lt_of_le hn $ by
    rw [length_append] <;> exact Nat.le_add_right _ _
  rw [get?_eq_get hn, get?_eq_get hn', get_append]

theorem getLast_eq_get : ∀ (l : List α) (h : l ≠ []),
  getLast l h = l.get ⟨l.length - 1, id <| Nat.sub_lt (length_pos_of_ne_nil h) Nat.one_pos⟩
| [a], h => by
  rw [getLast_singleton, get_singleton]
| a :: b :: l, h => by rw [getLast_cons, getLast_eq_get (b :: l)]; {rfl}; exact cons_ne_nil b l

@[simp] theorem get?_concat_length : ∀ (l : List α) a : α, (l ++ [a]).get? l.length = some a
| [], a => rfl
| b :: l, a => by rw [cons_append, length_cons]; simp only [get?, get?_concat_length]

theorem get_cons_length (x : α) (xs : List α) (n : ℕ) (h : n = xs.length) :
  (x :: xs).get ⟨n, by simp [h]⟩ = (x :: xs).getLast (cons_ne_nil x xs) := by
  rw [getLast_eq_get]; cases h; rfl

@[ext] theorem ext : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n) → l₁ = l₂
| [], [], h => rfl
| a :: l₁, [], h => nomatch h 0
| [], a' :: l₂, h => nomatch h 0
| a :: l₁, a' :: l₂, h => by
  have h0 : some a = some a' := h 0
  injection h0 with aa; simp only [aa, ext fun n => h (n+1)]

theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂)
  (h : ∀ n h₁ h₂, get l₁ ⟨n, h₁⟩ = get l₂ ⟨n, h₂⟩) : l₁ = l₂ :=
  ext fun n =>
    if h₁ : n < length l₁ then by
      rw [get?_eq_get, get?_eq_get, h n h₁ (by rwa [←hl])]
    else by
      have h₁ := le_of_not_gt h₁
      rw [get?_len_le h₁, get?_len_le]; rwa [← hl]

theorem modifyNthTail_id : ∀ n (l : List α), l.modifyNthTail id n = l
| 0, l => rfl
| n+1, [] => rfl
| n+1, a :: l => congr_arg (List.cons a) (modifyNthTail_id n l)

theorem removeNth_eq_nth_tail : ∀ n (l : List α), removeNth l n = modifyNthTail tail n l
| 0, l => by cases l <;> rfl
| n+1, [] => rfl
| n+1, a :: l => congr_arg (cons _) (removeNth_eq_nth_tail _ _)

theorem set_eq_modifyNth (a : α) : ∀ n (l : List α), set l n a = modifyNth (fun _ => a) n l
| 0, l => by cases l <;> rfl
| n+1, [] => rfl
| n+1, b :: l => congr_arg (cons _) (set_eq_modifyNth _ _ _)

theorem modifyNth_eq_set (f : α → α) :
  ∀ n (l : List α), l.modifyNth f n = ((fun a => l.set n (f a)) <$> l.get? n).getD l
| 0, l => by cases l <;> rfl
| n+1, [] => rfl
| n+1, b :: l =>
  (congr_arg (cons b) (modifyNth_eq_set f n l)).trans $ by
    cases l.get? n <;> rfl

theorem get?_modifyNth (f : α → α) :
  ∀ n (l : List α) m, (modifyNth f n l).get? m = (fun a => if n = m then f a else a) <$> l.get? m
| n, l, 0 => by cases l <;> cases n <;> rfl
| n, [], m+1 => by cases n <;> rfl
| 0, a :: l, m+1 => by cases l.get? m <;> rfl
| n+1, a :: l, m+1 =>
  (get?_modifyNth f n l m).trans $ by
    cases l.get? m <;> by_cases h : n = m <;>
      simp only [h, if_pos, if_true, if_false, Option.map, mt Nat.succ.inj, not_false_iff]

theorem modifyNthTail_length (f : List α → List α) (H : ∀ l, length (f l) = length l) :
  ∀ n l, length (modifyNthTail f n l) = length l
| 0, l => H _
| n+1, [] => rfl
| n+1, a :: l => congr_arg (·+1) (modifyNthTail_length _ H _ _)

@[simp] theorem modify_get?_length (f : α → α) : ∀ n l, length (modifyNth f n l) = length l :=
  modifyNthTail_length _ fun l => by cases l <;> rfl

@[simp] theorem get?_modifyNth_eq (f : α → α) (n) (l : List α) :
  (modifyNth f n l).get? n = f <$> l.get? n := by
  simp only [get?_modifyNth, if_pos]

@[simp] theorem get?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) :
  (modifyNth f m l).get? n = l.get? n := by
  simp only [get?_modifyNth, if_neg h, id_map']

theorem get?_set_eq (a : α) (n) (l : List α) : (set l n a).get? n = (fun _ => a) <$> l.get? n := by
  simp only [set_eq_modifyNth, get?_modifyNth_eq]

theorem get?_set_of_lt (a : α) {n} {l : List α} (h : n < length l) :
  (set l n a).get? n = some a := by rw [get?_set_eq, get?_eq_get h]; rfl

theorem get?_set_ne (a : α) {m n} (l : List α) (h : m ≠ n) : (set l m a).get? n = l.get? n := by
  simp only [set_eq_modifyNth, get?_modifyNth_ne _ _ h]

@[simp] theorem set_nil (n : ℕ) (a : α) : [].set n a = [] := rfl

@[simp] theorem set_succ (x : α) (xs : List α) (n : ℕ) (a : α) :
  (x :: xs).set n.succ a = x :: xs.set n a := rfl

theorem set_comm (a b : α) : ∀ {n m : ℕ} (l : List α) (h : n ≠ m),
  (l.set n a).set m b = (l.set m b).set n a
| _, _, [], _ => by simp
| n+1, 0, x :: t, h => by simp [set]
| 0, m+1, x :: t, h => by simp [set]
| n+1, m+1, x :: t, h => by
  simp only [set, true_and, eq_self_iff_true]
  conv => lhs; rhs; tactic' =>
    exact set_comm a b t fun h' => h $ Nat.succ_inj'.mpr h'

@[simp] theorem get_set_eq (l : List α) (i : ℕ) (a : α) (h : i < (l.set i a).length) :
    (l.set i a).get ⟨i, h⟩ = a := by
  rw [← Option.some_inj, ← get?_eq_get, get?_set_eq, get?_eq_get] <;> simp_all

@[simp] theorem get_set_ne {l : List α} {i j : ℕ} (h : i ≠ j) (a : α)
  (hj : j < (l.set i a).length) :
    (l.set i a).get ⟨j, hj⟩ = l.get ⟨j, by simp at hj; exact hj⟩ := by
  rw [← Option.some_inj, ← List.get?_eq_get, List.get?_set_ne _ _ h, List.get?_eq_get]

theorem mem_or_eq_of_mem_set : ∀ {l : List α} {n : ℕ} {a b : α} h : a ∈ l.set n b, a ∈ l ∨ a = b
| c :: l, 0, a, b, h => ((mem_cons ..).1 h).elim Or.inr (Or.inl ∘ mem_cons_of_mem _)
| c :: l, n+1, a, b, h =>
  ((mem_cons ..).1 h).elim (fun h => h ▸ Or.inl (mem_cons_self ..))
    fun h => (mem_or_eq_of_mem_set h).elim (Or.inl ∘ mem_cons_of_mem _) Or.inr

/-! ### insert -/
section insert
variable [DecidableEq α]

@[simp] theorem insert_of_mem {a : α} {l : List α} (h : a ∈ l) : insert a l = l := by
  simp only [insert, if_pos h]

@[simp] theorem insert_of_not_mem {a : α} {l : List α} (h : a ∉ l) : insert a l = a :: l := by
  simp only [insert, if_neg h]

@[simp] theorem mem_insert_iff {a b : α} {l : List α} : a ∈ insert b l ↔ a = b ∨ a ∈ l := by
  by_cases h : b ∈ l
  · rw [insert_of_mem h]
    constructor; {apply Or.inr}
    intro
    | Or.inl h' => rw [h']; exact h
    | Or.inr h' => exact h'
  · rw [insert_of_not_mem h, mem_cons]

@[simp 1100] theorem mem_insert_self (a : α) (l : List α) : a ∈ insert a l :=
mem_insert_iff.2 (Or.inl rfl)

theorem mem_insert_of_mem {a b : α} {l : List α} (h : a ∈ l) : a ∈ insert b l :=
mem_insert_iff.2 (Or.inr h)

theorem eq_or_mem_of_mem_insert {a b : α} {l : List α} (h : a ∈ insert b l) : a = b ∨ a ∈ l :=
mem_insert_iff.1 h

@[simp] theorem length_insert_of_mem {a : α} {l : List α} (h : a ∈ l) :
  length (insert a l) = length l := by
  rw [insert_of_mem h]

@[simp] theorem length_insert_of_not_mem {a : α} {l : List α} (h : a ∉ l) :
  length (insert a l) = length l + 1 := by
  rw [insert_of_not_mem h]; rfl

end insert

/-! ### erasep -/

section erasep

variable {p : α → Prop} [DecidablePred p]

@[simp] theorem erasep_nil : [].erasep p = [] := rfl

theorem erasep_cons (a : α) (l : List α) :
  (a :: l).erasep p = if p a then l else a :: l.erasep p := rfl

@[simp] theorem erasep_cons_of_pos {a : α} {l : List α} (h : p a) : (a :: l).erasep p = l := by
  simp [erasep_cons, h]

@[simp] theorem erasep_cons_of_neg {a : α} {l : List α} (h : ¬ p a) :
  (a::l).erasep p = a :: l.erasep p := by
  simp [erasep_cons, h]

theorem erasep_of_forall_not {l : List α}
  (h : ∀ a, a ∈ l → ¬ p a) : l.erasep p = l := by
  induction l with
  | nil => rfl
  | cons _ _ ih => simp [h _ (Mem.head ..), ih (forall_mem_of_forall_mem_cons h)]

theorem exists_of_erasep {l : List α} {a} (al : a ∈ l) (pa : p a) :
    ∃ a l₁ l₂, (∀ b ∈ l₁, ¬ p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.erasep p = l₁ ++ l₂ := by
  induction l with
  | nil => cases al
  | cons b l ih =>
    by_cases pb : p b
    · exact ⟨b, [], l, forall_mem_nil _, pb, by simp [pb]⟩
    · cases al with
      | head => cases pb pa
      | tail _ al =>
        let ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩ := ih al
        exact ⟨c, b::l₁, l₂, forall_mem_cons.2 ⟨pb, h₁⟩,
          h₂, by rw [h₃, cons_append], by simp [pb, h₄]⟩

theorem exists_or_eq_self_of_erasep (p : α → Prop) [DecidablePred p] (l : List α) :
    l.erasep p = l ∨
      ∃ a l₁ l₂, (∀ b ∈ l₁, ¬ p b) ∧ p a ∧ l = l₁ ++ a :: l₂ ∧ l.erasep p = l₁ ++ l₂ := by
  by_cases h : ∃ a ∈ l, p a
  · let ⟨a, ha, pa⟩ := h
    exact Or.inr (exists_of_erasep ha pa)
  · simp at h
    exact Or.inl (erasep_of_forall_not h)

@[simp] theorem length_erasep_of_mem {l : List α} {a} (al : a ∈ l) (pa : p a) :
   length (l.erasep p) = Nat.pred (length l) := by
  let ⟨_, l₁, l₂, _, _, e₁, e₂⟩ := exists_of_erasep al pa
  rw [e₂]; simp [length_append, e₁]; rfl

theorem erasep_append_left {a : α} (pa : p a) :
  ∀ {l₁ : List α} (l₂), a ∈ l₁ → (l₁++l₂).erasep p = l₁.erasep p ++ l₂
| (x::xs), l₂, h => by
  by_cases h' : p x <;> simp [h']
  rw [erasep_append_left pa l₂ (mem_of_ne_of_mem (mt _ h') h)]
  intro | rfl => exact pa

theorem erasep_append_right :
  ∀ {l₁ : List α} (l₂), (∀ b ∈ l₁, ¬ p b) → erasep p (l₁++l₂) = l₁ ++ l₂.erasep p
| [],      l₂, h => rfl
| (x::xs), l₂, h => by
  simp [(forall_mem_cons.1 h).1, erasep_append_right _ (forall_mem_cons.1 h).2]

-- theorem erasep_sublist (l : List α) : l.erasep p <+ l :=
-- by rcases exists_or_eq_self_of_erasep p l with h | ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩;
--    [rw h, {rw [h₄, h₃], simp}]

theorem erasep_subset (l : List α) : l.erasep p ⊆ l := fun a => by
  match exists_or_eq_self_of_erasep p l with
  | Or.inl h => rw [h]; apply subset.refl
  | Or.inr ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩ =>
    rw [h₄, h₃, mem_append, mem_append]
    intro
    | Or.inl h => exact Or.inl h
    | Or.inr h => exact Or.inr $ mem_cons_of_mem _ h
-- the proof was:
-- (erasep_sublist l).subset

-- theorem sublist.erasep {l₁ l₂ : List α} (s : l₁ <+ l₂) : l₁.erasep p <+ l₂.erasep p :=
-- begin
--   induction s,
--   case List.sublist.slnil { refl },
--   case List.sublist.cons : l₁ l₂ a s IH {
--     by_cases h : p a; simp [h],
--     exacts [IH.trans (erasep_sublist _), IH.cons _ _ _] },
--   case List.sublist.cons2 : l₁ l₂ a s IH {
--     by_cases h : p a; simp [h],
--     exacts [s, IH.cons2 _ _ _] }
-- end

theorem mem_of_mem_erasep {a : α} {l : List α} : a ∈ l.erasep p → a ∈ l :=
@erasep_subset _ _ _ _ _

@[simp] theorem mem_erasep_of_neg {a : α} {l : List α} (pa : ¬ p a) : a ∈ l.erasep p ↔ a ∈ l := by
  refine ⟨mem_of_mem_erasep, fun al => ?_⟩
  apply Or.elim (exists_or_eq_self_of_erasep p l)
  · intro h; rw [h]; assumption
  intro ⟨c, l₁, l₂, h₁, h₂, h₃, h₄⟩
  rw [h₄]
  rw [h₃] at al
  have : a ≠ c := fun h => by rw [h] at pa; exact pa.elim h₂
  simp [this] at al
  simp [al]

theorem erasep_map (f : β → α) :
  ∀ (l : List β), (map f l).erasep p = map f (l.erasep (p ∘ f))
| []     => rfl
| (b::l) => by
  by_cases h : p (f b)
  · simp [h, erasep_map f l, @erasep_cons_of_pos β (p ∘ f) _ b l h]
  · simp [h, erasep_map f l, @erasep_cons_of_neg β (p ∘ f) _ b l h]

-- @[simp] theorem extractp_eq_find_erasep :
--   ∀ l : List α, extractp p l = (find p l, erasep p l)
-- | []     => rfl
-- | (a::l) => by by_cases pa : p a; simp [extractp, pa, extractp_eq_find_erasep l]

end erasep

/-! ### erase -/

section erase
variable [DecidableEq α]

@[simp] theorem erase_nil (a : α) : [].erase a = [] := rfl

theorem erase_cons (a b : α) (l : List α) :
    (b :: l).erase a = if b = a then l else b :: l.erase a := by
  by_cases h : a = b
  · simp only [if_pos h.symm, List.erase, EqIffBeqTrue.mp h.symm]
  · simp only [if_neg (Ne.symm h), List.erase, NeqIffBeqFalse.mp (Ne.symm h)]

@[simp] theorem erase_cons_head (a : α) (l : List α) : (a :: l).erase a = l := by
  simp [erase_cons]

@[simp] theorem erase_cons_tail {a b : α} (l : List α) (h : b ≠ a) :
  (b::l).erase a = b :: l.erase a :=
by simp only [erase_cons, if_neg h]

theorem erase_eq_erasep (a : α) (l : List α) : l.erase a = l.erasep (Eq a) := by
  induction l with
  | nil => rfl
  | cons b l ih =>
    by_cases h : a = b
    · simp [h]
    · simp [h, Ne.symm h, ih]

theorem erase_of_not_mem {a : α} {l : List α} (h : a ∉ l) : l.erase a = l := by
  induction l with
  | nil => rfl
  | cons b l ih =>
    rw [mem_cons, not_or] at h
    rw [erase_cons, if_neg (Ne.symm h.1), ih h.2]

-- TODO: ∉ should have higher priority
theorem exists_erase_eq {a : α} {l : List α} (h : a ∈ l) :
    ∃ l₁ l₂, (a ∉ l₁) ∧ l = l₁ ++ a :: l₂ ∧ l.erase a = l₁ ++ l₂ :=
  match exists_of_erasep h rfl with
  | ⟨_, l₁, l₂, h₁, rfl, h₂, h₃⟩ => by
    rw [erase_eq_erasep]; exact ⟨l₁, l₂, fun h => h₁ _ h rfl, h₂, h₃⟩

@[simp] theorem length_erase_of_mem {a : α} {l : List α} (h : a ∈ l) :
  length (l.erase a) = Nat.pred (length l) := by
  rw [erase_eq_erasep]; exact length_erasep_of_mem h rfl

theorem erase_append_left {a : α} {l₁ : List α} (l₂) (h : a ∈ l₁) :
  (l₁++l₂).erase a = l₁.erase a ++ l₂ := by
  simp [erase_eq_erasep]; exact erasep_append_left (by rfl) l₂ h

theorem erase_append_right {a : α} {l₁ : List α} (l₂ : List α) (h : a ∉ l₁) :
    (l₁++l₂).erase a = (l₁ ++ l₂.erase a) := by
  rw [erase_eq_erasep, erase_eq_erasep, erasep_append_right]
  intros b h' h''; rw [h''] at h; exact h h'

-- theorem erase_sublist (a : α) (l : List α) : l.erase a <+ l :=
-- by rw erase_eq_erasep; apply erasep_sublist

theorem erase_subset (a : α) (l : List α) : l.erase a ⊆ l := by
  rw [erase_eq_erasep]; apply erasep_subset
--(erase_sublist a l).subset

-- theorem sublist.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+ l₂) : l₁.erase a <+ l₂.erase a :=
-- by simp [erase_eq_erasep]; exact sublist.erasep h

theorem mem_of_mem_erase {a b : α} {l : List α} : a ∈ l.erase b → a ∈ l :=
  @erase_subset _ _ _ _ _

@[simp] theorem mem_erase_of_ne {a b : α} {l : List α} (ab : a ≠ b) : a ∈ l.erase b ↔ a ∈ l := by
  rw [erase_eq_erasep]; exact mem_erasep_of_neg ab.symm

-- theorem erase_comm (a b : α) (l : List α) : (l.erase a).erase b = (l.erase b).erase a :=
-- if ab : a = b then by rw ab else
-- if ha : a ∈ l then
-- if hb : b ∈ l then match l, l.erase a, exists_erase_eq ha, hb with
-- | ._, ._, ⟨l₁, l₂, ha', rfl, rfl⟩, hb :=
--   if h₁ : b ∈ l₁ then
--     by rw [erase_append_left _ h₁, erase_append_left _ h₁,
--            erase_append_right _ (mt mem_of_mem_erase ha'), erase_cons_head]
--   else
--     by rw [erase_append_right _ h₁, erase_append_right _ h₁, erase_append_right _ ha',
--            erase_cons_tail _ ab, erase_cons_head]
-- end
-- else by simp only [erase_of_not_mem hb, erase_of_not_mem (mt mem_of_mem_erase hb)]
-- else by simp only [erase_of_not_mem ha, erase_of_not_mem (mt mem_of_mem_erase ha)]

-- theorem map_erase [DecidableEq β] {f : α → β} (finj : injective f) {a : α}
--   (l : List α) : map f (l.erase a) = (map f l).erase (f a) :=
-- by rw [erase_eq_erasep, erase_eq_erasep, erasep_map]; congr;
--    ext b; simp [finj.eq_iff]

-- theorem map_foldl_erase [DecidableEq β] {f : α → β} (finj : injective f) {l₁ l₂ : List α} :
--   map f (foldl List.erase l₁ l₂) = foldl (fun  l a, l.erase (f a)) (map f l₁) l₂ :=
-- by induction l₂ generalizing l₁; [refl,
-- simp only [foldl_cons, map_erase finj, *]]

-- @[simp] theorem count_erase_self (a : α) :
--   ∀ (s : List α), count a (List.erase s a) = pred (count a s)
-- | [] => by simp
-- | (h :: t) :=
-- begin
--   rw erase_cons,
--   by_cases p : h = a,
--   { rw [if_pos p, count_cons', if_pos p.symm], simp },
--   { rw [if_neg p, count_cons', count_cons', if_neg (fun  x : a = h, p x.symm), count_erase_self],
--     simp, }
-- end

-- @[simp] theorem count_erase_of_ne {a b : α} (ab : a ≠ b) :
--   ∀ (s : List α), count a (List.erase s b) = count a s
-- | [] := by simp
-- | (x :: xs) :=
-- begin
--   rw erase_cons,
--   split_ifs with h,
--   { rw [count_cons', h, if_neg ab], simp },
--   { rw [count_cons', count_cons', count_erase_of_ne] }
-- end

end erase

-- /-! ### disjoint -/

section disjoint

variable {α : Type _} {l l₁ l₂ : List α} {p : α → Prop} {a : α}

lemma disjoint_symm (d : disjoint l₁ l₂) : disjoint l₂ l₁ := λ _ i₂ i₁ => d i₁ i₂

lemma disjoint_comm : disjoint l₁ l₂ ↔ disjoint l₂ l₁ := ⟨disjoint_symm, disjoint_symm⟩

lemma disjoint_left : disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₁ → a ∉ l₂ := by simp [disjoint]

lemma disjoint_right : disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₂ → a ∉ l₁ := disjoint_comm

lemma disjoint_iff_ne : disjoint l₁ l₂ ↔ ∀ a ∈ l₁, ∀ b ∈ l₂, a ≠ b :=
  ⟨fun h a al1 b bl2 ab => h al1 (ab ▸ bl2), fun h a al1 al2 => h _ al1 _ al2 rfl⟩

lemma disjoint_of_subset_left (ss : l₁ ⊆ l) (d : disjoint l l₂) : disjoint l₁ l₂ :=
λ x m => d (ss m)

lemma disjoint_of_subset_right (ss : l₂ ⊆ l) (d : disjoint l₁ l) : disjoint l₁ l₂ :=
λ x m m₁ => d m (ss m₁)

lemma disjoint_of_disjoint_cons_left {l₁ l₂} : disjoint (a :: l₁) l₂ → disjoint l₁ l₂ :=
disjoint_of_subset_left (List.subset_cons _ _)

lemma disjoint_of_disjoint_cons_right {l₁ l₂} : disjoint l₁ (a :: l₂) → disjoint l₁ l₂ :=
disjoint_of_subset_right (List.subset_cons _ _)

@[simp] lemma disjoint_nil_left (l : List α) : disjoint [] l := λ a => (not_mem_nil a).elim

@[simp] lemma disjoint_nil_right (l : List α) : disjoint l [] := by
  rw [disjoint_comm]; exact disjoint_nil_left _

-- TODO: this lemma is marked with simp and priority 1100 in mathlib3
lemma singleton_disjoint : disjoint [a] l ↔ a ∉ l := by
simp [disjoint]

-- TODO: this lemma is marked with priority 1100 in mathlib3
@[simp] lemma disjoint_singleton : disjoint l [a] ↔ a ∉ l := by
rw [disjoint_comm, singleton_disjoint]

@[simp] lemma disjoint_append_left : disjoint (l₁ ++ l₂) l ↔ disjoint l₁ l ∧ disjoint l₂ l :=
by simp [disjoint, or_imp_distrib, forall_and_distrib]

-- @[simp] lemma disjoint_append_right : disjoint l (l₁ ++ l₂) ↔ disjoint l l₁ ∧ disjoint l l₂ :=
-- disjoint_comm.trans $ by simp [disjoint_comm, disjoint_append_left]

@[simp] lemma disjoint_cons_left : disjoint (a::l₁) l₂ ↔ (a ∉ l₂) ∧ disjoint l₁ l₂ :=
(@disjoint_append_left _ l₂ [a] l₁).trans $ by simp [singleton_disjoint]

-- @[simp] lemma disjoint_cons_right : disjoint l₁ (a :: l₂) ↔ (a ∉ l₁) ∧ disjoint l₁ l₂ :=
-- disjoint_comm.trans $ by simp [disjoint_comm, disjoint_cons_left]

lemma disjoint_of_disjoint_append_left_left (d : disjoint (l₁ ++ l₂) l) : disjoint l₁ l :=
(disjoint_append_left.1 d).1

lemma disjoint_of_disjoint_append_left_right (d : disjoint (l₁ ++ l₂) l) : disjoint l₂ l :=
(disjoint_append_left.1 d).2

-- lemma disjoint_of_disjoint_append_right_left (d : disjoint l (l₁ ++ l₂)) : disjoint l l₁ :=
-- (disjoint_append_right.1 d).1

-- lemma disjoint_of_disjoint_append_right_right (d : disjoint l (l₁ ++ l₂)) : disjoint l l₂ :=
-- (disjoint_append_right.1 d).2

-- lemma disjoint_take_drop {m n : ℕ} (hl : l.nodup) (h : m ≤ n) : disjoint (l.take m) (l.drop n) :=
-- begin
--   induction l generalizing m n,
--   case list.nil : m n
--   { simp },
--   case list.cons : x xs xs_ih m n
--   { cases m; cases n; simp only [disjoint_cons_left, mem_cons_iff, disjoint_cons_right, drop,
--                                  true_or, eq_self_iff_true, not_true, false_and,
--                                  disjoint_nil_left, take],
--     { cases h },
--     cases hl with _ _ h₀ h₁, split,
--     { intro h, exact h₀ _ (mem_of_mem_drop h) rfl, },
--     solve_by_elim [le_of_succ_le_succ] { max_depth := 4 } },
-- end

end disjoint

-- /-! ### union -/

section union

variable [DecidableEq α]

@[simp] theorem nil_union (l : List α) : nil.union l = l := by simp [List.union, foldr]

@[simp] theorem cons_union (a : α) (l₁ l₂ : List α) :
  (a :: l₁).union l₂ = insert a (l₁.union l₂) := by simp [List.union, foldr]

@[simp] theorem mem_union_iff [DecidableEq α] {x : α} {l₁ l₂ : List α} :
    x ∈ l₁.union l₂ ↔ x ∈ l₁ ∨ x ∈ l₂ := by
  induction l₁ with
  | nil => simp
  | cons a l' ih => simp [ih, or_assoc]

end union

-- /-! ### inter -/

@[simp] theorem mem_inter_iff [DecidableEq α] {x : α} {l₁ l₂ : List α} :
    x ∈ l₁.inter l₂ ↔ x ∈ l₁ ∧ x ∈ l₂ := by
  cases l₁ <;> simp [List.inter, mem_filter]

/--
List.prod satisfies a specification of cartesian product on lists.
-/
theorem product_spec (xs : List α) (ys : List β) (x : α) (y : β) :
  (x, y) ∈ product xs ys <-> (x ∈ xs ∧ y ∈ ys) := by
  constructor
  · simp only [List.product, and_imp, exists_prop, List.mem_map, Prod.mk.injEq,
      exists_eq_right_right', List.mem_bind]
    exact And.intro
  · simp only [product, mem_bind, mem_map, Prod.mk.injEq, exists_eq_right_right', exists_prop]
    exact id

section Pairwise

variable {R : α → α → Prop}

@[simp]
theorem Pairwise_cons {a : α} {l : List α} :
  Pairwise R (a::l) ↔ (∀ a', a' ∈ l -> R a a') ∧ Pairwise R l :=
  ⟨fun | Pairwise.cons h1 h2 => ⟨h1, h2⟩, And.elim Pairwise.cons⟩

instance decidablePairwise [DecidableRel R] (l : List α) : Decidable (Pairwise R l) :=
  match h: l with
  | [] => isTrue Pairwise.nil
  | hd :: tl =>
    match decidablePairwise tl with
    | isTrue ht =>
      match decidableBAll (R hd) tl with
      | isFalse hf => isFalse fun hf' =>
        have hAnd : (∀ a', a' ∈ tl -> R hd a') ∧ Pairwise R tl := Pairwise_cons.mp hf'
        hf hAnd.left
      | isTrue ht' =>  isTrue $ Pairwise_cons.mpr (And.intro ht' ht)
    | isFalse hf => isFalse fun
      | Pairwise.cons h ih => hf ih

end Pairwise

instance nodupDecidable [DecidableEq α] : ∀ l : List α, Decidable (Nodup l) :=
List.decidablePairwise

/-- pad `l : List α` with repeated occurrences of `a : α` until it's of length `n`.
  If `l` is initially larger than `n`, just return `l`. -/
def leftpad (n : ℕ) (a : α) (l : List α) : List α :=
repeat' a (n - length l) ++ l

/-- The length of the List returned by `List.leftpad n a l` is equal
  to the larger of `n` and `l.length` -/
theorem leftpad_length (n : ℕ) (a : α) (l : List α) : (leftpad n a l).length = max n l.length :=
by simp only [leftpad, length_append, length_repeat', Nat.sub_add_eq_max]

theorem leftpad_prefix [DecidableEq α] (n : ℕ) (a : α) (l : List α) : isPrefix (repeat' a (n - length l)) (leftpad n a l) :=
by
  simp only [isPrefix, leftpad]
  exact Exists.intro l rfl

theorem leftpad_suffix [DecidableEq α] (n : ℕ) (a : α) (l : List α) : isSuffix l (leftpad n a l) :=
by
  simp only [isSuffix, leftpad]
  exact Exists.intro (repeat' a (n - length l)) rfl

end List


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

namespace Cpdt
namespace Chapter2

inductive Ty where
  | nat : Ty
  | bool : Ty

inductive TBinop : Ty → Ty → Ty → Type where
  | plus : TBinop .nat .nat .nat
  | times : TBinop .nat .nat .nat
  | eq (t : Ty) : TBinop t t .bool
  | lt : TBinop .nat .nat .bool

inductive TExp : Ty → Type where
  | nConst : Nat → TExp .nat
  | bConst : Bool → TExp .bool
  | binop : TBinop t1 t2 r → TExp t1 → TExp t2 → TExp r

namespace Ty

@[reducible]
def denote : Ty → Type
  | nat => Nat
  | bool => Bool

end Ty

namespace TBinop

def denote : TBinop t1 t2 r → (t1.denote → t2.denote → r.denote)
  | plus => Nat.add
  | times => Nat.mul
  | eq .nat => (· == ·)
  | eq .bool => (· == ·)
  | lt => (· < ·)

end TBinop

namespace TExp

def denote : TExp t → t.denote
  | nConst n => n
  | bConst b => b
  | binop op arg1 arg2 => op.denote (denote arg1) (denote arg2)

@[simp] theorem denote_nConst : denote (nConst n) = n := by rfl
@[simp] theorem denote_bConst : denote (bConst b) = b := by rfl
@[simp] theorem denote_binop : denote (binop op arg1 arg2) = op.denote (denote arg1) (denote arg2) := by rfl

end TExp

abbrev TStack := List Ty

inductive TInstr : TStack → TStack → Type where
  | inConst (n : Nat) : TInstr s (.nat :: s)
  | ibConst (b : Bool) : TInstr s (.bool :: s)
  | iBinop (op : TBinop arg1 arg2 r) : TInstr (arg1 :: arg2 :: s) (r :: s)

inductive TProg : TStack → TStack → Type where
  | nil : TProg s s
  | cons : TInstr s1 s2 → TProg s2 s3 → TProg s1 s3

namespace TStack

@[reducible]
def VStack : TStack → Type
  | [] => Unit
  | t :: ts => t.denote × VStack ts

end TStack

namespace TInstr

open TStack

def denote : TInstr ts ts' → VStack ts → VStack ts'
  | inConst n, s => (n, s)
  | ibConst b, s => (b, s)
  | iBinop op, (arg1, (arg2, s')) => (op.denote arg1 arg2, s')

@[simp] theorem denote_inConst : denote (inConst n) s = (n, s) := by rfl
@[simp] theorem denote_ibConst : denote (ibConst b) s = (b, s) := by rfl
@[simp] theorem denote_iBinop : denote (iBinop op) (arg1, (arg2, s')) = (op.denote arg1 arg2, s') := by rfl

end TInstr

namespace TProg

open TStack

def denote : TProg ts ts' → VStack ts → VStack ts'
  | nil, s => s
  | cons i p, s => (denote p) (i.denote s)

def concat : TProg ts1 ts2 → TProg ts2 ts3 → TProg ts1 ts3
  | nil, ps => ps
  | cons i ps, rs => cons i (concat ps rs)

@[simp] theorem denote_nil : denote nil s = s := by rfl
@[simp] theorem denote_cons : denote (cons i p) s = (denote p) (i.denote s) := by rfl
@[simp] theorem concat_nil : concat nil ps = ps := by rfl
@[simp] theorem concat_cons : concat (cons i ps) rs = cons i (concat ps rs) := by rfl

end TProg

namespace TExp

open TInstr TProg TStack

def compile : (e : TExp t) → (ts : TStack) → TProg ts (t :: ts)
  | nConst n, _ => cons (inConst n) nil
  | bConst b, _ => cons (ibConst b) nil
  | binop op arg1 arg2, _ =>
      let arg2Out := compile arg2 _
      let arg1Out := compile arg1 _
      let opOut := cons (iBinop op) nil
      concat arg2Out (concat arg1Out opOut)

@[simp] theorem compile_nConst : compile (nConst n) ts = cons (inConst n) nil := by rfl
@[simp] theorem compile_bConst : compile (bConst b) ts = cons (ibConst b) nil := by rfl
@[simp] theorem compile_binop :
  compile (@binop _ _ r op arg1 arg2) ts
  = concat (compile arg2 ts) (concat (compile arg1 (r :: ts)) (cons (iBinop op) nil)) := by rfl

theorem concat_correct : ∀ (p1 : TProg ts1 ts2) (p2 : TProg ts2 ts3) (s : VStack ts1), TProg.denote (concat p1 p2) s = TProg.denote p2 (TProg.denote p1 s) := by
  intro p1
  induction p1 <;> simp_all

theorem compile_correct_helper : ∀ (e : TExp t) (ts : TStack) (s : VStack ts), TProg.denote (compile e ts) s = (TExp.denote e, s) := by
  intro e
  induction e <;> simp_all[compile, concat_correct]

theorem compile_correct : ∀ (e : TExp t), TProg.denote (compile e []) () = (TExp.denote e, ()) := by
  simp [compile_correct_helper]

end TExp

end Chapter2
end Cpdt


import Lib.Util
import Mathlib
import Lean

/-- definition of the selector predicate, it selects parsed puzzle lines
    that should be counted to get the solution -/
def Selector := ℕ -> ℕ -> ℕ -> Bool

/-- decode the puzzle data into the parsed format, which is `Option [ℕ, ℕ, ℕ]` -/
def decode (pred:Selector) (s:String) :=
  List.filterMap (decodeLine pred) (lines s)
  where
    /-- decodes a range, which is a string in the form "2-4" for example -/
    decodeRange (s:String) :=
      match String.splitOn s "-" with
      | (p1::p2::[]) =>
        let m := strToNat p1.data
        let n := strToNat p2.data
        some (List.range' m (n-m+1))
      | _ => none

    /-- decodes one line of the puzzle data in to an optional triplet of ℕ -/
    decodeLine (pred:Selector) (s:String) : Option (List ℕ × List ℕ × List ℕ) :=
      match String.splitOn s "," with
      | (p1::p2::[]) => do
        let m <- decodeRange p1
        let n <- decodeRange p2
        let int := m.inter n
        if pred m.length n.length int.length
        then pure (m, n, m.inter n)
        else none
      | _ => none

/-- calculate the answer, which part depends on the predicate. The first part
    requires the intersection be equal to one of the two ranges, the second part
    is looking for any intersection at all -/
def ans (pred:Selector) := do
  let s <- getPuz 22 4
  let ls := decode pred s
  pure ls.length

#eval ans (λ m n int => int >= m || int >= n)
#eval ans (λ _ _ int => int > 0)


open nat

inductive Expr
| zero : Expr
| one  : Expr
| add  : Expr → Expr → Expr

namespace Expr

inductive direct_subterm : Expr → Expr → Prop
| add_1 : ∀ e₁ e₂ : Expr, direct_subterm _ (add _ _)
| add_2 : ∀ e₁ e₂ : Expr, direct_subterm _ (add _ _)

theorem direct_subterm_wf : well_founded direct_subterm :=
begin
  constructor,
  intro e,
  induction e,
  all_goals { constructor },
  all_goals { sorry }
end

def subterm := tc direct_subterm

#check @tc -- tc : Π {α : Sort u_1}, (α → α → Prop) → α → α → Prop

theorem subterm_wf : well_founded subterm := tc.wf direct_subterm_wf

local infix `+` := Expr.add

set_option pp.notation false

def ev : Expr → nat
| zero := 0
| one := 1
| ((a : Expr) + b) := has_add.add (ev a) (ev b)

def foo : Expr := add zero (add one one)

example : ev foo = 2 := rfl

end Expr


open expr tactic classical

section logical_equivalences
local attribute [instance] prop_decidable
variables {a b : Prop}
theorem not_not_iff (a : Prop) : ¬¬a ↔ a :=
iff.intro classical.by_contradiction not_not_intro
theorem implies_iff_not_or (a b : Prop) : (a → b) ↔ (¬ a ∨ b) :=
iff.intro
(λ h, if ha : a then or.inr (h ha) else or.inl ha)
(λ h, or.elim h (λ hna ha, absurd ha hna) (λ hb ha, hb))
theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b) :=
assume ⟨ha, hb⟩, or.elim h (assume hna, hna ha) (assume hnb, hnb hb)
theorem not_or_not_of_not_and (h : ¬ (a ∧ b)) : ¬ a ∨ ¬ b :=
if ha : a then
or.inr (show ¬ b, from assume hb, h ⟨ha, hb⟩)
else
or.inl ha
theorem not_and_iff (a b : Prop) : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
iff.intro not_or_not_of_not_and not_and_of_not_or_not
theorem not_or_of_not_and_not (h : ¬ a ∧ ¬ b) : ¬ (a ∨ b) :=
assume h1, or.elim h1 (assume ha, h^.left ha) (assume hb, h^.right hb)
theorem not_and_not_of_not_or (h : ¬ (a ∨ b)) : ¬ a ∧ ¬ b :=
and.intro (assume ha, h (or.inl ha)) (assume hb, h (or.inr hb))

theorem not_or_iff (a b : Prop) : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
iff.intro not_and_not_of_not_or not_or_of_not_and_not
end logical_equivalences

meta def normalize_hyp (lemmas : simp_lemmas) (hyp : expr) : tactic unit :=
do try (simp_hyp lemmas [] hyp)

meta def normalize_hyps : tactic unit :=
do hyps ← local_context,
lemmas ← list.mmap mk_const [``iff_iff_implies_and_implies,
``implies_iff_not_or, ``not_and_iff, ``not_or_iff, ``not_not_iff,
``not_true_iff, ``not_false_iff],
lemmas2 ← simp_lemmas.append simp_lemmas.mk lemmas,
hyps.mmap' (normalize_hyp lemmas2)

meta def add_fact (prf : expr) : tactic unit :=
do nh ← get_unused_name `h none,
p ← infer_type prf,
assertv nh p prf,
return ()

meta def is_conj (e : expr) : tactic bool :=
do t ← infer_type e,
return (is_app_of t `and)

meta def add_conjuncts : expr → tactic unit | e :=
do e1 ← mk_app `and.left [e],
monad.cond (is_conj e1) (add_conjuncts e1) (add_fact e1),
e2 ← mk_app `and.right [e],
monad.cond (is_conj e2) (add_conjuncts e2) (add_fact e2)

meta def split_conjs_at (h : expr) : tactic unit :=
do monad.cond (is_conj h)
(add_conjuncts h >> clear h)
skip

meta def split_conjs : tactic unit :=
do l ← local_context,
l.mmap' split_conjs_at

meta def deny_conclusion : tactic unit :=
do refine ```(classical.by_contradiction _),
nh ← get_unused_name `h none,
intro nh,
return ()

meta def find_disj : tactic (option expr) :=
do l ← local_context,
(first $ l.map
(λ h, do t ← infer_type h,
cond (is_app_of t `or)
(return (option.some h)) failed)) <|>
return none

meta def prop_prover_aux : ℕ → tactic unit
| 0 := fail "prop prover max depth reached"
| (nat.succ n) :=
do split_conjs,
contradiction <|>
do (option.some h) ← find_disj |
fail "prop_prover failed: unprovable goal",
cases h,
prop_prover_aux n,
prop_prover_aux n

meta def prop_prover : tactic unit :=
do deny_conclusion,
normalize_hyps,
prop_prover_aux 30

section
variables a b c d : Prop
example (h1 : a ∧ b) (h2 : b ∧ ¬ c) : a ∨ c :=
by prop_prover
example (h1 : a ∧ b) (h2 : b ∧ ¬ c) : a ∧ ¬ c :=
by prop_prover
-- not valid
-- example (h1 : a ∧ b) (h2 : b ∧ ¬ c) : a ∧ c :=
-- by prop_prover
example : ((a → b) → a) → a :=
by prop_prover
example : (a → b) ∧ (b → c) → a → c :=
by prop_prover
example (α : Type) (x y z w : α) :
x = y ∧ (x = y → z = w) → z = w :=
by prop_prover
example : ¬ (a ↔ ¬ a) :=
by prop_prover
end


import tactic

@[derive decidable_eq] def free_cat : Type := ℕ

namespace free_cat

@[derive decidable_eq] inductive hom : free_cat → free_cat → Type
| id : Π (A : free_cat), hom A A
| cons : Π {A B C : free_cat}, ℕ → hom B C → hom A C

def comp : Π {A B C : free_cat} (f : hom A B) (g : hom B C), hom A C
| _ _ _ (hom.id _) g := g
| _ _ _ (hom.cons n f) g := hom.cons n (comp f g)

@[simp] lemma id_comp {A B : free_cat} (f : hom A B) : comp (hom.id A) f = f := rfl

@[simp] lemma comp_id {A B : free_cat} (f : hom A B) : comp f (hom.id B) = f :=
by { induction f; simp [*, comp] }

lemma comp_assoc {A B C D : free_cat} (f : hom A B) (g : hom B C) (h : hom C D) :
  comp f (comp g h) = comp (comp f g) h :=
by induction f; simp [comp, *]

end free_cat


/-
  Presheaf (of types).
  https://stacks.math.columbia.edu/tag/006D
-/

import topology.basic
import topology.opens
import order.bounds

universes u v

-- Definition of a presheaf.

open topological_space lattice

structure presheaf (α : Type u) [semilattice_inf α] :=
(F     : α → Type v)
(res   : ∀ (U V) (HVU : V ≤ U), F U → F V)
(Hid   : ∀ (U), res U U (le_refl U) = id)
(Hcomp : ∀ (U V W) (HWV : W ≤ V) (HVU : V ≤ U),
  res U W (le_trans HWV HVU) = res V W HWV ∘ res U V HVU)

namespace presheaf

variables {α : Type u} [semilattice_inf α]

instance : has_coe_to_fun (presheaf α) :=
{ F := λ _, α → Type v,
  coe := presheaf.F }

-- Simplification lemmas for Hid and Hcomp.

@[simp] lemma Hcomp' (F : presheaf α) :
∀ (U V W) (HWV : W ≤ V) (HVU : V ≤ U) (s : F U),
  (F.res U W (le_trans HWV HVU)) s =
  (F.res V W HWV) ((F.res U V HVU) s) :=
λ U V W HWV HVU s, by rw F.Hcomp U V W HWV HVU

@[simp] lemma Hid' (F : presheaf α) :
∀ (U) (s : F U),
  (F.res U U (le_refl U)) s = s :=
λ U s, by rw F.Hid U; simp

def total (F : presheaf α) : Type (max u v) := Σ U, F.F U

instance (F : presheaf α) (U : α) : has_coe_t (F U) F.total :=
⟨sigma.mk _⟩

@[elab_as_eliminator]
theorem total.cases_on (F : presheaf α) {C : F.total → Sort*}
  (x) (H : ∀ U (x : F U), C x) : C x :=
by cases x; apply H

def res' (F : presheaf α) (V : α) : F.total → F.total
| ⟨U, x⟩ := F.res U (U ⊓ V) inf_le_left x

theorem res'_def (F : presheaf α) {U V} (x : F U) :
  F.res' V x = F.res U (U ⊓ V) inf_le_left x := rfl

theorem res'_val (F : presheaf α) {U V} (x : F U) (h : V ≤ U) :
  F.res' V x = F.res U V h x :=
have ∀ W (H : W ≤ U), W = V →
  (F.res U W H x : F.total) = F.res U V h x :=
  by rintro _ _ rfl; refl,
this _ _ (inf_of_le_right h)

theorem res'_eq_inf (F : presheaf α) {U V} (x : F U) :
  F.res' V x = F.res' (U ⊓ V) x :=
by rw [res'_def, ← res'_val _ _ inf_le_left]

theorem res'_eq_left (F : presheaf α) {U V W} (x : F U) (H : U ⊓ V = U ⊓ W) :
  F.res' V x = F.res' W x :=
by rw [res'_eq_inf, H, ← res'_eq_inf]

@[simp] theorem res'_id {F : presheaf α} {U} (x : F U) : F.res' U x = x :=
by rw [res'_val _ _ (le_refl U), F.Hid]; refl

@[simp] theorem res'_comp {F : presheaf α} {U V} (x : F.total) :
  F.res' U (F.res' V x) = F.res' (U ⊓ V) x :=
total.cases_on F x $ λ W x,
by rw [res'_def, res'_def, ← F.Hcomp', ← res'_val, res'_eq_left];
   simp [inf_left_comm, inf_comm]

-- Morphism of presheaves.

-- Kenny wants morphisms on the subsheaves
structure morphism (F G : presheaf α) :=
(map      : ∀ (U), F U → G U)
(commutes : ∀ (U V) (HVU : V ≤ U),
  (G.res U V HVU) ∘ (map U) = (map V) ∘ (F.res U V HVU))

infix ` ⟶ `:80 := morphism

section morphism

def comp {F G H : presheaf α} (fg : F ⟶ G) (gh : G ⟶ H) : F ⟶ H :=
{ map := λ U, gh.map U ∘ fg.map U,
  commutes := λ U V HVU,
    begin
      rw [←function.comp.assoc, gh.commutes U V HVU], symmetry,
      rw [function.comp.assoc, ←fg.commutes U V HVU]
    end }

infix ` ⊚ `:80 := comp

def id (F : presheaf α) : F ⟶ F :=
{ map := λ U, id,
  commutes := λ U V HVU, by simp, }

structure iso (F G : presheaf α) :=
(mor : F ⟶ G)
(inv : G ⟶ F)
(mor_inv_id : mor ⊚ inv = id F)
(inv_mor_id : inv ⊚ mor = id G)

infix ` ≅ `:80 := iso

end morphism

section sheaf_condition

-- Sheaf condition.

def locality (F : presheaf α) :=
∀ {{U S}}, is_lub S U → ∀ {{s t : F U}},
  (∀ V ∈ S, F.res' V s = F.res' V t) → s = t

def gluing (F : presheaf α) :=
∀ {{U : α}} {{S}}, is_lub S U → ∀ (s : Π V : S, F V),
  (∀ V W : S, res' F (V ⊓ W) (s V) = res' F (V ⊓ W) (s W)) →
  ∃ x : F U, ∀ V:S, F.res' V x = s V

def is_sheaf (F : presheaf α) :=
locality F ∧ gluing F

end sheaf_condition

end presheaf

structure semilattice_inf_hom
  (α β : Type*) [semilattice_inf α] [semilattice_inf β] :=
(to_fun : α → β)
(mono : monotone to_fun)
(map_inf' : ∀ a b, to_fun (a ⊓ b) = to_fun a ⊓ to_fun b)

namespace semilattice_inf_hom

infixr ` →⊓ `:25 := semilattice_inf_hom

instance {α β : Type*} [semilattice_inf α] [semilattice_inf β] :
  has_coe_to_fun (α →⊓ β) := ⟨_, to_fun⟩

@[simp] theorem map_inf {α β : Type*} [semilattice_inf α] [semilattice_inf β]
  (f : α →⊓ β) (a b : α) : f (a ⊓ b) = f a ⊓ f b := map_inf' _ _ _

def id {α : Type*} [semilattice_inf α] : α →⊓ α :=
⟨id, monotone_id, λ _ _, rfl⟩

def comp {α β γ : Type*} [semilattice_inf α] [semilattice_inf β] [semilattice_inf γ]
  (g : β →⊓ γ) (f : α →⊓ β) : α →⊓ γ :=
⟨g ∘ f, monotone.comp g.mono f.mono, λ a b, by simp⟩

end semilattice_inf_hom

structure semilattice_inf_lub_emb
  (α β : Type*) [semilattice_inf α] [semilattice_inf β] extends α →⊓ β :=
(inj : function.injective to_fun)
(map_lub : ∀ {{S a}}, is_lub S a → is_lub (to_fun '' S) (to_fun a))

namespace semilattice_inf_lub_emb

infixr ` ↪⊓⨆ `:25 := semilattice_inf_lub_emb

instance {α β : Type*} [semilattice_inf α] [semilattice_inf β] :
  has_coe (α ↪⊓⨆ β) (α →⊓ β) := ⟨to_semilattice_inf_hom⟩

@[simp] theorem map_inf {α β : Type*} [semilattice_inf α] [semilattice_inf β]
  (f : α ↪⊓⨆ β) (a b : α) : f (a ⊓ b) = f a ⊓ f b := f.map_inf' _ _

def id {α : Type*} [semilattice_inf α] : α ↪⊓⨆ α :=
⟨semilattice_inf_hom.id, function.injective_id,
  λ S a h, by simp [semilattice_inf_hom.id, h]⟩

def comp {α β γ : Type*} [semilattice_inf α] [semilattice_inf β] [semilattice_inf γ]
  (g : β ↪⊓⨆ γ) (f : α ↪⊓⨆ β) : α ↪⊓⨆ γ :=
⟨(g : β →⊓ γ).comp f, function.injective_comp g.inj f.inj,
  λ S a h, by have := g.map_lub (f.map_lub h); rwa [set.image_image] at this⟩

end semilattice_inf_lub_emb

namespace presheaf

variables {α : Type*} {β : Type*} [semilattice_inf α] [semilattice_inf β]

def comap (f : α →⊓ β) (F : presheaf β) : presheaf α :=
{ F := λ a, F (f a),
  res := λ a b h, F.res _ _ (f.mono h),
  Hid := λ a, F.Hid _,
  Hcomp := λ a b c bc ab, F.Hcomp _ _ _ _ _ }

theorem comap_res (f : α →⊓ β) (F : presheaf β) (a b h) :
  (F.comap f).res a b h = F.res _ _ (f.mono h) := rfl

instance (f : α →⊓ β) (F : presheaf β) : has_coe (F.comap f).total F.total :=
⟨λ x, ⟨_, x.2⟩⟩

theorem comap_coe_inj (f : α →⊓ β) (F : presheaf β) (h : function.injective f) :
  function.injective (coe : (F.comap f).total → F.total)
| ⟨a, x⟩ ⟨b, y⟩ e := by cases h (congr_arg sigma.fst e:_); cases e; refl

@[simp] theorem coe_total_coe
  (f : α →⊓ β) (F : presheaf β) (U : α) (x : (F.comap f) U) :
  ((x : (F.comap f).total) : F.total) = @coe (F (f U)) _ _ x := rfl

theorem comap_res' (f : α →⊓ β) (F : presheaf β) (U : α) (x : (F.comap f).total) :
  ↑((F.comap f).res' U x) = F.res' (f U) x :=
total.cases_on (F.comap f) x $ λ W x,
by rw [res'_def, coe_total_coe, coe_total_coe, comap_res, ← res'_val, f.map_inf,
       ← res'_eq_inf]

end presheaf

structure sheaf (α : Type u) [semilattice_inf α] extends presheaf α :=
(locality : to_presheaf.locality)
(gluing   : to_presheaf.gluing)

structure sheaf_of_rings (α : Type u) [semilattice_inf α] extends sheaf α :=
[ring' : ∀ U, ring (F U)]
[ring_hom : ∀ U V h, is_ring_hom (res U V h)]

namespace sheaf

variables {α : Type*} {β : Type*} [semilattice_inf α] [semilattice_inf β]

def total (F : sheaf α) := F.to_presheaf.total

def res' (F : sheaf α) : α → F.total → F.total := F.to_presheaf.res'

instance : has_coe_to_fun (sheaf α) :=
{ F := λ _, α → Type v,
  coe := λ F, F.to_presheaf }

instance (F : sheaf α) (U : α) : has_coe_t (F U) F.total :=
⟨sigma.mk _⟩

def comap (f : α ↪⊓⨆ β) (F : sheaf β) : sheaf α :=
{ locality := λ a S lub (s t : F (f a)) H, F.locality (f.map_lub lub) begin
    rintro _ ⟨b, hb, rfl⟩,
    let G := F.to_presheaf.comap (f : α →⊓ β),
    have : G.res' b (@coe (G a) _ _ s) =
           G.res' b (@coe (G a) _ _ t) := H b hb,
    have H1 := F.to_presheaf.comap_res' (f : α →⊓ β) b _,
    rw [this, F.to_presheaf.comap_res' (f : α →⊓ β) b] at H1,
    simp at H1, exact H1.symm
  end,
  gluing := λ a S lub (g : ∀ U : S, F (f U)), begin
    let G := F.to_presheaf.comap (f : α →⊓ β),
    change ∀_: ∀ V W : S, G.res' (V ⊓ W) (@coe (G V) _ _ (g V)) =
                          G.res' (V ⊓ W) (@coe (G W) _ _ (g W)),
      ∃ U : F (f a), ∀ V : S, G.res' V (@coe (G a) _ _ U) = @coe (G V) _ _ (g V),
    choose k hk using show ∀ V : f '' S, ∃ U : S, (V:β) = f U,
    by rintro ⟨_, U, hU, rfl⟩; exact ⟨⟨U, hU⟩, rfl⟩,
    let g' : ∀ V : f '' S, F (V:β) := λ V, by rw hk V; exact g (k V),
    have g'eq : ∀ U (hU : U ∈ S), (g' ⟨f U, U, hU, rfl⟩ : F.total) = g ⟨U, hU⟩,
    { intros,
      suffices : ∀ U' (h' : U' = k ⟨f U, _⟩),
        (by rw h'; exact g (k ⟨f U, U, hU, rfl⟩) : F (f U')) = g U',
      { congr, exact this ⟨U, hU⟩ (subtype.eq (f.inj (hk ⟨f U, _⟩))) },
      rintro _ rfl, refl },
    intro h,
    cases F.gluing (f.map_lub lub) g' _ with z hz,
    { use z, rintro ⟨U, hU⟩,
      apply presheaf.comap_coe_inj _ _ f.inj,
      rw [presheaf.comap_res'],
      exact (hz ⟨_, U, hU, rfl⟩).trans (g'eq _ _) },
    { rintro ⟨_, V, hV, rfl⟩ ⟨_, W, hW, rfl⟩,
      have := congr_arg coe (h ⟨V, hV⟩ ⟨W, hW⟩),
      rw [presheaf.comap_res', presheaf.comap_res'] at this,
      simp at this, rwa [← g'eq, ← g'eq] at this }
  end,
  ..F.to_presheaf.comap f.to_semilattice_inf_hom }

end sheaf


import data.set.basic
import data.fintype.basic
import automata.nfa

open set

namespace epsnfa

structure epsNFA (S : Type) (Q : Type) [fintype Q] [decidable_eq Q] :=
    (start : Q) -- starting state
    (term : Q) -- terminal state (only one!)
    (next : Q → S → set Q) -- transitions
    (eps : Q → set Q) -- eps-transitions

variables {S Q : Type} [fintype S] [fintype Q] [decidable_eq Q] {enfa : epsNFA S Q}

inductive go (enfa : epsNFA S Q) : Q → list S → Q → Prop
| finish {q} :
    go q [] q
| step {hd tl q n f} (h : n ∈ enfa.next q hd) :
    go n tl f →
    go q (hd::tl) f
| eps {tl q n f} (h : n ∈ enfa.eps q):
    go n tl f → go q tl f

@[simp] def epsnfa_accepts_word (enfa : epsNFA S Q) (w : list S) := go enfa enfa.start w enfa.term

def eps_reach (enfa : epsNFA S Q) (q : Q) (r : Q) := go enfa q [] r

@[simp] def lang_of_epsnfa (enfa : epsNFA S Q) := {w | epsnfa_accepts_word enfa w}

@[simp] def mem_of_epsnfa_iff {w} : w ∈ lang_of_epsnfa enfa ↔ go enfa enfa.start w enfa.term := by refl

def epsnfa_lang (lang : set (list S)) : Prop :=
    ∃ {Q : Type} [fintype Q] [decidable_eq Q], by exactI ∃ (enfa : epsNFA S Q), lang_of_epsnfa enfa = lang

lemma epsnfa_go_trans {a b c : Q} {left right : list S}:
    go enfa a left b → go enfa b right c → go enfa a (left ++ right) c :=
begin
    rintro hab hfc,
    induction hab with q  head tail q n f h prev ih  tail q n f h prev ih,
    { exact hfc },
    { apply go.step h (ih hfc) },
    { apply go.eps h (ih hfc) },
end

lemma epsnfa_go_exists_cons {a d : Q}
    {head : S} {tail concat : list S} (clr : list.cons head tail = concat):
    go enfa a concat d → (∃ {b c : Q}, eps_reach enfa a b ∧ c ∈ enfa.next b head ∧ go enfa c tail d) :=
begin
    intros go_ac,
    induction go_ac with q  head tail q n f h prev ih  tail q n f h prev ih, {
        contradiction,
    }, {
        rw list.cons.inj_eq at clr,
        rcases clr with ⟨rfl, rfl⟩,
        use [q, n, go.finish, h, prev],
    }, {
        rcases ih clr with ⟨b, c, eps_ab, next_bc, tail_cd⟩,
        use [b, c, go.eps h eps_ab, next_bc, tail_cd],
    }
end

lemma epsnfa_go_exists_trans {a c : Q}
    {left right concat : list S} (clr : left ++ right = concat):
    go enfa a concat c → (∃ {b : Q}, go enfa a left b ∧ go enfa b right c) :=
begin
    intros go_ac,
    induction left with head tail ih generalizing a concat, {
        subst clr,
        use [a, go.finish, go_ac],
    }, {
        subst clr,
        rcases epsnfa_go_exists_cons rfl go_ac with ⟨b, c', eps_ab, next_bc', tail_cd⟩,
        specialize @ih c' (tail ++ right) rfl,
        rcases ih tail_cd with ⟨real_b, go_real_b_tail, go_real_b_right⟩,

        use [real_b],
        use [epsnfa_go_trans eps_ab (go.step next_bc' go_real_b_tail)],
        use [go_real_b_right],
    }
end

section epsnfa_to_nfa

def epsnfa_to_nfa (enfa : epsNFA S Q) : nfa.NFA S Q := {
    start := enfa.start,
    term := {x | eps_reach enfa x enfa.term},
    next := λ q c, {y | ∃ x, eps_reach enfa q x ∧ y ∈ enfa.next x c}
}

lemma epsnfa_to_nfa_accepts_iff_accepts
    (en : epsNFA S Q) {n : nfa.NFA S Q} (w : list S) (st : Q)
    : n = epsnfa_to_nfa en → (go en st w en.term ↔ ∃ t : Q, nfa.go n st w t ∧ t ∈ n.term) :=
begin
    rintro rfl,
    split, {
        rintro en_go,
        induction w with head tail hyp generalizing st, {
            use [st, nfa.go.finish],
            dsimp [epsnfa_to_nfa],
            use en_go,
        }, {
            replace en_go := epsnfa_go_exists_cons rfl en_go,
            rcases en_go with ⟨b, c, eps_stb, next_bc, tail_cent⟩,
            specialize hyp c tail_cent,
            rcases hyp with ⟨t, t_go, t_term⟩,
            use t,
            split, {
                refine nfa.go.step _ t_go,
                dsimp [epsnfa_to_nfa],
                use [b, eps_stb, next_bc],
            },
            exact t_term,
        }
    }, {
        rintro ⟨n_t, n_go, n_term⟩,
        dsimp [epsnfa_to_nfa] at n_term,
        induction w with head tail hyp generalizing st, {
            cases n_go,
            use n_term,
        }, {
            rcases n_go with (_ | ⟨_, _, _, _, _, h_nxt, h_go⟩),
            specialize hyp n_go_n h_go,
            simp [epsnfa_to_nfa] at h_nxt,
            rcases h_nxt with ⟨x, x_go, x_nxt⟩,
            exact epsnfa_go_trans x_go (go.step x_nxt hyp),
        }
    }
end

theorem epsnfa_to_nfa_eq {L : set (list S)} : epsnfa_lang L → nfa.nfa_lang L :=
begin
    rintro ⟨Q, fQ, dQ, enf, rfl⟩,
    letI := fQ,
    existsi [Q, _, _, epsnfa_to_nfa enf],
    ext x,
    exact epsnfa_to_nfa_accepts_iff_accepts enf x enf.start rfl,
end

theorem epsnfa_to_dfa_eq {L : set (list S)} : epsnfa_lang L → DFA.dfa_lang L :=
    nfa.nfa_to_dfa_eq ∘ epsnfa_to_nfa_eq

end epsnfa_to_nfa

section nfa_to_epsnfa

open option

variables (n : nfa.NFA S Q) [decidable_pred n.term]

def nfa_to_epsnfa : epsNFA S (option Q) := {
    start := some n.start,
    term := none,
    next := λ q c, option.cases_on q ∅ (λ q', some '' n.next q' c),
    eps := λ q, option.cases_on q ∅ (λ q', if q' ∈ n.term then {none} else ∅),
}

lemma nfa_to_epsnfa_go_from_finish {en : epsNFA S (option Q)} {w : list S} {fi : option Q}
    : en = nfa_to_epsnfa n → (go en none w fi) → w = [] :=
begin
    rintro rfl (⟨⟩ | ⟨_, _, _, _, _, nxt⟩ | ⟨_, _, _, _, nxt⟩),
    { refl, },
    { simpa only using nxt },
    { simpa only [nfa_to_epsnfa, mem_empty_eq] using nxt, },
end

lemma nfa_to_epsnfa_accepts_iff_accepts
    {en : epsNFA S (option Q)} (w : list S) (st : Q)
    : en = nfa_to_epsnfa n → (go en (some st) w none ↔ ∃ t : Q, nfa.go n st w t ∧ t ∈ n.term) :=
begin
    rintro rfl,
    split, {
        intro go_enfa,
        generalize hst : some st = ust,
        generalize hfi : (none : option Q) = ufi,
        rw [hst, hfi] at go_enfa,
        induction go_enfa generalizing st, {
            subst hfi,
            injection hst,
        }, {
            substs hst hfi,
            cases go_enfa_n, {
                simpa [nfa_to_epsnfa] using go_enfa_h,
            }, {
                specialize go_enfa_ih rfl go_enfa_n rfl,
                rcases go_enfa_ih with ⟨t, t_go, t_term⟩,
                simp [nfa_to_epsnfa] at go_enfa_h,
                use [t, nfa.go.step go_enfa_h t_go, t_term],
            }
        }, {
            substs hst hfi,
            simp only [forall_prop_of_true] at go_enfa_ih,
            cases go_enfa_n, {
                simp [nfa_to_epsnfa] at go_enfa_h,
                split_ifs at go_enfa_h, {
                    suffices tail_nil : go_enfa_tl = [],
                    subst tail_nil,
                    use [st, nfa.go.finish, h],
                    refine nfa_to_epsnfa_go_from_finish n rfl _,
                    exact none,
                    assumption,
                }, {
                    simpa [nfa_to_epsnfa, h] using go_enfa_h,
                }
            }, {
                simp [nfa_to_epsnfa] at go_enfa_h,
                split_ifs at go_enfa_h,
                all_goals {simpa only [mem_empty_eq] using go_enfa_h},
            },
        }
    }, {
        rintro ⟨t, t_go, t_term⟩,
        induction t_go, {
            refine go.eps _ go.finish,
            simp only [nfa_to_epsnfa, dite_eq_ite],
            simp only [t_term, if_true, mem_singleton],
        }, {
            refine go.step _ (t_go_ih t_term),
            simpa [nfa_to_epsnfa],
        },
    }
end

theorem nfa_to_epsnfa_eq {L : set (list S)} : nfa.nfa_lang L → epsnfa_lang L :=
begin
    rintro ⟨Q, fQ, dQ, nfa, rfl⟩,
    letI := dQ,
    have tmp : decidable_pred nfa.term := by sorry,
    letI := tmp,
    refine ⟨option Q, _, _, nfa_to_epsnfa nfa, _⟩,
    ext x,
    exact nfa_to_epsnfa_accepts_iff_accepts nfa x nfa.start rfl,
end

theorem dfa_to_epsnfa_eq {L : set (list S)} : DFA.dfa_lang L → epsnfa_lang L :=
    nfa_to_epsnfa_eq ∘ nfa.dfa_to_nfa_eq

end nfa_to_epsnfa

end epsnfa