inductive Vec (α : Type u) : Nat → Type u
  | nil  : Vec α 0
  | cons : α → {n : Nat} → Vec α n → Vec α (n+1)

def Vec.repeat (a : α) (n : Nat) : Vec α n :=
  match n with
  | 0   => nil
  | n+1 => cons a (repeat a n)

instance [Inhabited α] : Inhabited (Vec α n) where
  default := Vec.repeat arbitrary n

def Vec.map (v : Vec α n) (f : α → β) : Vec β n :=
  match n, v with
  | _, nil       => nil
  | _, cons a as => cons (f a) (map as f)

def Vec.reverse (v : Vec α n) : Vec α n :=
  let rec loop : {n m : Nat} → Vec α n → Vec α m → Vec α (n + m)
    | _, _, nil,       w => Nat.zero_add .. ▸ w
    | _, _, cons a as, w => Nat.add_assoc .. ▸ loop as (Nat.add_comm .. ▸ cons a w)
  loop v nil

@[simp] theorem map_id (v : Vec α n) : v.map id = v := by
  induction v with
  | nil => rfl
  | cons a as ih => simp [Vec.map, ih]

def foo [Add α] (v w : Vec α n) (f : α → α) (a : α) : α :=
  match n, v.map f, w.map f with
  | _, Vec.nil,       Vec.nil       => a
  | _, Vec.cons a .., Vec.cons b .. => a + b

theorem ex1 (a b : Nat) (as : Vec Nat n) : foo (Vec.cons a as) (Vec.cons b as) id 0 = a + b := by
  simp [foo]

#print ex1

def bla (b : Bool) (f g : α → β) (a : α) : β :=
  (match b with
   | true => f | false => g) a

theorem ex2 (h : b = false) : bla b (fun x => x + 1) id 10 = 10 := by
  simp [bla, h]

#print ex2


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

namespace Subtype

variable {α β : Type _}

def fromProdLeft {p : β → Prop} : α × Subtype p → Subtype (p ∘ Prod.snd (α:=α)) :=
  fun x => Subtype.mk (x.fst, x.snd.val) x.snd.property

def fromProdRight {p : α → Prop} : Subtype p × β → Subtype (p ∘ Prod.fst (β:=β)) :=
  fun x => Subtype.mk (x.fst.val,x.snd) x.fst.property

def toProdLeft {p : β → Prop} : Subtype (p ∘ Prod.snd (α:=α)) → α × Subtype p :=
  fun x => (x.val.fst, ⟨x.val.snd,x.property⟩)

def toProdRight {p : α → Prop} : Subtype (p ∘ Prod.fst (β:=β)) → Subtype p × β :=
  fun x => (⟨x.val.fst,x.property⟩, x.val.snd)

theorem map_val_toProdLeft {p : β → Prop} : Prod.map id Subtype.val ∘ toProdLeft (α:=α) (p:=p) = Subtype.val (p:=p ∘ Prod.snd (α:=α)) := funext (fun _ => rfl)

theorem map_val_toProdRight {p : α → Prop} : Prod.map Subtype.val id ∘ toProdRight (β:=β) (p:=p) = Subtype.val (p:=p ∘ Prod.fst (α:=α)) := funext (fun _ => rfl)

def push {p : β → Prop} (f : α → β) : Subtype (p ∘ f) → Subtype p :=
  fun x => ⟨f x, x.property⟩

@[simp]
theorem val_push {p : β → Prop} {f : α → β} (x : Subtype (p ∘ f)) : (x.push f).val = f x.val := rfl

def translate {p q : α → Prop} : (∀ a, p a → q a) → Subtype p → Subtype q :=
  fun hpq x => ⟨x.val, hpq x.val x.property⟩

@[simp]
theorem val_translate {p q : α → Prop} (hpq : ∀ a, p a → q a) (x : Subtype p) : (x.translate hpq).val = x.val := rfl

def zip {p : α → Prop} {q : β → Prop} : Subtype p → Subtype q → Subtype (α:=α×β) (fun c => p c.1 ∧ q c.2) :=
  fun x y => ⟨⟨x.val,y.val⟩, And.intro x.property y.property⟩

theorem val_zip {p : α → Prop} {q : β → Prop} (x : Subtype p) (y : Subtype q) : (zip x y).val = ⟨x.val,y.val⟩ := rfl

end Subtype


import game.sup_inf.level01
import game.sup_inf.level02
import data.real.basic
import game.limits.Blockus_Time
import game.Completeness.Bruh2
import game.Completeness.level085
import tactic

namespace xena -- hide

open classical

axiom choice {α : Sort*} : nonempty α → α

/-
# Chapter 7 : Limits

## Level 15

-/

definition is_limit (a : ℕ → ℝ) (α : ℝ) :=
∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - α| < ε

/- Hide
Lemma : thing1
{d n : ℕ} (hd : 0 < d) (nd : d ≤ n) : 1 / n ≤ 1 / d
-/

/- Hide
Lemma : thing2
{d n : ℕ} (hd : 0 < d) (nd : d ≤ n) (nd : 1 / n ≤ 1 / d ) : 1 / (n + 1) < 1 / d
-/

/-
Prove that there exists a sequence
that converges to the supremum
of a upper bounded set such that
every number in the seqence is in
the set for all natural numbers.
-/

theorem seq_conv_to_sup {x : ℝ}{S : set ℝ} {h1 : S ≠ ∅} (h2 : is_lub S x): ∃(a : ℕ → ℝ), ((is_limit a x) ∧ (∀(n : ℕ),(a n ∈ S))) :=
begin
-- give them this
have : ∀ n : ℕ, ∃ a ∈ S, x - 1/(n+1) < a,
{ intros n,
  have Q := generate_element h2 (1/(n + 1) : ℝ),
  have R : 0 < (1 / ((n : ℝ) + 1)),
  have Y : 0 < n + 1,
  linarith,
  rw one_div_pos,
  norm_cast,
  exact Y,
  have P : ¬ ∀ a ∈ S, a ≤ x - 1 / (n + 1) := Q R,
  push_neg at P,
  simpa using P,
  exact h1 },
choose a a_in lt_a using this,
use a,
-- to this
/- hint
sorry,
-/
end

/- Hide
split,
rw is_limit,
intro ε,
intro j,
swap,
intro n,
tauto,
have Y := archimedean_R,
specialize Y ε,
have J := Y(j),
cases J with d hd,
use d,
intro n,
intro v,
cases hd with g hg,

specialize lt_a n,
specialize a_in n,

have R : 1 / (n : ℝ) ≤ 1 / (d : ℝ),
have O := thing1 g v,
exact O,
have P : 0 < n,
linarith,
have T : 1 / ((n : ℝ) + 1) < 1 / (d : ℝ),
have M := thing2 g v,
have I := M(R),
exact I,
have U : a n ≤ x,
unfold is_lub at h2,
cases h2 with e he,
rw is_upper_bound at e,
specialize e (a n),
specialize e a_in,
exact e,
have Q : x < x + 1 / (n + 1),
linarith,
have L : a n - x < 1 / (n + 1),
linarith,
have L2 : - (1 / (↑n + 1)) < a n - x,
linarith,
have L3 : - (1 / (↑n + 1)) < a n - x ∧ a n - x < 1 / (n + 1),
split,
exact L2,
exact L,
have B : |a n - x| < 1 / (n + 1),
rw abs_lt,
exact L3,
have G : |a n - x| < 1 / d,
have K : 1 / ((n : ℝ) + 1) < 1 / (d : ℝ),
linarith,
have G := lt_trans B _, exact G, exact K, linarith,
-/

end xena


/-
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.list.basic
import Mathlib.PostPort

universes u

namespace Mathlib

namespace list

theorem rotate_mod {α : Type u} (l : List α) (n : ℕ) : rotate l (n % length l) = rotate l n := sorry

@[simp] theorem rotate_nil {α : Type u} (n : ℕ) : rotate [] n = [] :=
  nat.cases_on n (Eq.refl (rotate [] 0)) fun (n : ℕ) => Eq.refl (rotate [] (Nat.succ n))

@[simp] theorem rotate_zero {α : Type u} (l : List α) : rotate l 0 = l := sorry

@[simp] theorem rotate'_nil {α : Type u} (n : ℕ) : rotate' [] n = [] :=
  nat.cases_on n (Eq.refl (rotate' [] 0)) fun (n : ℕ) => Eq.refl (rotate' [] (Nat.succ n))

@[simp] theorem rotate'_zero {α : Type u} (l : List α) : rotate' l 0 = l :=
  list.cases_on l (Eq.refl (rotate' [] 0)) fun (l_hd : α) (l_tl : List α) => Eq.refl (rotate' (l_hd :: l_tl) 0)

theorem rotate'_cons_succ {α : Type u} (l : List α) (a : α) (n : ℕ) : rotate' (a :: l) (Nat.succ n) = rotate' (l ++ [a]) n := sorry

@[simp] theorem length_rotate' {α : Type u} (l : List α) (n : ℕ) : length (rotate' l n) = length l := sorry

theorem rotate'_eq_take_append_drop {α : Type u} {l : List α} {n : ℕ} : n ≤ length l → rotate' l n = drop n l ++ take n l := sorry

theorem rotate'_rotate' {α : Type u} (l : List α) (n : ℕ) (m : ℕ) : rotate' (rotate' l n) m = rotate' l (n + m) := sorry

@[simp] theorem rotate'_length {α : Type u} (l : List α) : rotate' l (length l) = l := sorry

@[simp] theorem rotate'_length_mul {α : Type u} (l : List α) (n : ℕ) : rotate' l (length l * n) = l := sorry

theorem rotate'_mod {α : Type u} (l : List α) (n : ℕ) : rotate' l (n % length l) = rotate' l n := sorry

theorem rotate_eq_rotate' {α : Type u} (l : List α) (n : ℕ) : rotate l n = rotate' l n := sorry

theorem rotate_cons_succ {α : Type u} (l : List α) (a : α) (n : ℕ) : rotate (a :: l) (Nat.succ n) = rotate (l ++ [a]) n := sorry

@[simp] theorem mem_rotate {α : Type u} {l : List α} {a : α} {n : ℕ} : a ∈ rotate l n ↔ a ∈ l := sorry

