/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import ring_theory.int.basic
import data.nat.factorization.prime_pow
import algebra.squarefree

/-!
# Lemmas about squarefreeness of natural numbers
A number is squarefree when it is not divisible by any squares except the squares of units.

## Main Results
 - `nat.squarefree_iff_nodup_factors`: A positive natural number `x` is squarefree iff
  the list `factors x` has no duplicate factors.

## Tags
squarefree, multiplicity

-/

namespace nat

lemma squarefree_iff_nodup_factors {n : ℕ} (h0 : n ≠ 0) :
  squarefree n ↔ n.factors.nodup :=
begin
  rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0, nat.factors_eq],
  simp,
end

theorem squarefree_iff_prime_squarefree {n : ℕ} : squarefree n ↔ ∀ x, prime x → ¬ x * x ∣ n :=
squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible ⟨_, prime_two⟩

lemma squarefree.factorization_le_one {n : ℕ} (p : ℕ) (hn : squarefree n) :
  n.factorization p ≤ 1 :=
begin
  rcases eq_or_ne n 0 with rfl | hn',
  { simp },
  rw [multiplicity.squarefree_iff_multiplicity_le_one] at hn,
  by_cases hp : p.prime,
  { have := hn p,
    simp only [multiplicity_eq_factorization hp hn', nat.is_unit_iff, hp.ne_one, or_false] at this,
    exact_mod_cast this },
  { rw factorization_eq_zero_of_non_prime _ hp,
    exact zero_le_one }
end

lemma squarefree_of_factorization_le_one {n : ℕ} (hn : n ≠ 0) (hn' : ∀ p, n.factorization p ≤ 1) :
  squarefree n :=
begin
  rw [squarefree_iff_nodup_factors hn, list.nodup_iff_count_le_one],
  intro a,
  rw factors_count_eq,
  apply hn',
end

lemma squarefree_iff_factorization_le_one {n : ℕ} (hn : n ≠ 0) :
  squarefree n ↔ ∀ p, n.factorization p ≤ 1 :=
⟨λ p hn, squarefree.factorization_le_one hn p, squarefree_of_factorization_le_one hn⟩

lemma squarefree.ext_iff {n m : ℕ} (hn : squarefree n) (hm : squarefree m) :
  n = m ↔ ∀ p, prime p → (p ∣ n ↔ p ∣ m) :=
begin
  refine ⟨by { rintro rfl, simp }, λ h, eq_of_factorization_eq hn.ne_zero hm.ne_zero (λ p, _)⟩,
  by_cases hp : p.prime,
  { have h₁ := h _ hp,
    rw [←not_iff_not, hp.dvd_iff_one_le_factorization hn.ne_zero, not_le, lt_one_iff,
      hp.dvd_iff_one_le_factorization hm.ne_zero, not_le, lt_one_iff] at h₁,
    have h₂ := squarefree.factorization_le_one p hn,
    have h₃ := squarefree.factorization_le_one p hm,
    rw [nat.le_add_one_iff, le_zero_iff] at h₂ h₃,
    cases h₂,
    { rwa [h₂, eq_comm, ←h₁] },
    { rw [h₂, h₃.resolve_left],
      rw [←h₁, h₂],
      simp only [nat.one_ne_zero, not_false_iff] } },
  rw [factorization_eq_zero_of_non_prime _ hp, factorization_eq_zero_of_non_prime _ hp],
end

lemma squarefree_pow_iff {n k : ℕ} (hn : n ≠ 1) (hk : k ≠ 0) :
  squarefree (n ^ k) ↔ squarefree n ∧ k = 1 :=
begin
  refine ⟨λ h, _, by { rintro ⟨hn, rfl⟩, simpa }⟩,
  rcases eq_or_ne n 0 with rfl | hn₀,
  { simpa [zero_pow hk.bot_lt] using h },
  refine ⟨squarefree_of_dvd_of_squarefree (dvd_pow_self _ hk) h, by_contradiction $ λ h₁, _⟩,
  have : 2 ≤ k := k.two_le_iff.mpr ⟨hk, h₁⟩,
  apply hn (nat.is_unit_iff.1 (h _ _)),
  rw ←sq,
  exact pow_dvd_pow _ this
end

lemma squarefree_and_prime_pow_iff_prime {n : ℕ} :
  squarefree n ∧ is_prime_pow n ↔ prime n :=
begin
  refine iff.symm ⟨λ hn, ⟨hn.squarefree, hn.is_prime_pow⟩, _⟩,
  rw is_prime_pow_nat_iff,
  rintro ⟨h, p, k, hp, hk, rfl⟩,
  rw squarefree_pow_iff hp.ne_one hk.ne' at h,
  rwa [h.2, pow_one],
end

/-- Assuming that `n` has no factors less than `k`, returns the smallest prime `p` such that
  `p^2 ∣ n`. -/
def min_sq_fac_aux : ℕ → ℕ → option ℕ
| n k :=
  if h : n < k * k then none else
  have nat.sqrt n + 2 - (k + 2) < nat.sqrt n + 2 - k,
    by { rw nat.add_sub_add_right, exact nat.min_fac_lemma n k h },
  if k ∣ n then
    let n' := n / k in
    have nat.sqrt n' + 2 - (k + 2) < nat.sqrt n + 2 - k, from
      lt_of_le_of_lt (nat.sub_le_sub_right
        (nat.add_le_add_right (nat.sqrt_le_sqrt $ nat.div_le_self _ _) _) _) this,
    if k ∣ n' then some k else min_sq_fac_aux n' (k + 2)
  else min_sq_fac_aux n (k + 2)
using_well_founded {rel_tac :=
  λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]}

/-- Returns the smallest prime factor `p` of `n` such that `p^2 ∣ n`, or `none` if there is no
  such `p` (that is, `n` is squarefree). See also `squarefree_iff_min_sq_fac`. -/
def min_sq_fac (n : ℕ) : option ℕ :=
if 2 ∣ n then
  let n' := n / 2 in
  if 2 ∣ n' then some 2 else min_sq_fac_aux n' 3
else min_sq_fac_aux n 3

/-- The correctness property of the return value of `min_sq_fac`.
  * If `none`, then `n` is squarefree;
  * If `some d`, then `d` is a minimal square factor of `n` -/
def min_sq_fac_prop (n : ℕ) : option ℕ → Prop
| none := squarefree n
| (some d) := prime d ∧ d * d ∣ n ∧ ∀ p, prime p → p * p ∣ n → d ≤ p

theorem min_sq_fac_prop_div (n) {k} (pk : prime k) (dk : k ∣ n) (dkk : ¬ k * k ∣ n)
  {o} (H : min_sq_fac_prop (n / k) o) : min_sq_fac_prop n o :=
begin
  have : ∀ p, prime p → p*p ∣ n → k*(p*p) ∣ n := λ p pp dp,
    have _ := (coprime_primes pk pp).2 (λ e, by { subst e, contradiction }),
    (coprime_mul_iff_right.2 ⟨this, this⟩).mul_dvd_of_dvd_of_dvd dk dp,
  cases o with d,
  { rw [min_sq_fac_prop, squarefree_iff_prime_squarefree] at H ⊢,
    exact λ p pp dp, H p pp ((dvd_div_iff dk).2 (this _ pp dp)) },
  { obtain ⟨H1, H2, H3⟩ := H,
    simp only [dvd_div_iff dk] at H2 H3,
    exact ⟨H1, dvd_trans (dvd_mul_left _ _) H2, λ p pp dp, H3 _ pp (this _ pp dp)⟩ }
end

theorem min_sq_fac_aux_has_prop : ∀ {n : ℕ} k, 0 < n → ∀ i, k = 2*i+3 →
  (∀ m, prime m → m ∣ n → k ≤ m) → min_sq_fac_prop n (min_sq_fac_aux n k)
| n k := λ n0 i e ih, begin
  rw min_sq_fac_aux,
  by_cases h : n < k*k; simp [h],
  { refine squarefree_iff_prime_squarefree.2 (λ p pp d, _),
    have := ih p pp (dvd_trans ⟨_, rfl⟩ d),
    have := nat.mul_le_mul this this,
    exact not_le_of_lt h (le_trans this (le_of_dvd n0 d)) },
  have k2 : 2 ≤ k, { subst e, exact dec_trivial },
  have k0 : 0 < k := lt_of_lt_of_le dec_trivial k2,
  have IH : ∀ n', n' ∣ n → ¬ k ∣ n' → min_sq_fac_prop n' (n'.min_sq_fac_aux (k + 2)),
  { intros n' nd' nk,
    have hn' := le_of_dvd n0 nd',
    refine
      have nat.sqrt n' - k < nat.sqrt n + 2 - k, from
        lt_of_le_of_lt (nat.sub_le_sub_right (nat.sqrt_le_sqrt hn') _) (nat.min_fac_lemma n k h),
      @min_sq_fac_aux_has_prop n' (k+2) (pos_of_dvd_of_pos nd' n0)
        (i+1) (by simp [e, left_distrib]) (λ m m2 d, _),
    cases nat.eq_or_lt_of_le (ih m m2 (dvd_trans d nd')) with me ml,
    { subst me, contradiction },
    apply (nat.eq_or_lt_of_le ml).resolve_left, intro me,
    rw [← me, e] at d, change 2 * (i + 2) ∣ n' at d,
    have := ih _ prime_two (dvd_trans (dvd_of_mul_right_dvd d) nd'),
    rw e at this, exact absurd this dec_trivial },
  have pk : k ∣ n → prime k,
  { refine λ dk, prime_def_min_fac.2 ⟨k2, le_antisymm (min_fac_le k0) _⟩,
    exact ih _ (min_fac_prime (ne_of_gt k2)) (dvd_trans (min_fac_dvd _) dk) },
  split_ifs with dk dkk,
  { exact ⟨pk dk, (nat.dvd_div_iff dk).1 dkk, λ p pp d, ih p pp (dvd_trans ⟨_, rfl⟩ d)⟩ },
  { specialize IH (n/k) (div_dvd_of_dvd dk) dkk,
    exact min_sq_fac_prop_div _ (pk dk) dk (mt (nat.dvd_div_iff dk).2 dkk) IH },
  { exact IH n (dvd_refl _) dk }
end
using_well_founded {rel_tac :=
  λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]}

theorem min_sq_fac_has_prop (n : ℕ) : min_sq_fac_prop n (min_sq_fac n) :=
begin
  dunfold min_sq_fac, split_ifs with d2 d4,
  { exact ⟨prime_two, (dvd_div_iff d2).1 d4, λ p pp _, pp.two_le⟩ },
  { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d4 dec_trivial },
    refine min_sq_fac_prop_div _ prime_two d2 (mt (dvd_div_iff d2).2 d4) _,
    refine min_sq_fac_aux_has_prop 3 (nat.div_pos (le_of_dvd n0 d2) dec_trivial) 0 rfl _,
    refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _),
    rintro rfl, contradiction },
  { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d2 dec_trivial },
    refine min_sq_fac_aux_has_prop _ n0 0 rfl _,
    refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _),
    rintro rfl, contradiction },
end

theorem min_sq_fac_prime {n d : ℕ} (h : n.min_sq_fac = some d) : prime d :=
by { have := min_sq_fac_has_prop n, rw h at this, exact this.1 }

theorem min_sq_fac_dvd {n d : ℕ} (h : n.min_sq_fac = some d) : d * d ∣ n :=
by { have := min_sq_fac_has_prop n, rw h at this, exact this.2.1 }

theorem min_sq_fac_le_of_dvd {n d : ℕ} (h : n.min_sq_fac = some d)
  {m} (m2 : 2 ≤ m) (md : m * m ∣ n) : d ≤ m :=
begin
  have := min_sq_fac_has_prop n, rw h at this,
  have fd := min_fac_dvd m,
  exact le_trans
    (this.2.2 _ (min_fac_prime $ ne_of_gt m2) (dvd_trans (mul_dvd_mul fd fd) md))
    (min_fac_le $ lt_of_lt_of_le dec_trivial m2),
end

lemma squarefree_iff_min_sq_fac {n : ℕ} :
  squarefree n ↔ n.min_sq_fac = none :=
begin
  have := min_sq_fac_has_prop n,
  split; intro H,
  { cases n.min_sq_fac with d, {refl},
    cases squarefree_iff_prime_squarefree.1 H _ this.1 this.2.1 },
  { rwa H at this }
end

instance : decidable_pred (squarefree : ℕ → Prop) :=
λ n, decidable_of_iff' _ squarefree_iff_min_sq_fac

theorem squarefree_two : squarefree 2 := by rw squarefree_iff_nodup_factors; norm_num

open unique_factorization_monoid

lemma divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) :
  (n.divisors.filter squarefree).val =
    (unique_factorization_monoid.normalized_factors n).to_finset.powerset.val.map
      (λ x, x.val.prod) :=
