import prelim.collections prelim.embed prelim.size prelim.induction prelim.minmax prelim.presetoid
import .rankfun matroid.submatroid.minor_iso matroid.submatroid.projection

noncomputable theory
open_locale classical

universes u v w

open set
namespace matroid

variables {α : Type*} {β : Type*} [fintype α] [fintype β]
{M : matroid α} {e f g : α} {X Y P : set α}

/-- relation of being both nonloops and having a rank-one union. Irreflexive at loops;
    an equivalence relation when restricted to nonloops -/
def parallel (M : matroid α) (e f : α) : Prop :=
  M.is_nonloop e ∧ M.is_nonloop f ∧ M.r {e,f} = 1

lemma parallel.nonloop_left (h : M.parallel e f) : M.is_nonloop e :=
h.1

lemma parallel.nonloop_right (h : M.parallel e f) : M.is_nonloop f :=
h.2.1

lemma parallel_of_rank_le_one
(he : M.is_nonloop e) (hf : M.is_nonloop f) (hef : M.r {e,f} ≤ 1) :
  M.parallel e f :=
begin
  refine ⟨he, hf, _⟩,
  rw [← he.r, eq_comm],
  apply rank_eq_of_le_supset,
    apply singleton_subset_pair_left,
  convert hef,
end

lemma rank_parallel_pair (hef : M.parallel e f) : M.r {e,f} = 1 :=
hef.2.2

lemma rank_one_of_mem_parallel_pair (hef : M.parallel e f) : M.r {e} = 1 :=
rank_nonloop hef.1

lemma rank_two_of_not_parallel (he : M.is_nonloop e)(hf : M.is_nonloop f)( h : ¬ M.parallel e f):
  M.r {e,f} = 2 :=
begin
  refine le_antisymm (le_trans (M.rank_le_size {e,f}) (size_pair_ub _ _)) _,
  by_contra hn, push_neg at hn,
  exact h (parallel_of_rank_le_one he hf (int.le_sub_one_of_lt hn)),
end

lemma rank_eq_rank_parallel_ext (he : e ∈ X) (hef : M.parallel e f) :
  M.r (insert f X) = M.r X :=
begin
  convert (rank_eq_of_union_eq_rank_subset X
    (singleton_subset_pair_left e f)
    (by rw [rank_parallel_pair hef, rank_one_of_mem_parallel_pair hef])).symm,
  { rw [pair_comm, pair_eq_union, union_assoc, ← union_singleton, union_comm],
    convert rfl,
    rw [union_comm, union_singleton, insert_eq_of_mem he], },
  rw [union_comm, union_singleton, insert_eq_of_mem he],
end