@[simp] theorem length_rotate {α : Type u} (l : List α) (n : ℕ) : length (rotate l n) = length l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (length (rotate l n) = length l)) (rotate_eq_rotate' l n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (length (rotate' l n) = length l)) (length_rotate' l n))) (Eq.refl (length l)))

theorem rotate_eq_take_append_drop {α : Type u} {l : List α} {n : ℕ} : n ≤ length l → rotate l n = drop n l ++ take n l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n ≤ length l → rotate l n = drop n l ++ take n l)) (rotate_eq_rotate' l n)))
    rotate'_eq_take_append_drop

theorem rotate_rotate {α : Type u} (l : List α) (n : ℕ) (m : ℕ) : rotate (rotate l n) m = rotate l (n + m) := sorry

@[simp] theorem rotate_length {α : Type u} (l : List α) : rotate l (length l) = l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (rotate l (length l) = l)) (rotate_eq_rotate' l (length l))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (rotate' l (length l) = l)) (rotate'_length l))) (Eq.refl l))

@[simp] theorem rotate_length_mul {α : Type u} (l : List α) (n : ℕ) : rotate l (length l * n) = l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (rotate l (length l * n) = l)) (rotate_eq_rotate' l (length l * n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (rotate' l (length l * n) = l)) (rotate'_length_mul l n))) (Eq.refl l))

theorem prod_rotate_eq_one_of_prod_eq_one {α : Type u} [group α] {l : List α} (hl : prod l = 1) (n : ℕ) : prod (rotate l n) = 1 := sorry


import data.set.countable tactic.find tactic.tidy tactic.ring
universe u

-- We introduce a much simplified version of
-- untyped first order (minimal) predicate logic.

-- make all propositions decidable.
-- Allows us to freely use ifs like in Haskell
-- but then we must add noncomputable to all functions
-- local attribute [instance] classical.prop_decidable

namespace logic

open logic list tactic set

section formulas
parameters {functional_symbol : Type u} [decidable_eq functional_symbol]
parameter {relational_symbol : Type u}
parameter {arity : functional_symbol -> ℕ}
parameter {rarity : relational_symbol -> ℕ}

-- arity types
def is_constant (f : functional_symbol) := arity f = 0
def nary (n : ℕ) := subtype {f : functional_symbol | arity f = n}
def nrary (n : ℕ) := subtype {r : relational_symbol | rarity r = n}
@[reducible]
def const := nary 0

-- terms in the language
inductive term
| var : ℕ → term
| app  {n : ℕ} (f : nary n) (v : fin n → term) :  term

-- constant terms.
def const.term : const → term
| c := term.app c fin_zero_elim

@[reducible]
def term.rw : term → ℕ → term → term
| (term.var a) x t := if x = a then t else term.var a
| (term.app f v) x t :=
    let v₂ := λ m, term.rw (v m) x t in
    term.app f v₂

def term.vars : term → list ℕ
| (term.var a) := [a]
| (term.app  f v) :=
    let v₂ := λ m, term.vars (v m) in
    foldr (++) [] (of_fn v₂)

@[reducible]
def term.denotes (t : term) := t.vars = []
@[reducible]
def term.conotes (t : term) := ¬ t.denotes

-- a term in the proper sense of the term (pun intended).
def pterm := subtype {t : term | t.denotes}
def expression := subtype {t : term | t.conotes}

-- def term.subterms : term → set term
-- | (term.app f v) :=
--     let v₂ := λ m, term.subterms (v m) in
--     (⋃ m, v₂ m) ∪ {(term.app f v)}
-- | t := {t}

def list.vars : list term → list ℕ
| [] := ∅
| (hd :: tl) := hd.vars ++ tl.vars

-- def list.subterms : list term → list term
-- | [] := ∅
-- | (hd :: tl) := hd.subterms ++ tl.subterms

def list.rw : list term → ℕ → term → list term
| [] _ _:= ∅
| (hd :: tl) x t := (hd.rw x t) :: tl.rw x t

-- def subterms : set term → list term
-- | S := ⋃ x ∈ S, term.subterms x

-- formulas
inductive uformula
| relational {n : ℕ} (r : nrary n) (v : fin n → term) : uformula
| equation (t₁ t₂ : term) : uformula
| false : uformula
| for_all :  ℕ → uformula → uformula
| if_then : uformula → uformula → uformula

def uformula.not (φ) := uformula.if_then φ uformula.false

reserve infixr ` ⇒ `:55
class has_exp (α : Type u) := (exp : α → α → α)
infixr ⇒ := has_exp.exp
instance uformula.has_exp : has_exp uformula := ⟨uformula.if_then⟩

local notation `∼` := uformula.not

@[reducible]
def uformula.rw : uformula → ℕ → term → uformula
| (uformula.relational r v) x t :=
    let v₂ := λ m, (v m).rw x t in
    uformula.relational r v₂
| (uformula.equation t₁ t₂) x t :=
    let t₃ := t₁.rw x t,
        t₄ := t₂.rw x t
    in uformula.equation t₃ t₄
| (uformula.for_all y φ) x t :=
    let ψ := if y = x then φ else φ.rw x t in
    uformula.for_all y ψ
| (uformula.if_then φ ψ) x t := uformula.if_then (φ.rw x t) (ψ.rw x t)
| φ _ _ := φ

def list_sub_aux {α} [decidable_eq α] : list α → list α → list α
| [] _ := []
| (hd::tl) xs :=
begin
    cases list.decidable_mem hd xs,
        exact hd :: list_sub_aux tl xs,
    exact list_sub_aux tl xs,
end

instance list_sub {α} [decidable_eq α] : has_sub (list α) :=
⟨list_sub_aux⟩

-- free variables
@[reducible]
def uformula.free : uformula → list ℕ
| (uformula.relational r v) := list.vars (of_fn v)
| (uformula.equation t₁ t₂) := t₁.vars ++ t₂.vars
| (uformula.for_all x φ) := φ.free - [x]
| (uformula.if_then φ ψ) := φ.free ++ ψ.free
| _ := []

-- open and closed formulas.
def uformula.closed : uformula → Prop
| φ := φ.free = ∅

def uformula.open : uformula → Prop
| φ := ¬ φ.closed

def uformula.vars : uformula → list ℕ
| (uformula.for_all x φ) := x::φ.free
| (uformula.if_then φ ψ) := φ.vars ++ ψ.vars
| φ := φ.free

inductive uaxiom : uformula → Prop
| p₁ (φ ψ : uformula) : uaxiom (φ ⇒ ψ ⇒ φ)
| p₂ (φ ψ δ : uformula) : uaxiom ((φ ⇒ ψ ⇒ δ) ⇒ ((φ ⇒ ψ) ⇒ φ ⇒ δ))
| p₃ (φ ψ : uformula) : uaxiom ((∼φ ⇒ ∼ψ) ⇒ ψ ⇒ φ)
| q₅ (x : ℕ) (φ : uformula) (t : pterm) : uaxiom ((uformula.for_all x φ) ⇒ φ.rw x t.val)
| q₆ (x : ℕ) (φ ψ : uformula) : uaxiom ((uformula.for_all x φ ⇒ ψ) ⇒ (uformula.for_all x φ) ⇒ (uformula.for_all x ψ))
| q₇ (x : ℕ) (φ : uformula) (x ∉ φ.free) : uaxiom (φ ⇒ (uformula.for_all x φ))

inductive argument
| silence {} : argument -- empty argument
| node : uformula → argument → argument → argument → argument

def argument.assumes (φ : uformula) : argument → Prop
| argument.silence := false
| (argument.node ψ argument.silence argument.silence argument.silence) := φ = ψ
| (argument.node _ a₁ a₂ a₃) := a₁.assumes ∨
                                a₂.assumes ∨
                                a₃.assumes

@[reducible]
def argument.concludes (φ : uformula) : argument → Prop
| argument.silence := false
| (logic.argument.node ψ x y z) := ψ = φ

-- def silence := argument.silence
-- -- because I said so
-- def argument.return : uformula → argument
-- | φ := argument.node φ silence silence silence

-- tells whether an argument is a proof from Γ
-- TODO: CONVERT THIS TO INDUCTIVE DEFINITION !!!!
@[reducible]
def argument.proof_from (Γ : set uformula) : argument → Prop
| (argument.node φ argument.silence argument.silence argument.silence) := φ ∈ Γ ∨
                                                                          φ = uformula.true ∨
                                                                          ∃ t, φ = uformula.equation t t
-- introduction rules
| (argument.node (uformula.and φ ψ)
                       γ₁
                       γ₂
                       argument.silence) := γ₁.concludes φ ∧
                                            γ₂.concludes ψ ∧
                                            γ₁.proof_from ∧
                                            γ₂.proof_from
| (argument.node (uformula.or φ _)
                       γ₁
                       argument.silence
                       argument.silence) := γ₁.concludes φ ∧ γ₁.proof_from
| (argument.node (uformula.or _ ψ)
                       argument.silence
                       γ₂
                       argument.silence) := γ₂.concludes ψ ∧ γ₂.proof_from
| (argument.node (uformula.if_then φ ψ)
                       γ
                       argument.silence
                       argument.silence) := γ.concludes ψ ∧
                                            γ.assumes φ ∧
                                            γ.proof_from
| (argument.node (uformula.for_all x φ)
                       γ
                       argument.silence
                       argument.silence) := ∃ c, γ.concludes (φ.rw x $ term.abs c) ∧
                                            x ∈ φ.free ∧
                                            γ.proof_from
| (argument.node (uformula.exist x φ)
                       γ
                       argument.silence
                       argument.silence) := ∃ t, γ.concludes (φ.rw x t) ∧
                                            t.denotes ∧
                                            x ∈ φ.free ∧
                                            γ.proof_from
-- elimination rules
| (argument.node φ γ argument.silence argument.silence) := ((∃ ψ, γ.concludes $ uformula.and φ ψ) ∨
                                                            (∃ ψ, γ.concludes $ uformula.and ψ φ) ∨
                                                            (∃ x (ψ : uformula) (t : term),
                                                             t.denotes ∧
                                                             x ∈ ψ.free ∧
                                                             γ.concludes (uformula.for_all x ψ) ∧
                                                             φ = ψ.rw x t)) ∧
                                                             γ.proof_from
| (argument.node φ γ₁ γ₂ argument.silence) := ((∃ ψ, γ₁.concludes (ψ ⇒ φ) ∧
                                               γ₂.concludes ψ) ∨
                                              (∃ x (ψ : uformula) c,
                                               x ∈ ψ.free ∧
                                               γ₁.concludes (uformula.exist x ψ) ∧
                                               γ₂.concludes ((ψ.rw x $ term.abs c) ⇒ φ)) ∨
                                              (∃ x (ψ : uformula) (t₁ t₂ : term),
                                               t₁.denotes ∧
                                               t₂.denotes ∧
                                               x ∈ ψ.free ∧
                                               γ₁.concludes (ψ.rw x t₁) ∧
                                               γ₂.concludes (uformula.equation t₁ t₂) ∧
                                               φ = ψ.rw x t₂)) ∧
                                               γ₁.proof_from ∧
                                               γ₂.proof_from
| (argument.node φ γ₁ γ₂ γ₃) := ∃ ψ₁ ψ₂, γ₁.concludes (uformula.or ψ₁ ψ₂) ∧
                                         γ₂.concludes (ψ₁ ⇒ φ) ∧
                                         γ₃.concludes (ψ₂ ⇒ φ) ∧
                                         γ₁.proof_from ∧
                                         γ₂.proof_from ∧
                                         γ₃.proof_from
| _ := false

def argument.proof_of (φ : uformula) (Γ : set uformula) : argument → Prop
| γ := γ.proof_from Γ ∧ γ.concludes φ

variables (Γ : set uformula) (φ : uformula)

theorem self_entailment : minimal.entails Γ (φ ⇒ φ) :=
begin
    apply minimal.entails.intro,
    apply minimal.entails.reflexive (Γ∪{φ}) φ,
    simp
end

theorem id_symm : ∀ (t₁ t₂ : pterm),
                  minimal.entails Γ (uformula.equation t₁.val t₂.val) →
                  minimal.entails Γ (uformula.equation t₂.val t₁.val)  :=
let ne := var_ne in
begin
    intros t₁ t₂ h,
    apply nonempty.elim ne, intro x,
    -- φ := "x = t₁"
    let φ := uformula.equation (term.var x) t₁.val,
    have den₁ := t₁.property.1,
    have den₂ := t₂.property.1,
    have c₀ : x ∈ φ.free, simp[φ],
    have c₁ : minimal.entails Γ (φ.rw x t₁.val),
        simp[φ],
        dunfold uformula.rw, simp,
        dunfold term.rw, simp,
        rw den_rw t₁.val t₁.val x t₁.property.1,
        apply minimal.entails.identity_intro Γ t₁.val,
    have c₂ : minimal.entails Γ (φ.rw x t₂.val),
        apply minimal.entails.identity_elim, --Γ φ x c₀ t₁ t₂ den₂ den₁,
        repeat {assumption <|> apply_assumption},
    simp[φ] at c₂,
    have c₃ : (uformula.equation (term.var x) (t₁.val)).rw x (t₂.val) = uformula.equation (t₂.val) (t₁.val),
        dunfold uformula.rw, simp,
        constructor,
            dunfold term.rw, simp,
        apply den_rw t₁.val t₂.val x den₁,
    rwa c₃ at c₂,
end

variables (Δ : set uformula) (ψ : uformula)

theorem monotonicity : Δ ⊆ Γ → minimal.entails Δ ψ → minimal.entails Γ ψ :=
begin
    intros H h,
    -- induction on the possible ways in which
    -- Δ could prove ψ
    induction h,
    -- case it was proven by reflection
        apply minimal.entails.reflexive Γ h_φ,
        exact H h_h,
    -- case it was proven by transitivity
        apply minimal.entails.transitivity Γ h_Δ h_φ,
        intros ψ₂ elem,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by and_intro
        apply minimal.entails.and_intro,-- h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by and_elim_left
        apply minimal.entails.and_elim_left h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by and_elim_right
        apply minimal.entails.and_elim_right h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by or_intro_left
        apply minimal.entails.or_intro_left h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by or_intro_right
        apply minimal.entails.or_intro_right h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by or_elim
        apply minimal.entails.or_elim,-- h_φ h_ψ h_δ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by modus ponens
        apply minimal.entails.modus_ponens h_φ h_ψ Γ,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by intro
        have c : minimal.entails h_Γ (h_φ ⇒ h_ψ),
            apply minimal.entails.intro h_φ h_ψ h_Γ,
            assumption,
        apply minimal.entails.transitivity Γ h_Γ (h_φ ⇒ h_ψ),
            intros ψ₂ elem,
            have c₂ := H elem,
            exact minimal.entails.reflexive Γ ψ₂ c₂,
        assumption,
    -- case it was proven by true_intro
        exact minimal.entails.true_intro Γ,
    -- case it was proven by for_all_intro
        apply minimal.entails.for_all_intro Γ h_φ h_x h_xf h_c,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by for_all_elim
        apply minimal.entails.for_all_elim Γ h_φ h_x h_xf,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by exists_intro
        apply minimal.entails.exists_intro Γ h_φ h_x h_xf h_t,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by exists_elim
        apply minimal.entails.exists_elim Γ h_φ h_ψ h_x h_xf,
        repeat {assumption <|> apply_assumption},
    -- case it was proven by identity_intro
        apply minimal.entails.identity_intro Γ h_t,
    -- case it was proven by identity_elim
        apply minimal.entails.identity_elim Γ h_φ h_x h_xf h_t₁ h_t₂,
        repeat {assumption <|> apply_assumption},
end

theorem proof_entails : (∃ p : argument, p.proof_of φ Γ) → minimal.entails Γ φ :=
begin
    intro h,
    obtain ⟨p, ph₁, ph₂⟩ := h,
    induction p,
        have c : false := ph₂,
        contradiction,
    have eq : φ = p_a := sorry,
        -- impossible to unfold at ph₂ for some reason
        -- simp [argument.concludes] at ph₂,
    rw ←eq at ph₁,
    admit,
    -- induction φ,

    -- simp at ph₁,

end

section semantics

parameters {α : Type u} [inhabited α]

-- functional interpretation
def fint  {n : ℕ} := nary n → (fin n → α) → α
-- relational interpretation
def rint {n : ℕ} := nrary n → (fin n → α) → Prop
-- variable assignment
def vasgn := ℕ → α

parameter exists_ass : nonempty vasgn

structure model :=
    (I₁ : Π {n}, @fint n)
    -- required because any constant that would map
    -- to the default value, would be a "generic point"
    -- of the type α, i.e. any of its properties would be
    -- true of any instance of α.
    (constant_no_default : ∀ f : nary 0, I₁ f fin_zero_elim ≠ default α)
    (I₂ : Π {n}, @rint n)

-- @[reducible]
def model.reference' (M : model) : term → vasgn → α
| (term.var x) asg := asg x
| (@term.app _ _ _ _ _ _ _ 0 f _) _ := model.I₁ M f fin_zero_elim
| (@term.app _ _ _ _ _ _ _ (n+1) f v) asg := let v₂ := λ k, model.reference' (v k) asg
                                             in model.I₁ M f v₂
-- An unavoidable trick.
-- It is just ridiculously hard to try any other
-- alternative. I gained A LOT of productivity
-- from this.
| _ _ := default α

-- If the default value is considered to be
-- a non-existent reference, like an option.none,
-- then this reference is only defined for pterms.
def model.reference (M : model) : pterm → α
| ⟨(@term.app _ _ _ _ _ _ _ 0 f _),_⟩ := model.I₁ M f fin_zero_elim
| ⟨(@term.app _ _ _ _ _ _ _ (n+1) f v),p⟩ := let v₂ := λ k, model.reference ⟨v k,
                                            begin
                                                admit,
                                            end⟩
                                             in model.I₁ M f v₂
| _ := sorry
-- | t := M.reference' t.val (λx, default α)
using_well_founded well_founded_tactics.default
-- begin
--     constructor,
--     intros x y,
--     exact `[exact well_founded_tactics.cancel_nat_add_lt],
--     exact assumption,
-- end

def model.satisfies' : model → uformula → vasgn → Prop
| M (uformula.relational r v) asg :=
          M.I₂ r $ λm,  M.reference' (v m) asg
| M (uformula.equation t₁ t₂) asg :=
    let x := model.reference' M t₁ asg,
        y := model.reference' M t₂ asg
    in x = y
| M uformula.true _ := true
| M uformula.false _ := false
| M (uformula.for_all x φ) asg :=
    ∀ (a : α) (ass : vasgn),
    ass x = a →
    (∀ y, y ≠ x → ass y = asg y) →
    M.satisfies' φ ass
| M (uformula.exist x φ) asg :=
    ∃ (a : α),
    ∀ (ass : vasgn),
    ass x = a →
    (∀ y, y ≠ x → ass y = asg y) →
    M.satisfies' φ ass
| M (uformula.and φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x ∧ y
| M (uformula.or φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x ∨ y
| M (uformula.if_then φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x → y

@[reducible]
def model.satisfies : model → uformula → Prop
| M φ := ∀ (ass : vasgn), M.satisfies' φ ass

local infixr `⊨₁`:55 := model.satisfies
local infixr `⊢`:55 := minimal.entails

include exists_ass
lemma false_is_unsat : ¬∃ M : model, M ⊨₁ uformula.false :=
begin
    intro h,
    obtain ⟨M, h⟩ := h,
    tactic.unfreeze_local_instances,
    obtain ⟨x⟩ := exists_ass,
    exact h x,
end
omit exists_ass

def model.for : model → set uformula → Prop
| M Γ := ∀ φ ∈ Γ, M ⊨₁ φ

-- semantic consequence
-- remember Γ and φ are already defined
def theory.follows : Prop :=
    ∀ (M : model) ass, (∀ ψ ∈ Γ, M.satisfies' ψ ass) → M.satisfies' φ ass

local infixr `⊨`:55 := theory.follows

def vasgn.bind (ass : vasgn) (x : ℕ) (val : α) : vasgn :=
    λy, if y = x then val else ass y

-- lemma uformula.rw.semantics (φ : uformula)
--                             (x : ℕ)
--                             (h₀ : x ∈ φ.free)
--                             (ass : vasgn)
--                             (M : model)
--                             (t : pterm)
--                             :
--                             M.satisfies' φ ass →
--                             M.satisfies' (φ.rw x t.val)
--                             (ass.bind x (M.reference' t.val ass))
--                             :=
-- begin
--     -- intro h,
--     induction φ;
--     dunfold uformula.rw; try{simp};
--     dunfold model.satisfies';
--     intro h,
--     -- have c₁ : (λ (m : fin φ_n), M.reference' (φ_v m) ass) = (flip M.reference' ass) ∘ φ_v,
--     --     dsimp [flip, function.comp],
--     --     refl,
--     have c : ∀ m, (M.reference' ((φ_v m).rw x t.val) (ass.bind x (M.reference' t.val ass))) = M.reference' (φ_v m) ass,
--         focus {
--             intro m,
--             induction (φ_v m);
--             dunfold term.rw;
--             dunfold vasgn.bind,
--             dunfold model.reference',
--             by_cases h₂ : x = a;
--                 simp [h₂],
--                 obtain ⟨t, pt₁, pt₂⟩ := t,
--                 induction t,
--                     dunfold model.reference',
--                     simp,

--                 revert pt₁,
--                 dunfold term.denotes,
--                 dunfold term.vars,
--                 simp,
--                     revert pt₂,
--                     dunfold term.concrete,
--                     contradiction,
--                 simp,
--                 induction t_n;
--                 dunfold model.reference',

--                     -- dunfold model.reference',

--         }

-- end

-- So pretty.
theorem soundness : Γ ⊢ φ → Γ ⊨ φ :=
begin
    intros entails M ass h,
    induction entails,
    -- case reflexive
    exact h entails_φ entails_h,
    -- case transitivity
    apply entails_ih_h₂,
    intros ψ H,
    exact entails_ih_h₁ ψ H h,
    -- case and.intro
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    exact ⟨c₁, c₂⟩,
    -- case and.elim_left
    have sat := entails_ih h,
    revert sat,
    dunfold model.satisfies',
    simp,
    intros sat aux,
    exact sat,
    -- case and.elim_right
    have sat := entails_ih h,
    revert sat,
    repeat {dunfold model.satisfies', simp},
    left,
    exact entails_ih h,
    right,
    exact entails_ih h,
    -- case or_intro_left
    -- already solved
    -- case or_intro_right
    -- already solved
    -- case or_elim
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    have c₃ := entails_ih_h₃ h,
    tactic.unfreeze_local_instances,
    dunfold model.satisfies' at *,
    simp at *,
    cases c₁,
        exact c₂ c₁,
    exact c₃ c₁,
    -- case modus ponens
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    revert c₁,
    dunfold model.satisfies',
    simp,
    intro c₁,
    exact c₁ c₂,
    -- case intro
    intro h₂,
    have sat := entails_ih,
    apply sat,
    intros ψ H,
    cases H,
    exact h ψ H,
    simp at H,
    rwa H,
    -- case true.intro
    trivial,
    -- case universal intro
    -- intros x asg h₁ h₂,
    -- have sat := entails_ih h,
    -- focus {
    --     induction entails_φ;
    --     revert sat;
    --     dunfold uformula.rw;
    --     dunfold model.satisfies';
    --     try{dunfold flip};
    --     try{dunfold vector.of_fn};
    --     try{dunfold vector.map},
    --         intro sat,
    -- },
    admit,
    -- case universal elim
    -- focus {
    --     induction entails_φ;
    --     have sat := entails_ih h;
    --     revert sat;
    --     dunfold uformula.rw; try{simp},
    --     -- I cant go any further applying strategies to
    --     -- all goals because the linter gets very slow.
    --     dunfold model.satisfies', try{simp},
    --         intro sat,
    -- },
    admit,
    -- case exists intro
    have sat := entails_ih h,
    existsi M.reference' entails_t ass,
    intros asg h₁ h₂,
    admit,
    -- case exists elim
    admit,
    -- case identity intro
    -- already solved
    -- case identity elim
    admit,
end

end semantics

section consistency
end consistency

end formulas
end logic


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Minchao Wu, Mario Carneiro
-/
import algebra.hom.embedding
import data.fin.basic
import data.finset.basic
import data.int.order.basic

/-! # Image and map operations on finite sets

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

Thie file provides the finite analog of `set.image`, along with some other similar functions.

Note there are two ways to take the image over a finset; via `finset.image` which applies the
function then removes duplicates (requiring `decidable_eq`), or via `finset.map` which exploits
injectivity of the function to avoid needing to deduplicate. Choosing between these is similar to
choosing between `insert` and `finset.cons`, or between `finset.union` and `finset.disj_union`.

## Main definitions

* `finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`.
* `finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`.
* `finset.subtype`: `s.subtype p` is the the finset of `subtype p` whose elements belong to `s`.
* `finset.fin`:`s.fin n` is the finset of all elements of `s` less than `n`.

-/

variables {α β γ : Type*}
open multiset
open function

namespace finset

/-! ### map -/
section map
open function

/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image
finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/
def map (f : α ↪ β) (s : finset α) : finset β := ⟨s.1.map f, s.2.map f.2⟩

@[simp] theorem map_val (f : α ↪ β) (s : finset α) : (map f s).1 = s.1.map f := rfl

@[simp] theorem map_empty (f : α ↪ β) : (∅ : finset α).map f = ∅ := rfl

variables {f : α ↪ β} {s : finset α}

@[simp] theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b :=
mem_map.trans $ by simp only [exists_prop]; refl

@[simp] lemma mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.to_embedding ↔ f.symm b ∈ s :=
by { rw mem_map, exact ⟨by { rintro ⟨a, H, rfl⟩, simpa }, λ h, ⟨_, h, by simp⟩⟩ }

lemma mem_map' (f : α ↪ β) {a} {s : finset α} : f a ∈ s.map f ↔ a ∈ s := mem_map_of_injective f.2

lemma mem_map_of_mem (f : α ↪ β) {a} {s : finset α} : a ∈ s → f a ∈ s.map f := (mem_map' _).2

lemma forall_mem_map {f : α ↪ β} {s : finset α} {p : Π a, a ∈ s.map f → Prop} :
  (∀ y ∈ s.map f, p y H) ↔ ∀ x ∈ s, p (f x) (mem_map_of_mem _ H) :=
⟨λ h y hy, h (f y) (mem_map_of_mem _ hy), λ h x hx,
  by { obtain ⟨y, hy, rfl⟩ := mem_map.1 hx, exact h _ hy }⟩

lemma apply_coe_mem_map (f : α ↪ β) (s : finset α) (x : s) : f x ∈ s.map f :=
mem_map_of_mem f x.prop

@[simp, norm_cast] theorem coe_map (f : α ↪ β) (s : finset α) : (s.map f : set β) = f '' s :=
set.ext $ λ x, mem_map.trans set.mem_image_iff_bex.symm

theorem coe_map_subset_range (f : α ↪ β) (s : finset α) : (s.map f : set β) ⊆ set.range f :=
calc ↑(s.map f) = f '' s      : coe_map f s
            ... ⊆ set.range f : set.image_subset_range f ↑s

/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
-/
lemma map_perm {σ : equiv.perm α} (hs : {a | σ a ≠ a} ⊆ s) : s.map (σ : α ↪ α) = s :=
coe_injective $ (coe_map _ _).trans $ set.image_perm hs

theorem map_to_finset [decidable_eq α] [decidable_eq β] {s : multiset α} :
  s.to_finset.map f = (s.map f).to_finset :=
ext $ λ _, by simp only [mem_map, multiset.mem_map, exists_prop, multiset.mem_to_finset]

@[simp] theorem map_refl : s.map (embedding.refl _) = s :=
ext $ λ _, by simpa only [mem_map, exists_prop] using exists_eq_right

@[simp] theorem map_cast_heq {α β} (h : α = β) (s : finset α) :
  s.map (equiv.cast h).to_embedding == s :=
by { subst h, simp }

theorem map_map (f : α ↪ β) (g : β ↪ γ) (s : finset α) : (s.map f).map g = s.map (f.trans g) :=
eq_of_veq $ by simp only [map_val, multiset.map_map]; refl

lemma _root_.function.semiconj.finset_map {f : α ↪ β} {ga : α ↪ α} {gb : β ↪ β}
  (h : function.semiconj f ga gb) :
  function.semiconj (map f) (map ga) (map gb) :=
λ s, map_comm h

lemma _root_.function.commute.finset_map {f g : α ↪ α} (h : function.commute f g) :
  function.commute (map f) (map g) :=
h.finset_map

@[simp] theorem map_subset_map {s₁ s₂ : finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ :=
⟨λ h x xs, (mem_map' _).1 $ h $ (mem_map' f).2 xs,
 λ h, by simp [subset_def, map_subset_map h]⟩

/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its
image under `f`. -/
def map_embedding (f : α ↪ β) : finset α ↪o finset β :=
order_embedding.of_map_le_iff (map f) (λ _ _, map_subset_map)

@[simp] theorem map_inj {s₁ s₂ : finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ :=
(map_embedding f).injective.eq_iff

lemma map_injective (f : α ↪ β) : injective (map f) := (map_embedding f).injective

@[simp] theorem map_embedding_apply : map_embedding f s = map f s := rfl

lemma filter_map {p : β → Prop} [decidable_pred p] :
  (s.map f).filter p = (s.filter (p ∘ f)).map f :=
eq_of_veq (map_filter _ _ _)

lemma map_filter {f : α ≃ β} {p : α → Prop} [decidable_pred p] :
  (s.filter p).map f.to_embedding = (s.map f.to_embedding).filter (p ∘ f.symm) :=
by simp only [filter_map, function.comp, equiv.to_embedding_apply, equiv.symm_apply_apply]

@[simp] lemma disjoint_map {s t : finset α} (f : α ↪ β) :
  disjoint (s.map f) (t.map f) ↔ disjoint s t :=
begin
  simp only [disjoint_iff_ne, mem_map, exists_prop, exists_imp_distrib, and_imp],
  refine ⟨λ h a ha b hb hab, h _ _ ha rfl _ _ hb rfl $ congr_arg _ hab, _⟩,
  rintro h _ a ha rfl _ b hb rfl,
  exact f.injective.ne (h _ ha _ hb),
end

theorem map_disj_union {f : α ↪ β} (s₁ s₂ : finset α) (h) (h' := (disjoint_map _).mpr h) :
  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
eq_of_veq $ multiset.map_add _ _ _

/-- A version of `finset.map_disj_union` for writing in the other direction. -/
theorem map_disj_union' {f : α ↪ β} (s₁ s₂ : finset α) (h') (h := (disjoint_map _).mp h') :
  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
map_disj_union _ _ _

theorem map_union [decidable_eq α] [decidable_eq β]
  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f :=
coe_injective $ by simp only [coe_map, coe_union, set.image_union]

theorem map_inter [decidable_eq α] [decidable_eq β]
  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f :=
coe_injective $ by simp only [coe_map, coe_inter, set.image_inter f.injective]

@[simp] theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} :=
coe_injective $ by simp only [coe_map, coe_singleton, set.image_singleton]

@[simp] lemma map_insert [decidable_eq α] [decidable_eq β] (f : α ↪ β) (a : α) (s : finset α) :
  (insert a s).map f = insert (f a) (s.map f) :=
by simp only [insert_eq, map_union, map_singleton]

@[simp] lemma map_cons (f : α ↪ β) (a : α) (s : finset α) (ha : a ∉ s) :
  (cons a s ha).map f = cons (f a) (s.map f) (by simpa using ha) :=
eq_of_veq $ multiset.map_cons f a s.val

@[simp] theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ :=
⟨λ h, eq_empty_of_forall_not_mem $
 λ a m, ne_empty_of_mem (mem_map_of_mem _ m) h, λ e, e.symm ▸ rfl⟩

@[simp] lemma map_nonempty : (s.map f).nonempty ↔ s.nonempty :=
by rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, map_eq_empty]

alias map_nonempty ↔ _ nonempty.map

lemma attach_map_val {s : finset α} : s.attach.map (embedding.subtype _) = s :=
eq_of_veq $ by rw [map_val, attach_val]; exact attach_map_val _

lemma disjoint_range_add_left_embedding (a b : ℕ) :
  disjoint (range a) (map (add_left_embedding a) (range b)) :=
begin
  refine disjoint_iff_inf_le.mpr _,
  intros k hk,
  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
    mem_inter] at hk,
  obtain ⟨a, haQ, ha⟩ := hk.2,
  simpa [← ha] using hk.1,
end

lemma disjoint_range_add_right_embedding (a b : ℕ) :
  disjoint (range a) (map (add_right_embedding a) (range b)) :=
begin
  refine disjoint_iff_inf_le.mpr _,
  intros k hk,
  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
    mem_inter] at hk,
  obtain ⟨a, haQ, ha⟩ := hk.2,
  simpa [← ha] using hk.1,
end

theorem map_disj_Union {f : α ↪ β} {s : finset α} {t : β → finset γ} {h} :
  (s.map f).disj_Union t h = s.disj_Union (λa, t (f a))
    (λ a ha b hb hab, h (mem_map_of_mem _ ha) (mem_map_of_mem _ hb) (f.injective.ne hab)) :=
eq_of_veq $ multiset.bind_map _ _ _

theorem disj_Union_map {s : finset α} {t : α → finset β} {f : β ↪ γ} {h} :
  (s.disj_Union t h).map f = s.disj_Union (λa, (t a).map f)
    (λ a ha b hb hab, disjoint_left.mpr $ λ x hxa hxb, begin
      obtain ⟨xa, hfa, rfl⟩ := mem_map.mp hxa,
      obtain ⟨xb, hfb, hfab⟩ := mem_map.mp hxb,
      obtain rfl := f.injective hfab,
      exact disjoint_left.mp (h ha hb hab) hfa hfb,
    end) :=
eq_of_veq $ multiset.map_bind _ _ _

end map

lemma range_add_one' (n : ℕ) :
  range (n + 1) = insert 0 ((range n).map ⟨λi, i + 1, assume i j, nat.succ.inj⟩) :=
by ext (⟨⟩ | ⟨n⟩); simp [nat.succ_eq_add_one, nat.zero_lt_succ n]

/-! ### image -/

section image
variables [decidable_eq β]

/-- `image f s` is the forward image of `s` under `f`. -/
def image (f : α → β) (s : finset α) : finset β := (s.1.map f).to_finset

@[simp] theorem image_val (f : α → β) (s : finset α) : (image f s).1 = (s.1.map f).dedup := rfl

@[simp] theorem image_empty (f : α → β) : (∅ : finset α).image f = ∅ := rfl

variables {f g : α → β} {s : finset α} {t : finset β} {a : α} {b c : β}

@[simp] lemma mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b :=
by simp only [mem_def, image_val, mem_dedup, multiset.mem_map, exists_prop]

lemma mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f := mem_image.2 ⟨_, h, rfl⟩

lemma forall_image {p : β → Prop} : (∀ b ∈ s.image f, p b) ↔ ∀ a ∈ s, p (f a) :=
by simp only [mem_image, forall_exists_index, forall_apply_eq_imp_iff₂]

@[simp] lemma mem_image_const : c ∈ s.image (const α b) ↔ s.nonempty ∧ b = c :=
by { rw mem_image, simp only [exists_prop, const_apply, exists_and_distrib_right], refl }

lemma mem_image_const_self : b ∈ s.image (const α b) ↔ s.nonempty :=
mem_image_const.trans $ and_iff_left rfl

instance can_lift (c) (p) [can_lift β α c p] :
  can_lift (finset β) (finset α) (image c) (λ s, ∀ x ∈ s, p x) :=
{ prf :=
    begin
      rintro ⟨⟨l⟩, hd : l.nodup⟩ hl,
      lift l to list α using hl,
      exact ⟨⟨l, hd.of_map _⟩, ext $ λ a, by simp⟩,
    end }

lemma image_congr (h : (s : set α).eq_on f g) : finset.image f s = finset.image g s :=
by { ext, simp_rw mem_image, exact bex_congr (λ x hx, by rw h hx) }

lemma _root_.function.injective.mem_finset_image (hf : injective f) : f a ∈ s.image f ↔ a ∈ s :=
begin
  refine ⟨λ h, _, finset.mem_image_of_mem f⟩,
  obtain ⟨y, hy, heq⟩ := mem_image.1 h,
  exact hf heq ▸ hy,
end

lemma filter_mem_image_eq_image (f : α → β) (s : finset α) (t : finset β) (h : ∀ x ∈ s, f x ∈ t) :
  t.filter (λ y, y ∈ s.image f) = s.image f :=
by { ext, rw [mem_filter, mem_image],
     simp only [and_imp, exists_prop, and_iff_right_iff_imp, exists_imp_distrib],
     rintros x xel rfl, exact h _ xel }

lemma fiber_nonempty_iff_mem_image (f : α → β) (s : finset α) (y : β) :
  (s.filter (λ x, f x = y)).nonempty ↔ y ∈ s.image f :=
by simp [finset.nonempty]

@[simp, norm_cast] lemma coe_image {f : α → β} : ↑(s.image f) = f '' ↑s :=
set.ext $ λ _, mem_image.trans set.mem_image_iff_bex.symm

protected lemma nonempty.image (h : s.nonempty) (f : α → β) : (s.image f).nonempty :=
let ⟨a, ha⟩ := h in ⟨f a, mem_image_of_mem f ha⟩

@[simp] lemma nonempty.image_iff (f : α → β) : (s.image f).nonempty ↔ s.nonempty :=
⟨λ ⟨y, hy⟩, let ⟨x, hx, _⟩ := mem_image.mp hy in ⟨x, hx⟩, λ h, h.image f⟩

theorem image_to_finset [decidable_eq α] {s : multiset α} :
  s.to_finset.image f = (s.map f).to_finset :=
ext $ λ _, by simp only [mem_image, multiset.mem_to_finset, exists_prop, multiset.mem_map]

lemma image_val_of_inj_on (H : set.inj_on f s) : (image f s).1 = s.1.map f := (s.2.map_on H).dedup

@[simp] lemma image_id [decidable_eq α] : s.image id = s :=
ext $ λ _, by simp only [mem_image, exists_prop, id, exists_eq_right]

@[simp] theorem image_id' [decidable_eq α] : s.image (λ x, x) = s := image_id

theorem image_image [decidable_eq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) :=
eq_of_veq $ by simp only [image_val, dedup_map_dedup_eq, multiset.map_map]

lemma image_comm {β'} [decidable_eq β'] [decidable_eq γ] {f : β → γ} {g : α → β}
  {f' : α → β'} {g' : β' → γ} (h_comm : ∀ a, f (g a) = g' (f' a)) :
  (s.image g).image f = (s.image f').image g' :=
by simp_rw [image_image, comp, h_comm]

lemma _root_.function.semiconj.finset_image [decidable_eq α] {f : α → β} {ga : α → α} {gb : β → β}
  (h : function.semiconj f ga gb) :
  function.semiconj (image f) (image ga) (image gb) :=
λ s, image_comm h

lemma _root_.function.commute.finset_image [decidable_eq α] {f g : α → α}
  (h : function.commute f g) :
  function.commute (image f) (image g) :=
h.finset_image

theorem image_subset_image {s₁ s₂ : finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f :=
by simp only [subset_def, image_val, subset_dedup', dedup_subset',
  multiset.map_subset_map h]

lemma image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t :=
calc s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t : by norm_cast
               ... ↔ _ : set.image_subset_iff

theorem image_mono (f : α → β) : monotone (finset.image f) := λ _ _, image_subset_image

lemma image_subset_image_iff {t : finset α} (hf : injective f) : s.image f ⊆ t.image f ↔ s ⊆ t :=
by { simp_rw ←coe_subset, push_cast, exact set.image_subset_image_iff hf }

theorem coe_image_subset_range : ↑(s.image f) ⊆ set.range f :=
calc ↑(s.image f) = f '' ↑s     : coe_image
              ... ⊆ set.range f : set.image_subset_range f ↑s

theorem image_filter {p : β → Prop} [decidable_pred p] :
  (s.image f).filter p = (s.filter (p ∘ f)).image f :=
ext $ λ b, by simp only [mem_filter, mem_image, exists_prop]; exact
⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩,
 by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩

theorem image_union [decidable_eq α] {f : α → β} (s₁ s₂ : finset α) :
  (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f :=
ext $ λ _, by simp only [mem_image, mem_union, exists_prop, or_and_distrib_right,
  exists_or_distrib]

lemma image_inter_subset [decidable_eq α] (f : α → β) (s t : finset α) :
  (s ∩ t).image f ⊆ s.image f ∩ t.image f :=
subset_inter (image_subset_image $ inter_subset_left _ _) $
  image_subset_image $ inter_subset_right _ _

lemma image_inter_of_inj_on [decidable_eq α] {f : α → β} (s t : finset α)
  (hf : set.inj_on f (s ∪ t)) :
  (s ∩ t).image f = s.image f ∩ t.image f :=
coe_injective $ by { push_cast, exact set.image_inter_on (λ a ha b hb, hf (or.inr ha) $ or.inl hb) }

lemma image_inter [decidable_eq α] (s₁ s₂ : finset α) (hf : injective f) :
  (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f :=
image_inter_of_inj_on _ _ $ hf.inj_on _

@[simp] theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} :=
ext $ λ x, by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm

@[simp] theorem image_insert [decidable_eq α] (f : α → β) (a : α) (s : finset α) :
  (insert a s).image f = insert (f a) (s.image f) :=
by simp only [insert_eq, image_singleton, image_union]

lemma erase_image_subset_image_erase [decidable_eq α] (f : α → β) (s : finset α) (a : α) :
  (s.image f).erase (f a) ⊆ (s.erase a).image f :=
begin
  simp only [subset_iff, and_imp, exists_prop, mem_image, exists_imp_distrib, mem_erase],
  rintro b hb x hx rfl,
  exact ⟨_, ⟨ne_of_apply_ne f hb, hx⟩, rfl⟩,
end

@[simp] lemma image_erase [decidable_eq α] {f : α → β} (hf : injective f) (s : finset α) (a : α) :
  (s.erase a).image f = (s.image f).erase (f a) :=
begin
  refine (erase_image_subset_image_erase _ _ _).antisymm' (λ b, _),
  simp only [mem_image, exists_prop, mem_erase],
  rintro ⟨a', ⟨haa', ha'⟩, rfl⟩,
  exact ⟨hf.ne haa', a', ha', rfl⟩,
end

@[simp] theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ :=
⟨λ h, eq_empty_of_forall_not_mem $
 λ a m, ne_empty_of_mem (mem_image_of_mem _ m) h, λ e, e.symm ▸ rfl⟩

lemma image_sdiff [decidable_eq α] {f : α → β} (s t : finset α) (hf : injective f) :
  (s \ t).image f = s.image f \ t.image f :=
coe_injective $ by { push_cast, exact set.image_diff hf _ _ }

lemma image_symm_diff [decidable_eq α] {f : α → β} (s t : finset α) (hf : injective f) :
  (s ∆ t).image f = s.image f ∆ t.image f :=
coe_injective $ by { push_cast, exact set.image_symm_diff hf _ _ }

@[simp] lemma _root_.disjoint.of_image_finset
  {s t : finset α} {f : α → β} (h : disjoint (s.image f) (t.image f)) :
  disjoint s t :=
disjoint_iff_ne.2 $ λ a ha b hb, ne_of_apply_ne f $ h.forall_ne_finset
  (mem_image_of_mem _ ha) (mem_image_of_mem _ hb)

lemma mem_range_iff_mem_finset_range_of_mod_eq' [decidable_eq α] {f : ℕ → α} {a : α} {n : ℕ}
  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
begin
  split,
  { rintros ⟨i, hi⟩,
    simp only [mem_image, exists_prop, mem_range],
    exact ⟨i % n, nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩ },
  { rintro h,
    simp only [mem_image, exists_prop, set.mem_range, mem_range] at *,
    rcases h with ⟨i, hi, ha⟩,
    exact ⟨i, ha⟩ }
end

lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ}
  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a, by simpa [h],
have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn,
iff.intro
  (assume ⟨i, hi⟩,
    have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'),
    ⟨int.to_nat (i % n),
      by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩)
  (assume ⟨i, hi, ha⟩,
    ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩)

lemma range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (add_left_embedding a) :=
by { rw [←val_inj, union_val], exact multiset.range_add_eq_union a b }

@[simp] lemma attach_image_val [decidable_eq α] {s : finset α} : s.attach.image subtype.val = s :=
eq_of_veq $ by rw [image_val, attach_val, multiset.attach_map_val, dedup_eq_self]

@[simp] lemma attach_image_coe [decidable_eq α] {s : finset α} : s.attach.image coe = s :=
finset.attach_image_val

@[simp] lemma attach_insert [decidable_eq α] {a : α} {s : finset α} :
  attach (insert a s) = insert (⟨a, mem_insert_self a s⟩ : {x // x ∈ insert a s})
    ((attach s).image (λx, ⟨x.1, mem_insert_of_mem x.2⟩)) :=
ext $ λ ⟨x, hx⟩, ⟨or.cases_on (mem_insert.1 hx)
  (λ h : x = a, λ _, mem_insert.2 $ or.inl $ subtype.eq h)
  (λ h : x ∈ s, λ _, mem_insert_of_mem $ mem_image.2 $ ⟨⟨x, h⟩, mem_attach _ _, subtype.eq rfl⟩),
λ _, finset.mem_attach _ _⟩

theorem map_eq_image (f : α ↪ β) (s : finset α) : s.map f = s.image f :=
eq_of_veq (s.map f).2.dedup.symm

@[simp] lemma disjoint_image
  {s t : finset α} {f : α → β} (hf : injective f) :
  disjoint (s.image f) (t.image f) ↔ disjoint s t :=
by convert disjoint_map ⟨_, hf⟩; simp [map_eq_image]

lemma image_const {s : finset α} (h : s.nonempty) (b : β) : s.image (λa, b) = singleton b :=
ext $ assume b', by simp only [mem_image, exists_prop, exists_and_distrib_right,
  h.bex, true_and, mem_singleton, eq_comm]

@[simp] lemma map_erase [decidable_eq α] (f : α ↪ β) (s : finset α) (a : α) :
  (s.erase a).map f = (s.map f).erase (f a) :=
by { simp_rw map_eq_image, exact s.image_erase f.2 a }

theorem image_bUnion [decidable_eq γ] {f : α → β} {s : finset α} {t : β → finset γ} :
  (s.image f).bUnion t = s.bUnion (λa, t (f a)) :=
by haveI := classical.dec_eq α; exact
finset.induction_on s rfl (λ a s has ih,
  by simp only [image_insert, bUnion_insert, ih])

theorem bUnion_image [decidable_eq γ] {s : finset α} {t : α → finset β} {f : β → γ} :
  (s.bUnion t).image f = s.bUnion (λa, (t a).image f) :=
by haveI := classical.dec_eq α; exact
finset.induction_on s rfl (λ a s has ih,
  by simp only [bUnion_insert, image_union, ih])

lemma image_bUnion_filter_eq [decidable_eq α] (s : finset β) (g : β → α) :
  (s.image g).bUnion (λa, s.filter $ (λc, g c = a)) = s :=
bUnion_filter_eq_of_maps_to (λ x, mem_image_of_mem g)

lemma bUnion_singleton {f : α → β} : s.bUnion (λa, {f a}) = s.image f :=
ext $ λ x, by simp only [mem_bUnion, mem_image, mem_singleton, eq_comm]

end image

/-! ### Subtype -/
section subtype

/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose
elements belong to `s`. -/
protected def subtype {α} (p : α → Prop) [decidable_pred p] (s : finset α) : finset (subtype p) :=
(s.filter p).attach.map ⟨λ x, ⟨x.1, (finset.mem_filter.1 x.2).2⟩,
λ x y H, subtype.eq $ subtype.mk.inj H⟩

@[simp] lemma mem_subtype {p : α → Prop} [decidable_pred p] {s : finset α} :
  ∀ {a : subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s
| ⟨a, ha⟩ := by simp [finset.subtype, ha]

lemma subtype_eq_empty {p : α → Prop} [decidable_pred p] {s : finset α} :
  s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s :=
by simp [ext_iff, subtype.forall, subtype.coe_mk]; refl

@[mono] lemma subtype_mono {p : α → Prop} [decidable_pred p] : monotone (finset.subtype p) :=
λ s t h x hx, mem_subtype.2 $ h $ mem_subtype.1 hx

/-- `s.subtype p` converts back to `s.filter p` with
`embedding.subtype`. -/
@[simp] lemma subtype_map (p : α → Prop) [decidable_pred p] {s : finset α} :
  (s.subtype p).map (embedding.subtype _) = s.filter p :=
begin
  ext x,
  simp [and_comm _ (_ = _), @and.left_comm _ (_ = _), and_comm (p x) (x ∈ s)]
end

/-- If all elements of a `finset` satisfy the predicate `p`,
`s.subtype p` converts back to `s` with `embedding.subtype`. -/
lemma subtype_map_of_mem {p : α → Prop} [decidable_pred p] {s : finset α} (h : ∀ x ∈ s, p x) :
  (s.subtype p).map (embedding.subtype _) = s :=
by rw [subtype_map, filter_true_of_mem h]

/-- If a `finset` of a subtype is converted to the main type with
`embedding.subtype`, all elements of the result have the property of
the subtype. -/
lemma property_of_mem_map_subtype {p : α → Prop} (s : finset {x // p x}) {a : α}
  (h : a ∈ s.map (embedding.subtype _)) : p a :=
begin
  rcases mem_map.1 h with ⟨x, hx, rfl⟩,
  exact x.2
end

/-- If a `finset` of a subtype is converted to the main type with
`embedding.subtype`, the result does not contain any value that does
not satisfy the property of the subtype. -/
lemma not_mem_map_subtype_of_not_property {p : α → Prop} (s : finset {x // p x})
  {a : α} (h : ¬ p a) : a ∉ (s.map (embedding.subtype _)) :=
mt s.property_of_mem_map_subtype h

/-- If a `finset` of a subtype is converted to the main type with
`embedding.subtype`, the result is a subset of the set giving the
subtype. -/
lemma map_subtype_subset {t : set α} (s : finset t) : ↑(s.map (embedding.subtype _)) ⊆ t :=
begin
  intros a ha,
  rw mem_coe at ha,
  convert property_of_mem_map_subtype s ha
end

end subtype

/-! ### Fin -/

/--
Given a finset `s` of natural numbers and a bound `n`,
`s.fin n` is the finset of all elements of `s` less than `n`.
-/
protected def fin (n : ℕ) (s : finset ℕ) : finset (fin n) :=
(s.subtype _).map fin.equiv_subtype.symm.to_embedding

@[simp] lemma mem_fin {n} {s : finset ℕ} :
  ∀ a : fin n, a ∈ s.fin n ↔ (a : ℕ) ∈ s
| ⟨a, ha⟩ := by simp [finset.fin]

@[mono] lemma fin_mono {n} : monotone (finset.fin n) :=
λ s t h x, by simpa using @h x

@[simp] lemma fin_map {n} {s : finset ℕ} : (s.fin n).map fin.coe_embedding = s.filter (< n) :=
by simp [finset.fin, finset.map_map]

lemma subset_image_iff [decidable_eq β] {s : set α} {t : finset β} {f : α → β}:
  ↑t ⊆ f '' s ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ s'.image f = t :=
begin
  split, swap,
  { rintro ⟨t, ht, rfl⟩, rw [coe_image], exact set.image_subset f ht },
  intro h,
  letI : can_lift β s (f ∘ coe) (λ y, y ∈ f '' s) := ⟨λ y ⟨x, hxt, hy⟩, ⟨⟨x, hxt⟩, hy⟩⟩,
  lift t to finset s using h,
  refine ⟨t.map (embedding.subtype _), map_subtype_subset _, _⟩,
  ext y, simp
end

lemma range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image nat.succ :=
begin
  induction n with k hk,
  { simp },
  nth_rewrite 1 range_succ,
  rw [range_succ, image_insert, ←hk, insert_sdiff_of_not_mem],
  simp
end

end finset

lemma _root_.multiset.to_finset_map [decidable_eq α] [decidable_eq β] (f : α → β) (m : multiset α) :
  (m.map f).to_finset = m.to_finset.image f :=
finset.val_inj.1 (multiset.dedup_map_dedup_eq _ _).symm

namespace equiv

/-- Given an equivalence `α` to `β`, produce an equivalence between `finset α` and `finset β`. -/
protected def finset_congr (e : α ≃ β) : finset α ≃ finset β :=
{ to_fun := λ s, s.map e.to_embedding,
  inv_fun := λ s, s.map e.symm.to_embedding,
  left_inv := λ s, by simp [finset.map_map],
  right_inv := λ s, by simp [finset.map_map] }

@[simp] lemma finset_congr_apply (e : α ≃ β) (s : finset α) :
  e.finset_congr s = s.map e.to_embedding :=
rfl

@[simp] lemma finset_congr_refl : (equiv.refl α).finset_congr = equiv.refl _ := by { ext, simp }
@[simp] lemma finset_congr_symm (e : α ≃ β) : e.finset_congr.symm = e.symm.finset_congr := rfl

@[simp] lemma finset_congr_trans (e : α ≃ β) (e' : β ≃ γ) :
  e.finset_congr.trans (e'.finset_congr) = (e.trans e').finset_congr :=
by { ext, simp [-finset.mem_map, -equiv.trans_to_embedding] }

lemma finset_congr_to_embedding (e : α ≃ β) :
  e.finset_congr.to_embedding = (finset.map_embedding e.to_embedding).to_embedding := rfl

end equiv


/-5 .8 Summary of New Constructs
Lemmas:
  dec_trivial -- decidable truth (e.g., a true closed executable expression)
  funext      -- functional extensionality
  propext     -- propositional extensionality

Tactics:
  generalize -- replaces a term by a fresh variable defined by a new hypothesis
  linarith   -- applies a procedure for linear arithmetic
-/

namespace binary_trees

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

def mirror {α : Type} : btree α → btree α
| btree.empty := btree.empty
| (btree.node (a : α) left right) := btree.node (a : α) (mirror right) (mirror left)

lemma mirror_mirror {α : Type} (t : btree α) :
  mirror (mirror t) = t :=
begin
  induction t with a l r ih_left ih_right,
  case btree.empty { refl },
  case btree.node {
    rw [mirror, mirror, ih_left, ih_right],
  },
end
#print mirror_mirror

lemma mirror_mirror₂ {α : Type} :
  ∀ t : btree α, mirror (mirror t) = t
| btree.empty := rfl
| (btree.node a l r) :=
  calc  mirror (mirror (btree.node a l r))
      = mirror (btree.node a (mirror r) (mirror l)) :
    by refl
  ... = btree.node a (mirror (mirror l)) (mirror (mirror r)) :
    by refl
  ... = btree.node a l (mirror (mirror r)) :
    by rewrite mirror_mirror₂ l
  ... = btree.node a l r :
    begin rewrite mirror_mirror₂ r, end -- another begin .. end syntax example
#print mirror_mirror₂

def singleton {α : Type} (a : α) : btree α :=
  btree.node a btree.empty btree.empty

#check btree.empty -- btree.empty : btree ?M_1
#check @btree.empty -- btree.empty : Π {α : Type}, btree α
#reduce @btree.empty nat -- btree.empty
#check btree.node 3 btree.empty btree.empty -- btree.node 3 btree.empty btree.empty : btree ℕ

example : singleton 3 = btree.node 3 btree.empty btree.empty := rfl

#reduce mirror (btree.node 10 (singleton 1) (singleton 2))
-- btree.node 10 (btree.node 2 btree.empty btree.empty) (btree.node 1 btree.empty btree.empty)

lemma mirror_singleton {α : Type} (a : α) :
  mirror (singleton a) = singleton a := rfl

example {α : Type} (a : α) (b : α) (c : α):
  mirror (btree.node c (singleton a) (singleton b)) = (btree.node c (singleton b) (singleton a)) :=
begin
  -- simp [mirror],
  -- split; rw mirror_singleton, -- OK

  -- rw mirror,
  -- constructor, -- split also works

  refl,
end

/-
A binary tree is full if all its nodes have either zero or two children.
This can be encoded as an inductive predicate as follows:
-/

-- -- version 1
-- inductive is_full {α : Type} : btree α → Prop
-- | empty : is_full btree.empty -- maybe this <=> boolean True? => is_full btree.empty = true
-- | node (a : α) :
--   (btree.node a (is_full btree.empty) (is_full btree.empty)) ∨ _

-- --version 2
-- inductive is_full {α : Type} : btree α → Prop
-- | empty : is_full btree.empty -- maybe this <=> boolean True? => is_full btree.empty = true
-- | node (a : α) :
--   is_full (btree.node a (btree.empty) (btree.empty)) ∨
--   is_full (btree.node a (is_full (btree.node a _ _)) (is_full (btree.node a _ _)))

namespace test

inductive is_full {α : Type} : btree α → Prop
| empty : is_full btree.empty -- maybe this <=> boolean True? => is_full btree.empty = true
| node (a : α) :
  is_full (btree.node a btree.empty btree.empty)

lemma is_full_singleton_test {α : Type} (a : α) :
  is_full (btree.node a btree.empty btree.empty) :=
begin
  -- rw is_full, -- fail
  -- rw is_full.node -- fail
  -- simp [is_full], -- fail

  -- constructor, -- OK
  -- cases is_full, -- fail
  -- by_cases is_full, --fail
  -- cases btree a, --fail
  -- cases is_full.node a, -- Doing nothing but no error
  -- refl, -- fail

  -- apply is_full.node, -- OK
  exact is_full.node a, -- OK
end

end test

-- version 4 -- invalid return type for 'binary_trees.is_full.node'
-- inductive is_full {α : Type} : btree α → Prop
-- | empty : is_full btree.empty
-- | node (a : α) {left : btree α} {right : btree α}
--   (hleft : is_full left) (hright : is_full right)
--   :
--   (is_full (btree.node a btree.empty btree.empty)) ∨
--   (is_full (btree.node a left right))

-- NO ERROR
-- inductive is_full {α : Type} : btree α → Prop
-- | empty : is_full btree.empty
-- | node (a : α) {left right : btree α} :
--   is_full (btree.node a left right)

namespace my_tries

inductive is_full {α : Type} : btree α → Prop
| empty : is_full btree.empty
| node (a : α) {left right : btree α} {l1 r1 l2 r2 : btree α}
  (hzero_or_two_children:
    (left = btree.empty ∧ right = btree.empty) ∨
    (left = (btree.node a l1 r1) ∧ right = (btree.node a l2 r2))
  )
  :
    is_full (btree.node a left right)

lemma is_full_singleton {α : Type} (a : α) :
  is_full (btree.node a btree.empty btree.empty) :=
begin
  constructor,
  simp,
  iterate 4 { exact btree.empty },
end

/-
  A somethat more interesting property of full trees is that fullness
  is preserved by the mirror operation. Our first proof is by rule
  induction on ht : is_full t:
-/
lemma is_full_mirror {α : Type} (t : btree α)
    (ht : is_full t) :
  is_full (mirror t) :=
begin
  induction t with a left right ih_left ih_right,
  case empty {
    rw mirror,
    exact ht,
  },
  case node {
    rw mirror,
    sorry,
  },
end

end my_tries

namespace from_book

-- for example proposition always_true (btree α)
inductive always_true {α : Type} : btree α → Prop
| empty : always_true btree.empty
| node (a : α) : always_true (singleton a)

inductive is_empty {α : Type} : btree α → Prop
| empty : is_empty btree.empty

inductive is_not_empty {α : Type} : btree α → Prop
| node (a : α) : is_not_empty (singleton a)

lemma is_not_empty.def {α : Type} (t : btree α) : is_not_empty t ↔ ¬ is_empty t := sorry

inductive is_full {α : Type} : btree α → Prop
| empty : is_full btree.empty
| node (a : α) (left right : btree α)
    (h_full_left : is_full left) (h_full_right : is_full right)
    (hiff : left = btree.empty ↔ right = btree.empty) :
  is_full (btree.node a left right)

constants {α : Type} (a : α)

lemma is_full_singleton :
  is_full (singleton a) :=
begin
  apply is_full.node _ _ _,
  exact is_full.empty,
  exact is_full.empty,
  refl,
end
#print is_full_singleton
-- is_full.node a btree.empty btree.empty is_full.empty is_full.empty (iff.refl (btree.empty = btree.empty))

lemma is_full_singleton₂ : is_full (singleton a)  :=
    is_full.node -- function <=> rule <=> definition
      _ _ _ is_full.empty is_full.empty (iff.refl _) -- arguments <=> goals
-- first 3 solve automatically, but last 3 solve by human

lemma mirror_eq_empty_iff {α : Type} (l r : btree α):
  (l = btree.empty ↔ r = btree.empty) →
  (mirror r = btree.empty ↔ mirror l = btree.empty) := sorry

-- proof by rule induction on ht : is_full t:
lemma is_full_mirror {α : Type} (t : btree α)
    (ht : is_full t) :
  is_full (mirror t) :=
begin
  induction ht,
  case is_full.empty {
    -- rw mirror,
    exact is_full.empty,
  },
  case is_full.node : a l r hl hr hiff ih_l ih_r {
    rewrite mirror,
    apply is_full.node,
    { exact ih_r },
    { exact ih_l },
    {
      -- simp [mirror_eq_empty_iff],
      sorry,
    },
  },
end

-- proof by structural induction on the tree t:
lemma is_full_mirror₂ {α : Type} :
  ∀ t : btree α, is_full t → is_full (mirror t)
| btree.empty := id
  -- begin
    -- assume ht : is_full btree.empty, <=> intro ht,
    -- exact ht,
    -- <=>
    -- exact id, -- <=> exact (λ ht, ht),
  -- end
| (btree.node a l r) :=
  begin
    intro ht,
    cases ht with _ _ _ hl hr hiff,
    rewrite mirror,

    -- α : Type,
    -- is_full_mirror₂ : ∀ (t : btree α), is_full t → is_full (mirror t),
    -- a : α,
    -- l r : btree α,
    -- hl hr : is_full l,
    -- hiff : l = btree.empty ↔ r = btree.empty
    -- ⊢ is_full (btree.node a (mirror r) (mirror l))
    apply is_full.node,
    {
      apply is_full_mirror₂, -- backward proof: goal changed from "is_full (mirror t)" to "is_full t"
      exact hr,
    },
    { exact is_full_mirror₂ _ hl }, -- same proof as in previous goal
    {
      -- simp [mirror_eq_empty_iff, *],
      sorry,
    },
  end

example : ¬ is_empty (singleton a) :=
begin
  -- assume h : is_empty (singleton a),
  -- type_check is_empty.empty,
  -- cases (singleton a) with a left right,
  -- induction a with a left right,
  by_contra h₁,
  have h₂ := @is_empty.empty α,
  -- type_check @is_empty α,
  -- prove with using axiom `is_not_empty.def`
  sorry,
end

lemma singleton_is_not_empty : ¬ is_empty (singleton a) := by {
  rw ←is_not_empty.def,
  exact is_not_empty.node a,
}

#print singleton_is_not_empty

lemma empty_is_empty: is_empty (@btree.empty α) := is_empty.empty

end from_book

-- When is_full function is undefined, proof of 1 = 1 using
-- is_full_singleton lemma works:
-- example : 1 = 1 :=
-- begin
--   have h := is_full_singleton btree.empty _,
--   refl,
--   exact nat,
-- end

end binary_trees


import prelim.embed prelim.minmax set_tactic.solver
import matroid.rankfun matroid.dual

open_locale classical
noncomputable theory

universes u v w

open matroid set

variables {α β α₁ α₂ α₃: Type*}
[fintype α] [fintype β]
[fintype α₁] [fintype α₂] [fintype α₃]

/-- a matroid_in α corresponds to a matroid defined on some subset E of α.
Implemented as a matroid on which the nonelements of E are all loops. -/

structure matroid_in (α : Type*)[fintype α] :=
(E : set α)
(carrier : matroid α)
(support : carrier.r Eᶜ = 0)

namespace matroid_in

/-- the rank of a set X wrt a matroid_in α. Elements of X outside the E of α are ignored -/
def r (M : matroid_in α) (X : set α) := M.carrier.r X

lemma r_carrier_eq_r (M : matroid_in α) (X : set α) :
  M.carrier.r X = M.r X :=
rfl

lemma r_eq_r_inter (M : matroid_in α) (X : set α) :
  M.r X = M.r (X ∩ M.E) :=
begin
  nth_rewrite 0 ←(inter_union_compl X M.E),
  apply rank_eq_rank_union_rank_zero,
  exact rank_zero_of_inter_rank_zero _ M.support,
end

lemma r_eq_inter_r (M : matroid_in α) (X : set α) :
  M.r X = M.r (M.E ∩ X) :=
by rw [r_eq_r_inter, inter_comm]

lemma ext' {M M' : matroid_in α} (h : M.E = M'.E) (h' : M.carrier = M'.carrier) :
  M = M' :=
by {cases M, cases M', dsimp only at *, induction h', induction h, refl,}

@[ext] lemma ext {M₁ M₂ : matroid_in α} (h_ground : M₁.E = M₂.E) (h_r : ∀ X ⊆ M₁.E, M₁.r X = M₂.r X) :
  M₁ = M₂ :=
begin
  apply ext' h_ground, ext X,
  specialize h_r (X ∩ M₁.E) (by simp),
  rw (by simp : X = (X ∩ M₁.E) ∪ (X ∩ M₁.Eᶜ)),
  have h₁ := matroid.rank_zero_of_inter_rank_zero X M₁.support,
  have h₂ := matroid.rank_zero_of_inter_rank_zero X M₂.support, rw ←h_ground at h₂,
  rw [matroid.rank_eq_rank_union_rank_zero (X ∩ M₁.E) h₁, matroid.rank_eq_rank_union_rank_zero (X ∩ M₁.E) h₂],
  exact h_r,
end

/-- a matroid_in α gives a matroid on a subtype -/
def as_mat_on (M : matroid_in α) (E : set α) : matroid E :=
{ r := λ X, M.r X,
  R0 := λ X, M.carrier.R0 _,
  R1 := λ X, by {dsimp only [r], rw ←size_subtype_image, apply M.carrier.R1},
  R2 := λ X Y hXY, by {apply M.carrier.R2, apply set.image_subset _ hXY, },
  R3 := λ X Y, by {dsimp only, convert M.carrier.R3 _ _, apply set.image_union,
                   exact (set.image_inter subtype.val_injective).symm} }

/-- a matroid_in α, viewed as a matroid on the subtype defined by its E -/
def as_mat (M : matroid_in α) : matroid M.E := as_mat_on M M.E

mk_simp_attribute msimp "minor simp lemmas"

--attribute [msimp] diff_eq

@[simp, msimp] lemma as_mat_r (M : matroid_in α) (X : set (M.E)) :
  M.as_mat.r X = M.r (X : set α) :=
rfl

/-- a matroid_in α, constructed from a matroid on a subtype of α -/
def of_mat {E : set α} (N : matroid E) : matroid_in α :=
{ E := E,
  carrier :=
  { r := λ X, N.r (inter_subtype E X ),
    R0 := λ X, N.R0 _,
    R1 := λ X, by {refine le_trans (N.R1 _) (eq.trans_le _ (size_mono_inter_right E X)),
                  rw inter_comm, apply sizNE_inter_subtype },
    R2 := λ X Y hXY, by {dsimp only, apply N.R2, tauto,  },
    R3 := λ X Y, N.R3 _ _, },
  support := by {simp [inter_subtype],} }

@[simp, msimp] lemma of_mat_E {E : set α} (N : matroid E) :
  (of_mat N).E = E :=
rfl

@[simp, msimp] lemma of_mat_r {E : set α} (N : matroid E) (X : set α) :
  (of_mat N).r X = N.r (inter_subtype E X) :=
rfl

lemma r_of_mat {E : set α} (N : matroid E) (X : set E) :
  N.r X = (of_mat N).r X :=
begin
  simp only [matroid_in.of_mat_r], convert rfl,
  unfold inter_subtype, ext x , --rcases x with ⟨x,hx⟩,
  simp only [set.mem_preimage],
  tidy,
end

@[simp,msimp] lemma as_mat_of_mat {E : set α} (N : matroid E) :
  as_mat (of_mat N) = N :=
begin
  ext X, dsimp only [as_mat, as_mat_on, of_mat], convert rfl, ext x,
  suffices: x ∈ X ↔ x.val ∈ subtype.val '' X, from this,
  simp only [image_congr, mem_image, exists_eq_right, subtype.exists, subtype.val_eq_coe],
  refine ⟨λ h, by {cases x, tauto}, λ h, _⟩,
  cases x with x hx, rcases h with ⟨y,z, h⟩, convert h.1, convert h.2.symm,
end

@[simp,msimp] lemma of_mat_as_mat (M : matroid_in α) :
  of_mat (as_mat M) = M :=
ext (by simp) (λ X hX, by {simp only with msimp coe_up at *, congr', exact subset_iff_inter_eq_left.mp hX})

lemma of_mat_as_mat_on {E E' : set α} (N : matroid E) (h : E' = E) :
   of_mat ((of_mat N).as_mat_on E') = of_mat N :=
begin
  ext : 1, convert rfl,
  intros X hX,
  simp only [of_mat, as_mat_on],
  convert rfl, exact h.symm,
  ext Y, unfold r, dsimp only, congr' 1,
  simp [h] with coe_up,
end

lemma of_mat_inj {R : set α} (N N' : matroid R) :
  of_mat N = of_mat N' → N = N' :=
λ h, by {ext, rw [r_of_mat,r_of_mat,h]}

def as_matroid_in (M : matroid α) : matroid_in α := ⟨univ, M, by simp⟩

instance coe_to_matroid_in : has_coe (matroid α) (matroid_in α) := ⟨λ M, as_matroid_in M⟩

@[simp, msimp] lemma as_matroid_in_E (M : matroid α) :
  (as_matroid_in M).E = univ
:= rfl

@[simp, msimp] lemma coe_to_as_matroid_in_E (M : matroid α) :
  (M : matroid_in α).E = univ
:= rfl

@[simp, msimp] lemma as_matroid_in_r (M : matroid α) (X : set α) :
  (as_matroid_in M).r X = M.r X
:= rfl

@[simp, msimp] lemma coe_r (M : matroid α) (X : set α) :
  (M : matroid_in α).r X = M.r X
:= rfl

@[simp, msimp] lemma coe_E (M : matroid α) :
  (M : matroid_in α).E = univ :=
rfl

section defs

/-- translates a property of sets defined on (matroid β) to the corresponding
set property on (matroid_in α). -/
def lift_mat_set_property
(P : Π {β : Type*} [fintype β], matroid β → set β → Prop) :
  (matroid_in α → set α → Prop) :=
  λ M, (λ X, X ⊆ M.E ∧ (P M.as_mat) (inter_subtype M.E X))

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

def is_indep [f : fintype α] (M : matroid_in α) (X : set α) : Prop :=
  (lift_mat_set_property (@matroid.is_indep)) M X

lemma indep_iff_r (M : matroid_in α) (X : set α) :
  is_indep M X ↔ M.r X = size X :=
begin
  rw [is_indep, lift_mat_set_property], dsimp only, rw [matroid.indep_iff_r],
  simp only with coe_up msimp,
  refine ⟨λ h, _, λ h, _⟩,
  { rw subset_iff_inter_eq_left at h, rw ←h.1, exact h.2},
  suffices h' : X ⊆ M.E, refine ⟨h', by {rwa[subset_iff_inter_eq_left.mp h'],}⟩,
  rw r_eq_r_inter at h,
  have h' := M.carrier.rank_le_size (X ∩ M.E),
  rw [r_carrier_eq_r, h] at h',
  rw [subset_iff_inter_eq_left, eq_of_le_size_subset _ h'],
  apply inter_subset_left,
end

lemma indep_iff_carrier {M : matroid_in α} {X : set α} :
  M.is_indep X ↔ M.carrier.is_indep X :=
by rw [indep_iff_r, matroid.indep_iff_r, r_carrier_eq_r]

lemma indep_iff_subtype {M : matroid_in α} {X : set α} :
  M.is_indep X ↔ X ⊆ M.E ∧ M.as_mat.is_indep (inter_subtype M.E X) :=
by rw [is_indep, lift_mat_set_property]

@[simp, msimp] lemma indep_iff_coe {M : matroid α} {X : set α} :
  (M : matroid_in α).is_indep X ↔ M.is_indep X :=
by {rw [matroid_in.indep_iff_r, matroid.indep_iff_r], simp,  }

def is_circuit (M : matroid_in α) (C : set α) :=
  (lift_mat_set_property (@matroid.is_circuit)) M C

lemma circuit_iff_r {M : matroid_in α} {C : set α} :
  M.is_circuit C ↔ M.r C = size C - 1 ∧ (∀ Y, Y ⊂ C → M.r Y = size Y) ∧ C ⊆ M.E :=
begin
  simp_rw [is_circuit, lift_mat_set_property, matroid.circuit_iff_r],
  simp only with coe_up msimp,
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with ⟨h, h', h''⟩,
    rwa subset_iff_inter_eq_left.mp h at h',
    refine ⟨h', (λ Y hY, _), h⟩,
    have hYE : Y ∩ M.E = Y := subset_iff_inter_eq_left.mp (subset.trans hY.1 h),
    rw subset_iff_inter_eq_left at h,
    specialize h'' (inter_subtype _ Y) _, swap,
    { simp only with coe_up at h'',
      convert h'';
      exact hYE.symm, },
    simpa only [h,hYE] with coe_up, },
  rcases h with ⟨h,h',h''⟩,
  refine ⟨h'', _,λ Y hY, _⟩,
  { convert h; rwa subset_iff_inter_eq_left.mp h'', },
  apply h',
  refine subset.lt_of_lt_of_le hY (inter_subset_left _ _),
end

lemma circuit_iff_carrier {M : matroid_in α} {C : set α} :
  M.is_circuit C ↔ M.carrier.is_circuit C ∧ C ⊆ M.E :=
by {simp_rw [circuit_iff_r, matroid.circuit_iff_r, r_carrier_eq_r], tauto}

lemma circuit_iff_subtype {M : matroid_in α} {X : set α} :
  M.is_circuit X ↔ X ⊆ M.E ∧ M.as_mat.is_circuit (inter_subtype M.E X) :=
by rw [is_circuit, lift_mat_set_property]

def dual (M : matroid_in α) : matroid_in α :=
  of_mat (as_mat M).dual

@[simp, msimp] lemma dual_r (M : matroid_in α) (X : set α) :
  (dual M).r X = size (X ∩ M.E) + M.r (M.E \ X) - M.r M.E  :=
begin
  rw [dual, of_mat_r, matroid.dual_r], simp only with coe_up, convert rfl,
  simp only with coe_up,
  ext,simp only [diff_eq, mem_inter_eq, mem_compl_eq], tauto,
  simp only with coe_up,
end

lemma of_mat_dual {E : set α} (M : matroid E) :
  of_mat M.dual = (of_mat M).dual :=
by {unfold dual, convert rfl, simp}

@[simp, msimp] lemma dual_ground (M : matroid_in α) :
  (dual M).E = M.E :=
rfl

@[simp, msimp] lemma dual_dual (M : matroid_in α) :
  M.dual.dual = M :=
by {simp_rw [dual,of_mat_dual, as_mat_of_mat, ←of_mat_dual, matroid.dual_dual, of_mat_as_mat]}

lemma dual_inj {M M' : matroid_in α} (h : M.dual = M'.dual) :
  M = M' :=
by rw [←dual_dual M, ←dual_dual M',h]

lemma dual_inj_iff {M M' : matroid_in α} :
  M = M' ↔ M.dual = M'.dual :=
⟨λ h, by {rw h}, λ h, dual_inj h⟩

lemma coindep_iff_r {M : matroid_in α} {X : set α} :
  M.dual.is_indep X ↔ X ⊆ M.E ∧ M.r (M.E \ X) = M.r M.E :=
begin
  simp_rw [indep_iff_r, dual_r, ←r_carrier_eq_r, diff_eq, subset_iff_inter_eq_left],
  refine ⟨λ h, _, λ h, _⟩,
  { have h1 := size_mono_inter_left X M.E,
    have h2 := M.carrier.rank_mono_inter_left M.E Xᶜ,
    refine ⟨eq_of_eq_size_subset (inter_subset_left _ _) (by linarith) , by linarith⟩},
  rw [h.1, h.2], simp,
end

end defs

section isom

/-- isomorphism between two matroid_in. -/
def isom (M : matroid_in α) (N : matroid_in β) :=
  matroid.isom M.as_mat N.as_mat

def isom_equiv {M₁ M₂ : matroid_in α} {N₁ N₂ : matroid_in β} (hM : M₁ = M₂) (hN : N₁ = N₂) (i : isom M₁ N₁) :
  isom M₂ N₂ :=
{
  equiv := ((equiv.set.of_eq (by rw hM : M₂.E = M₁.E)).trans i.equiv).trans (equiv.set.of_eq (by rw hN : N₁.E = N₂.E)),
  on_rank := λ X, by {subst hM, subst hN, rw ←i.on_rank, congr, ext, simp,  }
}

/-- there exists an isomorphism between two matroid_in -/
def is_isom (M : matroid_in α) (N : matroid_in β) :=
  nonempty (M.isom N)

/-- isomorphism from a matroid_in to a matroid -/
def isom_to_matroid (M : matroid_in α) (N : matroid β) :=
  matroid.isom M.as_mat N

/-- there exists an isomorphism from a matroid_in to a matroid -/
def is_isom_to_matroid (M : matroid_in α) (N : matroid β) :=
  nonempty (M.isom_to_matroid N)

/-- converts an isomorphism between (M : matroid_in) and (N : matroid) to one between
(M : matroid_in) and (↑N : matroid_in) -/
def isom_of_isom_to_matroid {M : matroid_in α} {N : matroid β} (i : isom_to_matroid M N) :
  isom M (N : matroid_in β) :=
⟨ i.equiv.trans ((equiv.set.univ β).symm.trans (equiv.set.of_eq (coe_E N).symm)),
  λ X, by {rw [←i.on_rank X, as_mat_r, coe_r], congr', unfold_coes, ext, simp}⟩

/-- converts an isomorphism between (M : matroid_in) and (↑N : matroid_in) to one between
(M : matroid_in) and (N : matroid) -/
def isom_to_matroid_of_isom {M : matroid_in α} {N : matroid β} (i : isom M (N : matroid_in β)) :
  isom_to_matroid M N :=
⟨ i.equiv.trans ((equiv.set.of_eq (coe_E N)).trans (equiv.set.univ β)),
  λ X, begin
    rw [←i.on_rank X, as_mat_r, coe_r], congr' 1,
    unfold_coes, ext,
    simp only [mem_image, equiv.to_fun_as_coe, equiv.set.of_eq_apply, set_coe.exists,
    mem_univ, function.comp_app, exists_eq_right, exists_prop_of_true, equiv.coe_trans,
    subtype.coe_eta, equiv.set.univ_apply, subtype.coe_mk, coe_E],
    split;
    {rintros ⟨x,hx,⟨hxX, h'⟩⟩, refine ⟨x,hx,hxX,_⟩, try {rw h', simp}, try {rw ←h', simp},},
  end ⟩

lemma is_isom_to_matroid_iff_is_isom_to_coe {M : matroid_in α} {N : matroid β} :
  is_isom_to_matroid M N ↔ is_isom M (N : matroid_in β) :=
begin
  split,
  rintros ⟨i⟩, exact ⟨isom_of_isom_to_matroid i⟩,
  rintros ⟨i⟩, exact ⟨isom_to_matroid_of_isom i⟩,
end

/-- for (M : matroid α), gives an matroid_in isomorphism from of_mat M to M -/
def coe_isom (M : matroid α) :
isom_to_matroid (M : matroid_in α) M :=
{ equiv := equiv.subtype_univ_equiv (by tauto),
  on_rank := λ X, by {apply congr_arg, ext, exact iff.rfl, } }

/-- for (M : matroid α), gives a matroid_in isomorphism from M to (M.as_mat : matroid_in M.E)-/
def as_mat_isom (M : matroid_in α) : isom M (M.as_mat : matroid_in M.E) :=
{ equiv := (equiv.set.univ M.E).symm.trans (equiv.set.of_eq (coe_E M.as_mat).symm),
  on_rank := λ X,  begin
    simp only [as_mat_r, coe_r,subtype.coe_mk,coe_E],
    congr, unfold_coes, ext, cases x with x hx,
    simp only [mem_image, equiv.to_fun_as_coe, equiv.set.of_eq_apply, set_coe.exists,
    exists_and_distrib_right, mem_univ, equiv.set.univ_symm_apply, function.comp_app,
    subtype.mk_eq_mk, exists_eq_right, exists_prop_of_true, equiv.coe_trans,  subtype.coe_mk,
    coe_E, subtype.val_eq_coe],
    tauto,
end}

/-- N is isomorphic to a matroid_in of M iff there is a suitable injection from N to M.
Yuck!  -/
lemma isom_to_matroid_iff_exists_embedding {M : matroid_in α} {N : matroid β} :
  M.is_isom_to_matroid N ↔ ∃ φ : β ↪ α, range φ = M.E ∧ ∀ X, N.r X = M.r (φ '' X) :=
begin
  split,
  begin
    rintros ⟨⟨eqv, hr⟩⟩,
    refine ⟨ eqv.symm.to_embedding.trans (function.embedding.subtype _),⟨_,λ X, _⟩⟩,
    { ext,
      simp only [equiv.to_embedding_apply, function.embedding.coe_subtype,
        function.embedding.trans_apply, mem_range],
      split, { rintros ⟨y,rfl⟩, cases (eqv.symm y), tauto, },
      exact λ hx, ⟨eqv ⟨x,hx⟩, by simp⟩,},
    specialize hr (eqv ⁻¹' X), simp only [equiv.image_preimage, matroid_in.as_mat_r] at hr,
    rw hr, congr', unfold_coes, ext,
    simp only [mem_image, equiv.to_fun_as_coe, equiv.to_embedding_apply, function.embedding.coe_subtype,
      set_coe.exists, function.embedding.trans_apply, exists_and_distrib_right,
      function.embedding.to_fun_eq_coe, exists_eq_right, mem_preimage, subtype.coe_mk],
    split, { rintros ⟨hx,h'⟩, refine ⟨_,h',_⟩, simp,  },
    rintros ⟨y, hyX, rfl⟩,
    refine ⟨_,_⟩, swap, convert hyX, simp,
    exact ((eqv.symm) y).property,
  end,
  rintros ⟨φ, hrange, hr⟩,
  set E := set.range φ with hE,

  set eqv : M.E ≃ β :=
    (equiv.trans (equiv.set.range φ φ.inj') (equiv.set.of_eq hrange)).symm with heqv,

  refine nonempty.intro ⟨eqv, λ X, _⟩,
  simp only [hr, heqv] with msimp, congr' 1,
  ext,  simp only [mem_image, equiv.symm_trans_apply, set_coe.exists,
  equiv.set.of_eq_symm_apply, subtype.coe_mk],
  split,
  { rintro ⟨y, ⟨x, hx, hxX', rfl⟩, rfl⟩,
    rw equiv.set.apply_range_symm φ φ.inj',
    unfold_coes, simp, refine ⟨hx,hxX'⟩,  },
  --refine λ h'', _,
  unfold_coes, simp only [mem_image, equiv.to_fun_as_coe, set_coe.exists, exists_and_distrib_right,
  function.embedding.to_fun_eq_coe, exists_eq_right, subtype.coe_mk, exists_imp_distrib],
  refine λ hx hxX', ⟨eqv ⟨x,hx⟩,⟨⟨x,hx,⟨hxX',_⟩⟩,_⟩⟩,
  all_goals {simp [heqv, equiv.set.apply_range_symm φ φ.inj']},
end

lemma isom_to_coe_iff_exists_embedding {M : matroid_in α} {N : matroid β} :
  M.is_isom (N : matroid_in β) ↔ ∃ φ : β ↪ α, range φ = M.E ∧ ∀ X, N.r X = M.r (φ '' X) :=
by rw [←isom_to_matroid_iff_exists_embedding, is_isom_to_matroid_iff_is_isom_to_coe]

end isom

end matroid_in