begin
  rw (finset.nodup _).ext ((finset.nodup _).map_on _),
  { intro a,
    simp only [multiset.mem_filter, id.def, multiset.mem_map, finset.filter_val, ← finset.mem_def,
      mem_divisors],
    split,
    { rintro ⟨⟨an, h0⟩, hsq⟩,
      use (unique_factorization_monoid.normalized_factors a).to_finset,
      simp only [id.def, finset.mem_powerset],
      rcases an with ⟨b, rfl⟩,
      rw mul_ne_zero_iff at h0,
      rw unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0.1 at hsq,
      rw [multiset.to_finset_subset, multiset.to_finset_val, hsq.dedup, ← associated_iff_eq,
        normalized_factors_mul h0.1 h0.2],
      exact ⟨multiset.subset_of_le (multiset.le_add_right _ _), normalized_factors_prod h0.1⟩ },
    { rintro ⟨s, hs, rfl⟩,
      rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hs,
      have hs0 : s.val.prod ≠ 0,
      { rw [ne.def, multiset.prod_eq_zero_iff],
        simp only [exists_prop, id.def, exists_eq_right],
        intro con,
        apply not_irreducible_zero (irreducible_of_normalized_factor 0
            (multiset.mem_dedup.1 (multiset.mem_of_le hs con))) },
      rw (normalized_factors_prod h0).symm.dvd_iff_dvd_right,
      refine ⟨⟨multiset.prod_dvd_prod_of_le (le_trans hs (multiset.dedup_le _)), h0⟩, _⟩,
      have h := unique_factorization_monoid.factors_unique irreducible_of_normalized_factor
        (λ x hx, irreducible_of_normalized_factor x (multiset.mem_of_le
          (le_trans hs (multiset.dedup_le _)) hx)) (normalized_factors_prod hs0),
      rw [associated_eq_eq, multiset.rel_eq] at h,
      rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors hs0, h],
      apply s.nodup } },
  { intros x hx y hy h,
    rw [← finset.val_inj, ← multiset.rel_eq, ← associated_eq_eq],
    rw [← finset.mem_def, finset.mem_powerset] at hx hy,
    apply unique_factorization_monoid.factors_unique _ _ (associated_iff_eq.2 h),
    { intros z hz,
      apply irreducible_of_normalized_factor z,
      rw ← multiset.mem_to_finset,
      apply hx hz },
    { intros z hz,
      apply irreducible_of_normalized_factor z,
      rw ← multiset.mem_to_finset,
      apply hy hz } }
end

open_locale big_operators

lemma sum_divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0)
  {α : Type*} [add_comm_monoid α] {f : ℕ → α} :
  ∑ i in (n.divisors.filter squarefree), f i =
    ∑ i in (unique_factorization_monoid.normalized_factors n).to_finset.powerset, f (i.val.prod) :=
by rw [finset.sum_eq_multiset_sum, divisors_filter_squarefree h0, multiset.map_map,
    finset.sum_eq_multiset_sum]

lemma sq_mul_squarefree_of_pos {n : ℕ} (hn : 0 < n) :
  ∃ a b : ℕ, 0 < a ∧ 0 < b ∧ b ^ 2 * a = n ∧ squarefree a :=
begin
  let S := {s ∈ finset.range (n + 1) | s ∣ n ∧ ∃ x, s = x ^ 2},
  have hSne : S.nonempty,
  { use 1,
    have h1 : 0 < n ∧ ∃ (x : ℕ), 1 = x ^ 2 := ⟨hn, ⟨1, (one_pow 2).symm⟩⟩,
    simpa [S] },
  let s := finset.max' S hSne,
  have hs : s ∈ S := finset.max'_mem S hSne,
  simp only [finset.sep_def, S, finset.mem_filter, finset.mem_range] at hs,
  obtain ⟨hsn1, ⟨a, hsa⟩, ⟨b, hsb⟩⟩ := hs,
  rw hsa at hn,
  obtain ⟨hlts, hlta⟩ := canonically_ordered_comm_semiring.mul_pos.mp hn,
  rw hsb at hsa hn hlts,
  refine ⟨a, b, hlta, (pow_pos_iff zero_lt_two).mp hlts, hsa.symm, _⟩,
  rintro x ⟨y, hy⟩,
  rw nat.is_unit_iff,
  by_contra hx,
  refine lt_le_antisymm _ (finset.le_max' S ((b * x) ^ 2) _),
  { simp_rw [S, hsa, finset.sep_def, finset.mem_filter, finset.mem_range],
    refine ⟨lt_succ_iff.mpr (le_of_dvd hn _), _, ⟨b * x, rfl⟩⟩; use y; rw hy; ring },
  { convert lt_mul_of_one_lt_right hlts
      (one_lt_pow 2 x zero_lt_two (one_lt_iff_ne_zero_and_ne_one.mpr ⟨λ h, by simp * at *, hx⟩)),
    rw mul_pow },
end

lemma sq_mul_squarefree_of_pos' {n : ℕ} (h : 0 < n) :
  ∃ a b : ℕ, (b + 1) ^ 2 * (a + 1) = n ∧ squarefree (a + 1) :=
begin
  obtain ⟨a₁, b₁, ha₁, hb₁, hab₁, hab₂⟩ := sq_mul_squarefree_of_pos h,
  refine ⟨a₁.pred, b₁.pred, _, _⟩;
  simpa only [add_one, succ_pred_eq_of_pos, ha₁, hb₁],
end

lemma sq_mul_squarefree (n : ℕ) : ∃ a b : ℕ, b ^ 2 * a = n ∧ squarefree a :=
begin
  cases n,
  { exact ⟨1, 0, (by simp), squarefree_one⟩ },
  { obtain ⟨a, b, -, -, h₁, h₂⟩ := sq_mul_squarefree_of_pos (succ_pos n),
    exact ⟨a, b, h₁, h₂⟩ },
end

/-- `squarefree` is multiplicative. Note that the → direction does not require `hmn`
and generalizes to arbitrary commutative monoids. See `squarefree.of_mul_left` and
`squarefree.of_mul_right` above for auxiliary lemmas. -/
lemma squarefree_mul {m n : ℕ} (hmn : m.coprime n) :
  squarefree (m * n) ↔ squarefree m ∧ squarefree n :=
begin
  simp only [squarefree_iff_prime_squarefree, ←sq, ←forall_and_distrib],
  refine ball_congr (λ p hp, _),
  simp only [hmn.is_prime_pow_dvd_mul (hp.is_prime_pow.pow two_ne_zero), not_or_distrib],
end

end nat

/-! ### Square-free prover -/

open norm_num

namespace tactic
namespace norm_num

/-- A predicate representing partial progress in a proof of `squarefree`. -/
def squarefree_helper (n k : ℕ) : Prop :=
0 < k → (∀ m, nat.prime m → m ∣ bit1 n → bit1 k ≤ m) → squarefree (bit1 n)

lemma squarefree_bit10 (n : ℕ) (h : squarefree_helper n 1) :
  squarefree (bit0 (bit1 n)) :=
begin
  refine @nat.min_sq_fac_prop_div _ _ nat.prime_two two_dvd_bit0 _ none _,
  { rw [bit0_eq_two_mul (bit1 n), mul_dvd_mul_iff_left (@two_ne_zero ℕ _ _)],
    exact nat.not_two_dvd_bit1 _ },
  { rw [bit0_eq_two_mul, nat.mul_div_right _ (dec_trivial:0<2)],
    refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)),
    rintro rfl, exact nat.not_two_dvd_bit1 _ dp }
end

lemma squarefree_bit1 (n : ℕ) (h : squarefree_helper n 1) :
  squarefree (bit1 n) :=
begin
  refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)),
  rintro rfl, exact nat.not_two_dvd_bit1 _ dp
end

lemma squarefree_helper_0 {k} (k0 : 0 < k)
  {p : ℕ} (pp : nat.prime p) (h : bit1 k ≤ p) : bit1 (k + 1) ≤ p ∨ bit1 k = p :=
begin
  rcases lt_or_eq_of_le h with (hp:_+1≤_) | hp,
  { rw [bit1, bit0_eq_two_mul] at hp, change 2*(_+1) ≤ _ at hp,
    rw [bit1, bit0_eq_two_mul],
    refine or.inl (lt_of_le_of_ne hp _), unfreezingI { rintro rfl },
    exact nat.not_prime_mul dec_trivial (lt_add_of_pos_left _ k0) pp },
  { exact or.inr hp }
end