lemma rank_eq_rank_of_parallel_ext (hXY : X ⊆ Y)
(hY : ∀ y : Y, M.is_nonloop y → ∃ x : X, M.parallel x y) :
M.r X = M.r Y :=
begin
  refine rank_eq_of_rank_all_insert_eq hXY (λ y, _),
  rcases M.loop_or_nonloop y with (hy | hy), rw rank_eq_rank_insert_loop _ hy,
  obtain ⟨⟨x,hx⟩, ⟨hxnl,hznl,hr⟩⟩ := hY y hy,
  dsimp only [subtype.coe_mk] at *, rw nonloop_iff_r at *,
  have hr' := rank_eq_of_union_eq_rank_subset X (singleton_subset_pair_left x y) (by rw [hr, hxnl]),
  rw [subset_iff_union_eq_left.mp (singleton_subset_iff.mpr hx)] at hr',
  rw [hr', eq_comm, union_comm],
  apply rank_eq_of_union_eq_rank_subset,
    apply singleton_subset_pair_right,
  rw [hznl, hr],
end

lemma is_nonloop.parallel_refl (h : M.is_nonloop e) : M.parallel e e :=
⟨h,h,by rwa [pair_eq_singleton]⟩

lemma parallel_refl_of_parallel (h : M.parallel e f) : M.parallel e e :=
h.nonloop_left.parallel_refl

lemma is_loop.parallel_irrefl (h : M.is_loop e) : ¬M.parallel e e :=
λ h', (loop_iff_not_nonloop.mp h) h'.1

lemma parallel_refl_iff_nonloop :
  M.parallel e e ↔ M.is_nonloop e :=
⟨λ h, nonloop_iff_not_loop.mpr
  (λ hl, (is_loop.parallel_irrefl hl) h),
  λ h, is_nonloop.parallel_refl h⟩

lemma parallel_irrefl_iff_loop :
  ¬M.parallel e e ↔ M.is_loop e :=
by rw [loop_iff_not_nonloop, not_iff_not, parallel_refl_iff_nonloop]

lemma parallel_iff_dep (he : M.is_nonloop e) (hf : M.is_nonloop f) :
  M.parallel e f ↔ (e = f) ∨ M.is_dep {e,f} :=
begin
  split,
  { rintros ⟨-,-,hef⟩,
    by_contra hn, push_neg at hn, cases hn with hne hef',
    rw [←indep_iff_not_dep, indep_iff_r, hef, size_pair hne] at hef',
    norm_num at hef', },
  rintros (heq | hef), rw heq, exact hf.parallel_refl,
  rw [dep_iff_r, ←int.le_sub_one_iff] at hef,
  refine ⟨he,hf,_⟩,
  linarith [nonloop_iff_r.mp he, M.rank_mono (by tidy: {e} ⊆ {e,f}), size_pair_ub e f],
end

lemma parallel_iff_cct {M: matroid α} (he : M.is_nonloop e) (hf : M.is_nonloop f) :
  M.parallel e f ↔ (e = f ∨ M.is_circuit {e,f}) :=
begin
  rw parallel_iff_dep he hf, split,
  { rintros (heq | hdep), left, assumption, right,
    rw circuit_iff_i,
    refine ⟨dep_iff_not_indep.mp hdep, λ Y hY, _⟩,
    rcases ssubset_pair hY with (rfl | rfl | rfl), apply M.empty_indep,
    all_goals {rwa ←nonloop_iff_indep}, },
  rintros (heq | hef), left, assumption, right,
  apply circuit_dep hef,
end

lemma parallel_of_nonloop_dep
(he : M.is_nonloop e) (hf : M.is_nonloop f) (h : M.is_dep {e,f}) :
  M.parallel e f :=
by {rw parallel_iff_dep he hf,right, assumption,  }

lemma parallel_of_circuit (hef : e ≠ f) (h : M.is_circuit {e,f}) :
  M.parallel e f :=
begin
  rw parallel_iff_cct, right, assumption, all_goals
  { rw [nonloop_iff_not_loop, loop_iff_circuit], by_contra hn,
    apply circuit_not_ssubset_circuit hn h,},
  apply singleton_ssubset_pair_left hef,
  apply singleton_ssubset_pair_right hef,
end

lemma parallel_trans (M : matroid α) :
  transitive M.parallel :=
begin
  rintros e f g ⟨he,hf,hef⟩ ⟨-,hg,hfg⟩,
  have := M.rank_submod ({e,f}) ({f,g}),
  rw [hef, hfg] at this,
  have h1 : 1 ≤ M.r (({e,f}) ∩ ({f,g})),
  {rw ←rank_nonloop hf, refine M.rank_mono (subset_inter _ _ ); simp, },
  have h2 := M.rank_mono (_ : ({e,g} : set α)  ⊆ {e,f} ∪ {f,g}), swap,
  { intro x, simp, tauto,  },
  apply parallel_of_rank_le_one he hg,
  linarith,
end

lemma parallel.trans {M : matroid α}(h : M.parallel e f)(h' : M.parallel f g):
  M.parallel e g :=
parallel_trans M h h'

lemma parallel_symm (M : matroid α) :
  symmetric M.parallel :=
by {rintros e f ⟨he,hf,hef⟩, refine ⟨hf,he,_⟩, rwa pair_comm}

lemma parallel.symm {M : matroid α}(h : M.parallel e f):
  M.parallel f e :=
parallel_symm M h

/-- the presetoid given by α and the parallel relation. Equivalence classes are the
parallel classes of M, and the kernel is the set of loops of M -/
def ps (M : matroid α) : presetoid α :=
⟨M.parallel, M.parallel_trans, M.parallel_symm ⟩

lemma ps_rel_eq_parallel :
  M.ps.rel = M.parallel :=
rfl

lemma ps_kernel_eq_loops (M : matroid α) :
  M.ps.kernel = M.loops :=
by {ext, rw [presetoid.mem_kernel_iff, ← loop_iff_mem_loops, ← parallel_irrefl_iff_loop], refl}

@[symm] lemma parallel_symm' (hef : M.parallel e f) :
  M.parallel f e :=
@presetoid.symm _ _ _ M.ps hef

lemma parallel_comm :
  M.parallel e f ↔ M.parallel f e :=
@presetoid.rel_comm _ _ _ M.ps

@[trans] lemma parallel_trans' {e f g : α} (hef : M.parallel e f) (hfg : M.parallel f g) :
  M.parallel e g :=
@presetoid.trans _ _ _ _ M.ps hef hfg

/-- the parallel class containing e. Empty if e is a loop -/
def parallel_cl (M : matroid α) (e : α) : set α :=
  M.ps.cl e

lemma parallel_cl_loop_empty (he : M.is_loop e) :
  M.parallel_cl e = ∅ :=
by {rw [parallel_cl, presetoid.cl_eq_empty_iff], rwa ← parallel_irrefl_iff_loop at he }

lemma mem_parallel_cl :
  e ∈ M.parallel_cl f ↔ M.parallel e f :=
@presetoid.mem_cl_iff _ _ _ _

lemma parallel_cl_nonempty_of_nonloop (he : M.is_nonloop e) :
  (M.parallel_cl e).nonempty :=
⟨e, by rwa [mem_parallel_cl, parallel_refl_iff_nonloop]⟩

lemma parallel_cl_eq_empty_iff_loop :
  M.parallel_cl e = ∅ ↔ M.is_loop e :=
by {rw [parallel_cl, presetoid.cl_eq_empty_iff, ← parallel_irrefl_iff_loop], refl}

lemma parallel_cl_nonempty_iff_nonloop :
  (M.parallel_cl e).nonempty ↔ M.is_nonloop e:=
⟨ λ h, by {rw [parallel_cl, presetoid.cl_nonempty_iff] at h, rwa ← parallel_refl_iff_nonloop, },
  λ h, parallel_cl_nonempty_of_nonloop h⟩

def is_parallel_class (M : matroid α) (P : set α)  :=
  M.ps.is_class P

lemma parallel_class_iff_is_parallel_cl :
  M.is_parallel_class P ↔ (∃ a, M.is_nonloop a ∧ P = M.parallel_cl a) :=
by {simp_rw [is_parallel_class, presetoid.is_class_iff_rep, ← parallel_refl_iff_nonloop], refl}

lemma rep_parallel_class (hP : M.is_parallel_class P) :
  (∃ a, M.is_nonloop a ∧ P = M.parallel_cl a) :=
by rwa ← parallel_class_iff_is_parallel_cl

lemma parallel_cl_is_parallel_class (he : M.is_nonloop e) :
  M.is_parallel_class (M.parallel_cl e) :=
presetoid.cl_is_class (parallel_refl_iff_nonloop.mpr he)

/-- the property that X ⊆ Y, up to parallel -/
def parallel_covered (M : matroid α) (X Y : set α) :=
  ∀ x ∈ X, M.is_nonloop x → ∃ y ∈ Y, M.parallel x y

lemma parallel_covered_of_insert (h : M.parallel e f) (heX : e ∈ X):
  M.parallel_covered (insert f X) X :=
begin
  intros x hx hx',
  rcases mem_insert_iff.mp hx with (rfl | he),
  { exact ⟨e, heX, h.symm⟩, },
  exact ⟨x, he, hx'.parallel_refl⟩,
end

lemma parallel_covered_apply (hXY : M.parallel_covered X Y) (heX : e ∈ X) (he : M.is_nonloop e) :
  ∃ y ∈ Y, M.parallel e y :=
hXY e heX he

lemma rank_le_rank_of_parallel_covered (h : M.parallel_covered X Y) :
  M.r X ≤ M.r Y :=
begin
  by_contra hn, push_neg at hn,
  obtain ⟨e, heX, henl, hr⟩ := rank_augment_nonloop hn,
  obtain ⟨f, hfY, hef⟩ := parallel_covered_apply h heX henl,
  have h':= rank_eq_rank_parallel_ext hfY (parallel_symm' hef),
  rw [union_singleton, h'] at hr,
  exact lt_irrefl _ hr,
end

lemma rank_eq_rank_of_parallel_covered (h₁ : M.parallel_covered X Y) (h₂ : M.parallel_covered Y X) :
  M.r X = M.r Y :=
by {apply le_antisymm; exact rank_le_rank_of_parallel_covered (by assumption), }

lemma rank_eq_rank_loopify_parallel (h : M.parallel e f) (hef : e ≠ f):
  (M ⟍ {f}).r univ = M.r univ :=
begin
  rw loopify_r,
  refine le_antisymm (rank_mono _ (subset_univ _)) (rank_le_rank_of_parallel_covered _),
  rintros x - hx,
  rcases em (x = f) with (rfl | hx'),
  { exact ⟨e, by simpa, h.symm⟩, },
  exact ⟨x, by simpa, hx.parallel_refl⟩,
end

lemma mem_flat_of_parallel {F : set α} (hF : M.is_flat F) (h : M.parallel e f) (he : e ∈ F) :
  f ∈ F :=
begin
  simp_rw [flat_iff_add_r, union_singleton] at hF,
  by_contra hn, specialize hF f hn,
  rw rank_eq_rank_parallel_ext he h at hF,
  exact lt_irrefl _ hF,
end

def parallel_class (M : matroid α) := {X : set α // M.is_parallel_class X}

def parallel_class_of (e : α) (he : M.is_nonloop e) : M.parallel_class :=
⟨M.parallel_cl e, parallel_class_iff_is_parallel_cl.mpr ⟨e,he,rfl⟩⟩

def parallel_class_of' (e : M.nonloop) : M.parallel_class :=
  parallel_class_of e.1 e.2

@[simp] lemma parallel_class_of'_eq (e : M.nonloop) :
  parallel_class_of' e = ⟨M.parallel_cl e, parallel_class_iff_is_parallel_cl.mpr ⟨e,e.2,rfl⟩⟩ :=
rfl

lemma parallel_cl_eq_of_parallel (hef : M.parallel e f) :
   M.parallel_cl e = M.parallel_cl f :=
presetoid.cl_eq_cl_of_rel hef

lemma parallel_of_parallel_cl_eq_left (he : M.is_nonloop e)
(hef : M.parallel_cl e = M.parallel_cl f) :
  M.parallel e f :=
by {rw [parallel_cl, parallel_cl, presetoid.cl_eq_cl_iff ] at hef,
    exact hef, exact he.parallel_refl}

lemma parallel_iff_parallel_cl_eq_left (he : M.is_nonloop e):
  M.parallel e f ↔ M.parallel_cl e = M.parallel_cl f :=
by {convert (presetoid.cl_eq_cl_iff _).symm, refl, exact he.parallel_refl}

instance coe_parallel_class_to_set : has_coe (M.parallel_class) (set α) :=
  ⟨subtype.val⟩
instance parallel_class_fintype : fintype M.parallel_class :=
by {unfold parallel_class, apply_instance}

lemma mem_parallel_class_of (he : M.is_nonloop e) :
  e ∈ (parallel_class_of e he : set α) :=
by {show e ∈ M.parallel_cl e, rwa [mem_parallel_cl, parallel_refl_iff_nonloop]}

@[simp] lemma coe_parallel_class_of (he : M.is_nonloop e) :
  (parallel_class_of e he : set α) = M.parallel_cl e :=
rfl

lemma parallel_of_mems_parallel_class
(hP : M.is_parallel_class P) (he : e ∈ P) (hf : f ∈ P) :
  M.parallel e f :=
presetoid.rel_of_mems_class hP he hf

lemma nonloop_of_mem_parallel_class
(heP : e ∈ P) (h : M.is_parallel_class P) :
  M.is_nonloop e :=
parallel_refl_iff_nonloop.mp (presetoid.rel_self_of_mem_class h heP)

lemma parallel_class_eq_cl_mem (hP : M.is_parallel_class P) (he : e ∈ P) :
  P = M.parallel_cl e :=
presetoid.class_eq_cl_mem hP he

lemma parallel_cl_eq_cl_minus_loops (M : matroid α) (e : α) :
  M.parallel_cl e = M.cl {e} \ M.loops :=
begin
  by_cases he: M.is_nonloop e, swap,
  { ext x, rw [mem_diff, mem_parallel_cl],
    refine ⟨λ h, false.elim (he h.2.1), λ h, false.elim _⟩,
    rw [←loop_iff_not_nonloop, loop_iff_r] at he,
    rw [mem_cl_iff_r,he, ←nonloop_iff_not_mem_loops, nonloop_iff_r] at h,
    linarith[h.1, h.2, M.rank_mono_union_right {e} {x}], },
  ext x,
  simp only [mem_diff, mem_set_of_eq, mem_cl_iff_r, rank_nonloop he,
    union_singleton, ←nonloop_iff_not_mem_loops],
  split, { rintros ⟨hx,he,hxe⟩, split; assumption,  },
  rintros ⟨hxe,hx⟩, exact ⟨hx,he,hxe⟩,
end

lemma cl_eq_parallel_cl_union_loops (M : matroid α) (e : α) :
  M.cl {e} = M.parallel_cl e ∪ M.loops :=
begin
  rw [parallel_cl_eq_cl_minus_loops, diff_union_self, eq_comm, ← subset_iff_union_eq_right],
  apply loops_subset_cl,
end

lemma parallel_of_mem_cl ( h : e ∈ M.cl {f} ) (he : M.is_nonloop e):
  M.parallel e f :=
begin
  rw cl_eq_parallel_cl_union_loops at h,
  cases h,
  rwa ← mem_parallel_cl,
  rw [← loop_iff_mem_loops, loop_iff_not_nonloop] at h,
  exact false.elim (h he),
end

lemma rank_parallel_cl (he : M.is_nonloop e) :
  M.r (M.parallel_cl e) = 1 :=
by rwa [parallel_cl_eq_cl_minus_loops, rank_eq_rank_diff_rank_zero _ M.rank_loops,
        rank_cl, ←nonloop_iff_r]

lemma parallel_class_eq_cl_nonloop_diff_loops :
  M.is_parallel_class P ↔ P.nonempty ∧ (∀ e ∈ P, P = M.cl {e} \ M.loops ) :=
begin
  rw [parallel_class_iff_is_parallel_cl],
  simp_rw [←parallel_cl_eq_cl_minus_loops],
  split,
  { rintros ⟨a, ha, rfl⟩,
    rw parallel_cl_nonempty_iff_nonloop,
    refine ⟨ha, λ e he, parallel_cl_eq_of_parallel _⟩,
    symmetry, rwa mem_parallel_cl at he, },
  rintros ⟨⟨e,he⟩,h⟩,
  obtain rfl := h e he,
  rw [mem_parallel_cl, parallel_refl_iff_nonloop] at he,
  exact ⟨e, he, rfl⟩,
end

lemma cl_eq_cl_iff_parallel_cl_eq_parallel_cl :
  M.cl {e} = M.cl {f} ↔ M.parallel_cl e = M.parallel_cl f :=
begin
  repeat {rw cl_eq_parallel_cl_union_loops},
  refine ⟨λ h, _, λ h, by rw h⟩,
  ext x,
  simp_rw [ext_iff, mem_union, mem_parallel_cl, ← loop_iff_mem_loops, loop_iff_not_nonloop] at h,
  rw [mem_parallel_cl, mem_parallel_cl],
  unfold parallel at *,
  specialize h x,
  tauto,
end

/-- the natural equivalence between points and parallel classes in a matroid -/
def parallel_class_point_equiv (M : matroid α) :
  M.parallel_class ≃ M.point :=
{ to_fun := λ P, ⟨P.val ∪ M.loops,
  let ⟨e,he,h⟩ := parallel_class_iff_is_parallel_cl.mp P.property in by
  { simp_rw [h, point_iff_cl_nonloop, parallel_cl_eq_cl_minus_loops, diff_union_self, union_comm,
    subset_iff_union_eq_left.mp (M.loops_subset_cl {e})],
    exact ⟨e,he,rfl⟩, }⟩,
inv_fun := λ P, ⟨P.val \ M.loops,
  let ⟨e,he,hP⟩ := point_iff_cl_nonloop.mp P.2 in by
  { rw [hP, ← parallel_cl_eq_cl_minus_loops, parallel_class_iff_is_parallel_cl],
    refine ⟨e, he, rfl⟩,}⟩,
left_inv := λ P, let ⟨e,he,h⟩ := parallel_class_iff_is_parallel_cl.mp P.2 in by
  { simp_rw [h, union_diff_right, parallel_cl_eq_cl_minus_loops, diff_diff, union_self,
    ← parallel_cl_eq_cl_minus_loops, ← h], simp, },
right_inv := λ P, let ⟨e,he,hP⟩ := point_iff_cl_nonloop.mp P.2 in by
  { dsimp only, simp_rw [hP, diff_union_self, union_comm,
    subset_iff_union_eq_left.mp (M.loops_subset_cl {e}), ←hP],simp, }}

@[simp] lemma parallel_class_point_equiv_apply (P : M.parallel_class) :
  M.parallel_class_point_equiv P
= ⟨P.val ∪ M.loops,
  let ⟨e,he,h⟩ := parallel_class_iff_is_parallel_cl.mp P.property in by
  { simp_rw [h, point_iff_cl_nonloop, parallel_cl_eq_cl_minus_loops, diff_union_self, union_comm,
    subset_iff_union_eq_left.mp (M.loops_subset_cl {e})],
    exact ⟨e,he,rfl⟩, }⟩ :=
rfl

@[simp] lemma parallel_class_point_equiv_apply_symm (P : M.point) :
  (M.parallel_class_point_equiv.symm P)
= ⟨P.val \ M.loops,
  let ⟨e,he,hP⟩ := point_iff_cl_nonloop.mp P.2 in by
  { rw [hP, ← parallel_cl_eq_cl_minus_loops, parallel_class_iff_is_parallel_cl],
    refine ⟨e, he, rfl⟩,}⟩ :=
rfl

lemma parallel_class_nonempty (P : M.parallel_class) :
  set.nonempty (P : set α) :=
(parallel_class_eq_cl_nonloop_diff_loops.mp P.property).1

lemma nonloop_of_parallel_cl_is_parallel_class {P : M.parallel_class}
(h : (P : set α) = (M.parallel_cl e)) :
  M.is_nonloop e :=
begin
  by_contra hn,
  rw parallel_cl_loop_empty (loop_iff_not_nonloop.mpr hn) at h,
  exact nonempty.ne_empty (parallel_class_nonempty P) h,
end

lemma parallel_class_eq_parallel_cl_of_mem {P : M.parallel_class} (he : e ∈ (P : set α)) :
  (P : set α) = M.parallel_cl e :=
begin
  obtain ⟨-, h'⟩ := parallel_class_eq_cl_nonloop_diff_loops.mp P.property,
  simp_rw [←parallel_cl_eq_cl_minus_loops, subtype.val_eq_coe] at h',
  rwa ←(h' e he),
end

lemma parallel_class_is_cl_diff_loops (P : M.parallel_class) :
  ∃ e ∈ (P : set α), M.is_nonloop e ∧ (P : set α) = M.cl {e} \ M.loops :=
begin
  rcases parallel_class_eq_cl_nonloop_diff_loops.mp P.property with ⟨⟨e,he⟩,hP⟩,
  exact ⟨e,he,nonloop_of_mem_parallel_class he P.property, hP e he⟩,
end

lemma parallel_class_is_parallel_cl_nonloop (P : M.parallel_class) :
  ∃ e ∈ (P : set α), M.is_nonloop e ∧ (P : set α) = M.parallel_cl e :=
begin
  have := parallel_class_is_cl_diff_loops P,
  simp_rw ←parallel_cl_eq_cl_minus_loops at this,
  assumption
end

lemma parallel_class_is_parallel_cl (P : M.parallel_class) :
  ∃ e, (P : set α) = M.parallel_cl e :=
by {obtain ⟨e,he,he'⟩ := parallel_class_is_parallel_cl_nonloop P, use ⟨e,he'.2⟩,   }

lemma mem_parallel_class_iff_parallel_cl  {P : M.parallel_class} :
  e ∈ (P : set α) ↔ (P : set α) = M.parallel_cl e :=
begin
  refine ⟨λ h, parallel_class_eq_parallel_cl_of_mem h, λ h, _⟩,
  rw [h, parallel_cl, presetoid.mem_cl_iff],--, mem_set_of_eq],
  exact (nonloop_of_parallel_cl_is_parallel_class h).parallel_refl,
end

lemma rank_parallel_class (M : matroid α) (P : M.parallel_class ) :
  M.r P = 1 :=
begin
  obtain ⟨e,heP,he, hP⟩ := parallel_class_is_parallel_cl_nonloop P,
  rw hP,
  apply rank_parallel_cl he
end

lemma parallel_class_eq_of_nonempty_inter {P₁ P₂ : M.parallel_class}
(h : set.nonempty (P₁ ∩ P₂ : set α)) :
  P₁ = P₂ :=
begin
  rcases h with ⟨x,hx⟩,
  rcases parallel_class_is_parallel_cl_nonloop P₁ with ⟨e₁,he₁P,⟨he₁,h₁⟩⟩,
  rcases parallel_class_is_parallel_cl_nonloop P₂ with ⟨e₂,he₂P,⟨he₂,h₂⟩⟩,

  rw [mem_inter_iff, h₁,h₂] at hx,
  have h₁₂ : M.parallel e₁ e₂, {transitivity x, symmetry, exact hx.1, exact hx.2},
  have h₂₁ := parallel_symm' h₁₂,
  rcases P₁ with ⟨P₁, hP₁⟩, rcases P₂ with ⟨P₂, hP₂⟩, rw subtype.mk_eq_mk,
  rw subtype.coe_mk at *, subst h₁, subst h₂,
  ext y, simp only [mem_parallel_cl],
  split; {intro h, symmetry, transitivity, assumption, symmetry, assumption,},
end

lemma disj_of_distinct_parallel_classes {P₁ P₂ : M.parallel_class} (h : P₁ ≠ P₂) :
  disjoint (P₁ : set α) (P₂ : set α) :=
begin
  by_contra hn, rcases not_disjoint_iff.mp hn with ⟨e,⟨h₁,h₂⟩⟩,
  exact h (parallel_class_eq_of_nonempty_inter ⟨e,mem_inter h₁ h₂⟩),
end

lemma parallel_class_eq_of_mem_both {P₁ P₂ : M.parallel_class} {x : α}
  (h₁ : x ∈ (P₁ : set α)) (h₂ : x ∈ (P₂ : set α)) :
  P₁ = P₂ :=
parallel_class_eq_of_nonempty_inter ⟨x,mem_inter h₁ h₂⟩

/-- the set of parallel classes of M -/
def parallel_classes_set (M : matroid α) : set (set α) :=
  range (coe : M.parallel_class → set α)

lemma parallel_class_set_disjoint (M : matroid α) :
  pairwise_disjoint M.parallel_classes_set :=
begin
  rintros S hS T hT hST,
  rcases mem_range.mp hS with ⟨P₁,rfl⟩,
  rcases mem_range.mp hT with ⟨P₂,rfl⟩,
  have h : P₁ ≠ P₂ := λ hP₁P₂, by {rw hP₁P₂ at hST, tauto, },
  apply disj_of_distinct_parallel_classes h,
end

/-- the union of a set of parallel classes of M -/
def union_parallel_classes (S : set M.parallel_class) : set α :=
  ⋃₀ (coe '' S)

lemma mem_union_parallel_classes {S : set M.parallel_class} :
  e ∈ union_parallel_classes S ↔ ∃ (he : M.is_nonloop e), (parallel_class_of e he) ∈ S  :=
begin
  simp_rw [union_parallel_classes, mem_sUnion], split,
  { rintros ⟨X, hX, heX⟩,
    obtain ⟨⟨P,hP⟩,hP₁,rfl⟩ := (mem_image _ _ _).mp hX,
    obtain ⟨f, hf, rfl⟩ := rep_parallel_class hP,
    use nonloop_of_mem_parallel_class heX hP,
    convert hP₁ using 1,
    rw [parallel_class_of, subtype.mk_eq_mk],
    apply parallel_cl_eq_of_parallel,
    rwa [subtype.coe_mk, mem_parallel_cl] at heX},
  rintros ⟨he, heP⟩,
  refine ⟨M.parallel_cl e, _,_⟩,
  { simp only [mem_image], exact ⟨_, heP, rfl⟩},
  rwa [mem_parallel_cl, parallel_refl_iff_nonloop],
end

lemma union_union_parallel_classes (S₁ S₂ : set M.parallel_class) :
  union_parallel_classes (S₁ ∪ S₂) = union_parallel_classes S₁ ∪ union_parallel_classes S₂ :=
by simp_rw [union_parallel_classes, image_union, sUnion_union]

lemma inter_union_parallel_classes (S₁ S₂ : set M.parallel_class) :
  union_parallel_classes (S₁ ∩ S₂) = union_parallel_classes S₁ ∩ union_parallel_classes S₂ :=
begin
  simp_rw [union_parallel_classes, ←image_inter (subtype.coe_injective)],
  apply pairwise_disjoint_inter_sUnion (parallel_class_set_disjoint M);
  apply image_subset_range,
end

/-- the set of parallel classes containing an element of X-/
def parallel_cl_image_of (M : matroid α) (X : set α) :
  set (M.parallel_class) :=
{P | (X ∩ P).nonempty}

lemma mem_parallel_cl_image_of_iff {P : M.parallel_class} :
  P ∈ M.parallel_cl_image_of X ↔ (X ∩ P).nonempty :=
by simp [parallel_cl_image_of]

lemma rank_eq_rank_parallel_cl_image_of (M : matroid α) (X : set α) :
  M.r X = M.r (union_parallel_classes (M.parallel_cl_image_of X)) :=
begin
  refine rank_eq_rank_of_parallel_covered
    (λ x hx hnl, ⟨x, _, hnl.parallel_refl⟩) (λ y hy hnl, _),
  { simp_rw [mem_union_parallel_classes, mem_parallel_cl_image_of_iff],
    exact ⟨hnl, ⟨x, mem_inter hx (by simpa [mem_parallel_cl] using hnl.parallel_refl)⟩⟩},
  simp_rw [mem_union_parallel_classes, mem_parallel_cl_image_of_iff] at hy,
  obtain ⟨he', ⟨x, hx⟩⟩ := hy,
  simp only [mem_inter_eq, coe_parallel_class_of, mem_parallel_cl] at hx,
  exact ⟨x, hx.1, parallel_symm' hx.2⟩,
end

--lemma intersecting_parallel_nl_classes_eq (S : set M.parallel_nl_class) : set α :=

/- property that a map sends parallel classes to representatives -/
def is_transversal (f : M.parallel_class → α) :=
  ∀ P, M.parallel_cl (f P) = (P : set α)

def transversal (M : matroid α) :=
  { f : M.parallel_class → α // is_transversal f}

instance coe_transversal  : has_coe_to_fun M.transversal := { F := _, coe := subtype.val }

lemma transversal_def (f : M.transversal) (P : M.parallel_class) :
  M.parallel_cl (f P) = (P : set α) :=
(f.property P)

lemma transversal_def' (f : M.transversal) (hP : M.is_parallel_class P) :
  M.parallel_cl (f ⟨P,hP⟩) = P :=
f.property ⟨P,hP⟩

lemma nonloop_of_range_transversal (f : M.transversal) (P : M.parallel_class) :
  M.is_nonloop (f P) :=
nonloop_of_parallel_cl_is_parallel_class (f.property P).symm

lemma exists_transversal (M : matroid α) :
  ∃ (f : M.parallel_class → α), is_transversal f :=
⟨λ P, (classical.some (parallel_class_is_parallel_cl P)),
 λ P, (classical.some_spec (parallel_class_is_parallel_cl P)).symm ⟩

def choose_transversal (M : matroid α) : M.transversal  :=
classical.indefinite_description _ (M.exists_transversal)

lemma transversal_subset_union (f : M.transversal) (S : set M.parallel_class) :
  f '' S ⊆ union_parallel_classes S :=
begin
  intros x hx,
  obtain ⟨P, hP, rfl⟩ := (mem_image _ _ _).mp hx,
  rw mem_union_parallel_classes,
  refine ⟨nonloop_of_range_transversal f _,_⟩,
  convert hP,
  simp [parallel_class_of, transversal_def],
end

lemma eq_of_parallel_range_transversal {P Q : M.parallel_class} (f : M.transversal)
(h : M.parallel (f P) (f Q)) :
  P = Q :=
begin
  cases P with P hP, cases Q with Q hQ,
  rw [subtype.mk_eq_mk, ←transversal_def' f hP, ←transversal_def' f hQ],
  have := parallel_symm' h,
  ext, simp_rw mem_parallel_cl,
  split; {intro h', transitivity, assumption, assumption,},
end

lemma transversal_inj (f : M.transversal) :
  function.injective f :=
begin
  intros P Q hPQ,
  apply eq_of_parallel_range_transversal f, rw hPQ,
  apply (nonloop_of_range_transversal _ _).parallel_refl,
end

lemma size_image_transversal (f : M.transversal)
(S : set M.parallel_class) :
  size (f '' S) = size S :=
size_image_inj (transversal_inj f) S

lemma rank_img_transversal (f : M.transversal)
(S : set M.parallel_class) :
  M.r (union_parallel_classes S) = M.r (f '' S) :=
begin
  refine (rank_eq_rank_of_parallel_ext (transversal_subset_union f _) (λ y hy, _)).symm,
  rcases y with ⟨y,hy'⟩,
  rcases mem_union_parallel_classes.mp hy' with ⟨hy_nl,hP⟩,
  set PY := parallel_class_of y hy_nl with hPY,
  refine ⟨ ⟨f PY, _ ⟩, _⟩, apply mem_image_of_mem _ hP,
  simp_rw [PY, subtype.coe_mk],
  rwa [parallel_comm, ← mem_parallel_cl, transversal_def, coe_parallel_class_of, mem_parallel_cl,
  parallel_refl_iff_nonloop],
end

end matroid


import data.rat data.pnat.basic data.pnat.factors
import data.rat_extra

def prat := {q : ℚ // q > 0}

notation ℚ+ := prat

namespace prat

instance to_rat : has_coe ℚ+ ℚ := ⟨subtype.val⟩

theorem pos (p : ℚ+) : (p : ℚ) > 0 := p.property

theorem eq {p q : ℚ+} : (p : ℚ) = (q : ℚ) → p = q := subtype.eq

instance : comm_group ℚ+ :=
{ one := ⟨(1 : ℚ), zero_lt_one ⟩,
  mul := λ p q,⟨(p * q : ℚ), mul_pos p.pos q.pos⟩,
  inv := λ q, ⟨(q ⁻¹ : ℚ), inv_pos.mpr q.pos⟩,
  one_mul      := λ q,     eq (one_mul q),
  mul_one      := λ q,     eq (mul_one q),
  mul_comm     := λ p q,   eq (mul_comm p q),
  mul_assoc    := λ p q r, eq (mul_assoc p q r),
  mul_left_inv := λ q,     eq (inv_mul_cancel (ne_of_gt q.pos)) }

instance : add_comm_semigroup ℚ+ :=
{ add := λ p q, ⟨(p + q : ℚ), add_pos p.pos q.pos⟩ ,
  add_comm  := λ p q,   eq (add_comm p q),
  add_assoc := λ p q r, eq (add_assoc p q r) }

instance : distrib ℚ+ :=
{ left_distrib  := λ a b c, eq (mul_add a b c),
  right_distrib := λ a b c, eq (add_mul a b c),
  .. (prat.add_comm_semigroup), .. (prat.comm_group) }

instance : decidable_eq ℚ+ := λ (a b : ℚ+), by apply_instance

instance : linear_order ℚ+ := subtype.linear_order _

/-- Subtraction a - b is defined in the obvious way when
  a > b, and by a - b = 1 if a ≤ b. -/

def of_rat (q : ℚ) : ℚ+ := dite (q > 0) (λ h, ⟨q,h⟩) (λ h, 1)

theorem of_rat_coe (q : ℚ) : ((of_rat q) : ℚ) = ite (q > 0) q 1 :=
by { dsimp [of_rat], split_ifs with h; refl}

theorem of_rat_pos_coe {q : ℚ} (h : q > 0) : ((of_rat q) : ℚ) = q :=
by rw [of_rat_coe, if_pos h]

instance : has_sub ℚ+ :=  ⟨λ a b, of_rat (a - b : ℚ)⟩

theorem one_coe            : ((1 : ℚ+) : ℚ) = 1            := rfl
theorem inv_coe (q : ℚ+)   : ((q⁻¹ : ℚ+) : ℚ) = (q : ℚ)⁻¹ := rfl
theorem mul_coe (p q : ℚ+) : ((p * q : ℚ+) : ℚ) = p * q   := rfl
theorem add_coe (p q : ℚ+) : ((p + q : ℚ+) : ℚ) = p + q   := rfl
theorem lt_coe  (p q : ℚ+) : p < q ↔ (p : ℚ) < (q : ℚ)    := iff.refl _
theorem gt_coe  (p q : ℚ+) : p > q ↔ (p : ℚ) > (q : ℚ)    := iff.refl _

theorem sub_coe (a b : ℚ+) : ((a - b : ℚ+) : ℚ) = ite (a > b) ((a : ℚ) - (b : ℚ)) 1 :=
begin
  change ((of_rat (a - b : ℚ)) : ℚ) = ite _ (a - b : ℚ) 1,
  have h₀ : a > b ↔ ((a : ℚ) > (b : ℚ)) := by { refl },
/-  change ((of_rat (a - b : ℚ)) : ℚ) = ite ((a : ℚ) > (b : ℚ)) (a - b : ℚ) 1, -/
  rw[of_rat_coe],
  by_cases h₁ : (a : ℚ) > (b : ℚ);
  have h₂ := h₁; rw[← h₀] at h₂,
  { rw[if_pos h₂, if_pos (sub_pos_of_lt h₁)] },
  { rw[if_neg h₂, if_neg (mt lt_of_sub_pos h₁)] }
end

theorem add_sub_of_lt {a b : ℚ+} : a < b → a + (b - a) = b :=
 λ h, eq $ by { rw[add_coe, sub_coe, if_pos h, add_sub_cancel'_right] }

def mk (n d : ℕ+) : ℚ+ :=
⟨ rat.mk ((n : ℕ) : ℤ) d,
  begin
    let nz_pos : ((n : ℕ) : ℤ) > 0 := int.coe_nat_pos.mpr n.pos,
    let dz_pos : ((d : ℕ) : ℤ) > 0 := int.coe_nat_pos.mpr d.pos,
    by_cases h₀ : rat.mk (n : ℕ) (d : ℕ) = 0,
    { exfalso,
      exact ((ne_of_gt nz_pos) ((rat.mk_eq_zero (ne_of_gt dz_pos)).mp h₀)) },
    have : rat.mk (n : ℕ) (d : ℕ) ≠ 0 := h₀,
    apply lt_of_le_of_ne _ this.symm,
    apply rat.nonneg_iff_zero_le.mp,
    exact ((rat.mk_nonneg (n : ℕ) dz_pos).mpr (le_of_lt nz_pos))
  end ⟩

theorem mk_coe (n d : ℕ+) : ((mk n d) : ℚ) = rat.mk (n : ℕ) (d : ℕ) := rfl

theorem mk_coe' (n d : ℕ+) : ((mk n d) : ℚ) = rat.mk_pnat (n : ℕ) d :=
begin
  dsimp [mk], unfold_coes,
  dsimp [rat.mk], rw[rat.mk_nat], rw[dif_neg (ne_of_gt d.pos)],
  congr, apply subtype.eq, refl,
end

instance of_pnat : has_coe ℕ+ ℚ+ := ⟨λ n, mk n 1⟩

theorem coe_pnat_prat_rat (n : ℕ+) : ((n : ℚ+) : ℚ) = n := rfl

theorem coe_pnat_nat_rat : ∀ (n : ℕ+), ((n : ℕ) : ℚ) = n
| ⟨n,hn⟩ := by { change (n : ℚ) = rat.mk_nat (n : ℤ) 1,
                rw[rat.mk_nat_with_one_eq_cast n], refl }

theorem of_pnat_one : ((1 : ℕ+) : ℚ+) = 1 := prat.eq
begin
  unfold_coes, dsimp[prat.mk], rw[zero_add, rat.mk_one_one], refl
end

theorem of_pnat_inj {n m : ℕ+} : (n : ℚ+) = (m : ℚ+) → n = m :=
begin
  intro h,
  have : ((n : ℚ+) : ℚ) = ((m : ℚ+) : ℚ) := by { rw [h] },
  rw [coe_pnat_prat_rat, coe_pnat_prat_rat] at this,
  rw [← coe_pnat_nat_rat, ← coe_pnat_nat_rat] at this,
  exact pnat.eq (nat.cast_inj.mp this),
end

theorem of_pnat_mul (n m : ℕ+) : ((n * m : ℕ+) : ℚ+) = n * m :=
by { apply eq,
     rw[mul_coe],
     repeat { rw[coe_pnat_prat_rat] },
     repeat { rw[← coe_pnat_nat_rat] },
     rw [pnat.mul_coe, nat.cast_mul] }

theorem of_pnat_add (n m : ℕ+) : ((n + m : ℕ+) : ℚ+) = n + m :=
by { apply eq,
     rw[add_coe],
     repeat { rw[coe_pnat_prat_rat] },
     repeat { rw[← coe_pnat_nat_rat] },
     rw [pnat.add_coe, nat.cast_add] }

def num (q : ℚ+) : ℕ+ :=
 ⟨(q : ℚ).num.nat_abs,
  int.nat_abs_pos_of_ne_zero (ne_of_gt (rat.num_pos_iff_pos.mpr q.pos))⟩

def denom (q : ℚ+) : ℕ+ := ⟨(q : ℚ).denom, (q : ℚ).pos⟩

theorem num_coe (q : ℚ+) : (q.num : ℕ) = (q : ℚ).num.nat_abs := rfl

theorem num_coe' (q : ℚ+) : ((q.num : ℕ) : ℤ) = (q : ℚ).num :=
 by { rw[num_coe q],
      exact (int.eq_nat_abs_of_zero_le (le_of_lt (rat.num_pos_iff_pos.mpr q.pos))).symm }

theorem denom_coe (q : ℚ+) : (denom q : ℕ) = (q : ℚ).denom := rfl

theorem num_denom_coprime (q : ℚ+) : nat.coprime q.num q.denom := (q : ℚ).cop

theorem mk_eq_div (n d : ℕ+) : mk n d = (n : ℚ+) * (d : ℚ+)⁻¹ :=
 by {apply eq,
     rw[mk_coe,mul_coe,inv_coe,← div_eq_mul_inv,rat.mk_eq_div,
        int.cast_coe_nat,int.cast_coe_nat,coe_pnat_nat_rat,coe_pnat_nat_rat,
        coe_pnat_prat_rat,coe_pnat_prat_rat]}

theorem num_denom (q : ℚ+) : q = mk q.num q.denom :=
 by {apply eq, rw[mk_coe, num_coe' q,denom_coe q], symmetry,
     exact rat.num_denom }

theorem num_denom' (q : ℚ+) : q = (q.num : ℚ+) * (q.denom : ℚ+)⁻¹ :=
 q.num_denom.trans (mk_eq_div _ _)

theorem mk_spec (n d : ℕ+) :
  n = (pnat.gcd n d) * (mk n d).num ∧
  d = (pnat.gcd n d) * (mk n d).denom :=
begin
  let g := pnat.gcd n d,
  rcases pnat.dvd_iff.mp (pnat.gcd_dvd_left  n d) with ⟨n',hn₀⟩,
  rcases pnat.dvd_iff.mp (pnat.gcd_dvd_right n d) with ⟨d',hd₀⟩,
  change (n : ℕ) = g * n' at hn₀,
  change (d : ℕ) = g * d' at hd₀,
  have hn₁ : (n' : ℕ) = (n : ℕ) / (g : ℕ) :=
    by { rw [hn₀, nat.mul_div_cancel_left _ g.pos] },
  have hd₁ : (d' : ℕ) = (d : ℕ) / (g : ℕ) :=
    by { rw [hd₀, nat.mul_div_cancel_left _ g.pos] },
  have hn₂ : (int.nat_abs ((n : ℕ) : ℤ)) = n := rfl,
  have hd₂ : ((mk n d).denom : ℕ) = d' :=
  begin
    dsimp[denom],
    rw [mk_coe', rat.mk_pnat_denom, hn₂,← pnat.gcd_coe, hd₁]
  end,
  have hn₃ : ((mk n d).num : ℕ) = n' :=
  begin
    dsimp[num],
    rw [mk_coe',rat.mk_pnat_num,hn₂,← pnat.gcd_coe,← int.coe_nat_div],
    norm_cast, exact hn₁.symm,
  end,
  split; apply pnat.eq; rw[pnat.mul_coe],
  { rw[hn₃], exact hn₀ },
  { rw[hd₂], exact hd₀ }
end

theorem mk_spec' (n d : ℕ+) :
  n = (pnat.gcd n d) * ((n : ℚ+) * (d : ℚ+)⁻¹).num   ∧
  d = (pnat.gcd n d) * ((n : ℚ+) * (d : ℚ+)⁻¹).denom :=
(mk_eq_div n d) ▸ (mk_spec n d)

theorem eq_iff (n₁ d₁ n₂ d₂ : ℕ+) :
 ((n₁ : ℚ+) * (d₁ : ℚ+)⁻¹) = ((n₂ : ℚ+) * (d₂ : ℚ+)⁻¹) ↔ n₁ * d₂ = n₂ * d₁ :=
begin
 rw[eq_mul_inv_iff_mul_eq, mul_comm, ← mul_assoc],
 have : ∀ (x y : ℚ+), x = y ↔ y = x := λ x y, ⟨λ h, h.symm, λ h, h.symm⟩,
 rw [this, eq_mul_inv_iff_mul_eq, ← of_pnat_mul, ← of_pnat_mul, mul_comm d₂, this],
 split,
 { intro h, exact of_pnat_inj h },
 { intro h, rw [h] }
end

theorem eq_iff' (q₁ q₂ : ℚ+) : q₁ = q₂ ↔ q₁.num * q₂.denom = q₂.num * q₁.denom :=
begin
 let n₁ := q₁.num, let d₁ := q₁.denom,
 let n₂ := q₂.num, let d₂ := q₂.denom,
 change q₁ = q₂ ↔ n₁ * d₂ = n₂ * d₁,
 have : q₁ = n₁ * d₁ ⁻¹ := num_denom' q₁, rw [this],
 have : q₂ = n₂ * d₂ ⁻¹ := num_denom' q₂, rw [this],
 apply eq_iff
end

theorem mk_eq_mk_iff (n₁ d₁ n₂ d₂ : ℕ+) : mk n₁ d₁ = mk n₂ d₂ ↔ n₁ * d₂ = n₂ * d₁ :=
by { rw[mk_eq_div, mk_eq_div], apply eq_iff }

theorem eq_mk_iff (q : ℚ+) (n d : ℕ+) : q = mk n d ↔ q.num * d = n * q.denom :=
begin
  rw [mk_eq_div],
  let n' := q.num, let d' := q.denom,
  change _ ↔ n' * d = n * d',
  have : q = (n' : ℚ+) * (d' : ℚ+)⁻¹ := num_denom' q,
  rw [this],
  apply eq_iff
end

def size (q : ℚ+) : ℕ := q.num + q.denom

instance : has_sizeof ℚ+ := ⟨size⟩

theorem sizeof_val (q : ℚ+) : sizeof q = q.num + q.denom := rfl

theorem sizeof_le (a b : ℕ+) :
  sizeof ((a : ℚ+) * (b : ℚ+)⁻¹) ≤ a + b :=
begin
  let g := pnat.gcd a b,
  let a' := (mk a b).num,
  let b' := (mk a b).denom,
  rw[← mk_eq_div, sizeof_val],
  change (a' + b' : ℕ) ≤ a + b,
  let h := mk_spec a b,
  have ha : a = g * a' := h.1,
  have hb : b = g * b' := h.2,
  rw [ha, hb, pnat.mul_coe, pnat.mul_coe, ← mul_add],
  exact nat.le_mul_of_pos_left g.pos
end

theorem inv_num_denom (q : ℚ+) : q⁻¹.num = q.denom ∧ q⁻¹.denom = q.num :=
begin
  let n := q.num,
  let d := q.denom,
  have h : pnat.gcd d n = 1 :=
    pnat.eq (by { rw[pnat.gcd_coe, pnat.one_coe, nat.gcd_comm],
                  exact q.num_denom_coprime }),
  have := calc
    q⁻¹ = ((n : ℚ+) * (d : ℚ+)⁻¹)⁻¹ : by rw [num_denom' q]
    ... = (d : ℚ+) * (n : ℚ+)⁻¹ : by rw[mul_inv_rev, inv_inv]
    ... = mk d n : (mk_eq_div d n).symm,
  rw [this],
  have h' := mk_spec d n,
  rw [h, one_mul, one_mul] at h',
  exact ⟨h'.1.symm, h'.2.symm⟩
end

@[simp] theorem inv_num   (q : ℚ+) : q⁻¹.num = q.denom := q.inv_num_denom.1
@[simp] theorem inv_denom (q : ℚ+) : q⁻¹.denom = q.num := q.inv_num_denom.2

theorem inv_sizeof (q : ℚ+) : sizeof q⁻¹ = sizeof q :=
by { rw[q.sizeof_val, q⁻¹.sizeof_val, q.inv_num, q.inv_denom, add_comm] }

theorem inv_gt_one_iff {q : ℚ+} : q⁻¹ > 1 ↔ q < 1 :=
begin
  let h := inv_lt_inv (1 : ℚ+).pos q.pos,
  rw [← inv_coe, ← inv_coe, one_coe, inv_one, one_coe] at h,
  exact h
end

theorem inv_lt_one_iff {q : ℚ+} : q⁻¹ < 1 ↔ q > 1 :=
by { let h := iff.symm (@inv_gt_one_iff q⁻¹),
     rw [inv_inv q] at h, exact h }

def succ   (q : ℚ+) : ℚ+ := q + 1
def pred   (q : ℚ+) : ℚ+ := q - 1
def cosucc (q : ℚ+) : ℚ+ := (q⁻¹.succ)⁻¹
def copred (q : ℚ+) : ℚ+ := (q⁻¹.pred)⁻¹

theorem succ_coe   (q : ℚ+) : (q.succ : ℚ) = q + 1 := rfl
theorem cosucc_coe (q : ℚ+) : (q.cosucc : ℚ) = (q⁻¹ + 1)⁻¹ := rfl

theorem pred_coe   {q : ℚ+} (h : q > 1) : (q.pred : ℚ) = q - 1 :=
by { rw[pred, sub_coe, if_pos h, one_coe] }

theorem copred_coe {q : ℚ+} (h : q < 1) : (q.copred : ℚ) = (q⁻¹ - 1)⁻¹ :=
by { rw[copred, inv_coe, pred_coe (inv_gt_one_iff.mpr h), inv_coe] }

theorem succ_gt_one (q : ℚ+) : q.succ > 1 :=
by { change (q : ℚ) + 1 > 1, exact lt_add_of_pos_left _ q.pos }

theorem cosucc_lt_one (q : ℚ+) : q.cosucc < 1 :=
inv_lt_one_iff.mpr q⁻¹.succ_gt_one

theorem pred_succ (q : ℚ+) : q.succ.pred = q :=
eq $ (by rw[pred_coe (succ_gt_one q), succ, add_coe, one_coe, add_sub_cancel])

theorem copred_cosucc (q : ℚ+) : q.cosucc.copred = q :=
by { rw [cosucc, copred, inv_inv, pred_succ, inv_inv] }

theorem succ_pred {q : ℚ+} (h : q > 1) : succ (pred q) = q :=
eq $ (by { rw[succ_coe, pred_coe h, sub_add_cancel] })

theorem cosucc_copred {q : ℚ+} (h : q < 1): q.copred.cosucc = q :=
by { rw [copred, cosucc, inv_inv, succ_pred (inv_gt_one_iff.mpr h), inv_inv] }

theorem succ_num_denom (q : ℚ+) :
  q.succ.num = q.num + q.denom ∧ q.succ.denom = q.denom :=
begin
  let n := q.num, let d := q.denom,
  change q.succ.num = n + d ∧ q.succ.denom = d,
  have h₀ := calc
    q.succ = q + 1 : rfl
    ... = n * d⁻¹ + (d * d⁻¹) : by { rw[mul_inv_self, num_denom' q] }
    ... = (n + d : ℕ+) * d⁻¹ : by { rw [of_pnat_add, add_mul] },
  have h₁ : pnat.gcd (n + d) d = 1 :=
  begin
    apply pnat.eq,
    rw[pnat.gcd_coe, pnat.one_coe,pnat.add_coe],
    let d' := nat.gcd (n + d) d, change d' = 1,
    have hd : d' ∣ d := nat.gcd_dvd_right (n + d) d,
    have hn := (nat.dvd_add_iff_left hd).mpr (nat.gcd_dvd_left (n + d) d),
    exact nat.eq_one_of_dvd_one (q.num_denom_coprime ▸ (nat.dvd_gcd hn hd))
  end,
  have h₂ := mk_spec' (n + d) d,
  rw [h₁, one_mul, one_mul, ← h₀] at h₂,
  exact ⟨h₂.1.symm, h₂.2.symm⟩
end

theorem pred_num_denom {q : ℚ+} (h : q > 1) :
  q.pred.num + q.denom = q.num ∧ q.pred.denom = q.denom :=
begin
  let r := q.pred,
  change r.num + q.denom = q.num ∧ r.denom = q.denom,
  have : q = r.succ := (succ_pred h).symm,
  let h := succ_num_denom r,
  rw [← this] at h,
  exact ⟨h.2.symm ▸ h.1.symm, h.2.symm⟩
end

theorem cosucc_num_denom (q : ℚ+) :
  q.cosucc.num = q.num ∧ q.cosucc.denom = q.denom + q.num :=
begin
  let h := succ_num_denom q⁻¹,
  rw [cosucc, inv_num, inv_denom, h.1, h.2, inv_denom, inv_num],
  split; refl
end

theorem copred_num_denom {q : ℚ+} (h : q < 1) :
  q.copred.num = q.num ∧ q.copred.denom + q.num = q.denom :=
begin
  let h' := pred_num_denom (inv_gt_one_iff.mpr h),
  rw [inv_num, inv_denom] at h',
  rw [copred, inv_num, inv_denom, h'.2, h'.1],
  split; refl
end

theorem pred_sizeof {q : ℚ+} (h : q > 1) : sizeof (pred q) < sizeof q :=
by { let h := pred_num_denom h,
     rw [sizeof_val, sizeof_val, ← h.1, ← h.2, pnat.add_coe],
     apply nat.lt_add_of_pos_right q.pred.denom.pos }

theorem copred_sizeof {q : ℚ+} (h : q < 1) : sizeof (copred q) < sizeof q :=
by { dsimp [copred], rw[inv_sizeof (pred q⁻¹), ← inv_sizeof q],
     exact pred_sizeof (inv_gt_one_iff.mpr h) }

def of_word : list bool → ℚ+
| list.nil := 1
| (list.cons tt l) := succ (of_word l)
| (list.cons ff l) := cosucc (of_word l)

def to_word : ℚ+ → list bool
| q := dite (q = 1)
        (λ h_eq, list.nil)
        (λ h_ne, dite (q > 1)
                 (λ h_gt,
                    have h' : _ := pred_sizeof h_gt,
                    list.cons tt (to_word (pred q)) )
                 (λ h_le,
                    have h_lt : q < 1 := lt_of_le_of_ne (le_of_not_gt h_le) h_ne,
                    have h' : _ := copred_sizeof h_lt,
                    list.cons ff (to_word (copred q))))

theorem to_word_one : to_word (1 : ℚ+) = list.nil := begin
  have h : (1 : ℚ+) = (1 : ℚ+) := rfl,
  rw[to_word, dif_pos h]
end

theorem to_word_of_gt_one {q : ℚ+} (h : q > 1) :
  q.to_word = list.cons tt q.pred.to_word :=
by rw [to_word, dif_neg (ne_of_gt h), dif_pos h]

theorem to_word_of_lt_one {q : ℚ+} (h : q < 1) :
  q.to_word = list.cons ff q.copred.to_word :=
by rw [to_word, dif_neg (ne_of_lt h), dif_neg (not_lt_of_ge (le_of_lt h)) ]

theorem to_of_word : ∀ l : list bool, to_word (of_word l) = l
| list.nil := to_word_one
| (list.cons tt l) :=
    by rw [of_word, to_word_of_gt_one (succ_gt_one _), pred_succ, to_of_word l]
| (list.cons ff l) :=
    by rw [of_word, to_word_of_lt_one (cosucc_lt_one _), copred_cosucc, to_of_word l]

theorem of_to_word : ∀ (q : ℚ+), of_word (to_word q) = q
| q := dite (q = 1)
         (λ h_eq, by { rw[h_eq,to_word_one], refl })
         (λ h_ne, dite (q > 1)
                  (λ h_gt,
                     have h' : _ := pred_sizeof h_gt,
                     by { rw [to_word_of_gt_one h_gt, of_word,
                              of_to_word q.pred, succ_pred h_gt] }
                  )
                  (λ h_le,
                     have h_lt : q < 1 := lt_of_le_of_ne (le_of_not_gt h_le) h_ne,
                     have h' : _ := copred_sizeof h_lt,
                     by { rw [to_word_of_lt_one h_lt, of_word,
                              of_to_word q.copred, cosucc_copred h_lt] } ) )

end prat


/-
Some basic facts unrelated to clauses, etc.

Author: Cayden Codel, Marijn Heule, Jeremy Avigad
Carnegie Mellon University
-/

import data.bool.basic
import data.list.basic
import data.fin.basic
import data.list.indexes
import init.data.nat.lemmas
import data.finset.basic
import data.finset.fold
import init.function
import tactic

open list
open function
open nat

variables {α β γ : Type*}

/-! # Boolean logic -/

/- General -/

theorem ne_of_eq_ff_of_eq_tt {a b : bool} : a = ff → b = tt → a ≠ b :=
assume h₁ h₂, by { rw [h₁, h₂], intro h, contradiction }

theorem bool_symm : ∀ (a b : bool), a = b ↔ b = a :=
by simp only [bool.forall_bool, iff_self, and_self]

theorem prod.ext_self {α β : Type*} (p : α × β) : p = ⟨p.1, p.2⟩ :=
prod.ext rfl rfl

/- bxor -/

@[simp] theorem bxor_tt_left  : ∀ a, bxor tt a = !a := dec_trivial
@[simp] theorem bxor_tt_right : ∀ a, bxor a tt = !a := dec_trivial

theorem bxor_conjunctive (a b : bool) : bxor a b = (a || b) && (!a || !b) :=
by cases a; cases b; dec_trivial

theorem bxor_disjunctive (a b : bool) : bxor a b = (!a && b) || (a && !b) :=
by cases a; cases b; dec_trivial

/- cond -/

@[simp] theorem cond_tt_ff : ∀ a, cond a tt ff = a := dec_trivial
@[simp] theorem cond_ff_tt : ∀ a, cond a ff tt = !a := dec_trivial

theorem tt_of_cond_ne_second [decidable_eq α] {c d : α} {b : bool} :
  cond b c d ≠ d → b = tt :=
by { cases b, contradiction, tautology }

theorem ff_of_cond_ne_first [decidable_eq α] {c d : α} {b : bool} :
  cond b c d ≠ c → b = ff :=
by { cases b, tautology, contradiction }

theorem tt_of_ne_second_of_cond_eq [decidable_eq α] {c d e : α} {b : bool} :
  d ≠ e → cond b c d = e → b = tt :=
by { cases b, { intros, contradiction }, { tautology } }

theorem ff_of_ne_first_of_cond_eq [decidable_eq α] {c d e : α} {b : bool} :
  c ≠ e → cond b c d = e → b = ff :=
by { cases b, { tautology }, { intros, contradiction } }

theorem tt_of_ne_of_cond_eq_first [decidable_eq α] {c d : α} {b : bool} :
  c ≠ d → cond b c d = c → b = tt :=
by { cases b, { intros h₁ h₂, exact absurd h₂.symm h₁ }, { tautology } }

theorem ff_of_ne_of_cond_eq_second [decidable_eq α] {c d : α} {b : bool} :
  c ≠ d → cond b c d = d → b = ff :=
by { cases b, { tautology }, { intros, contradiction }}

/-! # Set -/

theorem not_mem_subset {a : α} {s₁ s₂ : set α} : a ∉ s₂ → s₁ ⊆ s₂ → a ∉ s₁ :=
begin
  intros ha hs,
  exact mt (@hs a) ha,
end

/-! # List operations -/

/- General results -/

theorem exists_append_singleton_of_ne_nil {l : list α} :
  l ≠ [] → ∃ L a, l = L ++ [a] :=
begin
  induction l with l₁ l ih,
  { contradiction },
  { intro h,
    cases l with l₂ l,
    { use [[], l₁], simp only [nil_append, eq_self_iff_true, and_self] },
    { rcases ih (cons_ne_nil l₂ l) with ⟨L, t, ht⟩,
      use [l₁ :: L, t], simp only [ht, cons_append, eq_self_iff_true, and_self] } }
end

-- TODO: do casewise with |, not in tactic
theorem exists_cons_cons_of_length_ge_two {l : list α} :
  length l ≥ 2 → ∃ (a b : α) (L : list α), (a :: b :: L) = l :=
begin
  cases l with a as,
  { intro h, rw length at h, linarith },
  { cases as with b bs,
    { intro h, rw [length, length] at h, linarith },
    { intro _,
      use [a, b, bs] } }
end

theorem exists_cons_cons_of_length_eq_two {l : list α} :
  length l = 2 → ∃ (a b : α), [a, b] = l :=
begin
  cases l with a as,
  { intro h, rw length at h, linarith },
  { cases as with b bs,
    { intro h, rw [length, length] at h, linarith },
    { cases bs with c cs,
      { simp },
      { intro h, rw [length, length, length] at h, linarith } } }
end

theorem nth_le_of_ge {α : Type*} {l : list α} {n c : nat} (Hn : n < length l) :
  n ≥ c → ∃ (Hn' : (n - c) + c < length l),
  nth_le l n Hn = nth_le l ((n - c) + c) Hn' :=
begin
  intro hc,
  have := nat.sub_add_cancel hc,
  use this.symm ▸ Hn,
  simp [this]
end

theorem nth_le_mem_take_of_lt {α : Type*} [inhabited α] {l : list α} {i j : nat} (Hi : i < length l) :
  i < j → l.nth_le i Hi ∈ l.take j :=
begin
  induction l with a as ih generalizing i j,
  { simp at Hi, contradiction },
  { intro hlt,
    cases i,
    { cases j,
      { exact absurd hlt (nat.not_lt_zero 0) },
      { rw [nth_le_zero, head, take], exact mem_cons_self _ _ } },
    { cases j,
      { exact absurd hlt (nat.not_lt_zero i.succ) },
      { rw [nth_le, take],
        rw length at Hi,
        exact mem_cons_of_mem _ (ih (succ_lt_succ_iff.mp Hi) (succ_lt_succ_iff.mp hlt)) } } }
end

theorem nth_le_mem_drop_of_ge {α : Type*} [inhabited α] {l : list α} {i j : nat} (Hi : i < length l) :
  i ≥ j → l.nth_le i Hi ∈ l.drop j :=
begin
  induction l with a as ih generalizing i j,
  { simp at Hi, contradiction },
  { intro hge,
    cases i,
    { cases j,
      { rw [nth_le, drop], exact mem_cons_self _ _ },
      { simp at hge, contradiction } },
    { cases j,
      { rw drop, exact nth_le_mem _ _ _ },
      { rw [nth_le, drop],
        rw length at Hi,
        exact ih (succ_lt_succ_iff.mp Hi) (succ_le_succ_iff.mp hge) } } }
end

theorem take_one_of_ne_nil {α : Type*} [inhabited α] {l : list α} :
  l ≠ [] → l.take 1 = [l.head] :=
begin
  intro hl,
  rcases exists_cons_of_ne_nil hl with ⟨a, as, rfl⟩,
  simp [take, head]
end

@[simp] theorem mem_map_with_index {α β : Type*} {l : list α} {b : β} {f : nat → α → β} :
  b ∈ l.map_with_index f ↔ ∃ (a : α) (i : nat) (Hi : i < length l), a = l.nth_le i Hi ∧ f i a = b :=
begin
  induction l with a l ih generalizing f,
  { split, { rintro ⟨_⟩ }, { rintro ⟨a, _, ⟨_⟩, _⟩ } },
  { split,
    { intro hb,
      rcases eq_or_mem_of_mem_cons hb with (rfl | hw),
      { use [a, 0, dec_trivial],
        rw nth_le,
        exact ⟨rfl, rfl⟩ },
      { rw map_with_index_core_eq at hw,
        rcases ih.mp hw with ⟨a, i, Hi, ha, hf⟩,
        use [a, i + 1, succ_lt_succ_iff.mpr Hi],
        rw nth_le,
        subst ha,
        simp [hf], -- Investigate below later
        exact equiv.apply_swap_eq_self rfl Hi } },
    { rintros ⟨a, i, Hi, ha, hf⟩,
      cases i,
      { rw nth_le at ha,
        subst hf,
        rw [map_with_index, map_with_index_core, ha],
        exact mem_cons_self _ _ },
      { rw nth_le at ha,
        have := succ_lt_succ_iff.mp Hi,
        rw [map_with_index, map_with_index_core],
        apply (mem_cons_iff _ _ _).mpr,
        right,
        rw map_with_index_core_eq,
        apply ih.mpr,
        use [a, i, this, ha, hf] } } }
end

theorem take_sublist_of_le {α : Type*} {i j : nat} : i ≤ j →
  ∀ (l : list α), l.take i <+ l.take j :=
begin
  intros hij l,
  induction l with a as ih generalizing i j,
  { rw [take_nil, take_nil] },
  { cases i,
    { rw take_zero,
      exact nil_sublist _ },
    { cases j,
      { exact absurd hij (not_le.mpr (succ_pos i)) },
      { rw [take, take],
        exact cons_sublist_cons_iff.mpr (ih (succ_le_succ_iff.mp hij)) } } }
end

theorem ne_tail_of_eq_head_of_ne [decidable_eq α] {a b : α} {l₁ l₂ : list α} :
  (a :: l₁) ≠ (b :: l₂) → a = b → l₁ ≠ l₂ :=
assume hne hab hl, absurd (congr (congr_arg cons hab) hl) hne

theorem length_lt_length_cons (a : α) (l : list α) :
  length l < length (a :: l) :=
by { rw length_cons, exact lt_add_one _ }

theorem strong_induction_on_lists [inhabited α] {p : list α → Prop} (l : list α)
  (h : ∀ l₁, (∀ l₂, length l₂ < length l₁ → p l₂) → p l₁) : p l :=
suffices ∀ (l₁ : list α) (l₂ : list α), length l₂ < length l₁ → p l₂,
  from this ((arbitrary α) :: l) l (length_lt_length_cons (arbitrary α) l),
begin
  intro l₁, induction l₁ with a as ih,
  { intros l₂ h₁, exact absurd h₁ (l₂.length).not_lt_zero },
  { intros m h₁,
    apply or.by_cases (decidable.lt_or_eq_of_le (nat.le_of_lt_succ h₁)),
    { intros, apply ih, assumption },
    { intro hlen, have := h m, rw hlen at this, exact this ih } }
end

theorem exists_append_of_gt_length {l : list α} {n : nat} :
  length l > n → ∃ (l₁ l₂ : list α), l₁ ++ l₂ = l ∧ length l₁ = n :=
begin
  induction n with n ih,
  { intro h, use [nil, l, nil_append l, rfl] },
  { intro h,
    rcases ih (nat.lt_of_succ_lt h) with ⟨l₁, l₂, rfl, hl₁⟩,
    cases l₂ with l₂h hl₂t,
    { simp [hl₁] at h,
      exact absurd h (nat.not_succ_lt_self) },
    { use [l₁ ++ [l₂h], hl₂t],
      simp only [hl₁, eq_self_iff_true, length, singleton_append,
        append_assoc, and_self, length_append] } }
end

theorem exists_append_mem_of_mem_of_ne {l : list α} {a b : α} :
  a ∈ l → b ∈ l → a ≠ b → ∃ (l₁ l₂), l₁ ++ l₂ = l ∧
  ((a ∈ l₁ ∧ b ∈ l₂) ∨ (a ∈ l₂ ∧ b ∈ l₁)) :=
begin
  induction l with x xs ih,
  { simp only [not_mem_nil, is_empty.forall_iff] },
  { intros ha hb hne,
    rcases eq_or_mem_of_mem_cons ha with (rfl | ha),
    { have := mem_of_ne_of_mem hne.symm hb,
      use [[a], xs],
      simp only [this, true_or, eq_self_iff_true, singleton_append,
        and_self, mem_singleton] },
    { rcases eq_or_mem_of_mem_cons hb with (rfl | hb),
      { have := mem_of_ne_of_mem hne ha,
        use [[b], xs],
        simp only [this, hne, false_or, eq_self_iff_true, singleton_append,
          and_self, mem_singleton, false_and] },
      { rcases ih ha hb hne with ⟨l₁, l₂, rfl, (⟨hl₁, hl₂⟩ | ⟨hl₁, hl₂⟩)⟩,
        { use [(x :: l₁), l₂],
          simp only [hl₁, hl₂, mem_cons_iff, cons_append, true_or,
            eq_self_iff_true, or_true, and_self] },
        { use [(x :: l₁), l₂],
          simp only [hl₁, hl₂, mem_cons_iff, cons_append, eq_self_iff_true,
            or_true, and_self] } } } }
end

theorem nth_le_sub_of_gt_zero {l : list α} {a : α} {n : nat}
  (hn : n < length (a :: l)) (hnsub : (n - 1) < length l) :
  n > 0 → nth_le (a :: l) n hn = nth_le l (n - 1) hnsub :=
begin
  cases n,
  { intro h, exact absurd (ge_of_eq (refl 0)) (not_le.mpr h) },
  { intro _,
    rw nth_le,
    refl }
end

/- fold -/

theorem foldr_bor_tt (l : list α) (f : α → bool) :
  foldr (λ x b, b || f x) tt l = tt :=
begin
  induction l with x xs ih,
  { rw foldr_nil },
  { rw [foldr_cons, ih, tt_bor] }
end

theorem foldr_band_ff (l : list α) (f : α → bool) :
  foldr (λ x b, b && f x) ff l = ff :=
begin
  induction l with x xs ih,
  { rw foldr_nil },
  { rw [foldr_cons, ih, ff_band] }
end

section map

variables {f : α → β} {a : α} {b : β} {l : list α}

theorem exists_of_map_singleton : map f l = [b] → ∃ a, [a] = l ∧ f a = b :=
begin
  cases l with x xs,
  { contradiction },
  { simp [map_cons],
    intros h₁ h₂,
    simp [h₁, h₂] }
end

theorem exists_cons_of_map_cons {bs : list β} :
  map f l = b :: bs → ∃ h L, l = h :: L ∧ f h = b ∧ map f L = bs :=
begin
  cases l with x xs,
  { contradiction },
  { rw map_cons,
    intro h,
    use [x, xs, ⟨refl _, (head_eq_of_cons_eq h), (tail_eq_of_cons_eq h)⟩] }
end

theorem exists_map_cons_of_map_cons {as : list α} : map f l = map f (a :: as) →
  ∃ h L, l = h :: L ∧ f h = f a ∧ map f L = map f as :=
by { rw [map_cons], intro h, exact exists_cons_of_map_cons h }

theorem mem_map_append {l₁ l₂ : list α} {f : α → β} {b : β} :
  b ∈ map f (l₁ ++ l₂) → b ∈ map f l₁ ∨ b ∈ map f l₂ :=
by { rw [map_append, mem_append], exact id }

theorem mem_map_fst_of_mem {l : list (α × β)} {a : α} {b : β} :
  (a, b) ∈ l → a ∈ map prod.fst l :=
assume h, mem_map.mpr ⟨⟨a, b⟩, h, rfl⟩

theorem mem_map_snd_of_mem {l : list (α × β)} {a : α} {b : β} :
  (a, b) ∈ l → b ∈ map prod.snd l :=
assume h, mem_map.mpr ⟨⟨a, b⟩, h, rfl⟩

end map

/- filter -/

theorem length_filter {p : α → Prop} [decidable_pred p] {l : list α} :
  length (filter p l) ≤ length l :=
begin
  induction l with x xs ih,
  { refl },
  { by_cases p x,
    { rw [filter_cons_of_pos _ h, length_cons, length_cons],
      exact nat.succ_le_succ_iff.mpr ih },
    { rw [filter_cons_of_neg _ h, length_cons],
      exact le_add_right ih } }
end

/-! # Naturals and successors of supremums -/

section nat

open nat

variables {f : α → nat} {l : list nat} {n m : nat}

/- General -/

theorem ne_succ_add (n m : nat) : n.succ + m ≠ n :=
begin
  rw [succ_eq_add_one, add_assoc, ← succ_eq_one_add],
  exact ne_of_gt (lt_add_of_pos_right n (succ_pos m))
end

theorem eq_succ_of_gt_of_le_succ {n m : nat} : m < n → n ≤ m + 1 → n = m + 1 :=
assume h₁ h₂, ge_antisymm (succ_le_iff.mpr h₁) h₂

theorem add_gt_one_of_gt_zero_of_gt_zero {n m : nat} : n > 0 → m > 0 → n + m > 1 :=
assume h₁ h₂, succ_le_iff.mp (add_le_add (succ_le_iff.mpr h₁) (succ_le_iff.mpr h₂))

theorem lt_min_left {a b c : nat} : a < min b c → a < b :=
assume hmin, lt_of_lt_of_le hmin (min_le_left b c)

theorem lt_min_right {a b c : nat} : a < min b c → a < c :=
assume hmin, lt_of_lt_of_le hmin (min_le_right b c)

section max_nat

def max_nat : list nat → nat
| []        := 0
| (n :: ns) := max n (max_nat ns)

theorem max_nat_eq_foldr_max (l) : max_nat l = foldr max 0 l :=
begin
  induction l with n ns ih,
  { refl },
  { unfold max_nat, rw [foldr_cons, ih] }
end

theorem le_max_nat_of_mem : n ∈ l → n ≤ max_nat l :=
begin
  induction l with m ms ih,
  { intro h, exact absurd h (not_mem_nil _) },
  { intros h,
    rcases eq_or_mem_of_mem_cons h with rfl | hms,
    { exact le_max_iff.mpr (or.inl (le_refl n)) },
    { exact le_max_iff.mpr (or.inr (ih hms)) } }
end

theorem not_mem_of_gt_max_nat : n > max_nat l → n ∉ l :=
by { contrapose, simp, exact le_max_nat_of_mem }

theorem exists_not_mem_of_bijective_of_gt_max_nat
  (hf : bijective f) {l : list α} :
  n > max_nat (map f l) → ∃ a, f a = n ∧ a ∉ l :=
begin
  intros h,
  rcases (bijective_iff_exists_unique f).mp hf n with ⟨b, hb, _⟩,
  use b,
  split,
  { exact hb },
  { intro hbl,
    exact (not_mem_of_gt_max_nat h) (hb ▸ mem_map_of_mem f hbl) }
end

end max_nat

end nat

/-! # fin -/
namespace fin
open fin

theorem eq_or_exists_eq {n : ℕ} (i : fin (n + 1)) : i = n ∨ ∃ j : fin n, i = j :=
begin
  rcases eq_or_lt_of_le (le_of_lt_succ i.prop) with (h | h),
  { left,
    have : ↑n = ↑(i.val), { rw h },
    rw this,
    simp },
  { right, use ⟨i.val, h⟩, simp }
end

/-! # range -/

def range_core (n : nat) : list (fin (n + 1)) → Π (m : nat), m < n + 1 → list (fin (n + 1))
| l 0       hm := ⟨0, hm⟩ :: l
| l (m + 1) hm := range_core (⟨m + 1, hm⟩ :: l) m (lt_of_succ_lt hm)

def range : Π (n : nat), list (fin n)
| 0       := []
| (n + 1) := range_core n [] n (lt_succ_self n)

theorem mem_range_core {n m : nat} (hm : m < n + 1) :
  ∀ (l : list (fin (n + 1))) (a : fin (n + 1)),
  a ∈ range_core n l m hm ↔ (a ∈ l ∨ a.val ≤ m) :=
begin
  intros l a,
  induction m with m ih generalizing l,
  { simp [range_core],
    split,
    { rintro (rfl | h),
      { exact or.inr rfl },
      { exact or.inl h } },
    { rintro (h | h),
      { exact or.inr h },
      { exact or.inl (ext h) } } },
  { split,
    { intro ha,
      unfold range_core at ha,
      rcases (ih (lt_of_succ_lt hm) _).mp ha with (h | h),
      { rcases eq_or_mem_of_mem_cons h with (rfl | hl),
        { right, refl },
        { exact or.inl hl } },
      { exact or.inr (le_succ_of_le h) } },
    { intro ha,
      unfold range_core,
      apply (ih (lt_of_succ_lt hm) _).mpr,
      rcases ha with (h | h),
      { exact or.inl (mem_cons_of_mem _ h) },
      { rcases eq_or_lt_of_le h with (h | h),
        { left,
          have : a = ⟨m + 1, hm⟩,
          { exact ext h },
          rw this,
          exact mem_cons_self _ l },
        { exact or.inr (le_of_lt_succ h) } } } }
end

theorem mem_range (n : nat) : ∀ (a : fin n), a ∈ range n :=
begin
  intro a,
  induction n with n ih,
  { exact elim0 a },
  { apply (mem_range_core (lt_succ_self n) [] a).mpr,
    exact or.inr (le_of_lt_succ a.prop) }
end

/-! # Cartesian product -/

def cp (n m : nat) : list (fin n × fin m) :=
  join ((range n).map (λ a, (range m).map (λ b, ⟨a, b⟩)))

theorem mem_cp (n m : nat) : ∀ (a : fin n) (b : fin m), (a, b) ∈ cp n m :=
begin
  intros a b,
  simp only [cp, mem_join, mem_map, exists_exists_and_eq_and, prod.mk.inj_iff, exists_eq_right_right],
  exact ⟨mem_range n a, mem_range m b⟩
end

def square : Π {n : nat}, fin n → fin (n^2)
| 0       i := elim0 i
| (n + 1) i := ⟨i.val * (n + 1), (pow_two (n + 1)).symm ▸ (mul_lt_mul_right (zero_lt_succ n)).mpr i.prop⟩

theorem nat.mul_pred_eq_square_sub (n : nat) : n * (n - 1) = n^2 - n :=
by rw [pow_two, nat.mul_sub_left_distrib, mul_one]

theorem nat.le_square_sub_of_lt {a b : nat} : a < b → a * b ≤ b^2 - b :=
begin
  intro h,
  cases b,
  { exact absurd h (nat.not_lt_zero a) },
  { rw ← nat.mul_pred_eq_square_sub,
    simp,
    rw mul_comm b.succ b,
    exact (mul_le_mul_right (pos_of_gt h)).mpr (le_of_lt_succ h) }
end

theorem nat.sub_add_lt_of_lt_of_lt {a b c : nat} : a < b → b < c → c - b + a < c :=
assume ha hb, lt_of_lt_of_le (add_lt_add_left ha (c - b)) (le_of_eq (nat.sub_add_cancel (le_of_lt hb)))

theorem nat.lt_square_of_gt_one {a : nat} : 1 < a → a < a^2 :=
begin
  intro h,
  rw pow_two,
  exact lt_mul_self h
end

theorem nat.sub_add_lt_square_of_lt {a b : nat} : a < b → b^2 - b + a < b^2 :=
begin
  intro h,
  cases b,
  { exact absurd h (nat.not_lt_zero a) },
  { cases b,
    { simp at h, subst h, simp },
    { have : 1 < b.succ.succ, dec_trivial,
      exact nat.sub_add_lt_of_lt_of_lt h (nat.lt_square_of_gt_one this) } }
end

theorem nat.mul_add_lt_square_of_lt_of_lt {a b c : nat} : a < c → b < c → (a * c) + b < c^2 :=
assume h₁ h₂, lt_of_le_of_lt (add_le_add_right (nat.le_square_sub_of_lt h₁) b)
  (nat.sub_add_lt_square_of_lt h₂)

def square_add : Π {n : nat}, fin n → fin n → fin (n^2)
| 0       i j := fin.elim0 i
| (n + 1) i j := ⟨i.val * (n + 1) + j.val, nat.mul_add_lt_square_of_lt_of_lt i.prop j.prop⟩

end fin

namespace finset
open finset

variables [decidable_eq α]

theorem subset_union_of_subset_left {s₁ s₂ : finset α} (s₃ : finset α) :
  s₁ ⊆ s₂ → s₁ ⊆ s₂ ∪ s₃ :=
λ h, subset.trans h (subset_union_left s₂ s₃)

theorem subset_union_of_subset_right {s₁ s₃ : finset α} (s₂ : finset α) :
  s₁ ⊆ s₃ → s₁ ⊆ s₂ ∪ s₃ :=
λ h, subset.trans h (subset_union_right s₂ s₃)

end finset

namespace list

/-! # idx_filter -/

/- Better version with fin, but tough to prove theorems about
def filter_by_idx (l : list α) (p : fin (length l) → Prop) [decidable_pred p] : list α :=
  map prod.snd (filter (p ∘ prod.fst) (zip (fin.range (length l)) l))
-/

-- Version with nat. Still hard to prove things
--def filter_by_idx (p : nat → Prop) [decidable_pred p] (l : list α) : list α :=
--  map prod.snd (filter (p ∘ prod.fst) (zip (range (length l)) l))

section filter_by_idx

variables (p : nat → Prop) [decidable_pred p] (a : α) (l : list α)

def filter_by_idx_core : nat → list α → list α
| n []        := []
| n (a :: as) := if p n then a :: (filter_by_idx_core (n + 1) as)
                 else filter_by_idx_core (n + 1) as

def filter_by_idx : list α := filter_by_idx_core p 0 l

@[simp] theorem filter_by_idx_core_nil (n : nat) : filter_by_idx_core p n ([] : list α) = [] := rfl
@[simp] theorem filter_by_idx_nil : filter_by_idx p ([] : list α) = [] := rfl

@[simp] theorem filter_by_idx_core_singleton (n : nat) :
  filter_by_idx_core p n [a] = if p n then [a] else [] := rfl

@[simp] theorem filter_by_idx_singleton : filter_by_idx p [a] = if p 0 then [a] else [] := rfl

theorem filter_by_idx_core_add (n c : nat) :
  filter_by_idx_core (p ∘ (λ x, x + c)) n l = filter_by_idx_core p (n + c) l :=
begin
  induction l with a as ih generalizing n c,
  { refl },
  { unfold filter_by_idx_core,
    by_cases hp : p (n + c);
    { simp [hp],
      rw [add_assoc n c 1, add_comm c 1, ← add_assoc n 1 c],
      exact ih (n + 1) c } }
end

@[simp] theorem filter_by_idx_cons (p : nat → Prop) [decidable_pred p] (a : α) (l : list α) :
  filter_by_idx p (a :: l) = if p 0 then a :: filter_by_idx (p ∘ succ) l else filter_by_idx (p ∘ succ) l :=
begin
  unfold filter_by_idx,
  rw filter_by_idx_core,
  by_cases hp : p 0;
  { simp [hp], exact (filter_by_idx_core_add p l 0 1).symm }
end

theorem map_filter_by_idx (f : β → α) (l : list β) (p : nat → Prop) [decidable_pred p] :
  filter_by_idx p (map f l) = map f (filter_by_idx p l) :=
begin
  unfreezingI { induction l with b bs ih generalizing p,
  { refl },
  { by_cases hp : p 0;
    { simp [hp], apply ih (p ∘ succ) } } }
end

theorem filter_by_idx_sublist : filter_by_idx p l <+ l :=
begin
  unfreezingI { induction l with a as ih generalizing p,
  { refl },
  { by_cases hp : p 0; simp [hp],
    { apply sublist.cons_cons a, exact ih _ },
    { apply sublist.cons, exact ih _ } } }
end

theorem filter_by_idx_subset : filter_by_idx p l ⊆ l :=
sublist.subset (filter_by_idx_sublist _ _)

end filter_by_idx

end list


/-
Copyright (c) 2022 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Floris van Doorn, Yury Kudryashov
-/
import order.filter.lift
import order.filter.at_top_bot

/-!
# The filter of small sets

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

This file defines the filter of small sets w.r.t. a filter `f`, which is the largest filter
containing all powersets of members of `f`.

`g` converges to `f.small_sets` if for all `s ∈ f`, eventually we have `g x ⊆ s`.

An example usage is that if `f : ι → E → ℝ` is a family of nonnegative functions with integral 1,
then saying that `λ i, support (f i)` tendsto `(𝓝 0).small_sets` is a way of saying that
`f` tends to the Dirac delta distribution.
-/

open_locale filter
open filter set

variables {α β : Type*} {ι : Sort*}

namespace filter

variables {l l' la : filter α} {lb : filter β}

/-- The filter `l.small_sets` is the largest filter containing all powersets of members of `l`. -/
def small_sets (l : filter α) : filter (set α) := l.lift' powerset

lemma small_sets_eq_generate {f : filter α} : f.small_sets = generate (powerset '' f.sets) :=
by { simp_rw [generate_eq_binfi, small_sets, infi_image], refl }

lemma has_basis.small_sets {p : ι → Prop} {s : ι → set α}
  (h : has_basis l p s) : has_basis l.small_sets p (λ i, 𝒫 (s i)) :=
h.lift' monotone_powerset

lemma has_basis_small_sets (l : filter α) :
  has_basis l.small_sets (λ t : set α, t ∈ l) powerset :=
l.basis_sets.small_sets

/-- `g` converges to `f.small_sets` if for all `s ∈ f`, eventually we have `g x ⊆ s`. -/
lemma tendsto_small_sets_iff {f : α → set β} :
  tendsto f la lb.small_sets ↔ ∀ t ∈ lb, ∀ᶠ x in la, f x ⊆ t :=
(has_basis_small_sets lb).tendsto_right_iff

lemma eventually_small_sets {p : set α → Prop} :
  (∀ᶠ s in l.small_sets, p s) ↔ ∃ s ∈ l, ∀ t ⊆ s, p t :=
eventually_lift'_iff monotone_powerset

lemma eventually_small_sets' {p : set α → Prop} (hp : ∀ ⦃s t⦄, s ⊆ t → p t → p s) :
  (∀ᶠ s in l.small_sets, p s) ↔ ∃ s ∈ l, p s :=
eventually_small_sets.trans $ exists₂_congr $ λ s hsf,
  ⟨λ H, H s subset.rfl, λ hs t ht, hp ht hs⟩

lemma frequently_small_sets {p : set α → Prop} :
  (∃ᶠ s in l.small_sets, p s) ↔ ∀ t ∈ l, ∃ s ⊆ t, p s :=
l.has_basis_small_sets.frequently_iff

lemma frequently_small_sets_mem (l : filter α) : ∃ᶠ s in l.small_sets, s ∈ l :=
frequently_small_sets.2 $ λ t ht, ⟨t, subset.rfl, ht⟩

lemma has_antitone_basis.tendsto_small_sets {ι} [preorder ι] {s : ι → set α}
  (hl : l.has_antitone_basis s) : tendsto s at_top l.small_sets :=
tendsto_small_sets_iff.2 $ λ t ht, hl.eventually_subset ht

@[mono] lemma monotone_small_sets : monotone (@small_sets α) :=
monotone_lift' monotone_id monotone_const

@[simp] lemma small_sets_bot : (⊥ : filter α).small_sets = pure ∅ :=
by rw [small_sets, lift'_bot monotone_powerset, powerset_empty, principal_singleton]

@[simp] lemma small_sets_top : (⊤ : filter α).small_sets = ⊤ :=
by rw [small_sets, lift'_top, powerset_univ, principal_univ]

@[simp] lemma small_sets_principal (s : set α) : (𝓟 s).small_sets = 𝓟(𝒫 s) :=
lift'_principal monotone_powerset

lemma small_sets_comap (l : filter β) (f : α → β) :
  (comap f l).small_sets = l.lift' (powerset ∘ preimage f) :=
comap_lift'_eq2 monotone_powerset

lemma comap_small_sets (l : filter β) (f : α → set β) :
  comap f l.small_sets = l.lift' (preimage f ∘ powerset) :=
comap_lift'_eq

lemma small_sets_infi {f : ι → filter α} :
  (infi f).small_sets = (⨅ i, (f i).small_sets) :=
lift'_infi_of_map_univ powerset_inter powerset_univ

lemma small_sets_inf (l₁ l₂ : filter α) :
  (l₁ ⊓ l₂).small_sets = l₁.small_sets ⊓ l₂.small_sets :=
lift'_inf _ _ powerset_inter

instance small_sets_ne_bot (l : filter α) : ne_bot l.small_sets :=
(lift'_ne_bot_iff monotone_powerset).2 $ λ _ _, powerset_nonempty

lemma tendsto.small_sets_mono {s t : α → set β}
  (ht : tendsto t la lb.small_sets) (hst : ∀ᶠ x in la, s x ⊆ t x) :
  tendsto s la lb.small_sets :=
begin
  rw [tendsto_small_sets_iff] at ht ⊢,
  exact λ u hu, (ht u hu).mp (hst.mono $ λ a hst ht, subset.trans hst ht)
end

/-- Generalized **squeeze theorem** (also known as **sandwich theorem**). If `s : α → set β` is a
family of sets that tends to `filter.small_sets lb` along `la` and `f : α → β` is a function such
that `f x ∈ s x` eventually along `la`, then `f` tends to `lb` along `la`.

If `s x` is the closed interval `[g x, h x]` for some functions `g`, `h` that tend to the same limit
`𝓝 y`, then we obtain the standard squeeze theorem, see
`tendsto_of_tendsto_of_tendsto_of_le_of_le'`. -/
lemma tendsto.of_small_sets {s : α → set β} {f : α → β} (hs : tendsto s la lb.small_sets)
  (hf : ∀ᶠ x in la, f x ∈ s x) : tendsto f la lb :=
λ t ht, hf.mp $ (tendsto_small_sets_iff.mp hs t ht).mono $ λ x h₁ h₂, h₁ h₂

@[simp] lemma eventually_small_sets_eventually {p : α → Prop} :
  (∀ᶠ s in l.small_sets, ∀ᶠ x in l', x ∈ s → p x) ↔ ∀ᶠ x in l ⊓ l', p x :=
calc _ ↔ ∃ s ∈ l, ∀ᶠ x in l', x ∈ s → p x :
  eventually_small_sets' $ λ s t hst ht, ht.mono $ λ x hx hs, hx (hst hs)
... ↔ ∃ (s ∈ l) (t ∈ l'), ∀ x, x ∈ t → x ∈ s → p x :
  by simp only [eventually_iff_exists_mem]
... ↔ ∀ᶠ x in l ⊓ l', p x : by simp only [eventually_inf, and_comm, mem_inter_iff, ← and_imp]

@[simp] lemma eventually_small_sets_forall {p : α → Prop} :
  (∀ᶠ s in l.small_sets, ∀ x ∈ s, p x) ↔ ∀ᶠ x in l, p x :=
by simpa only [inf_top_eq, eventually_top] using @eventually_small_sets_eventually α l ⊤ p

alias eventually_small_sets_forall ↔ eventually.of_small_sets eventually.small_sets

@[simp] lemma eventually_small_sets_subset {s : set α} :
  (∀ᶠ t in l.small_sets, t ⊆ s) ↔ s ∈ l :=
eventually_small_sets_forall

end filter


import data.fintype.basic
import data.sym.sym2
import data.list
import data.set.basic
import order.conditionally_complete_lattice
import init.logic
import init.data.nat
import data.nat.lattice
import data.nat.parity

/-
Reflexive Graphs:
We define reflexive graphs as a refstraAlexive symmetric relation on a vertex type 'V'.
-/
open finset
open classical

noncomputable theory
open_locale classical

structure refl_graph (V: Type):=
(adj : V → V → Prop)
(sym : symmetric adj)
(selfloop : reflexive adj . obviously)

def get_vtxs {V: Type} (G: refl_graph V) : Type := V

def complete_refl_graph (V: Type) : refl_graph V :=
{ adj := λ u v, true,
  sym := λ u v h,  trivial ,
  selfloop := λ u, trivial }

-- open_locale classical
@[symm] lemma rgraph_adj_symm {V: Type} {G: refl_graph V} {v w : V} : G.adj v w ↔ G.adj w v :=
begin
  split, intro x, exact G.sym x, intro y, exact G.sym y,
end

lemma rgraph_adj_eq_trans {V: Type} {G: refl_graph V} {v w x: V} (P: G.adj v w) (Q: w=x) : G.adj v x :=
begin
  rw Q.symm, exact P,
end

lemma rgraph_nadj_imp_neq {V: Type} {G: refl_graph V} {v w: V} (P: ¬ G.adj v w) : v ≠ w :=
begin
  classical,
  by_contradiction K,
  let P' := rgraph_adj_eq_trans (G.selfloop v) K,
  contradiction,
end

lemma rgraph_adj_cmp {V: Type} {G: refl_graph V} {v w x: V} (P: ¬ G.adj v w) (Q: G.adj v x): w ≠ x :=
begin
  classical,
  by_contradiction K,
  let P' := rgraph_adj_eq_trans Q K.symm,
  contradiction,
end

lemma rgraph_vtx_neq {V: Type} {x: V} {G: refl_graph V} (v: V) (h: ∃ (w : V), G.adj x w ∧ ¬G.adj v w)
: some h ≠ v :=
begin
  have h': ¬G.adj v (some h),
    exact and.right (some_spec h),
  have refl: G.adj v v,
    exact G.selfloop v,
  by_contradiction C,
  have cnt: G.adj v (some h),
    exact eq.subst C.symm refl,
  contradiction,
end

lemma rgraph_vtx_neq' {V: Type} {G: refl_graph V} (v: V) (h: ∃ (w : V),  ¬G.adj v w)
: some h ≠ v :=
begin
  have h': ¬G.adj v (some h),
    exact some_spec h,
  have refl: G.adj v v,
    exact G.selfloop v,
  by_contradiction C,
  have cnt: G.adj v (some h),
    exact eq.subst C.symm refl,
  contradiction,
end

def empty_graph : refl_graph empty :=
/-complete_refl_graph empty-/
{
  adj := λ u v, true,
  sym := λ u v h, trivial,
  selfloop := λ u, trivial
}

def cat_prod_graph {V W: Type} (G: refl_graph V) (H: refl_graph W) : refl_graph (V × W) :=
{
  adj := λ u v, (G.adj u.1 v.1) ∧ (H.adj u.2 v.2),
  sym :=
  begin
    intros u v,
    intros h,
    cases h with Gedge Hedge,
    split,
    exact G.sym Gedge,
    exact H.sym Hedge,
  end,
  selfloop:=
  begin
    intro x,
    split,
    exact G.selfloop x.1,
    exact H.selfloop x.2,
  end
}

def singleton_graph : refl_graph unit := complete_refl_graph unit

structure graph_hom {V W: Type} (G  : refl_graph V) (H: refl_graph W) :=
(to_fun : V → W)
(map_edges: ∀ v w, G.adj v w → H.adj (to_fun v) (to_fun w))

def graph_hom_comp {U V W : Type} {G: refl_graph U} {H: refl_graph V} {I: refl_graph W}
  (f: graph_hom G H) (g: graph_hom H I) : graph_hom G I :=
{
  to_fun := g.to_fun ∘ f.to_fun ,
  map_edges :=
  begin
    intros u v,
    intro h,
    have adj_H : H.adj (f.to_fun u) (f.to_fun v),
      exact f.map_edges u v h,
    exact g.map_edges (f.to_fun u) (f.to_fun v) adj_H,
  end
}

def trivial_hom {V:Type} (G: refl_graph V) : graph_hom G G :=
{
  to_fun := λ x, x,
  map_edges :=
  begin
    intros u v h,
    exact h,
  end
}

structure graph_iso {V W: Type} (G  : refl_graph V) (H: refl_graph W) :=
(to_fun : V → W)
(bij: function.bijective to_fun)
(map_edges: ∀ v w, G.adj v w ↔ H.adj (to_fun v) (to_fun w))

def equivgraph {V W: Type} (G  : refl_graph V) (H: refl_graph W)  : Prop := nonempty(graph_iso G H)

notation G `≅` H  := equivgraph G H

def identity_iso {V: Type} (G: refl_graph V) : graph_iso G G:=
{ to_fun:= λ x,x,
  bij:=
    begin
      unfold function.bijective,
      split,
      { intros x y,
        intros h,
        apply h,
      },
      { intro x,
        use x,
      },
    end,
  map_edges:=
    begin
      intros v w,
      split,
      { intro h, exact h},
      { intro h, exact h}
    end
}
def trivial_iso : graph_iso empty_graph empty_graph := identity_iso empty_graph

/-
Set up a cops and robber's game on a graph
-/
def capture {V: Type} [fintype V] {k : ℕ } (P: vector V k × V) := ∃ i, vector.nth P.1 i = P.2

structure pre_cop_strat {V: Type} [fintype V] (G: refl_graph V) (n :ℕ ) :=
(init:  vector V n)
(strat: vector V n × V  → vector V n)

structure pre_rob_strat {V: Type} [fintype V] (G: refl_graph V) (n : ℕ ) :=
(init: vector V n → V)
(strat: vector V n × V → V)

noncomputable def pre_round {V: Type} [fintype V] {G: refl_graph V} {k : ℕ } (CS: pre_cop_strat G k) (RS: pre_rob_strat G k) : ℕ → vector V k × V
| 0 := (CS.init, RS.init (CS.init))
| (n+1) := if even (n+1)
           then ((pre_round n).1, RS.strat (pre_round n))
           else (CS.strat (pre_round n), (pre_round n).2)

structure cop_strat {V: Type} [fintype V] (G: refl_graph V) (n : ℕ ) :=
(strat: pre_cop_strat G n)
(nocheat: ∀ (RS: pre_rob_strat G n) (i : ℕ ), capture (pre_round strat RS i) → strat.strat (pre_round strat RS i) = (pre_round strat RS i).1)
(legal: ∀ i v P, G.adj (vector.nth P i) (vector.nth (strat.strat (P,v)) i))

structure rob_strat {V: Type} [fintype V] (G: refl_graph V) (n : ℕ ) :=
(strat: pre_rob_strat G n)
(nocheat: ∀ (CS: pre_cop_strat G n) (i : ℕ ), capture (pre_round CS strat i) → strat.strat (pre_round CS strat i) = (pre_round CS strat i).2)
(legal: ∀ v P, G.adj v (strat.strat (P,v)))

noncomputable def round {V: Type} [fintype V] {G: refl_graph V} {k : ℕ } (CS: cop_strat G k) (RS: rob_strat G k) := pre_round CS.strat RS.strat

def winning_strat_cop {V: Type} [fintype V] {G: refl_graph V} {k :ℕ }
(CS: cop_strat G k) :=
  ∀ RS: rob_strat G k , ∃ n : ℕ, capture (round CS RS n)

def k_cop_win {V: Type} [fintype V] (G: refl_graph V) (k: ℕ ) :=
∃ CS: cop_strat G k, winning_strat_cop CS

def winning_strat_rob {V: Type} [fintype V] {G: refl_graph V} {k : ℕ }
(RS: rob_strat G k) :=
  ∀ CS: cop_strat G k, ∀ n : ℕ, not(capture (round CS RS n))

structure cr_game {V: Type} [fintype V] (G: refl_graph V) (n : ℕ ):=
(cop_strat: cop_strat G n)
(rob_strat: rob_strat G n)

def cop_number {V: Type} [fintype V] [has_Inf ℕ] (G: refl_graph V) :=
  Inf {k : ℕ | k_cop_win G k}

def cop_win_graph {V: Type} [fintype V] [has_Inf ℕ] (G: refl_graph V) := cop_number G = 1

def capture_time {V: Type} [fintype V] [has_Inf ℕ] {G: refl_graph V} {n : ℕ} (CS: cop_strat G n) (RS: rob_strat G n) := Inf{k :ℕ | capture (round CS RS k)}

lemma cop_win_min_cap_time {V: Type} [fintype V] [has_Inf ℕ] {G: refl_graph V} {n : ℕ} {CS: cop_strat G n} {RS: rob_strat G n} : winning_strat_cop CS → ∃ n: ℕ, n = capture_time CS RS := begin simp, end

lemma not_cap_iff_diff_vtx {V: Type} [fintype V] {G: refl_graph V} {k : ℕ }{CS: cop_strat G k} {RS: rob_strat G k} : ∀ n : ℕ , ¬ capture (round CS RS n) ↔ ∀ i : fin k, (round CS RS n).1.nth i ≠ (round CS RS n).2 :=
begin
  intros n,
  split,
  intros h i,
  by_contradiction K,
  have this: capture (round CS RS n),
    use i, exact K,
  contradiction, contrapose, push_neg, intro h, exact h,
end

def enum_elts (V: Type) [fintype V] [decidable_eq V]: fin (fintype.card V) ≃ V :=
(fintype.equiv_fin V).symm

lemma exists_index {V: Type} [fintype V] [decidable_eq V] (v : V)  : ∃ i, enum_elts V i = v :=
(enum_elts V).bijective.surjective v

lemma exists_index_vec {V: Type} [fintype V] [decidable_eq V] (v: V) : ∃ i, vector.nth (vector.of_fn (enum_elts V)) i = v :=
begin
  cases exists_index v with i hi,
  use i,
  simp,
  exact hi,
end

def pre_trivial_strat {V: Type} [fintype V] [decidable_eq V] (G: refl_graph V) : pre_cop_strat G (fintype.card V) :=
{ init := vector.of_fn (enum_elts V),
  strat := λ x, x.1 }

def trivial_strat {V: Type} [fintype V] [decidable_eq V] (G: refl_graph V) : cop_strat G (fintype.card V) :=
{
  strat := pre_trivial_strat G,
  nocheat := begin intros RS i cap, refl end,
  legal := begin intros i v L, rw pre_trivial_strat, simp, apply G.selfloop end, }

lemma lots_of_cops {V: Type} [fintype V] [decidable_eq V] [inhabited V] (G: refl_graph V) :
set.nonempty {k : ℕ | k_cop_win G k} :=
begin
  have con: (fintype.card V) ∈ {k : ℕ | k_cop_win G k},
  { use (trivial_strat G), intro RS, use 0,
    let v := (round (trivial_strat G) RS 0).snd,
    exact exists_index_vec v, },
  rwa set.nonempty_def, use fintype.card V, exact con,
end

def pre_zcop_rob_strat {V: Type} [fintype V] [decidable_eq V] [inhabited V] [decidable_eq V] (G: refl_graph V): pre_rob_strat G 0 :=
{ init:= λ x, arbitrary V,
  strat := λ x, x.2,}

def zcop_rob_strat {V: Type} [fintype V] [decidable_eq V] [inhabited V] [decidable_eq V] (G: refl_graph V): rob_strat G 0 :=
{ strat := pre_zcop_rob_strat G,
  nocheat := begin intros K i cap, refl, end,
  legal := begin intros v P, rw pre_zcop_rob_strat, simp, exact G.selfloop v end}

lemma zero_cops_cant_win {V: Type} [fintype V] [decidable_eq V][inhabited V]  :
  ∀ G : refl_graph V, 0 < cop_number G :=
begin
  intro G, apply nat.pos_of_ne_zero, intro zero_cops,
  cases nat.Inf_eq_zero.mp zero_cops with H1 H2,
  { cases H1 with CS WCS,
    specialize WCS (zcop_rob_strat G),
    rcases WCS with ⟨n, ⟨x, _⟩⟩,
    exact fin.elim0 x},
  cases lots_of_cops G with x h,
  rw H2 at h,
  exact set.not_mem_empty _ h,
end

def pre_complete_strat (V: Type) [fintype V] [decidable_eq V] [inhabited V] : pre_cop_strat (complete_refl_graph V) 1 :=
{ init  := ⟨[arbitrary V], rfl⟩, strat := λ x, ⟨[x.2], rfl⟩,}

def complete_strategy (V: Type) [fintype V] [decidable_eq V] [inhabited V] : cop_strat (complete_refl_graph V) 1 :=
{ strat := pre_complete_strat V,
  nocheat := begin
    intros K hyp cap, conv {congr, congr, rw pre_complete_strat}, simp, refine vector.ext _,
    intro m, have : m=0, simp, rw this, clear this m, simp,
    rw capture at cap, cases cap with i cap, have : i=0, simp, rw this at cap, clear this i,
    simp at cap, rw cap, refl, end,
  legal := λ i v p, trivial }

lemma complete_refl_graph_cop_win (V: Type) [fintype V][decidable_eq V] [inhabited V] : cop_win_graph (complete_refl_graph V) :=
begin
  rw cop_win_graph,
  rw cop_number,
  have CW : 1 ∈ {k : ℕ | k_cop_win (complete_refl_graph V) k},
  { let CW_strat := complete_strategy V,
    have winning : winning_strat_cop CW_strat,
    { intro RS, use 1, use 0,
      rw round, rw pre_round, simp, refl, },
    simp, use CW_strat, exact winning, },
  have leq: Inf {k : ℕ | k_cop_win (complete_refl_graph V) k} ≤ 1,
    exact nat.Inf_le CW,
  have ge : Inf {k : ℕ | k_cop_win (complete_refl_graph V) k} >0,
    exact zero_cops_cant_win (complete_refl_graph V),
  linarith,
end

section

variables {V: Type} [fintype V] [inhabited V] {a b: ℕ}

def ge_cs_strat_init (va: vector V a) : vector V b :=
vector.of_fn (λ i, if h : ↑i < a then va.nth ⟨_, h⟩ else arbitrary V)

def vec_remove (va: vector V b) (ge: a ≤ b) : vector V a :=
vector.of_fn (λ i, va.nth (fin.cast_le ge i))

def ge_cs_strat_fn (strat: vector V a × V → vector V a) (ge: a ≤ b ): vector V b × V → vector V b :=
  λ x, vector.of_fn (λ i, if h : ↑i < a then (strat ⟨vec_remove x.1 ge, x.2⟩).nth ⟨_, h⟩  else x.1.nth i )

def pre_ge_cop_strat (G: refl_graph V) (CS: cop_strat G a) (ge: a ≤ b) : pre_cop_strat G b :=
{ init := ge_cs_strat_init CS.strat.init,
  strat := ge_cs_strat_fn CS.strat.strat ge}

--suffices :  ∀ (m : fin b), (ge_cs_strat_fn CS.cop_strat ge K).nth m = K.fst.nth m, exact vector.ext this,
def ge_cop_strat (G: refl_graph V) (CS: cop_strat G a) (ge: a ≤ b) : cop_strat G b :=
{ strat := pre_ge_cop_strat G CS ge,
  nocheat := begin
    intros RS i cap,
    conv {congr, congr, rw pre_ge_cop_strat}, simp,
    suffices :  ∀ (m : fin b), (ge_cs_strat_fn CS.strat.strat ge (pre_round (pre_ge_cop_strat G CS ge) RS i)).nth m = (pre_round (pre_ge_cop_strat G CS ge) RS i).fst.nth m, exact vector.ext this,
    intro m, rw [ge_cs_strat_fn], simp, intro h, sorry, end,
  legal := begin
      intros i v P, rw pre_ge_cop_strat, simp, rw ge_cs_strat_fn, simp, by_cases h: ¬↑i < a,
      rw dif_neg h, exact G.selfloop (P.nth i),
      simp at h, rw dif_pos h,
      have : P.nth i = (vec_remove P ge).nth ⟨↑i, h⟩, rw vec_remove, simp, rw this,
      exact CS.legal ⟨↑i, h⟩ v (vec_remove P ge),
    end }

def ge_rob_init (G: refl_graph V) (RS : rob_strat G b) : vector V a → V := λ v, RS.strat.init (ge_cs_strat_init v)

def ge_rob_fn (G: refl_graph V) (RS: rob_strat G b) : (vector V a) × V → V :=
 λ x, RS.strat.strat ⟨ge_cs_strat_init x.1, x.2⟩

def pre_ge_rob_strat (G: refl_graph V) (RS: rob_strat G b) (ge: a ≤ b) : pre_rob_strat G a :=
{ init := ge_rob_init G RS, strat := ge_rob_fn G RS}

def ge_rob_strat (G: refl_graph V) (RS: rob_strat G b) (ge: a ≤ b) : rob_strat G a :=
{ strat := pre_ge_rob_strat G RS ge,
  legal := begin
  intros i v P, rw pre_ge_rob_strat, rw ge_rob_fn, simp,
  let x:= RS.legal (fin.cast_le ge i) v (ge_cs_strat_init P),
  have : ((ge_cs_strat_init P).nth (fin.cast_le ge i)) = P.nth i,
    rw ge_cs_strat_init, simp, intro le, exfalso, let le2 := i.2, rw not_lt.symm at le,
    contradiction,
  rw this.symm, exact x,
  end,
  nocheat := begin
    intros CS i cap, conv {congr, congr, rw pre_ge_rob_strat}, simp, rw ge_rob_fn, simp,
    set K := (pre_round CS (pre_ge_rob_strat G RS ge) i),
    suffices : capture (ge_cs_strat_init K.fst, K.snd),
    sorry, sorry, sorry,
  end }

lemma copnumber_upwards_closed {V: Type}{G: refl_graph V}  [fintype V] [decidable_eq V] [inhabited V] : ∀ a b : ℕ, a ≤ b → a ∈ {k : ℕ | k_cop_win G k} → b ∈ {k : ℕ | k_cop_win G k} :=
begin
  intros a b ge win_a, simp, rw k_cop_win, simp at win_a, rw k_cop_win at win_a,
  cases win_a with CS win_CS, use ge_cop_strat CS ge,
  rw winning_strat_cop, rw winning_strat_cop at win_CS, intro RS,
  specialize win_CS (ge_rob_strat RS ge), cases win_CS with n win_CS, use n,
  rw capture, cases win_CS with i win_CS, use fin.cast_le ge i, cases n,
  --zero case
  rw round, simp, rw round at win_CS, simp at win_CS, rw ge_cop_strat, simp,
  rw ge_cs_strat_init, simp, rw if_pos (fin.is_lt i), rw win_CS, refl,
  by_cases even(n.succ),
  --even case
  sorry, sorry,
end

end


import POVM
import Quantum_relative_entropy

import analysis.special_functions.complex.log

open complex

variables
(ℋ : Type) [complex_Hilbert_space ℋ]

variables
(A : λ n : ℕ, ℋ^⊗n →ₗ[ℂ] ℋ^⊗n) [∀ n, POVM {A n, 1 - A n}]

variables
{ρ: ℋ →ₗ[ℂ] ℋ} [quantum_state ρ]
{σ: ℋ →ₗ[ℂ] ℋ} [quantum_state σ]

variable (n : ℕ)

/--
Probability of guessing σ^⊗n when actually ρ^⊗n.
-/
def prob_σₙ_when_ρₙ_of_Aₙ := tr(ρ^⊗n * (1 - A n))

/--
Probability of guessing ρ^⊗n when actually σ^⊗n.
-/
def prob_ρₙ_when_σₙ_of_Aₙ := tr(σ^⊗n * (A n))

/--
What is the minimum?
-/
def min_prob_ρₙ_when_σₙ_if_prob_σₙ_when_ρₙ_leq_ε (ε > 0) :=
min {prob_ρₙ_when_σₙ_of_Aₙ A n | A : λ n : ℕ, ℋ^⊗n →ₗ[ℂ] ℋ^⊗n ∧ ∀ n, POVM {A n, 1 - A n} ∧ prob_σₙ_when_ρₙ_of_Aₙ A n ≤ ε}

/--
Quantum Stein's lemma.
-/
lemma log_minimum_achieves_quantum_relative_entropy :
∀ ε > 0, ∀ δ > 0,
∃ k : ℕ, ∀ n > k,
1/n * log min_prob_ρₙ_when_σₙ_if_prob_σₙ_when_ρₙ_leq_ε n ε ≥ quantum_relative_entropy ρ σ - δ :=
begin
  sorry
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.nat.interval

/-!
# Finite intervals in `fin n`

This file proves that `fin n` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset fin function

open_locale big_operators

variables (n : ℕ)

instance : locally_finite_order (fin n) := subtype.locally_finite_order _
instance : locally_finite_order_bot (fin n) := subtype.locally_finite_order_bot _

instance : Π n, locally_finite_order_top (fin n)
| 0 := is_empty.to_locally_finite_order_top
| (n + 1) := infer_instance

namespace fin
variables {n} (a b : fin n)

lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ x, x < n) := rfl

@[simp] lemma map_subtype_embedding_Icc : (Icc a b).map (embedding.subtype _) = Icc a b :=
map_subtype_embedding_Icc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ico : (Ico a b).map (embedding.subtype _) = Ico a b :=
map_subtype_embedding_Ico _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioc : (Ioc a b).map (embedding.subtype _) = Ioc a b :=
map_subtype_embedding_Ioc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioo : (Ioo a b).map (embedding.subtype _) = Ioo a b :=
map_subtype_embedding_Ioo _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map]

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [←nat.card_Ico, ←map_subtype_embedding_Ico, card_map]

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map]

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [←card_Ioo, fintype.card_of_finset]

lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) n).subtype (λ x, x < n) :=
by { ext x, simp only [mem_subtype, mem_Ici, mem_Icc, coe_fin_le, iff_self_and], exact λ _, x.2.le }

lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) n).subtype (λ x, x < n) :=
by { ext x, simp only [mem_subtype, mem_Ioi, mem_Ioc, coe_fin_lt, iff_self_and], exact λ _, x.2.le }

lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).subtype (λ x, x < n) := rfl
lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).subtype (λ x, x < n) := rfl

@[simp] lemma map_subtype_embedding_Ici : (Ici a).map (embedding.subtype _) = Icc a (n - 1) :=
begin
  ext x,
  simp only [exists_prop, embedding.coe_subtype, mem_Ici, mem_map, mem_Icc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ },
  cases n,
  { exact fin.elim0 a },
  { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map (embedding.subtype _) = Ioc a (n - 1) :=
begin
  ext x,
  simp only [exists_prop, embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ },
  cases n,
  { exact fin.elim0 a },
  { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Iic : (Iic b).map (embedding.subtype _) = Iic b :=
map_subtype_embedding_Iic _ _ $ λ _ _, lt_of_le_of_lt

@[simp] lemma map_subtype_embedding_Iio : (Iio b).map (embedding.subtype _) = Iio b :=
map_subtype_embedding_Iio _ _ $ λ _ _, lt_of_le_of_lt

@[simp] lemma card_Ici : (Ici a).card = n - a :=
by { cases n, { exact fin.elim0 a }, rw [←card_map, map_subtype_embedding_Ici, nat.card_Icc], refl }

@[simp] lemma card_Ioi : (Ioi a).card = n - 1 - a :=
by { rw [←card_map, map_subtype_embedding_Ioi, nat.card_Ioc] }

@[simp] lemma card_Iic : (Iic b).card = b + 1 :=
by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map]

@[simp] lemma card_Iio : (Iio b).card = b :=
by rw [←nat.card_Iio b, ←map_subtype_embedding_Iio, card_map]

@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n - a :=
by rw [fintype.card_of_finset, card_Ici]

@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - 1 - a :=
by rw [fintype.card_of_finset, card_Ioi]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

end fin


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

/-!
# Erasing duplicates in a multiset.
-/

namespace multiset
open list

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

/-! ### dedup -/

/-- `dedup s` removes duplicates from `s`, yielding a `nodup` multiset. -/
def dedup (s : multiset α) : multiset α :=
quot.lift_on s (λ l, (l.dedup : multiset α))
  (λ s t p, quot.sound p.dedup)

@[simp] theorem coe_dedup (l : list α) : @dedup α _ l = l.dedup := rfl

@[simp] theorem dedup_zero : @dedup α _ 0 = 0 := rfl

@[simp] theorem mem_dedup {a : α} {s : multiset α} : a ∈ dedup s ↔ a ∈ s :=
quot.induction_on s $ λ l, mem_dedup

@[simp] theorem dedup_cons_of_mem {a : α} {s : multiset α} : a ∈ s →
  dedup (a ::ₘ s) = dedup s :=
quot.induction_on s $ λ l m, @congr_arg _ _ _ _ coe $ dedup_cons_of_mem m

@[simp] theorem dedup_cons_of_not_mem {a : α} {s : multiset α} : a ∉ s →
  dedup (a ::ₘ s) = a ::ₘ dedup s :=
quot.induction_on s $ λ l m, congr_arg coe $ dedup_cons_of_not_mem m

theorem dedup_le (s : multiset α) : dedup s ≤ s :=
quot.induction_on s $ λ l, (dedup_sublist _).subperm

theorem dedup_subset (s : multiset α) : dedup s ⊆ s :=
subset_of_le $ dedup_le _

theorem subset_dedup (s : multiset α) : s ⊆ dedup s :=
λ a, mem_dedup.2

@[simp] theorem dedup_subset' {s t : multiset α} : dedup s ⊆ t ↔ s ⊆ t :=
⟨subset.trans (subset_dedup _), subset.trans (dedup_subset _)⟩

@[simp] theorem subset_dedup' {s t : multiset α} : s ⊆ dedup t ↔ s ⊆ t :=
⟨λ h, subset.trans h (dedup_subset _), λ h, subset.trans h (subset_dedup _)⟩

@[simp] theorem nodup_dedup (s : multiset α) : nodup (dedup s) :=
quot.induction_on s nodup_dedup

theorem dedup_eq_self {s : multiset α} : dedup s = s ↔ nodup s :=
⟨λ e, e ▸ nodup_dedup s,
 quot.induction_on s $ λ l h, congr_arg coe h.dedup⟩

alias dedup_eq_self ↔ _ nodup.dedup

theorem dedup_eq_zero {s : multiset α} : dedup s = 0 ↔ s = 0 :=
⟨λ h, eq_zero_of_subset_zero $ h ▸ subset_dedup _,
 λ h, h.symm ▸ dedup_zero⟩

@[simp] theorem dedup_singleton {a : α} : dedup ({a} : multiset α) = {a} :=
(nodup_singleton _).dedup

theorem le_dedup {s t : multiset α} : s ≤ dedup t ↔ s ≤ t ∧ nodup s :=
⟨λ h, ⟨le_trans h (dedup_le _), nodup_of_le h (nodup_dedup _)⟩,
 λ ⟨l, d⟩, (le_iff_subset d).2 $ subset.trans (subset_of_le l) (subset_dedup _)⟩

theorem dedup_ext {s t : multiset α} : dedup s = dedup t ↔ ∀ a, a ∈ s ↔ a ∈ t :=
by simp [nodup.ext]

theorem dedup_map_dedup_eq [decidable_eq β] (f : α → β) (s : multiset α) :
  dedup (map f (dedup s)) = dedup (map f s) := by simp [dedup_ext]

@[simp]
lemma dedup_nsmul {s : multiset α} {n : ℕ} (h0 : n ≠ 0) :
  (n • s).dedup = s.dedup :=
begin
  ext a,
  by_cases h : a ∈ s;
  simp [h,h0]
end

lemma nodup.le_dedup_iff_le {s t : multiset α} (hno : s.nodup) :
  s ≤ t.dedup ↔ s ≤ t :=
by simp [le_dedup, hno]

end multiset

lemma multiset.nodup.le_nsmul_iff_le {α : Type*} {s t : multiset α}
  {n : ℕ} (h : s.nodup) (hn : n ≠ 0) :
  s ≤ n • t ↔ s ≤ t :=
begin
  classical,
  rw [← h.le_dedup_iff_le, iff.comm, ← h.le_dedup_iff_le],
  simp [hn]
end