lemma squarefree_helper_1 (n k k' : ℕ) (e : k + 1 = k')
  (hk : nat.prime (bit1 k) → ¬ bit1 k ∣ bit1 n)
  (H : squarefree_helper n k') : squarefree_helper n k :=
λ k0 ih, begin
  subst e,
  refine H (nat.succ_pos _) (λ p pp dp, _),
  refine (squarefree_helper_0 k0 pp (ih p pp dp)).resolve_right (λ hp, _),
  subst hp, cases hk pp dp
end

lemma squarefree_helper_2 (n k k' c : ℕ) (e : k + 1 = k')
  (hc : bit1 n % bit1 k = c) (c0 : 0 < c)
  (h : squarefree_helper n k') : squarefree_helper n k :=
begin
  refine squarefree_helper_1 _ _ _ e (λ _, _) h,
  refine mt _ (ne_of_gt c0), intro e₁,
  rwa [← hc, ← nat.dvd_iff_mod_eq_zero],
end

lemma squarefree_helper_3 (n n' k k' c : ℕ) (e : k + 1 = k')
  (hn' : bit1 n' * bit1 k = bit1 n)
  (hc : bit1 n' % bit1 k = c) (c0 : 0 < c)
  (H : squarefree_helper n' k') : squarefree_helper n k :=
λ k0 ih, begin
  subst e,
  have k0' : 0 < bit1 k := bit1_pos (nat.zero_le _),
  have dn' : bit1 n' ∣ bit1 n := ⟨_, hn'.symm⟩,
  have dk : bit1 k ∣ bit1 n := ⟨_, ((mul_comm _ _).trans hn').symm⟩,
  have : bit1 n / bit1 k = bit1 n',
  { rw [← hn', nat.mul_div_cancel _ k0'] },
  have k2 : 2 ≤ bit1 k := nat.succ_le_succ (bit0_pos k0),
  have pk : (bit1 k).prime,
  { refine nat.prime_def_min_fac.2 ⟨k2, le_antisymm (nat.min_fac_le k0') _⟩,
    exact ih _ (nat.min_fac_prime (ne_of_gt k2)) (dvd_trans (nat.min_fac_dvd _) dk) },
  have dkk' : ¬ bit1 k ∣ bit1 n', {rw [nat.dvd_iff_mod_eq_zero, hc], exact ne_of_gt c0},
  have dkk : ¬ bit1 k * bit1 k ∣ bit1 n, {rwa [← nat.dvd_div_iff dk, this]},
  refine @nat.min_sq_fac_prop_div _ _ pk dk dkk none _,
  rw this, refine H (nat.succ_pos _) (λ p pp dp, _),
  refine (squarefree_helper_0 k0 pp (ih p pp $ dvd_trans dp dn')).resolve_right (λ e, _),
  subst e, contradiction
end

lemma squarefree_helper_4 (n k k' : ℕ) (e : bit1 k * bit1 k = k')
  (hd : bit1 n < k') : squarefree_helper n k :=
begin
  cases nat.eq_zero_or_pos n with h h,
  { subst n, exact λ _ _, squarefree_one },
  subst e,
  refine λ k0 ih, irreducible.squarefree (nat.prime_def_le_sqrt.2 ⟨bit1_lt_bit1.2 h, _⟩),
  intros m m2 hm md,
  obtain ⟨p, pp, hp⟩ := nat.exists_prime_and_dvd (ne_of_gt m2),
  have := (ih p pp (dvd_trans hp md)).trans
    (le_trans (nat.le_of_dvd (lt_of_lt_of_le dec_trivial m2) hp) hm),
  rw nat.le_sqrt at this,
  exact not_le_of_lt hd this
end

lemma not_squarefree_mul (a aa b n : ℕ) (ha : a * a = aa) (hb : aa * b = n)
  (h₁ : 1 < a) : ¬ squarefree n :=
by { rw [← hb, ← ha], exact λ H, ne_of_gt h₁ (nat.is_unit_iff.1 $ H _ ⟨_, rfl⟩) }

/-- Given `e` a natural numeral and `a : nat` with `a^2 ∣ n`, return `⊢ ¬ squarefree e`. -/
meta def prove_non_squarefree (e : expr) (n a : ℕ) : tactic expr := do
  let ea := reflect a,
  let eaa := reflect (a*a),
  c ← mk_instance_cache `(nat),
  (c, p₁) ← prove_lt_nat c `(1) ea,
  let b := n / (a*a), let eb := reflect b,
  (c, eaa, pa) ← prove_mul_nat c ea ea,
  (c, e', pb) ← prove_mul_nat c eaa eb,
  guard (e' =ₐ e),
  return $ `(@not_squarefree_mul).mk_app [ea, eaa, eb, e, pa, pb, p₁]

/-- Given `en`,`en1 := bit1 en`, `n1` the value of `en1`, `ek`,
  returns `⊢ squarefree_helper en ek`. -/
meta def prove_squarefree_aux : ∀ (ic : instance_cache) (en en1 : expr) (n1 : ℕ)
  (ek : expr) (k : ℕ), tactic expr
| ic en en1 n1 ek k := do
  let k1 := bit1 k,
  let ek1 := `(bit1:ℕ→ℕ).mk_app [ek],
  if n1 < k1*k1 then do
    (ic, ek', p₁) ← prove_mul_nat ic ek1 ek1,
    (ic, p₂) ← prove_lt_nat ic en1 ek',
    pure $ `(squarefree_helper_4).mk_app [en, ek, ek', p₁, p₂]
  else do
    let c := n1 % k1,
    let k' := k+1, let ek' := reflect k',
    (ic, p₁) ← prove_succ ic ek ek',
    if c = 0 then do
      let n1' := n1 / k1,
      let n' := n1' / 2, let en' := reflect n',
      let en1' := `(bit1:ℕ→ℕ).mk_app [en'],
      (ic, _, pn') ← prove_mul_nat ic en1' ek1,
      let c := n1' % k1,
      guard (c ≠ 0),
      (ic, ec, pc) ← prove_div_mod ic en1' ek1 tt,
      (ic, p₀) ← prove_pos ic ec,
      p₂ ← prove_squarefree_aux ic en' en1' n1' ek' k',
      pure $ `(squarefree_helper_3).mk_app [en, en', ek, ek', ec, p₁, pn', pc, p₀, p₂]
    else do
      (ic, ec, pc) ← prove_div_mod ic en1 ek1 tt,
      (ic, p₀) ← prove_pos ic ec,
      p₂ ← prove_squarefree_aux ic en en1 n1 ek' k',
      pure $ `(squarefree_helper_2).mk_app [en, ek, ek', ec, p₁, pc, p₀, p₂]

/-- Given `n > 0` a squarefree natural numeral, returns `⊢ squarefree n`. -/
meta def prove_squarefree (en : expr) (n : ℕ) : tactic expr :=
match match_numeral en with
| match_numeral_result.one := pure `(@squarefree_one ℕ _)
| match_numeral_result.bit0 en1 := match match_numeral en1 with
  | match_numeral_result.one := pure `(nat.squarefree_two)
  | match_numeral_result.bit1 en := do
    ic ← mk_instance_cache `(ℕ),
    p ← prove_squarefree_aux ic en en1 (n / 2) `(1:ℕ) 1,
    pure $ `(squarefree_bit10).mk_app [en, p]
  | _ := failed
  end
| match_numeral_result.bit1 en' := do
  ic ← mk_instance_cache `(ℕ),
  p ← prove_squarefree_aux ic en' en n `(1:ℕ) 1,
  pure $ `(squarefree_bit1).mk_app [en', p]
| _ := failed
end

/-- Evaluates the `prime` and `min_fac` functions. -/
@[norm_num] meta def eval_squarefree : expr → tactic (expr × expr)
| `(squarefree (%%e : ℕ)) := do
  n ← e.to_nat,
  match n with
  | 0 := false_intro `(@not_squarefree_zero ℕ _ _)
  | 1 := true_intro `(@squarefree_one ℕ _)
  | _ := match n.min_sq_fac with
    | some d := prove_non_squarefree e n d >>= false_intro
    | none := prove_squarefree e n >>= true_intro
    end
  end
| _ := failed

end norm_num
end tactic


import tactic.basic
import tactic.linarith
import tactic.hint
import data.vector.basic

namespace data
namespace binary_nat

inductive node : Type
| bit (b: bool): node
| intro (u l: node): node

namespace node
def height: node → ℕ
| (bit _) := 0
| (intro u l) := (height u) + 1
end node

inductive well_formed: ℕ → node → Prop
| wf_bit (b: bool): well_formed 0 (node.bit b)
| wf_intro {n m: node} (wn: well_formed n.height n) (wm: well_formed m.height m) (hp: n.height = m.height): well_formed ((n.intro m).height) (n.intro m)

namespace well_formed

theorem intro_pos {n m: node} {h: ℕ} (w: well_formed h (n.intro m)): h ≠ 0 :=
begin
  cases w,
  exact nat.succ_ne_zero _
end

theorem intro_height {n m: node} {h: ℕ} (hw: well_formed h (n.intro m)): n.height = m.height :=
begin
  cases hw with h w,
  assumption
end

theorem elim_intro {n m: node} {h: ℕ} (w: well_formed (h + 1) (n.intro m)): well_formed h n ∧ well_formed h m :=
begin
  cases w,
  refine ⟨ by assumption, _ ⟩,
  rw [w_hp],
  assumption,
end

theorem elim_intro' {n m: node} (w: well_formed (n.intro m).height (n.intro m)): well_formed n.height n ∧ well_formed m.height m :=
begin
  rw [← intro_height w],
  exact elim_intro w,
end

theorem eq_height {n: node} {h₀ h₁: ℕ} (h: h₀ = h₁): well_formed h₀ n → well_formed h₁ n :=
by rw [h]; exact id

theorem eq_height' {n: node} {h₀ h₁: ℕ} (h: h₁ = h₀): well_formed h₀ n → well_formed h₁ n :=
by rw [h]; exact id

end well_formed

end binary_nat

def binary_nat := { n: binary_nat.node // binary_nat.well_formed n.height n }

namespace binary_nat

def height (x: binary_nat): ℕ := x.val.height

@[pattern]
def bit (b: bool): binary_nat := ⟨ node.bit b, well_formed.wf_bit b⟩

@[pattern]
def intro: Π (high low: binary_nat), high.height = low.height → binary_nat
| ⟨ high_val, high_proof⟩ ⟨ low_val, low_proof ⟩ h := ⟨ node.intro high_val low_val, well_formed.wf_intro high_proof low_proof h ⟩

theorem height_intro (x y: binary_nat): ∀  (h: x.height = y.height), (x.intro y h).height = x.height + 1 :=
begin
  cases x,
  cases y,
  simp [intro, height, node.height],
end

theorem height_intro' (x y: binary_nat): ∀  (h: x.height = y.height), (x.intro y h).height = y.height + 1 :=
begin
  cases x,
  cases y,
  simp [intro, height, node.height],
end

@[simp] theorem sizeof_leaf (b: bool): (bit b).sizeof = 2 :=
begin
  unfold bit,
  unfold_wf,
end

@[simp] theorem sizeof_intro (x y: binary_nat) (h: x.val.height = y.val.height): (intro x y h).sizeof = 1 + x.sizeof + y.sizeof :=
begin
  cases x,
  cases y,
  unfold intro,
  unfold_wf,
end

universe u
@[elab_as_eliminator] def elim {C: binary_nat → Sort u}
  (bit: Π (b: bool), C (bit b))
  (intro: Π (high low: binary_nat) (h: high.height = low.height), C (intro high low h)):
  Π (x: binary_nat), C x
| ⟨ (node.bit b), _ ⟩ := bit b
| ⟨ (node.intro n m), pf ⟩ := intro
  ⟨ n, (well_formed.elim_intro' pf).left ⟩
  ⟨ m, (well_formed.elim_intro' pf).right ⟩
  (well_formed.intro_height pf)

@[elab_as_eliminator]
def rec_on {C: binary_nat → Sort u}:
  Π (x: binary_nat)
  (handle_bit: Π (b: bool), C (bit b))
  (handle_intro: Π (high low: binary_nat) (h: high.height = low.height) (ih_high: C high) (ih_low: C low), C (intro high low h)),
  C x := λ x hb hi,
begin
  cases x,
  induction x_val,
  { apply hb },
  refine hi ⟨ x_val_u, _ ⟩ ⟨ x_val_l, _⟩ _ _ _,
  exact (well_formed.elim_intro' x_property).left,
  exact (well_formed.elim_intro' x_property).right,
  exact (well_formed.intro_height x_property),
  apply x_val_ih_u,
  apply x_val_ih_l,
end

@[elab_as_eliminator]
def rec {C: binary_nat → Sort u}
  (handle_bit: Π (b: bool), C (bit b))
  (handle_intro: Π (high low: binary_nat) (h: high.height = low.height) (ih_high: C high) (ih_low: C low), C (intro high low h)):
  Π (x: binary_nat), C x := λ x, rec_on x handle_bit handle_intro

def simp_rec {α: Type*}
  (handle_bit: Π (b: bool), α)
  (handle_intro: Π (high low: binary_nat) (ih_high ih_low: α), α):
  Π (x: binary_nat), α := λ x, rec_on x handle_bit (λ high low _ ih_high ih_low, handle_intro high low ih_high ih_low)

def zero: ℕ → binary_nat
| 0 := bit ff
| (n+1) := intro (zero n) (zero n) rfl

theorem zero_height (n: ℕ): (zero n).height = n :=
begin
  induction n,
  refl,
  rw [nat.succ_eq_add_one, ← n_ih],
  unfold zero,
  conv_lhs {
    congr,
    congr,
    rw n_ih,
    skip,
    rw n_ih,
  },
  apply height_intro,
end

def zero_extend (x: binary_nat): ℕ → binary_nat
| 0 := x
| (n+1) := intro (zero (zero_extend n).height) (zero_extend n) (by rw [zero_height])

theorem zero_extend_height (x: binary_nat) (n: ℕ): (zero_extend x n).height = x.height + n :=
begin
  induction n,
  refl,
  rw [nat.succ_eq_add_one, ← add_assoc, ← n_ih],
  unfold zero_extend,
  conv_lhs {
    congr,
    congr,
    rw n_ih,
    skip },
  apply height_intro',
end

def intro' (x y: binary_nat): binary_nat :=
  intro (zero_extend x (y.height - x.height)) (zero_extend y (x.height - y.height))
begin
  rw [zero_extend_height, zero_extend_height],
  cases @nat.le_total x.height y.height;
  rw [nat.add_sub_of_le h, nat.sub_eq_zero_of_le h, add_zero],
end

def is_zero: binary_nat → Prop := simp_rec
  (λ b, b = ff)
  (λ _ _ high_ih low_ih, high_ih ∧ low_ih)

instance is_zero.decidable (x: binary_nat): decidable (is_zero x) :=
begin
  induction x using data.binary_nat.rec_on,
  unfold is_zero,
  unfold bit,
  unfold simp_rec,
  unfold rec_on,
  apply_instance,
  cases x_high,
  cases x_low,
  apply @and.decidable _ _ x_ih_high x_ih_low,
end

def minimize: binary_nat → binary_nat := simp_rec
  (λ b, bit b)
  (λ high low high_ih low_ih,
    ite (is_zero high) low_ih (intro' high low))

def to_nat (x: binary_nat): binary_nat → ℕ := simp_rec (λ b, ite b 1 0) (λ high _ high_ih low_ih, 2 ^ 2 ^ high.height * high_ih + low_ih)

def inc_helper: binary_nat → (bool × binary_nat) := simp_rec
  (λ b: bool, ite b (tt, bit ff) (ff, bit tt))
  (λ high _ (high_ih low_ih: (bool × binary_nat)), ite low_ih.fst
    (high_ih.fst, (intro' high_ih.snd low_ih.snd))
    (ff, (intro' high low_ih.snd)))

def inc (x: binary_nat): binary_nat := minimize (intro' (bit (inc_helper x).fst) (inc_helper x).snd)

def of_nat (n: ℕ) := inc^[n] (zero 0)

end binary_nat
end data


inductive compare : Type
  | eq
  | lt
  | gt

def compare_dec : ℕ → ℕ → compare
| 0 0 := compare.eq
| 0 (nat.succ n) := compare.lt
| (nat.succ m) 0 := compare.gt
| (nat.succ m) (nat.succ n) := compare_dec m n

def compare_dec_eq_iff : Π (m n : ℕ), compare_dec m n = compare.eq ↔ m = n :=
begin
  intros m,
  induction m;
    intro n;
    split;
    intro H;
    cases n;
    try { trivial },

    congr,
    exact (m_ih n).mp H,
    apply (m_ih n).mpr,
    injection H
end

def compare_dec_lt_iff : Π (m n : ℕ), compare_dec m n = compare.lt ↔ m < n :=
begin
  intros m,
  induction m;
    intro n;
    split;
    intro H;
    cases n;
    try { trivial };
    try { exfalso; exact (nat.not_succ_le_zero _ H)},

    apply nat.zero_lt_succ,
    apply nat.succ_lt_succ,
    exact (m_ih _).mp H,
    apply (m_ih _).mpr,
    exact nat.lt_of_succ_lt_succ H
end

def compare_dec_gt_iff : Π (m n : ℕ), compare_dec m n = compare.gt ↔ m > n :=
begin
  intros m,
  induction m;
    intro n;
    split;
    intro H;
    cases n;
    try { trivial };
    try { exfalso; exact (nat.not_succ_le_zero _ H)},

    apply nat.zero_lt_succ,
    apply nat.succ_lt_succ,
    exact (m_ih _).mp H,
    apply (m_ih _).mpr,
    exact nat.lt_of_succ_lt_succ H
end

inductive calkin_wilf : Type
  | cw_one : calkin_wilf
  | cw_left : calkin_wilf → calkin_wilf
  | cw_right : calkin_wilf → calkin_wilf

open calkin_wilf

inductive cw_rational : Type
| cw_zero : cw_rational
| cw_pos : calkin_wilf → cw_rational
| cw_neg : calkin_wilf → cw_rational

lemma sub_lt2 {m n : ℕ} : m > 0 → n > m → n - m < n :=
begin
  intros Hm Hn,
  cases m,
  exfalso; exact (nat.not_succ_le_zero _ Hm),
  cases n,
  exfalso; exact (nat.not_succ_le_zero _ Hn),
  rewrite nat.succ_sub_succ_eq_sub,
  apply nat.sub_lt_succ
end

lemma succ_n_sub_n_1 (n : ℕ) : nat.succ n - n = 1 :=
begin
  induction n,
  refl,
  rewrite nat.succ_sub_succ_eq_sub,
  assumption
end

lemma succ_succ_n_sub_n_2 (n : ℕ) : nat.succ (nat.succ n) - n = 2 :=
begin
  induction n,
  refl,
  rewrite nat.succ_sub_succ_eq_sub,
  assumption
end

lemma sub_succ_eq {m n : ℕ} : n > m → nat.succ n - m = nat.succ (n - m) :=
begin
  revert n,
  induction m; intros n H,
  refl,
  cases n,
  exfalso,
  exact (nat.not_succ_le_zero _ H),
  simp [nat.succ_sub_succ_eq_sub],
  apply m_ih,
  apply nat.lt_of_succ_lt_succ,
  assumption
end

lemma sub_gt_0 {m n : ℕ} : m > n → m - n > 0 :=
begin
  intro H,
  induction H,
  rewrite succ_n_sub_n_1,
  constructor,
  apply (nat.lt_trans H_ih),
  rewrite sub_succ_eq,
  constructor,
  assumption
end

def cw_to_nat_prod : calkin_wilf → ℕ × ℕ
| cw_one := (1, 1)
| (cw_left cw) := let ⟨m, n⟩ := (cw_to_nat_prod cw) in (m, m + n)
| (cw_right cw) := let ⟨m, n⟩ := (cw_to_nat_prod cw) in (m + n, n)

def nat_prod_to_cw_rec
  (m : ℕ)
  (f : Π  (x : ℕ) (H : x < m) (n' : ℕ)
    (g' : Π  (x : ℕ) (H : x < n') (m' : ℕ), 0 < x → 0 < m' → calkin_wilf), 0 < x → 0 < n' → calkin_wilf)
  (n : ℕ)
  (g : Π  (x : ℕ) (H : x < n) (m' : ℕ), 0 < x → 0 < m' → calkin_wilf)
  (Hm : 0 < m) (Hn : 0 < n) : calkin_wilf :=
begin
  cases eq : (compare_dec m n),
  exact cw_one,

  apply cw_left,
  refine (g m _ (n - m) Hm _),
  exact (compare_dec_lt_iff m n).mp eq,
  apply sub_gt_0,
  exact (compare_dec_lt_iff m n).mp eq,

  apply cw_right,
  refine (f (m - n) _ n g _ Hn),
  apply sub_lt2,
  assumption,
  exact (compare_dec_gt_iff m n).mp eq,
  apply sub_gt_0,
  exact (compare_dec_gt_iff m n).mp eq
end

def cw_symmetry : calkin_wilf → calkin_wilf
| cw_one := cw_one
| (cw_left cw) := cw_right (cw_symmetry cw)
| (cw_right cw) := cw_left (cw_symmetry cw)

def nat_prod_to_cw_rec2 (m : ℕ)
  (f : Π  (x : ℕ) (H : x < m) (n' : ℕ), 0 < x → 0 < n' → calkin_wilf)
  (n : ℕ)
  (Hm : 0 < m) (Hn : 0 < n) : calkin_wilf :=
  cw_symmetry ((well_founded.fix nat.lt_wf nat_prod_to_cw_rec) n m f Hn Hm)

def nat_prod_to_cw (m n : nat) (Hm : 0 < m) (Hn : 0 < n) : calkin_wilf :=
  cw_symmetry (well_founded.fix nat.lt_wf nat_prod_to_cw_rec2 n m Hn Hm)

#check nat_prod_to_cw

#reduce cw_to_nat_prod (nat_prod_to_cw 7 28 _ _)


import .supermatroid_minor
import order.zorn

universes u v

open set

variables {α : Type u} {κ : Type v}

section qmatroid

/-- A `qmatroid` is a `supermatroid` with some lattice-closure conditions on the set of elements
spanned by an independent set i -/
class qmatroid (α : Type u) extends supermatroid α :=
(basis_sup : ∀ (i x y : α), i basis_for x → i basis_for y → i basis_for x ⊔ y)
(basis_Sup_chain : ∀ (i C),
  is_chain (≤) C → C.nonempty → (∀ (x ∈ C), i basis_for x) → i basis_for (Sup C))
(canopy_Inf_chain : ∀ (s C),
  is_chain (≤) C → C.nonempty → (∀ (x ∈ C), s canopy_for x) → s canopy_for (Inf C))

variables [qmatroid α] {S : set α} {i j x y x' y' z z' s t a b : α} {f : α → α}

lemma basis_for.sup (hx : i basis_for x) (hy : i basis_for y) : i basis_for x ⊔ y :=
qmatroid.basis_sup _ _ _ hx hy

lemma indep.basis_Sup_basis (hi : indep i) : i basis_for Sup {x | i basis_for x} :=
begin
  obtain ⟨u, hub, hu⟩ := @zorn_partial_order₀ α _ {x | i basis_for x}
    (λ C hCb hC, C.eq_empty_or_nonempty.elim
      (by {rintro rfl, exact ⟨i, hi.basis_self, by simp⟩, })
      (λ hC_ne, ⟨Sup C, qmatroid.basis_Sup_chain _ _ hC hC_ne hCb, λ _, le_Sup⟩)),
  rwa (le_Sup hub).antisymm'
    (Sup_le (λ x hx, sup_eq_right.mp (hu _ (basis_for.sup hx hub) le_sup_right))),
end

lemma basis_Sup_of_forall (hS : S.nonempty) (h : ∀ x ∈ S, i basis_for x) :
  i basis_for (Sup S) :=
(exists.elim hS (λ x hx, (h x hx).indep)).basis_Sup_basis.basis_of_le
  (exists.elim hS (λ x hx, (h x hx).le.trans (le_Sup hx)))
  (Sup_le (λ x hx, le_Sup (h x hx)))

lemma basis_bsupr_of_forall (hS : S.nonempty) (h : ∀ x ∈ S, i basis_for (f x)) :
  i basis_for (⨆ (x ∈ S), f x) :=
by {rw ←Sup_image, exact basis_Sup_of_forall (hS.image _) (λ x ⟨y,hy,hyx⟩,
      by {rw ← hyx, exact h _ hy})}

lemma basis_supr_of_forall [nonempty κ] {x : κ → α} (h : ∀ k, i basis_for (x k)) :
  i basis_for (⨆ k, x k) :=
basis_Sup_of_forall (range_nonempty x) (λ y ⟨k,hk⟩,hk.subst (h k))

lemma basis_Sup_of_forall_sup (hS : S.nonempty) (h : ∀ x ∈ S, i basis_for (x ⊔ i)) :
  i basis_for (Sup S ⊔ i) :=
by {rw [Sup_eq_supr, ←bsupr_sup hS], exact basis_bsupr_of_forall hS h}

lemma indep.basis_Sup_of_forall_sup (hi : indep i) (h : ∀ x ∈ S, i basis_for x ⊔ i) :
  i basis_for (Sup S) ⊔ i :=
S.eq_empty_or_nonempty.elim (by {rintro rfl, simpa using hi.basis_self})
  (λ hS, basis_Sup_of_forall_sup hS h)

lemma basis_for.basis_sup_of_basis (hx : i basis_for x) (hy : i basis_for y) :
  i basis_for (x ⊔ y) :=
by {rw sup_eq_supr, exact basis_supr_of_forall (λ k, by {cases k; assumption})}

lemma indep.basis_closure (hi : indep i) : i basis_for (closure i) :=
begin
  rw [←sup_eq_left.mpr (le_closure_self i)],
  exact basis_Sup_of_forall_sup ⟨i, by simp⟩ (λ x hx, hx i hi.basis_self),
end

lemma basis_for.basis_closure (hix : i basis_for x) : i basis_for (closure x) :=
begin
  rw [←sup_eq_left.mpr (hix.le.trans (le_closure_self x))],
  refine basis_Sup_of_forall_sup ⟨x, by simp⟩ (λ y hy, _),
  exact (hy _ hix).basis_of_le le_sup_right (sup_le_sup_left hix.le _),
end

lemma indep.basis_sup_of_le_closure (hi : indep i) (hxi : x ≤ closure i) :
  i basis_for (i ⊔ x) :=
hi.basis_closure.basis_of_le le_sup_left (sup_le (le_closure_self i) hxi)

lemma spans_closure_self (x : α) : x spans (closure x) :=
begin
  rintros i hi,
  rw [sup_eq_left.mpr (le_closure_self x), ←sup_eq_left.mpr (hi.le.trans (le_closure_self x))],
  exact hi.indep.basis_Sup_of_forall_sup
    (λ y hy, (hy i hi).basis_of_le le_sup_right (sup_le_sup_left hi.le _)),
end

lemma basis_for.basis_of_basis_basis_le (hix : i basis_for x) (hiy : i basis_for y)
(hjx : j basis_for x) (hjy : j ≤ y) :
  j basis_for y :=
begin
  obtain ⟨j',hj',hjj'⟩ := hjx.indep.le_basis_of_le hjy,
  refine hjj'.lt_or_eq.elim (λ hlt, by_contra (λ hjy', _)) (λ h, h.substr hj'),
  obtain ⟨k,hk,hjk,hki⟩ := hjx.indep.lt_basis_le_sup_of_not_basis hjy' hiy hjy,
  exact hjx.not_indep_of_lt hjk (hki.trans (sup_le hjx.le hix.le)) hk.indep,
end

lemma basis_for.basis_sup_of_le_closure (hix : i basis_for x) (hyx : y ≤ closure x) :
  i basis_for (y ⊔ i) :=
((spans_closure_self x).basis_for hix).basis_of_le le_sup_right (sup_le_sup hyx hix.le)

lemma basis_for.spans_iff_basis_sup (hi : i basis_for x) :
  x spans y ↔ i basis_for (y ⊔ i) :=
begin
  refine ⟨λ h, (h _ hi).basis_of_le le_sup_right (sup_le_sup_left hi.le _), λ h j hj, _⟩,
  refine (hi.basis_of_basis_basis_le (hi.basis_sup_of_basis h) hj
    (hj.le.trans le_sup_left)).basis_of_le
    (hj.le.trans le_sup_right) (by {rw sup_comm, exact sup_le_sup_left le_sup_left _}),
end

lemma basis_for.le_closure_iff_basis_sup (hix : i basis_for x):
  y ≤ closure x ↔ i basis_for (y ⊔ i)  :=
begin
  refine ⟨hix.basis_sup_of_le_closure,λ h, le_Sup (λ j hj, _)⟩,
  exact (hix.basis_of_basis_basis_le (hix.basis_sup_of_basis h) hj
    (hj.le.trans le_sup_left)).basis_of_le
    (hj.le.trans le_sup_right) (by {rw sup_comm, exact sup_le_sup_left le_sup_left _}),
end

lemma spans_iff_le_closure :
  x spans y ↔ y ≤ closure x :=
by {obtain ⟨i,hi⟩ := exists_basis x,
  rw [hi.le_closure_iff_basis_sup, hi.spans_iff_basis_sup]}

lemma basis_for.spans_of_basis_sup (hix : i basis_for x) (hiy : i basis_for (y ⊔ i)) :
  x spans y :=
hix.spans_iff_basis_sup.mpr hiy

lemma spans.mono_right (hxy : x spans y) (hy'y : y' ≤ y) : x spans y' :=
λ i hix, (hxy _ hix).basis_of_le (le_sup_of_le_right hix.le) (sup_le_sup_right hy'y _)

lemma spans.mono_left (hxy : x spans y) (hxx' : x ≤ x') : x' spans y :=
begin
  obtain ⟨i,hi⟩ := exists_basis x,
  obtain ⟨i',hi',hii'⟩ := hi.indep.le_basis_of_le (hi.le.trans hxx'),
  exact hi'.spans_of_basis_sup
   (((hxy.basis_for hi).basis_sup_mono hi'.indep hii').basis_of_le le_sup_right
    (sup_le_sup_right le_sup_left _)),
end

lemma spans.mono (hxy : x spans y) (hxx' : x ≤ x') (hy'y : y' ≤ y) : x' spans y' :=
(hxy.mono_left hxx').mono_right hy'y

lemma spans_bot (x : α) : x spans ⊥ := λ i hi, by rwa bot_sup_eq

lemma spans_iff_exists :
  x spans y ↔ ∃ i, i basis_for (y ⊔ i) ∧ i ≤ x :=
⟨λ h, (exists_basis x).imp (λ i hi, ⟨hi.spans_iff_basis_sup.mp h,hi.le⟩),
  λ ⟨i, hi, hix⟩, spans.mono_left (hi.indep.basis_self.spans_of_basis_sup hi) hix⟩

lemma basis_for.spans_of_basis (hi : i basis_for x) (hiy : i basis_for (y ⊔ i)) : x spans y :=
  spans_iff_exists.mpr ⟨i, hiy, hi.le⟩

lemma basis_for.spans (hi : i basis_for x) : i spans x :=
spans_iff_exists.mpr ⟨i, hi.basis_sup_self, rfl.le⟩

lemma basis_for.spans_right (hi : i basis_for x) : x spans i :=
spans_iff_exists.mpr ⟨i , sup_idem.substr hi.indep.basis_self, hi.le⟩

lemma spanning_iff_spans_top : spanning s ↔ s spans (⊤ : α) :=
by simp_rw [spans_iff_exists, spanning_iff_basis_le, top_sup_eq, basis_top_iff]

lemma indep.basis_sup_of_spans (hi : indep i) (hix : i spans x) : i basis_for x ⊔ i :=
begin
  obtain ⟨i',hi',hi'i⟩ := spans_iff_exists.mp hix,
  refine (hi'.basis_sup_mono hi hi'i).basis_of_le le_sup_right _,
  rw sup_right_comm, exact le_sup_left,
end

lemma indep.basis_of_spans_le (hi : indep i) (hix : i spans x) (hle : i ≤ x) : i basis_for x :=
(sup_eq_left.mpr hle) ▸ (hi.basis_sup_of_spans hix)

lemma closure_idem (x : α) : closure (closure x) = closure x :=
begin
  refine le_antisymm _ (le_closure_self _),
  obtain ⟨i,hi⟩ := exists_basis x,
  rw [hi.le_closure_iff_basis_sup,
    sup_eq_left.mpr (hi.le.trans ((le_closure_self x).trans (le_closure_self _)))],
  exact basis_for.basis_closure (basis_for.basis_closure hi),
end

lemma indep.inf_Sup_basis_Sup_of_forall_inf_basis (hi : indep i)
(hS : ∀ x ∈ S, (x ⊓ i) basis_for x) :
  (Sup S ⊓ i) basis_for (Sup S) :=
begin
  refine S.eq_empty_or_nonempty.elim (by {rintro rfl, simpa using (bot_indep α).basis_self})
    (λ hS_ne, _),

  obtain ⟨k,hk,hkS⟩ := (hi.inf_left_indep (Sup S)).le_basis_of_le inf_le_left,
  have hxS := λ {x : α} (hx : x ∈ S), (hS x hx).eq_of_le_indep (hk.indep.inf_left_indep x)
    (le_inf inf_le_left (le_trans (inf_le_inf_right _ (le_Sup hx)) hkS)) inf_le_left,

  have hb := λ x hx, (hS x hx).basis_sup_mono (hi.inf_left_indep (Sup S))
    (inf_le_inf_right i (le_Sup hx)),
  refine (basis_bsupr_of_forall hS_ne hb).basis_of_le inf_le_left _,
  rw ←Sup_image,
  refine Sup_le_Sup_of_forall_exists_le (λ x hx, _),
  simp only [mem_image, exists_prop, exists_exists_and_eq_and],
  refine ⟨x,hx, le_sup_left⟩,
end

lemma supr_basis_supr_of_forall {i x : κ → α}
(h : ∀ k, (i k) basis_for (x k)) (hind : indep (⨆ k, (i k))) :
  (⨆ k, i k) basis_for (⨆ k, x k) :=
begin
  refine hind.basis_for (supr_le (λ k, (h k).le.trans (le_supr _ _))) (λ j hj hjle hi'j, _),
  set i' := ⨆ k, i k with hi',
  have h' : ∀ k, (i k) = (x k)  ⊓ i' := λ k, (h k).eq_of_le_indep
    (hind.inf_left_indep _) (le_inf (h k).le (le_supr _ _) ) inf_le_left,
  simp_rw h' at h,
  have hb := @indep.inf_Sup_basis_Sup_of_forall_inf_basis _ _ (range x) _ hind
    (λ y ⟨z,hz⟩, by {simpa [hz] using h z}),
  obtain rfl := hb.eq_of_le_indep hj (le_trans inf_le_right hi'j) hjle,
  exact hi'j.antisymm inf_le_right,
end

lemma basis_for.baz (hi : i basis_for x) (hj : j basis_for y) (hij : indep (i ⊔ j)) :
  (i ⊔ j) basis_for (x ⊔ y) :=
begin
  have := @supr_basis_supr_of_forall _ _ _ (λ b, cond b i j) (λ b, cond b x y)
    (λ k, by {cases k; simpa}),
  simp only [supr_bool_eq] at this,
  exact this hij,
end

lemma basis_for.baz' (hi : i basis_for x) (hj : j basis_for y) (hij : i ≤ j) :
  j basis_for (x ⊔ y) :=
let hij' := sup_eq_right.mpr hij in by {convert hi.baz hj (by {rw hij', exact hj.indep}), rw hij'}

lemma closure_mono (hxy : x ≤ y) : closure x ≤ closure y :=
begin
  obtain ⟨i,hi⟩ := exists_basis x,
  obtain ⟨j, hj, hij⟩ := hi.indep.le_basis_of_le (hi.le.trans hxy),
  exact hj.le_closure_iff_basis_sup.mpr
    (basis_Sup_of_forall_sup (⟨x, λ hk, by {rw sup_idem, exact id}⟩)
      (λ z hz, ((hz _ hi).baz' hj hij).basis_of_le le_sup_right
        (sup_assoc.substr (sup_le_sup_left (le_sup_of_le_right hj.le) _)))),
end

lemma spans.trans (hxy : x spans y) (hyz : y spans z) : x spans z :=
begin
  obtain ⟨i,hi⟩ := exists_basis x,
  refine basis_for.spans_of_basis_sup hi _,
  have hb := (hxy.basis_for hi).basis_of_le le_sup_right (sup_le_sup_left hi.le y),
  exact ((hyz.mono_left le_sup_left) i hb).basis_of_le le_sup_right
    (sup_le_sup_left le_sup_right _),
end

lemma spanning.spanning_of_spans (hs : spanning s) (hxs : x spans s) : spanning x :=
by {rw spanning_iff_spans_top at *, exact hxs.trans hs}

lemma base.spanning_of_spans (hb : base b) (hxb : x spans b) : spanning x :=
hb.spanning.spanning_of_spans hxb

lemma supr_spans_supr_of_forall {a x : κ → α} (h : ∀ k, a k spans x k) :
  (⨆ k, a k) spans (⨆ k, x k) :=
begin
  refine (is_empty_or_nonempty κ).elim (λ he, _ ) (λ hk, _),
  { simp_rw @supr_of_empty _ _ _ he, exact spans_bot _, },
  obtain ⟨i, hi⟩ := exists_basis (⨆ k, a k),
  have h1 := λ k, (hi.spans.mono_right (le_supr _ _)).trans (h k),
  have h2 := (λ k, hi.indep.basis_sup_of_spans (h1 k)),
  have h3 := (@basis_supr_of_forall α _ _ _ hk _ h2).spans,
  refine (hi.spans_right.trans h3).mono_right _,
  rw [←(@supr_sup _ _ _ hk)], exact le_sup_left,
end

lemma spans_Sup_of_forall (h : ∀ x ∈ S, a spans x) : a spans (Sup S) :=
begin
  refine S.eq_empty_or_nonempty.elim (by {rintro rfl, simpa using spans_bot _}) (λ hS, _),
  convert @supr_spans_supr_of_forall α S _ (λ _, a) coe (λ ⟨x,hx⟩, h x hx),
  exact (@supr_const _ S _ _ (hS.to_subtype)).symm,
  simp,
end

lemma spans.sup (ha : a spans x) (hb : b spans y) : (a ⊔ b) spans (x ⊔ y) :=
begin
  rw [sup_eq_supr, sup_eq_supr],
  exact @supr_spans_supr_of_forall _ _ _ (λ i, cond i a b) (λ i, cond i x y)
    (λ i, by {cases i; assumption}),
end

lemma bsupr_spans_Sup_of_forall (h : ∀ x ∈ S, f x spans x) : (⨆ (x ∈ S), f x) spans Sup S :=
begin
  convert @supr_spans_supr_of_forall α S _ (λ z, f z) coe (λ (z : S), h z.1 z.2) using 1,
  exact supr_subtype',
  rw [Sup_eq_supr, supr_subtype'], refl,
end

lemma basis_for.sup_canopy_of_le_base (hix : i basis_for x) (hb : base b) (hib : i ≤ b) :
  (x ⊔ b) canopy_for x :=
by {obtain rfl := hix.eq_of_le_indep (hb.inf_left_indep x) (le_inf hix.le hib) inf_le_left,
  rwa hb.sup_canopy_iff_inf_basis}

lemma sup_eq_sup_of_basis_basis_spans (hi_inf : x ⊓ i basis_for x) (hi_sup : i basis_for x ⊔ i)
(hy : y spans x ⊔ i) (hy_le : y ≤ x ⊔ i):
  x ⊔ y = x ⊔ i :=
begin
  obtain ⟨j,hj⟩ := exists_basis y,
  have hj' := spans_iff_forall.mp hy _ hj,
  rw [sup_eq_left.mpr hy_le] at hj',
  have h' := sup_eq_of_basis_basis_basis hi_inf hi_sup hj',
  rw [←h'],
  exact (sup_le le_sup_left (by rwa h')).antisymm (sup_le le_sup_left (hj.le.trans le_sup_right)),
end

section dual

/-- This lemma is the minimum needed to bootstrap duality for q-matroids. Its generalization to
  arbitrary indexing types will follow from duality. -/
private lemma closure_infi_eq_infi_closure_of_indep_bool {i : bool → α} (h : indep (⨆ t, i t)) :
  (⨅ t, closure (i t)) = closure (⨅ t, i t) :=
begin
  refine le_antisymm _ (le_infi (λ t, closure_mono (infi_le _ _))),
  rw [←spans_iff_le_closure, spans_iff_exists],
  have h_indep := λ t, h.indep_of_le (le_supr _ t),
  refine ⟨_, (h.indep_of_le ((infi_le _ tt).trans (le_supr _ _))).basis_for
    le_sup_right (λ k hk hk_le hle_k, hle_k.antisymm _), rfl.le⟩,

  rw [sup_eq_left.mpr
    (le_infi (λ t, (infi_le _ _).trans (le_closure_self _)) : (⨅ t, i t) ≤ ⨅ t, closure (i t) ),
    le_infi_iff] at hk_le,
  simp_rw [←spans_iff_le_closure, spans_iff_forall] at hk_le,
  have hforall_b := λ t, (hk_le t (i t) (h_indep t).basis_self), clear hk_le,

  have heq_inf_supr : ∀ t, i t = (k ⊔ (i t)) ⊓ (⨆ t', i t') :=
    λ t, (hforall_b t).eq_of_le_indep (h.indep_of_le inf_le_right)
      (le_inf le_sup_right (le_supr _ _)) inf_le_left,

  have h' : ∀ t, (i t) ⊓ (k ⊔ i (!t)) = (i (!t)) ⊓ (k ⊔ i t) := λ t, by
    {nth_rewrite 1 [heq_inf_supr (!t)], nth_rewrite 0 [heq_inf_supr t], rw inf_left_right_swap},

  have h'' : ∀ t, (i t ⊓ (k ⊔ i (!t))) = ⨅ t', i t' :=
  begin
    intro t,
    rw [←@inf_idem _ _ (i t ⊓ (k ⊔ i (!t)))], nth_rewrite 0 h',
    rw [inf_left_comm, inf_right_comm, inf_eq_left.mpr (@le_sup_right _ _  k _), inf_left_comm,
      inf_eq_left.mpr (@le_sup_right _ _ k _), inf_comm, infi_bool_eq'],
  end,

  have hk_eq : k = ⨅ t, (k ⊔ i t) := le_antisymm (le_infi (λ t, le_sup_left))
    (by rwa [infi_bool_eq, sup_comm, @sup_comm _ _ _ (i _), is_modular_lattice.sup_inf_sup_assoc,
      inf_comm, @sup_comm _ _ (i _), ←bool.bnot_false, h', bool.bnot_false, ←bool.bnot_true, h'',
      sup_eq_right.mpr]),

  have hwin : ∀ (t : bool), k ≤ i (!t) := λ t, by {
    obtain ⟨k', hk', hlek'⟩ := hk.le_basis_of_le (le_sup_left : k ≤ k ⊔ i (!t)),
    have hspans : k' ⊔ i t spans k ⊔ i t ⊔ (⨆ t, i t),
    { refine (hk'.spans.sup (spans_self (i t))).mono_right _,
      rw [sup_right_comm _ (i (!t)), supr_bool_eq' t, ←sup_assoc, @sup_assoc _ _ k (i t),sup_idem]},

    have hbig := @eq_of_le_of_inf_le_of_sup_le _ _ _  _ _ (k ⊔ i t) hk'.le
    (by {rw [inf_comm, ←(infi_bool_eq' t), ←hk_eq], exact le_inf hlek' le_sup_left})
    (by {
      have hk'' := @sup_eq_sup_of_basis_basis_spans _ _ (⨆ t, i t) (k ⊔ i t) (k' ⊔ i t)
        (by {rw ←heq_inf_supr, exact hforall_b _})
        (by {refine h.basis_of_spans_le _ le_sup_right,
          convert supr_spans_supr_of_forall (λ t, (hforall_b t).spans),
          rw [supr_bool_eq' t, supr_bool_eq' t, ←sup_assoc, ←sup_assoc, @sup_assoc _ _ k,
            sup_idem, sup_right_comm k (i t) k, sup_idem]})
        hspans
        (sup_le (hk'.le.trans (sup_le (le_sup_of_le_left le_sup_left)
          (le_sup_of_le_right (le_supr _ _)))) (le_sup_of_le_left le_sup_right)),
      rw [sup_right_comm, sup_assoc, sup_assoc, sup_idem, ←sup_assoc, @sup_comm _ _ k] at hk'',
      rw [←@sup_assoc _ _ k', hk'', sup_comm, sup_right_comm, ←sup_assoc, sup_idem, sup_right_comm],
      exact sup_le_sup_left (le_supr _ _) _}),

    have hb' := hk'.indep.eq_of_basis (hbig.substr (hforall_b (!t))),
    rwa [hb', eq_comm, sup_eq_right] at hbig},

  refine le_infi (λ t, by {have := hwin (!t), rwa bnot_bnot at this}),
end

private lemma canopy_infi_bool {x : bool → α} (h_can : ∀ k, s canopy_for (x k)) :
  s canopy_for (⨅ k, x k) :=
begin
  obtain ⟨b,hb, (hsb : ∀ k, s = x k ⊔ b)⟩ := eq_sup_basis_forall_of_canopy_forall h_can,

  have h_bas := λ k, hb.sup_canopy_iff_inf_basis.mp ((hsb k).subst (h_can k)),

  have hsupr_inf_basis : (⨆ k, ((x k) ⊓ b)) basis_for ⨆ k, x k := indep.basis_of_spans_le
    (hb.indep_of_le (Sup_le (by simp)))
    (supr_spans_supr_of_forall (λ k, (h_bas k).spans))
    (supr_le (λ k, inf_le_left.trans (le_supr _ _))),

  have h_distrib : (⨆ k, x k ⊓ b) = (⨆ k, x k) ⊓ b :=
    hsupr_inf_basis.eq_of_le_indep (hb.inf_left_indep _)
    (supr_le (λ k, inf_le_inf_right _ (le_supr _ _))) inf_le_left,

  have h_distrib' : ∀ k, (x k ⊓ b) ⊔ (x (!k)) ⊓ b = (x k ⊔ x (!k)) ⊓ b :=
    λ k, by rw [←supr_bool_eq' k, h_distrib, supr_bool_eq'],

  have hinf_sup_inf : ∀ k, x k = (x k) ⊓ b ⊔ ((x k) ⊓ (x (!k))) :=
  begin
    intro k,
    rw [inf_comm, @inf_comm _ _ _ (x (!k)), is_modular_lattice.inf_sup_inf_assoc, eq_comm,
      inf_eq_right, inf_comm],

    calc x k ≤ (x k ⊔ b) ⊓ (x k ⊔ x (!k))     : le_inf le_sup_left le_sup_left
        ...  = _ : by {rw [←hsb k, hsb (!k), sup_inf_assoc_of_le, inf_comm, ←h_distrib', sup_comm],
                        exact le_sup_right}
        ...  ≤ _ : sup_le (sup_le_sup_left inf_le_left _) le_sup_right,
  end,

  have hs_inf_b : ∀ k, s = ((x k) ⊓ (x (!k))) ⊔ b :=
  λ k, le_antisymm
    ((hsb k).le.trans (sup_le ((hinf_sup_inf k).le.trans
      (sup_comm.le.trans (sup_le_sup_left inf_le_right _))) le_sup_right))
    (sup_le ((inf_le_of_left_le (@le_sup_left _ _ (x k) _)).trans (hsb k).symm.le)
      (le_sup_right.trans (hsb k).symm.le)),

  rw infi_bool_eq,
  rw [hs_inf_b tt, bool.bnot_true, hb.sup_canopy_iff_inf_basis],
  specialize h_can tt,
  rw [hs_inf_b tt] at h_can,

  refine indep.basis_of_spans_le (hb.inf_left_indep _) _ inf_le_left,
  have assoc : (x tt ⊓ x ff ⊓ b) = (x tt ⊓ b) ⊓ (x ff ⊓ b) :=
    by {rw [inf_assoc, inf_assoc], congr' 1, simp},
  rw [spans_iff_le_closure, assoc, ←infi_bool_eq, ←@infi_bool_eq _ _ (λ k, (x k ⊓ b)),
    ←closure_infi_eq_infi_closure_of_indep_bool
      (hb.indep_of_le (supr_le (λ i, @inf_le_right _ _ (x i) b)))],

  exact le_infi (λ k, spans_iff_le_closure.mp ((h_bas k).spans.mono_right (infi_le _ _))),
end

lemma canopy_for.inf (hsx : s canopy_for x) (hsy : s canopy_for y) : s canopy_for (x ⊓ y) :=
by {convert @canopy_infi_bool _ _ s (λ i, cond i x y) (λ k, by {cases k; assumption}),
  simp [infi_bool_eq]}

instance : qmatroid αᵒᵈ :=
{ basis_sup := λ _ _ _, @canopy_for.inf α _ _ _ _,
  basis_Sup_chain := λ _ _ hC, @qmatroid.canopy_Inf_chain _ _ _ _ hC.symm,
  canopy_Inf_chain := λ _ _ hC, @qmatroid.basis_Sup_chain _ _ _ _ hC.symm}

end dual

lemma canopy_infi_of_forall [nonempty κ] {x : κ → α} (h : ∀ k, s canopy_for (x k)) :
  s canopy_for (⨅ k, x k) :=
@basis_supr_of_forall αᵒᵈ _ _ _ _ _ h

section minor

open subtype

-- False, even for matroids; the RHS has 'loops
lemma ugh {i a x : α} (hia : i basis_for a) (hax : a ≤ x) :
  indep (⟨x,hax⟩ : Ici a) ↔ indep (⟨x,hia.le.trans hax⟩ : Ici i) :=
begin
  simp_rw [indep_Ici_iff_exists_canopy_ge_coe, coe_mk],
  refine ⟨λ h, _, λ h, h.imp (λ t ⟨⟨ht_sp,hat,h_forall⟩, hxt⟩,
    ⟨⟨ht_sp, hax.trans hxt, λ t' ht' hit' ht't, h_forall _ ht' (hia.le.trans hit') ht't⟩, hxt⟩)⟩,
  obtain ⟨t,hta,hxt⟩ := h,
  obtain ⟨b,hb,rfl,hmin⟩ := hia.exists_base,
  rw [←hb.sup_canopy_iff_inf_basis] at hia,

  --have := hia.spanning.ge_canopy_ge_inf,
  -- obtain ⟨ti, hti⟩ := exists_canopy i,
  --obtain ⟨t₀,ht₀,ht₀t, htt₀⟩ := --hta.spanning.ge_canopy_ge_inf hti ((hia.le.trans hax).trans hxt),

  --refine ⟨⟨ht_sp,hia.le.trans hat, λ t' ht' hit' ht't, _⟩, hxt⟩,

end

lemma coe_spans_coe_of_spans_Ici {x y : Ici a} (hxy : x spans y) : (x : α) spans y :=
begin
  obtain ⟨⟨x,hxa : a ≤ x⟩,⟨y,hya : a ≤ y⟩⟩ := ⟨x,y⟩, rw [coe_mk,coe_mk],
  obtain ⟨i,hi⟩ := exists_basis a,
  obtain ⟨j,hj,hij⟩ := hi.indep.le_basis_of_le (hi.le.trans hxa),
  rw [spans_iff_forall] at hxy,
  rw spans_iff_exists,

  -- have : (⟨_, @le_sup_left _ _ a i⟩ : Ici a) basis_for ⟨x,hxa⟩,
  -- { refine ⟨_,_,_⟩, },
  refine ⟨j, _, hj.le⟩,
  obtain ⟨b,hb,hjb⟩ := hj.indep,
  have := (hi.eq_of_le_indep (hb.inf_left_indep a) (le_inf hi.le (hij.trans hjb)) inf_le_left),
  subst this,
  rw ←hb.sup_canopy_iff_inf_basis at hi,
  have : (⟨(a ⊔ b) ⊓ x, (le_inf le_sup_left hxa : a ≤ (a ⊔ b) ⊓ x)⟩ : Ici a) basis_for ⟨x,hxa⟩,
  { refine ⟨_,coe_le_coe.mpr inf_le_right,_⟩,
    { exact indep_Ici_iff_exists_canopy_ge_coe.mpr ⟨_,hi,inf_le_left⟩},
    rintros ⟨j', (hj' : a ≤ j')⟩ hj' hj'_le hle_j',
    obtain ⟨t,ht,hj't⟩ := indep_Ici_iff_exists_canopy_ge_coe.mp hj'_1,
    rw mk_le_mk at hj'_le hle_j', rw coe_mk at hj't,
    sorry,
    --have := hj.eq_of_le_indep
    },

  have := hxy _ this,

end

end minor

-- lemma closure_infi_eq_infi_closure_of_indep {i : κ → α} (h : indep (⨆ t, i t)) :
--   (⨅ t, closure (i t)) = closure (⨅ t, i t) :=
-- begin
--   refine (is_empty_or_nonempty κ).elim
--     (λ h_empty, by simp_rw [@infi_of_empty _ _ _ h_empty, closure_top_eq]) (λ h_ne, _),
--   obtain ⟨t₀⟩ := h_ne,
--   refine le_antisymm _ (le_infi (λ t, closure_mono (infi_le _ _))),
--   rw [←spans_iff_le_closure, spans_iff_exists],
--   have h_indep := λ t, h.indep_of_le (le_supr _ t),
--   refine ⟨_, (h.indep_of_le ((infi_le _ t₀).trans (le_supr _ _))).basis_for
--     le_sup_right (λ k hk hk_le hle_k, hle_k.antisymm _), rfl.le⟩,

--   rw [sup_eq_left.mpr
--     (le_infi (λ t, (infi_le _ _).trans (le_closure_self _)) : (⨅ t, i t) ≤ ⨅ t, closure (i t) ),
--     le_infi_iff] at hk_le,
--   simp_rw [←spans_iff_le_closure, spans_iff_forall] at hk_le,
--   have hforall_b := λ t, (hk_le t (i t) (h_indep t).basis_self), clear hk_le,

--   sorry

-- end

end qmatroid


/-
Copyright (c) 2022 Tomaz Gomes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Tomaz Gomes.
-/
import data.list.sort tactic
import data.nat.log

/-!
# Timed Insertion Sort
  This file defines a new version of Insertion Sort that, besides sorting the input list, counts the
  number of comparisons made through the execution of the algorithm. Also, it presents proofs of
  it's time complexity and it's equivalence to the one defined in data/list/sort.lean
## Main Definition
  - Timed.insertion_sort : list α → (list α × ℕ)
## Main Results
  - Timed.insertion_sort_complexity :
      ∀ l : list α, (Timed.insertion_sort r l).snd ≤ l.length * l.length
  - Timed.insertion_sort_equivalence :
      ∀ l : list α, (Timed.insertion_sort r l).fst = list.insertion_sort r l
-/

variables {α : Type} (r : α → α → Prop) [decidable_rel r]
local infix ` ≼ ` : 50 := r

namespace Timed

@[simp] def ordered_insert (a : α) : list α → (list α × ℕ)
| []       := ([a], 0)
| (h :: t) := if a ≼ h then (a :: h :: t, 1)
              else let (l', n) := ordered_insert t in (h :: l', n + 1)

#eval ordered_insert (≤) 2 [5, 3, 1, 4]
-- ([2, 5, 3, 1, 4], 1)

#eval ordered_insert (≤) 9 [1, 0, 8]
-- ([1, 0, 8, 9], 3)

@[simp] def insertion_sort : list α → (list α × ℕ)
| [] := ([], 0)
| (h :: t) := let (l', n) := (insertion_sort t), (l'', m) := ordered_insert r h l'
              in (l'', n + m)

#eval insertion_sort (≤) [1, 2, 3, 4, 5]
-- ([1, 2, 3, 4, 5], 4)

#eval insertion_sort (≤) [5, 4, 3, 2, 1]
-- ([1, 2, 3, 4, 5], 10)

theorem ordered_insert_complexity (a : α) :
  ∀ l : list α, (ordered_insert r a l).snd ≤ l.length :=
begin
  intro l,
  induction l,
  { simp only [list.length, ordered_insert], },
  { simp only [list.length, ordered_insert], split_ifs,
    { simp only [zero_le, le_add_iff_nonneg_left], },
    { cases (ordered_insert r a l_tl),
      unfold ordered_insert,
      linarith,
    }
  }
end

theorem ordered_insert_equivalence (a : α) : ∀ l : list α,
  (ordered_insert r a l).fst = list.ordered_insert r a l :=
begin
  intro l,
  induction l,
  { simp only [list.ordered_insert_nil, ordered_insert, eq_self_iff_true, and_self], },
  { simp only [list.ordered_insert, ordered_insert], split_ifs,
    { simp only [eq_self_iff_true, and_self], },
    { cases (ordered_insert r a l_tl),
      unfold ordered_insert,
      simp only [true_and, eq_self_iff_true],
      exact l_ih,
    }
  }
end

theorem ordered_insert_length (a : α) : ∀ l : list α,
  (ordered_insert r a l).fst.length = l.length + 1 :=
begin
  intro l,
  rw ordered_insert_equivalence r a l,
  exact list.ordered_insert_length r l a,
end

theorem insertion_sort_preserves_length : ∀ l : list α,
  (insertion_sort r l).fst.length = l.length :=
begin
  intro l,
  induction l,
  { simp only [insertion_sort], },
  { simp only [insertion_sort, list.length],
    cases (insertion_sort r l_tl) with sorted_tl _,
    unfold insertion_sort,
    have ordered_length : (ordered_insert r l_hd sorted_tl).fst.length = sorted_tl.length + 1 :=
      ordered_insert_length r l_hd sorted_tl,
    cases (ordered_insert r l_hd sorted_tl) with sorted_list _,
    unfold insertion_sort,
    rw ordered_length,
    rw l_ih,
  }
end

theorem insertion_sort_complexity :
  ∀ l : list α, (insertion_sort r l).snd ≤ l.length * l.length :=
begin
  intro l,
  induction l,
  { simp only [insertion_sort, list.length, mul_zero], },
  { simp only [insertion_sort, list.length],
    have same_lengths : (insertion_sort r l_tl).fst.length = l_tl.length :=
      insertion_sort_preserves_length r l_tl,
    cases (insertion_sort r l_tl) with sorted_tl ops,
    unfold insertion_sort,
    have hh : (ordered_insert r l_hd sorted_tl).snd ≤ sorted_tl.length :=
      ordered_insert_complexity r l_hd sorted_tl,
    cases (ordered_insert r l_hd sorted_tl),
    unfold insertion_sort,
    linarith,
  }
end

theorem insertion_sort_equivalence : ∀ l : list α,
  (insertion_sort r l).fst = list.insertion_sort r l :=
begin
  intro l,
  induction l,
  { simp only [insertion_sort, list.insertion_sort], },
  { simp only [insertion_sort, list.insertion_sort],
    rw ← l_ih,
    cases insertion_sort r l_tl,
    unfold insertion_sort,
    rw ← ordered_insert_equivalence r l_hd fst,
    cases ordered_insert r l_hd fst,
    unfold insertion_sort,
  }
end

end Timed


/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison

! This file was ported from Lean 3 source module topology.unit_interval
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Instances.Real
import Mathlib.Topology.Algebra.Field
import Mathlib.Data.Set.Intervals.ProjIcc
import Mathlib.Data.Set.Intervals.Instances

/-!
# The unit interval, as a topological space

Use `open unitInterval` to turn on the notation `I := Set.Icc (0 : ℝ) (1 : ℝ)`.

We provide basic instances, as well as a custom tactic for discharging
`0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` when `x : I`.

-/

noncomputable section

open Classical Topology Filter

open Set Int Set.Icc

/-! ### The unit interval -/

/-- The unit interval `[0,1]` in ℝ. -/
abbrev unitInterval : Set ℝ :=
  Set.Icc 0 1
#align unit_interval unitInterval

@[inherit_doc]
scoped[unitInterval] notation "I" => unitInterval

namespace unitInterval

theorem zero_mem : (0 : ℝ) ∈ I :=
  ⟨le_rfl, zero_le_one⟩
#align unit_interval.zero_mem unitInterval.zero_mem

theorem one_mem : (1 : ℝ) ∈ I :=
  ⟨zero_le_one, le_rfl⟩
#align unit_interval.one_mem unitInterval.one_mem

theorem mul_mem {x y : ℝ} (hx : x ∈ I) (hy : y ∈ I) : x * y ∈ I :=
  ⟨mul_nonneg hx.1 hy.1, (mul_le_mul hx.2 hy.2 hy.1 zero_le_one).trans_eq <| one_mul 1⟩
#align unit_interval.mul_mem unitInterval.mul_mem

theorem div_mem {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) (hxy : x ≤ y) : x / y ∈ I :=
  ⟨div_nonneg hx hy, div_le_one_of_le hxy hy⟩
#align unit_interval.div_mem unitInterval.div_mem

theorem fract_mem (x : ℝ) : fract x ∈ I :=
  ⟨fract_nonneg _, (fract_lt_one _).le⟩
#align unit_interval.fract_mem unitInterval.fract_mem

theorem mem_iff_one_sub_mem {t : ℝ} : t ∈ I ↔ 1 - t ∈ I := by
  rw [mem_Icc, mem_Icc]
  constructor <;> intro <;> constructor <;> linarith
#align unit_interval.mem_iff_one_sub_mem unitInterval.mem_iff_one_sub_mem

instance hasZero : Zero I :=
  ⟨⟨0, zero_mem⟩⟩
#align unit_interval.has_zero unitInterval.hasZero

instance hasOne : One I :=
  ⟨⟨1, by constructor <;> norm_num⟩⟩
#align unit_interval.has_one unitInterval.hasOne

theorem coe_ne_zero {x : I} : (x : ℝ) ≠ 0 ↔ x ≠ 0 :=
  not_iff_not.mpr coe_eq_zero
#align unit_interval.coe_ne_zero unitInterval.coe_ne_zero

theorem coe_ne_one {x : I} : (x : ℝ) ≠ 1 ↔ x ≠ 1 :=
  not_iff_not.mpr coe_eq_one
#align unit_interval.coe_ne_one unitInterval.coe_ne_one

instance : Nonempty I :=
  ⟨0⟩

instance : Mul I :=
  ⟨fun x y => ⟨x * y, mul_mem x.2 y.2⟩⟩

-- todo: we could set up a `LinearOrderedCommMonoidWithZero I` instance
theorem mul_le_left {x y : I} : x * y ≤ x :=
  Subtype.coe_le_coe.mp <| (mul_le_mul_of_nonneg_left y.2.2 x.2.1).trans_eq <| mul_one x.1
#align unit_interval.mul_le_left unitInterval.mul_le_left

/-- Unit interval central symmetry. -/
def symm : I → I := fun t => ⟨1 - t, mem_iff_one_sub_mem.mp t.prop⟩
#align unit_interval.symm unitInterval.symm

@[inherit_doc]
scoped notation "σ" => unitInterval.symm

@[simp]
theorem symm_zero : σ 0 = 1 :=
  Subtype.ext <| by simp [symm]
#align unit_interval.symm_zero unitInterval.symm_zero

@[simp]
theorem symm_one : σ 1 = 0 :=
  Subtype.ext <| by simp [symm]
#align unit_interval.symm_one unitInterval.symm_one

@[simp]
theorem symm_symm (x : I) : σ (σ x) = x :=
  Subtype.ext <| by simp [symm]
#align unit_interval.symm_symm unitInterval.symm_symm

@[simp]
theorem coe_symm_eq (x : I) : (σ x : ℝ) = 1 - x :=
  rfl
#align unit_interval.coe_symm_eq unitInterval.coe_symm_eq

-- Porting note: Proof used to be `by continuity!`
@[continuity]
theorem continuous_symm : Continuous σ :=
(continuous_const.add continuous_induced_dom.neg).subtype_mk _
#align unit_interval.continuous_symm unitInterval.continuous_symm

instance : ConnectedSpace I :=
  Subtype.connectedSpace ⟨nonempty_Icc.mpr zero_le_one, isPreconnected_Icc⟩

/-- Verify there is an instance for `CompactSpace I`. -/
example : CompactSpace I := by infer_instance

theorem nonneg (x : I) : 0 ≤ (x : ℝ) :=
  x.2.1
#align unit_interval.nonneg unitInterval.nonneg

theorem one_minus_nonneg (x : I) : 0 ≤ 1 - (x : ℝ) := by simpa using x.2.2
#align unit_interval.one_minus_nonneg unitInterval.one_minus_nonneg

theorem le_one (x : I) : (x : ℝ) ≤ 1 :=
  x.2.2
#align unit_interval.le_one unitInterval.le_one

theorem one_minus_le_one (x : I) : 1 - (x : ℝ) ≤ 1 := by simpa using x.2.1
#align unit_interval.one_minus_le_one unitInterval.one_minus_le_one

theorem add_pos {t : I} {x : ℝ} (hx : 0 < x) : 0 < (x + t : ℝ) :=
  add_pos_of_pos_of_nonneg hx <| nonneg _
#align unit_interval.add_pos unitInterval.add_pos

/-- like `unitInterval.nonneg`, but with the inequality in `I`. -/
theorem nonneg' {t : I} : 0 ≤ t :=
  t.2.1
#align unit_interval.nonneg' unitInterval.nonneg'

/-- like `unitInterval.le_one`, but with the inequality in `I`. -/
theorem le_one' {t : I} : t ≤ 1 :=
  t.2.2
#align unit_interval.le_one' unitInterval.le_one'

theorem mul_pos_mem_iff {a t : ℝ} (ha : 0 < a) : a * t ∈ I ↔ t ∈ Set.Icc (0 : ℝ) (1 / a) := by
  constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor
  · exact nonneg_of_mul_nonneg_right h₁ ha
  · rwa [le_div_iff ha, mul_comm]
  · exact mul_nonneg ha.le h₁
  · rwa [le_div_iff ha, mul_comm] at h₂
#align unit_interval.mul_pos_mem_iff unitInterval.mul_pos_mem_iff

theorem two_mul_sub_one_mem_iff {t : ℝ} : 2 * t - 1 ∈ I ↔ t ∈ Set.Icc (1 / 2 : ℝ) 1 := by
-- Porting note: used to be
-- constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor <;> linarith
letI : NeZero 1 := inferInstance
constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor <;> try {linarith}
· rw [← (mul_le_mul_left (zero_lt_two))]
  simp [le_of_sub_nonneg h₁]
· rw [sub_nonneg]
  exact (div_le_iff' (zero_lt_two)).1 h₁
#align unit_interval.two_mul_sub_one_mem_iff unitInterval.two_mul_sub_one_mem_iff

end unitInterval

@[simp]
theorem projIcc_eq_zero {x : ℝ} : projIcc (0 : ℝ) 1 zero_le_one x = 0 ↔ x ≤ 0 :=
  projIcc_eq_left zero_lt_one
#align proj_Icc_eq_zero projIcc_eq_zero

@[simp]
theorem projIcc_eq_one {x : ℝ} : projIcc (0 : ℝ) 1 zero_le_one x = 1 ↔ 1 ≤ x :=
  projIcc_eq_right zero_lt_one
#align proj_Icc_eq_one projIcc_eq_one

namespace Tactic.Interactive

-- Porting note: This replaces an unsafe def tactic
/-- A tactic that solves `0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` for `x : I`. -/
macro "unit_interval ": tactic =>
  `(tactic| (first
  | apply unitInterval.nonneg
  | apply unitInterval.one_minus_nonneg
  | apply unitInterval.le_one
  | apply unitInterval.one_minus_le_one))
#noalign tactic.interactive.unit_interval

example (x : unitInterval) : 0 ≤ (x : ℝ) := by unit_interval

end Tactic.Interactive

section

variable {𝕜 : Type _} [LinearOrderedField 𝕜] [TopologicalSpace 𝕜] [TopologicalRing 𝕜]

-- We only need the ordering on `𝕜` here to avoid talking about flipping the interval over.
-- At the end of the day I only care about `ℝ`, so I'm hesitant to put work into generalizing.
/-- The image of `[0,1]` under the homeomorphism `fun x ↦ a * x + b` is `[b, a+b]`.
-/
theorem affineHomeomorph_image_I (a b : 𝕜) (h : 0 < a) :
    affineHomeomorph a b h.ne.symm '' Set.Icc 0 1 = Set.Icc b (a + b) := by simp [h]
set_option linter.uppercaseLean3 false in
#align affine_homeomorph_image_I affineHomeomorph_image_I

/-- The affine homeomorphism from a nontrivial interval `[a,b]` to `[0,1]`.
-/
def iccHomeoI (a b : 𝕜) (h : a < b) : Set.Icc a b ≃ₜ Set.Icc (0 : 𝕜) (1 : 𝕜) := by
  let e := Homeomorph.image (affineHomeomorph (b - a) a (sub_pos.mpr h).ne.symm) (Set.Icc 0 1)
  refine' (e.trans _).symm
  apply Homeomorph.setCongr
  rw [affineHomeomorph_image_I _ _ (sub_pos.2 h)]
  simp
set_option linter.uppercaseLean3 false in
#align Icc_homeo_I iccHomeoI

@[simp]
theorem iccHomeoI_apply_coe (a b : 𝕜) (h : a < b) (x : Set.Icc a b) :
    ((iccHomeoI a b h) x : 𝕜) = (x - a) / (b - a) :=
  rfl
set_option linter.uppercaseLean3 false in
#align Icc_homeo_I_apply_coe iccHomeoI_apply_coe

@[simp]
theorem iccHomeoI_symm_apply_coe (a b : 𝕜) (h : a < b) (x : Set.Icc (0 : 𝕜) (1 : 𝕜)) :
    ((iccHomeoI a b h).symm x : 𝕜) = (b - a) * x + a :=
  rfl
set_option linter.uppercaseLean3 false in
#align Icc_homeo_I_symm_apply_coe iccHomeoI_symm_apply_coe

end