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

! This file was ported from Lean 3 source module number_theory.bertrand
! leanprover-community/mathlib commit 824f9ae93a4f5174d2ea948e2d75843dd83447bb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Choose.Factorization
import Mathbin.Data.Nat.PrimeNormNum
import Mathbin.NumberTheory.Primorial
import Mathbin.Analysis.Convex.SpecificFunctions

/-!
# Bertrand's Postulate

This file contains a proof of Bertrand's postulate: That between any positive number and its
double there is a prime.

The proof follows the outline of the Erdős proof presented in "Proofs from THE BOOK": One considers
the prime factorization of `(2 * n).choose n`, and splits the constituent primes up into various
groups, then upper bounds the contribution of each group. This upper bounds the central binomial
coefficient, and if the postulate does not hold, this upper bound conflicts with a simple lower
bound for large enough `n`. This proves the result holds for large enough `n`, and for smaller `n`
an explicit list of primes is provided which covers the remaining cases.

As in the [Metamath implementation](carneiro2015arithmetic), we rely on some optimizations from
[Shigenori Tochiori](tochiori_bertrand). In particular we use the cleaner bound on the central
binomial coefficient given in `nat.four_pow_lt_mul_central_binom`.

## References

* [M. Aigner and G. M. Ziegler _Proofs from THE BOOK_][aigner1999proofs]
* [S. Tochiori, _Considering the Proof of “There is a Prime between n and 2n”_][tochiori_bertrand]
* [M. Carneiro, _Arithmetic in Metamath, Case Study: Bertrand's Postulate_][carneiro2015arithmetic]

## Tags

Bertrand, prime, binomial coefficients
-/

open BigOperators

section Real

open Real

namespace Bertrand

/-- A reified version of the `bertrand.main_inequality` below.
This is not best possible: it actually holds for 464 ≤ x.
-/
theorem real_main_inequality {x : ℝ} (n_large : (512 : ℝ) ≤ x) :
    x * (2 * x) ^ sqrt (2 * x) * 4 ^ (2 * x / 3) ≤ 4 ^ x :=
  by
  let f : ℝ → ℝ := fun x => log x + sqrt (2 * x) * log (2 * x) - log 4 / 3 * x
  have hf' : ∀ x, 0 < x → 0 < x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3) := fun x h =>
    div_pos (mul_pos h (rpow_pos_of_pos (mul_pos two_pos h) _)) (rpow_pos_of_pos four_pos _)
  have hf : ∀ x, 0 < x → f x = log (x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3)) :=
    by
    intro x h5
    have h6 := mul_pos (zero_lt_two' ℝ) h5
    have h7 := rpow_pos_of_pos h6 (sqrt (2 * x))
    rw [log_div (mul_pos h5 h7).ne' (rpow_pos_of_pos four_pos _).ne', log_mul h5.ne' h7.ne',
      log_rpow h6, log_rpow zero_lt_four, ← mul_div_right_comm, ← mul_div, mul_comm x]
  have h5 : 0 < x := lt_of_lt_of_le (by norm_num1) n_large
  rw [← div_le_one (rpow_pos_of_pos four_pos x), ← div_div_eq_mul_div, ← rpow_sub four_pos, ←
    mul_div 2 x, mul_div_left_comm, ← mul_one_sub, (by norm_num1 : (1 : ℝ) - 2 / 3 = 1 / 3),
    mul_one_div, ← log_nonpos_iff (hf' x h5), ← hf x h5]
  have h : ConcaveOn ℝ (Set.Ioi 0.5) f := by
    refine'
        ((strict_concave_on_log_Ioi.concave_on.subset (Set.Ioi_subset_Ioi _) (convex_Ioi 0.5)).add
              ((strict_concave_on_sqrt_mul_log_Ioi.concave_on.comp_linear_map
                    ((2 : ℝ) • LinearMap.id)).Subset
                (fun a ha => lt_of_eq_of_lt _ ((mul_lt_mul_left two_pos).mpr ha))
                (convex_Ioi 0.5))).sub
          ((convexOn_id (convex_Ioi (0.5 : ℝ))).smul (div_nonneg (log_nonneg _) _)) <;>
      norm_num1
  suffices ∃ x1 x2, 0.5 < x1 ∧ x1 < x2 ∧ x2 ≤ x ∧ 0 ≤ f x1 ∧ f x2 ≤ 0
    by
    obtain ⟨x1, x2, h1, h2, h0, h3, h4⟩ := this
    exact (h.right_le_of_le_left'' h1 ((h1.trans h2).trans_le h0) h2 h0 (h4.trans h3)).trans h4
  refine' ⟨18, 512, by norm_num1, by norm_num1, le_trans (by norm_num1) n_large, _, _⟩
  · have : sqrt (2 * 18) = 6 := (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1)
    rw [hf, log_nonneg_iff (hf' 18 _), this] <;> norm_num1
  · have : sqrt (2 * 512) = 32 := (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1)
    rw [hf, log_nonpos_iff (hf' _ _), this, div_le_one (rpow_pos_of_pos four_pos _), ←
        rpow_le_rpow_iff _ (rpow_pos_of_pos four_pos _).le three_pos, ← rpow_mul] <;>
      norm_num1
#align bertrand.real_main_inequality Bertrand.real_main_inequality

end Bertrand

end Real

section Nat

open Nat

/-- The inequality which contradicts Bertrand's postulate, for large enough `n`.
-/
theorem bertrand_main_inequality {n : ℕ} (n_large : 512 ≤ n) :
    n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n :=
  by
  rw [← @cast_le ℝ]
  simp only [cast_bit0, cast_add, cast_one, cast_mul, cast_pow, ← Real.rpow_nat_cast]
  have n_pos : 0 < n := (by decide : 0 < 512).trans_le n_large
  have n2_pos : 1 ≤ 2 * n := mul_pos (by decide) n_pos
  refine' trans (mul_le_mul _ _ _ _) (Bertrand.real_main_inequality (by exact_mod_cast n_large))
  · refine' mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg _)
    refine' Real.rpow_le_rpow_of_exponent_le (by exact_mod_cast n2_pos) _
    exact_mod_cast Real.nat_sqrt_le_real_sqrt
  · exact Real.rpow_le_rpow_of_exponent_le (by norm_num1) (cast_div_le.trans (by norm_cast))
  · exact Real.rpow_nonneg_of_nonneg (by norm_num1) _
  · refine' mul_nonneg (Nat.cast_nonneg _) _
    exact Real.rpow_nonneg_of_nonneg (mul_nonneg zero_le_two (Nat.cast_nonneg _)) _
#align bertrand_main_inequality bertrand_main_inequality

/-- A lemma that tells us that, in the case where Bertrand's postulate does not hold, the prime
factorization of the central binomial coefficent only has factors at most `2 * n / 3 + 1`.
-/
theorem centralBinom_factorization_small (n : ℕ) (n_large : 2 < n)
    (no_prime : ¬∃ p : ℕ, p.Prime ∧ n < p ∧ p ≤ 2 * n) :
    centralBinom n = ∏ p in Finset.range (2 * n / 3 + 1), p ^ (centralBinom n).factorization p :=
  by
  refine' (Eq.trans _ n.prod_pow_factorization_central_binom).symm
  apply Finset.prod_subset
  · exact Finset.range_subset.2 (add_le_add_right (Nat.div_le_self _ _) _)
  intro x hx h2x
  rw [Finset.mem_range, lt_succ_iff] at hx h2x
  rw [not_le, div_lt_iff_lt_mul' three_pos, mul_comm x] at h2x
  replace no_prime := not_exists.mp no_prime x
  rw [← and_assoc', not_and', not_and_or, not_lt] at no_prime
  cases' no_prime hx with h h
  · rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero]
  · rw [factorization_central_binom_of_two_mul_self_lt_three_mul n_large h h2x, pow_zero]
#align central_binom_factorization_small centralBinom_factorization_small

/-- An upper bound on the central binomial coefficient used in the proof of Bertrand's postulate.
The bound splits the prime factors of `central_binom n` into those
1. At most `sqrt (2 * n)`, which contribute at most `2 * n` for each such prime.
2. Between `sqrt (2 * n)` and `2 * n / 3`, which contribute at most `4^(2 * n / 3)` in total.
3. Between `2 * n / 3` and `n`, which do not exist.
4. Between `n` and `2 * n`, which would not exist in the case where Bertrand's postulate is false.
5. Above `2 * n`, which do not exist.
-/
theorem centralBinom_le_of_no_bertrand_prime (n : ℕ) (n_big : 2 < n)
    (no_prime : ¬∃ p : ℕ, Nat.Prime p ∧ n < p ∧ p ≤ 2 * n) :
    centralBinom n ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
  by
  have n_pos : 0 < n := (Nat.zero_le _).trans_lt n_big
  have n2_pos : 1 ≤ 2 * n := mul_pos (zero_lt_two' ℕ) n_pos
  let S := (Finset.range (2 * n / 3 + 1)).filterₓ Nat.Prime
  let f x := x ^ n.central_binom.factorization x
  have : (∏ x : ℕ in S, f x) = ∏ x : ℕ in Finset.range (2 * n / 3 + 1), f x :=
    by
    refine' Finset.prod_filter_of_ne fun p hp h => _
    contrapose! h
    dsimp only [f]
    rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero]
  rw [centralBinom_factorization_small n n_big no_prime, ← this, ←
    Finset.prod_filter_mul_prod_filter_not S (· ≤ sqrt (2 * n))]
  apply mul_le_mul'
  · refine' (Finset.prod_le_prod' fun p hp => (_ : f p ≤ 2 * n)).trans _
    · exact pow_factorization_choose_le (mul_pos two_pos n_pos)
    have : (Finset.Icc 1 (sqrt (2 * n))).card = sqrt (2 * n) := by rw [card_Icc, Nat.add_sub_cancel]
    rw [Finset.prod_const]
    refine' pow_le_pow n2_pos ((Finset.card_le_of_subset fun x hx => _).trans this.le)
    obtain ⟨h1, h2⟩ := Finset.mem_filter.1 hx
    exact finset.mem_Icc.mpr ⟨(Finset.mem_filter.1 h1).2.one_lt.le, h2⟩
  · refine' le_trans _ (primorial_le_4_pow (2 * n / 3))
    refine' (Finset.prod_le_prod' fun p hp => (_ : f p ≤ p)).trans _
    · obtain ⟨h1, h2⟩ := Finset.mem_filter.1 hp
      refine' (pow_le_pow (Finset.mem_filter.1 h1).2.one_lt.le _).trans (pow_one p).le
      exact Nat.factorization_choose_le_one (sqrt_lt'.mp <| not_le.1 h2)
    refine' Finset.prod_le_prod_of_subset_of_one_le' (Finset.filter_subset _ _) _
    exact fun p hp _ => (Finset.mem_filter.1 hp).2.one_lt.le
#align central_binom_le_of_no_bertrand_prime centralBinom_le_of_no_bertrand_prime

namespace Nat

/-- Proves that Bertrand's postulate holds for all sufficiently large `n`.
-/
theorem exists_prime_lt_and_le_two_mul_eventually (n : ℕ) (n_big : 512 ≤ n) :
    ∃ p : ℕ, p.Prime ∧ n < p ∧ p ≤ 2 * n :=
  by
  -- Assume there is no prime in the range.
  by_contra no_prime
  -- Then we have the above sub-exponential bound on the size of this central binomial coefficient.
  -- We now couple this bound with an exponential lower bound on the central binomial coefficient,
  -- yielding an inequality which we have seen is false for large enough n.
  have H1 : n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n := bertrand_main_inequality n_big
  have H2 : 4 ^ n < n * n.central_binom :=
    Nat.four_pow_lt_mul_centralBinom n (le_trans (by norm_num1) n_big)
  have H3 : n.central_binom ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
    centralBinom_le_of_no_bertrand_prime n (lt_of_lt_of_le (by norm_num1) n_big) no_prime
  rw [mul_assoc] at H1; exact not_le.2 H2 ((mul_le_mul_left' H3 n).trans H1)
#align nat.exists_prime_lt_and_le_two_mul_eventually Nat.exists_prime_lt_and_le_two_mul_eventually

/-- Proves that Bertrand's postulate holds over all positive naturals less than n by identifying a
descending list of primes, each no more than twice the next, such that the list contains a witness
for each number ≤ n.
-/
theorem exists_prime_lt_and_le_two_mul_succ {n} (q) {p : ℕ} (prime_p : Nat.Prime p)
    (covering : p ≤ 2 * q) (H : n < q → ∃ p : ℕ, p.Prime ∧ n < p ∧ p ≤ 2 * n) (hn : n < p) :
    ∃ p : ℕ, p.Prime ∧ n < p ∧ p ≤ 2 * n :=
  by
  by_cases p ≤ 2 * n; · exact ⟨p, prime_p, hn, h⟩
  exact H (lt_of_mul_lt_mul_left' (lt_of_lt_of_le (not_le.1 h) covering))
#align nat.exists_prime_lt_and_le_two_mul_succ Nat.exists_prime_lt_and_le_two_mul_succ

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/--
**Bertrand's Postulate**: For any positive natural number, there is a prime which is greater than
it, but no more than twice as large.
-/
theorem exists_prime_lt_and_le_two_mul (n : ℕ) (hn0 : n ≠ 0) :
    ∃ p, Nat.Prime p ∧ n < p ∧ p ≤ 2 * n :=
  by
  -- Split into cases whether `n` is large or small
  cases lt_or_le 511 n
  -- If `n` is large, apply the lemma derived from the inequalities on the central binomial
  -- coefficient.
  · exact exists_prime_lt_and_le_two_mul_eventually n h
  replace h : n < 521 := h.trans_lt (by norm_num1)
  revert h
  -- For small `n`, supply a list of primes to cover the initial cases.
  run_tac
    [317, 163, 83, 43, 23, 13, 7, 5, 3, 2].mapM' fun n => sorry
  exact fun h2 => ⟨2, prime_two, h2, Nat.mul_le_mul_left 2 (Nat.pos_of_ne_zero hn0)⟩
#align nat.exists_prime_lt_and_le_two_mul Nat.exists_prime_lt_and_le_two_mul

alias Nat.exists_prime_lt_and_le_two_mul ← bertrand
#align nat.bertrand Nat.bertrand

end Nat

end Nat


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov

! This file was ported from Lean 3 source module linear_algebra.affine_space.ordered
! leanprover-community/mathlib commit 78261225eb5cedc61c5c74ecb44e5b385d13b733
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Invertible
import Mathlib.Algebra.Order.Module
import Mathlib.LinearAlgebra.AffineSpace.MidpointZero
import Mathlib.LinearAlgebra.AffineSpace.Slope
import Mathlib.Tactic.FieldSimp

/-!
# Ordered modules as affine spaces

In this file we prove some theorems about `slope` and `lineMap` in the case when the module `E`
acting on the codomain `PE` of a function is an ordered module over its domain `k`. We also prove
inequalities that can be used to link convexity of a function on an interval to monotonicity of the
slope, see section docstring below for details.

## Implementation notes

We do not introduce the notion of ordered affine spaces (yet?). Instead, we prove various theorems
for an ordered module interpreted as an affine space.

## Tags

affine space, ordered module, slope
-/

open AffineMap

variable {k E PE : Type _}

/-!
### Monotonicity of `lineMap`

In this section we prove that `lineMap a b r` is monotone (strictly or not) in its arguments if
other arguments belong to specific domains.
-/

section OrderedRing

variable [OrderedRing k] [OrderedAddCommGroup E] [Module k E] [OrderedSMul k E]

variable {a a' b b' : E} {r r' : k}

theorem lineMap_mono_left (ha : a ≤ a') (hr : r ≤ 1) : lineMap a b r ≤ lineMap a' b r := by
  simp only [lineMap_apply_module]
  exact add_le_add_right (smul_le_smul_of_nonneg ha (sub_nonneg.2 hr)) _
#align line_map_mono_left lineMap_mono_left

theorem lineMap_strict_mono_left (ha : a < a') (hr : r < 1) : lineMap a b r < lineMap a' b r := by
  simp only [lineMap_apply_module]
  exact add_lt_add_right (smul_lt_smul_of_pos ha (sub_pos.2 hr)) _
#align line_map_strict_mono_left lineMap_strict_mono_left

theorem lineMap_mono_right (hb : b ≤ b') (hr : 0 ≤ r) : lineMap a b r ≤ lineMap a b' r := by
  simp only [lineMap_apply_module]
  exact add_le_add_left (smul_le_smul_of_nonneg hb hr) _
#align line_map_mono_right lineMap_mono_right

theorem lineMap_strict_mono_right (hb : b < b') (hr : 0 < r) : lineMap a b r < lineMap a b' r := by
  simp only [lineMap_apply_module]
  exact add_lt_add_left (smul_lt_smul_of_pos hb hr) _
#align line_map_strict_mono_right lineMap_strict_mono_right

theorem lineMap_mono_endpoints (ha : a ≤ a') (hb : b ≤ b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
    lineMap a b r ≤ lineMap a' b' r :=
  (lineMap_mono_left ha h₁).trans (lineMap_mono_right hb h₀)
#align line_map_mono_endpoints lineMap_mono_endpoints

theorem lineMap_strict_mono_endpoints (ha : a < a') (hb : b < b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
    lineMap a b r < lineMap a' b' r := by
  rcases h₀.eq_or_lt with (rfl | h₀); · simpa
  exact (lineMap_mono_left ha.le h₁).trans_lt (lineMap_strict_mono_right hb h₀)
#align line_map_strict_mono_endpoints lineMap_strict_mono_endpoints

theorem lineMap_lt_lineMap_iff_of_lt (h : r < r') : lineMap a b r < lineMap a b r' ↔ a < b := by
  simp only [lineMap_apply_module]
  rw [← lt_sub_iff_add_lt, add_sub_assoc, ← sub_lt_iff_lt_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_lt_smul_iff_of_pos (sub_pos.2 h)]
#align line_map_lt_line_map_iff_of_lt lineMap_lt_lineMap_iff_of_lt

theorem left_lt_lineMap_iff_lt (h : 0 < r) : a < lineMap a b r ↔ a < b :=
  Iff.trans (by rw [lineMap_apply_zero]) (lineMap_lt_lineMap_iff_of_lt h)
#align left_lt_line_map_iff_lt left_lt_lineMap_iff_lt

theorem lineMap_lt_left_iff_lt (h : 0 < r) : lineMap a b r < a ↔ b < a :=
  @left_lt_lineMap_iff_lt k Eᵒᵈ _ _ _ _ _ _ _ h
#align line_map_lt_left_iff_lt lineMap_lt_left_iff_lt

theorem lineMap_lt_right_iff_lt (h : r < 1) : lineMap a b r < b ↔ a < b :=
  Iff.trans (by rw [lineMap_apply_one]) (lineMap_lt_lineMap_iff_of_lt h)
#align line_map_lt_right_iff_lt lineMap_lt_right_iff_lt

theorem right_lt_lineMap_iff_lt (h : r < 1) : b < lineMap a b r ↔ b < a :=
  @lineMap_lt_right_iff_lt k Eᵒᵈ _ _ _ _ _ _ _ h
#align right_lt_line_map_iff_lt right_lt_lineMap_iff_lt

end OrderedRing

section LinearOrderedRing

variable [LinearOrderedRing k] [OrderedAddCommGroup E] [Module k E] [OrderedSMul k E]
  [Invertible (2 : k)] {a a' b b' : E} {r r' : k}

theorem midpoint_le_midpoint (ha : a ≤ a') (hb : b ≤ b') : midpoint k a b ≤ midpoint k a' b' :=
  lineMap_mono_endpoints ha hb (invOf_nonneg.2 zero_le_two) <| invOf_le_one one_le_two
#align midpoint_le_midpoint midpoint_le_midpoint

end LinearOrderedRing

section LinearOrderedField

variable [LinearOrderedField k] [OrderedAddCommGroup E]

variable [Module k E] [OrderedSMul k E]

section

variable {a b : E} {r r' : k}

theorem lineMap_le_lineMap_iff_of_lt (h : r < r') : lineMap a b r ≤ lineMap a b r' ↔ a ≤ b := by
  simp only [lineMap_apply_module]
  rw [← le_sub_iff_add_le, add_sub_assoc, ← sub_le_iff_le_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_le_smul_iff_of_pos (sub_pos.2 h)]
#align line_map_le_line_map_iff_of_lt lineMap_le_lineMap_iff_of_lt

theorem left_le_lineMap_iff_le (h : 0 < r) : a ≤ lineMap a b r ↔ a ≤ b :=
  Iff.trans (by rw [lineMap_apply_zero]) (lineMap_le_lineMap_iff_of_lt h)
#align left_le_line_map_iff_le left_le_lineMap_iff_le

@[simp]
theorem left_le_midpoint : a ≤ midpoint k a b ↔ a ≤ b :=
  left_le_lineMap_iff_le <| inv_pos.2 zero_lt_two
#align left_le_midpoint left_le_midpoint

theorem lineMap_le_left_iff_le (h : 0 < r) : lineMap a b r ≤ a ↔ b ≤ a :=
  @left_le_lineMap_iff_le k Eᵒᵈ _ _ _ _ _ _ _ h
#align line_map_le_left_iff_le lineMap_le_left_iff_le

@[simp]
theorem midpoint_le_left : midpoint k a b ≤ a ↔ b ≤ a :=
  lineMap_le_left_iff_le <| inv_pos.2 zero_lt_two
#align midpoint_le_left midpoint_le_left

theorem lineMap_le_right_iff_le (h : r < 1) : lineMap a b r ≤ b ↔ a ≤ b :=
  Iff.trans (by rw [lineMap_apply_one]) (lineMap_le_lineMap_iff_of_lt h)
#align line_map_le_right_iff_le lineMap_le_right_iff_le

@[simp]
theorem midpoint_le_right : midpoint k a b ≤ b ↔ a ≤ b :=
  lineMap_le_right_iff_le <| inv_lt_one one_lt_two
#align midpoint_le_right midpoint_le_right

theorem right_le_lineMap_iff_le (h : r < 1) : b ≤ lineMap a b r ↔ b ≤ a :=
  @lineMap_le_right_iff_le k Eᵒᵈ _ _ _ _ _ _ _ h
#align right_le_line_map_iff_le right_le_lineMap_iff_le

@[simp]
theorem right_le_midpoint : b ≤ midpoint k a b ↔ b ≤ a :=
  right_le_lineMap_iff_le <| inv_lt_one one_lt_two
#align right_le_midpoint right_le_midpoint

end

/-!
### Convexity and slope

Given an interval `[a, b]` and a point `c ∈ (a, b)`, `c = lineMap a b r`, there are a few ways to
say that the point `(c, f c)` is above/below the segment `[(a, f a), (b, f b)]`:

* compare `f c` to `lineMap (f a) (f b) r`;
* compare `slope f a c` to `slope `f a b`;
* compare `slope f c b` to `slope f a b`;
* compare `slope f a c` to `slope f c b`.

In this section we prove equivalence of these four approaches. In order to make the statements more
readable, we introduce local notation `c = lineMap a b r`. Then we prove lemmas like

```
lemma map_le_lineMap_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  f c ≤ lineMap (f a) (f b) r ↔ slope f a c ≤ slope f a b :=
```

For each inequality between `f c` and `lineMap (f a) (f b) r` we provide 3 lemmas:

* `*_left` relates it to an inequality on `slope f a c` and `slope f a b`;
* `*_right` relates it to an inequality on `slope f a b` and `slope f c b`;
* no-suffix version relates it to an inequality on `slope f a c` and `slope f c b`.

These inequalities can be used to restate `convexOn` in terms of monotonicity of the slope.
-/

variable {f : k → E} {a b r : k}

-- mathport name: exprc
local notation "c" => lineMap a b r

/-- Given `c = lineMap a b r`, `a < c`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f a b`. -/
theorem map_le_lineMap_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
    f c ≤ lineMap (f a) (f b) r ↔ slope f a c ≤ slope f a b := by
  rw [lineMap_apply, lineMap_apply, slope, slope, vsub_eq_sub, vsub_eq_sub, vsub_eq_sub,
    vadd_eq_add, vadd_eq_add, smul_eq_mul, add_sub_cancel, smul_sub, smul_sub, smul_sub,
    sub_le_iff_le_add, mul_inv_rev, mul_smul, mul_smul, ← smul_sub, ← smul_sub, ← smul_add,
    smul_smul, ← mul_inv_rev, inv_smul_le_iff h, smul_smul,
    mul_inv_cancel_right₀ (right_ne_zero_of_mul h.ne'), smul_add,
    smul_inv_smul₀ (left_ne_zero_of_mul h.ne')]
#align map_le_line_map_iff_slope_le_slope_left map_le_lineMap_iff_slope_le_slope_left

/-- Given `c = lineMap a b r`, `a < c`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f a c`. -/
theorem lineMap_le_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
    lineMap (f a) (f b) r ≤ f c ↔ slope f a b ≤ slope f a c :=
  @map_le_lineMap_iff_slope_le_slope_left k Eᵒᵈ _ _ _ _ f a b r h
#align line_map_le_map_iff_slope_le_slope_left lineMap_le_map_iff_slope_le_slope_left

/-- Given `c = lineMap a b r`, `a < c`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f a b`. -/
theorem map_lt_lineMap_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
    f c < lineMap (f a) (f b) r ↔ slope f a c < slope f a b :=
  lt_iff_lt_of_le_iff_le' (lineMap_le_map_iff_slope_le_slope_left h)
    (map_le_lineMap_iff_slope_le_slope_left h)
#align map_lt_line_map_iff_slope_lt_slope_left map_lt_lineMap_iff_slope_lt_slope_left

/-- Given `c = lineMap a b r`, `a < c`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f a c`. -/
theorem lineMap_lt_map_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
    lineMap (f a) (f b) r < f c ↔ slope f a b < slope f a c :=
  @map_lt_lineMap_iff_slope_lt_slope_left k Eᵒᵈ _ _ _ _ f a b r h
#align line_map_lt_map_iff_slope_lt_slope_left lineMap_lt_map_iff_slope_lt_slope_left

/-- Given `c = lineMap a b r`, `c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f c b`. -/
theorem map_le_lineMap_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
    f c ≤ lineMap (f a) (f b) r ↔ slope f a b ≤ slope f c b := by
  rw [← lineMap_apply_one_sub, ← lineMap_apply_one_sub _ _ r]
  revert h; generalize 1 - r = r'; clear! r; intro h
  simp_rw [lineMap_apply, slope, vsub_eq_sub, vadd_eq_add, smul_eq_mul]
  rw [sub_add_eq_sub_sub_swap, sub_self, zero_sub, neg_mul_eq_mul_neg, neg_sub, le_inv_smul_iff h,
    smul_smul, mul_inv_cancel_right₀, le_sub_comm, ← neg_sub (f b), smul_neg, neg_add_eq_sub]
  · exact right_ne_zero_of_mul h.ne'
#align map_le_line_map_iff_slope_le_slope_right map_le_lineMap_iff_slope_le_slope_right

/-- Given `c = lineMap a b r`, `c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a b`. -/
theorem lineMap_le_map_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
    lineMap (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a b :=
  @map_le_lineMap_iff_slope_le_slope_right k Eᵒᵈ _ _ _ _ f a b r h
#align line_map_le_map_iff_slope_le_slope_right lineMap_le_map_iff_slope_le_slope_right

/-- Given `c = lineMap a b r`, `c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f c b`. -/
theorem map_lt_lineMap_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
    f c < lineMap (f a) (f b) r ↔ slope f a b < slope f c b :=
  lt_iff_lt_of_le_iff_le' (lineMap_le_map_iff_slope_le_slope_right h)
    (map_le_lineMap_iff_slope_le_slope_right h)
#align map_lt_line_map_iff_slope_lt_slope_right map_lt_lineMap_iff_slope_lt_slope_right

/-- Given `c = lineMap a b r`, `c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a b`. -/
theorem lineMap_lt_map_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
    lineMap (f a) (f b) r < f c ↔ slope f c b < slope f a b :=
  @map_lt_lineMap_iff_slope_lt_slope_right k Eᵒᵈ _ _ _ _ f a b r h
#align line_map_lt_map_iff_slope_lt_slope_right lineMap_lt_map_iff_slope_lt_slope_right

/-- Given `c = lineMap a b r`, `a < c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f c b`. -/
theorem map_le_lineMap_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
    f c ≤ lineMap (f a) (f b) r ↔ slope f a c ≤ slope f c b := by
  rw [map_le_lineMap_iff_slope_le_slope_left (mul_pos h₀ (sub_pos.2 hab)), ←
    lineMap_slope_lineMap_slope_lineMap f a b r, right_le_lineMap_iff_le h₁]
#align map_le_line_map_iff_slope_le_slope map_le_lineMap_iff_slope_le_slope

/-- Given `c = lineMap a b r`, `a < c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a c`. -/
theorem lineMap_le_map_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
    lineMap (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a c :=
  @map_le_lineMap_iff_slope_le_slope k Eᵒᵈ _ _ _ _ _ _ _ _ hab h₀ h₁
#align line_map_le_map_iff_slope_le_slope lineMap_le_map_iff_slope_le_slope

/-- Given `c = lineMap a b r`, `a < c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f c b`. -/
theorem map_lt_lineMap_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
    f c < lineMap (f a) (f b) r ↔ slope f a c < slope f c b :=
  lt_iff_lt_of_le_iff_le' (lineMap_le_map_iff_slope_le_slope hab h₀ h₁)
    (map_le_lineMap_iff_slope_le_slope hab h₀ h₁)
#align map_lt_line_map_iff_slope_lt_slope map_lt_lineMap_iff_slope_lt_slope

/-- Given `c = lineMap a b r`, `a < c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a c`. -/
theorem lineMap_lt_map_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
    lineMap (f a) (f b) r < f c ↔ slope f c b < slope f a c :=
  @map_lt_lineMap_iff_slope_lt_slope k Eᵒᵈ _ _ _ _ _ _ _ _ hab h₀ h₁
#align line_map_lt_map_iff_slope_lt_slope lineMap_lt_map_iff_slope_lt_slope

end LinearOrderedField


/-
Copyright (c) 2020 Xi Wang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Xi Wang
-/
import order.basic
import tactic.basic

/-!
# A compiler for arithmetic expressions

A formalization of the correctness of a compiler from arithmetic expressions to machine language
described by McCarthy and Painter, which is considered the first proof of compiler correctness.

## Main definitions

* `expr`       : the syntax of the source language.
* `value`      : the semantics of the source language.
* `instruction`: the syntax of the target language.
* `step`       : the semantics of the target language.
* `compile`    : the compiler.

## Main results

* `compiler_correctness`: the compiler correctness theorem.

## Notation

* `≃[t]/ac`: partial equality of two machine states excluding registers x ≥ t and the accumulator.
* `≃[t]`   : partial equality of two machine states excluding registers x ≥ t.

## References

* John McCarthy and James Painter. Correctness of a compiler for arithmetic expressions.
  In Mathematical Aspects of Computer Science, volume 19 of Proceedings of Symposia in
  Applied Mathematics. American Mathematical Society, 1967.
  <http://jmc.stanford.edu/articles/mcpain/mcpain.pdf>

## Tags

compiler
-/

namespace arithcc

section types

/-! ### Types -/

/-- Value type shared by both source and target languages. -/
@[reducible]
def word := ℕ

/-- Variable identifier type in the source language. -/
@[reducible]
def identifier := string

/-- Register name type in the target language. -/
@[reducible]
def register := ℕ

lemma register.lt_succ_self :
  ∀ (r : register), r < r + 1 :=
nat.lt_succ_self

lemma register.le_of_lt_succ {r₁ r₂ : register} :
  r₁ < r₂ + 1 → r₁ ≤ r₂ :=
nat.le_of_succ_le_succ

end types

section source

/-! ### Source language -/

/-- An expression in the source language is formed by constants, variables, and sums. -/
@[derive inhabited]
inductive expr
| const (v : word) : expr
| var (x : identifier) : expr
| sum (s₁ s₂ : expr) : expr

/-- The semantics of the source language (2.1). -/
@[simp]
def value : expr → (identifier → word) → word
| (expr.const v)   _ := v
| (expr.var x)     ξ := ξ x
| (expr.sum s₁ s₂) ξ := (value s₁ ξ) + (value s₂ ξ)

end source

section target

/-! ### Target language -/

/-- Instructions of the target machine language (3.1--3.7). -/
@[derive inhabited]
inductive instruction
| li   : word → instruction
| load : register → instruction
| sto  : register → instruction
| add  : register → instruction

/-- Machine state consists of the accumulator and a vector of registers.

The paper uses two functions `c` and `a` for accessing both the accumulator and registers.
For clarity, we make accessing the accumulator explicit and use `read`/`write` for registers.
-/
structure state :=
mk :: (ac : word) (rs : register → word)

instance : inhabited state :=
⟨{ac := 0, rs := λ x, 0}⟩

/-- This is similar to the `c` function (3.8), but for registers only. -/
@[simp]
def read (r : register) (η : state) : word :=
η.rs r

/-- This is similar to the `a` function (3.9), but for registers only. -/
@[simp]
def write (r : register) (v : word) (η : state) : state :=
{rs := λ x, if x = r then v else η.rs x, ..η}

/-- The semantics of the target language (3.11). -/
def step : instruction → state → state
| (instruction.li   v) η := {ac := v, ..η}
| (instruction.load r) η := {ac := read r η, ..η}
| (instruction.sto  r) η := write r η.ac η
| (instruction.add  r) η := {ac := read r η + η.ac, ..η}

/-- The resulting machine state of running a target program from a given machine state (3.12). -/
@[simp]
def outcome : list instruction → state → state
| []        η := η
| (i :: is) η := outcome is (step i η)

/-- A lemma on the concatenation of two programs (3.13). -/
@[simp]
lemma outcome_append (p₁ p₂ : list instruction) (η : state) :
  outcome (p₁ ++ p₂) η = outcome p₂ (outcome p₁ η) :=
begin
  revert η,
  induction p₁; intros; simp,
  apply p₁_ih
end

end target

section compiler

open instruction

/-! ### Compiler -/

/-- Map a variable in the source expression to a machine register. -/
@[simp]
def loc (ν : identifier) (map : identifier → register) : register :=
map ν

/-- The implementation of the compiler (4.2).

This definition explicitly takes a map from variables to registers.
-/
@[simp]
def compile (map : identifier → register) : expr → register → (list instruction)
| (expr.const v)   _ := [li v]
| (expr.var x)     _ := [load (loc x map)]
| (expr.sum s₁ s₂) t := compile s₁ t ++ [sto t] ++ compile s₂ (t + 1) ++ [add t]

end compiler

section correctness

/-! ### Correctness -/

/-- Machine states ζ₁ and ζ₂ are equal except for the accumulator and registers {x | x ≥ t}. -/
def state_eq_rs (t : register) (ζ₁ ζ₂ : state) : Prop :=
∀ (r : register), r < t → ζ₁.rs r = ζ₂.rs r

notation ζ₁ ` ≃[`:50 t `]/ac ` ζ₂:50 := state_eq_rs t ζ₁ ζ₂

@[refl]
protected lemma state_eq_rs.refl (t : register) (ζ : state) :
  ζ ≃[t]/ac ζ :=
by simp [state_eq_rs]

@[symm]
protected lemma state_eq_rs.symm {t : register} (ζ₁ ζ₂ : state) :
  ζ₁ ≃[t]/ac ζ₂ →
  ζ₂ ≃[t]/ac ζ₁ :=
by finish [state_eq_rs]

@[trans]
protected lemma state_eq_rs.trans {t : register} (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t]/ac ζ₂ →
  ζ₂ ≃[t]/ac ζ₃ →
  ζ₁ ≃[t]/ac ζ₃ :=
by finish [state_eq_rs]

/-- Machine states ζ₁ and ζ₂ are equal except for registers {x | x ≥ t}. -/
def state_eq (t : register) (ζ₁ ζ₂ : state) : Prop :=
ζ₁.ac = ζ₂.ac ∧ state_eq_rs t ζ₁ ζ₂

notation ζ₁ ` ≃[`:50 t `] ` ζ₂:50 := state_eq t ζ₁ ζ₂

@[refl]
protected lemma state_eq.refl (t : register) (ζ : state) :
  ζ ≃[t] ζ :=
by simp [state_eq]

@[symm]
protected lemma state_eq.symm {t : register} (ζ₁ ζ₂ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t] ζ₁ :=
begin
  simp [state_eq], intros,
  split; try { cc },
  symmetry,
  assumption
end

@[trans]
protected lemma state_eq.trans {t : register} (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t] ζ₃ →
  ζ₁ ≃[t] ζ₃ :=
begin
  simp [state_eq], intros,
  split; try { cc },
  transitivity ζ₂; assumption
end

/-- Transitivity of chaining `≃[t]` and `≃[t]/ac`. -/
@[trans]
protected theorem state_eq_state_eq_rs.trans (t : register) (ζ₁ ζ₂ ζ₃ : state) :
  ζ₁ ≃[t] ζ₂ →
  ζ₂ ≃[t]/ac ζ₃ →
  ζ₁ ≃[t]/ac ζ₃ :=
begin
  simp [state_eq], intros,
  transitivity ζ₂; assumption
end

/-- Writing the same value to register `t` gives `≃[t + 1]` from `≃[t]`. -/
lemma state_eq_implies_write_eq {t : register} {ζ₁ ζ₂ : state} (h : ζ₁ ≃[t] ζ₂) (v : word) :
  write t v ζ₁ ≃[t + 1] write t v ζ₂ :=
begin
  simp [state_eq, state_eq_rs] at *,
  split ; try { cc },
  intros _ hr,
  have hr : r ≤ t := register.le_of_lt_succ hr,
  cases lt_or_eq_of_le hr with hr hr,
  { cases h with _ h,
    specialize h r hr,
    cc },
  { cc }
end

/-- Writing the same value to any register preserves `≃[t]/ac`. -/
lemma state_eq_rs_implies_write_eq_rs {t : register} {ζ₁ ζ₂ : state} (h : ζ₁ ≃[t]/ac ζ₂)
                                      (r : register) (v : word) :
  write r v ζ₁ ≃[t]/ac write r v ζ₂ :=
begin
  simp [state_eq_rs] at *,
  intros r' hr',
  specialize h r' hr',
  cc
end

/-- `≃[t + 1]` with writing to register `t` implies `≃[t]`. -/
lemma write_eq_implies_state_eq {t : register} {v : word} {ζ₁ ζ₂ : state}
                                (h : ζ₁ ≃[t + 1] write t v ζ₂) :
  ζ₁ ≃[t] ζ₂ :=
begin
  simp [state_eq, state_eq_rs] at *,
  split; try { cc },
  intros r hr,
  cases h with _ h,
  specialize h r (lt_trans hr (register.lt_succ_self _)),
  rwa if_neg (ne_of_lt hr) at h
end

/-- The main **compiler correctness theorem**.

Unlike Theorem 1 in the paper, both `map` and the assumption on `t` are explicit.
-/
theorem compiler_correctness :
  ∀ (map : identifier → register) (e : expr) (ξ : identifier → word) (η : state) (t : register),
    (∀ x, read (loc x map) η = ξ x) →
    (∀ x, loc x map < t) →
    outcome (compile map e t) η ≃[t] {ac := value e ξ, ..η} :=
begin
  intros _ _ _ _ _ hmap ht,
  revert η t,
  induction e; intros,

  -- 5.I
  case expr.const { simp [state_eq, step] },

  -- 5.II
  case expr.var   { finish [hmap, state_eq, step] },

  -- 5.III
  case expr.sum   { simp,
    generalize_hyp dν₁ : value e_s₁ ξ = ν₁ at e_ih_s₁ ⊢,
    generalize_hyp dν₂ : value e_s₂ ξ = ν₂ at e_ih_s₂ ⊢,
    generalize     dν  : ν₁ + ν₂ = ν,

    generalize dζ₁ : outcome (compile _ e_s₁ t) η        = ζ₁,
    generalize dζ₂ : step (instruction.sto t) ζ₁         = ζ₂,
    generalize dζ₃ : outcome (compile _ e_s₂ (t + 1)) ζ₂ = ζ₃,
    generalize dζ₄ : step (instruction.add t) ζ₃         = ζ₄,

    have hζ₁ : ζ₁ ≃[t] {ac := ν₁, ..η},
    calc ζ₁
        = outcome (compile map e_s₁ t) η : by cc
    ... ≃[t] {ac := ν₁, ..η}             : by apply e_ih_s₁; assumption,

    have hζ₁_ν₁ : ζ₁.ac = ν₁,
    { finish [state_eq] },

    have hζ₂ : ζ₂ ≃[t + 1]/ac write t ν₁ η,
    calc ζ₂
        = step (instruction.sto t) ζ₁       : by cc
    ... = write t ζ₁.ac ζ₁                  : by simp [step]
    ... = write t ν₁ ζ₁                     : by cc
    ... ≃[t + 1] write t ν₁ {ac := ν₁, ..η} : by apply state_eq_implies_write_eq hζ₁
    ... ≃[t + 1]/ac write t ν₁ η            : by { apply state_eq_rs_implies_write_eq_rs,
                                                   simp [state_eq_rs] },

    have hζ₂_ν₂ : read t ζ₂ = ν₁,
    { simp [state_eq_rs] at hζ₂ ⊢,
      specialize hζ₂ t (register.lt_succ_self _),
      cc },

    have ht' : ∀ x, loc x map < t + 1,
    { intros,
      apply lt_trans (ht _) (register.lt_succ_self _) },

    have hmap' : ∀ x, read (loc x map) ζ₂ = ξ x,
    { intros,
      calc read (loc x map) ζ₂
          = read (loc x map) (write t ν₁ η) : hζ₂ _ (ht' _)
      ... = read (loc x map) η              : by { simp only [loc] at ht, simp [(ht _).ne] }
      ... = ξ x                             : hmap x },

    have hζ₃ : ζ₃ ≃[t + 1] {ac := ν₂, ..(write t ν₁ η)},
    calc ζ₃
        = outcome (compile map e_s₂ (t + 1)) ζ₂ : by cc
    ... ≃[t + 1] {ac := ν₂, ..ζ₂}               : by apply e_ih_s₂; assumption
    ... ≃[t + 1] {ac := ν₂, ..(write t ν₁ η)}   : by { simp [state_eq], apply hζ₂ },

    have hζ₃_ν₂ : ζ₃.ac = ν₂,
    { finish [state_eq] },

    have hζ₃_ν₁ : read t ζ₃ = ν₁,
    { simp [state_eq, state_eq_rs] at hζ₃ ⊢,
      cases hζ₃ with _ hζ₃,
      specialize hζ₃ t (register.lt_succ_self _),
      cc },

    have hζ₄ : ζ₄ ≃[t + 1] {ac := ν, ..write t ν₁ η},
    calc ζ₄
        = step (instruction.add t) ζ₃      : by cc
    ... = {ac := read t ζ₃ + ζ₃.ac, ..ζ₃}  : by simp [step]
    ... = {ac := ν, ..ζ₃}                  : by cc
    ... ≃[t + 1] {ac := ν, ..{ac := ν₂, ..write t ν₁ η}}
                                           : by { simp [state_eq] at hζ₃ ⊢, cases hζ₃, assumption }
    ... ≃[t + 1] {ac := ν, ..write t ν₁ η} : by simp,

    apply write_eq_implies_state_eq; assumption }
end

end correctness

section test

open instruction

/-- The example in the paper for compiling (x + 3) + (x + (y + 2)). -/
example (x y t : register) :
  let map := λ v, if v = "x" then x else if v = "y" then y else 0,
      p   := expr.sum (expr.sum (expr.var "x") (expr.const 3))
                      (expr.sum (expr.var "x") (expr.sum (expr.var "y") (expr.const 2))) in
  compile map p t =
  [ load x,
    sto  t,
    li   3,
    add  t,
    sto  t,
    load x,
    sto  (t + 1),
    load y,
    sto  (t + 2),
    li   2,
    add  (t + 2),
    add  (t + 1),
    add  t ] :=
rfl

end test

end arithcc


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

! This file was ported from Lean 3 source module representation_theory.maschke
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.MonoidAlgebra.Basic
import Mathlib.Algebra.CharP.Invertible
import Mathlib.LinearAlgebra.Basis

/-!
# Maschke's theorem

We prove **Maschke's theorem** for finite groups,
in the formulation that every submodule of a `k[G]` module has a complement,
when `k` is a field with `Invertible (Fintype.card G : k)`.

We do the core computation in greater generality.
For any `[CommRing k]` in which  `[Invertible (Fintype.card G : k)]`,
and a `k[G]`-linear map `i : V → W` which admits a `k`-linear retraction `π`,
we produce a `k[G]`-linear retraction by
taking the average over `G` of the conjugates of `π`.

## Implementation Notes
* These results assume `Invertible (Fintype.card G : k)` which is equivalent to the more
familiar `¬(ringChar k ∣ Fintype.card G)`. It is possible to convert between them using
`invertibleOfRingCharNotDvd` and `not_ringChar_dvd_of_invertible`.

## Future work
It's not so far to give the usual statement, that every finite dimensional representation
of a finite group is semisimple (i.e. a direct sum of irreducibles).
-/

universe u v w

noncomputable section

open Module MonoidAlgebra BigOperators

/-!
We now do the key calculation in Maschke's theorem.

Given `V → W`, an inclusion of `k[G]` modules,
assume we have some retraction `π` (i.e. `∀ v, π (i v) = v`),
just as a `k`-linear map.
(When `k` is a field, this will be available cheaply, by choosing a basis.)

We now construct a retraction of the inclusion as a `k[G]`-linear map,
by the formula
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/

namespace LinearMap

set_option synthInstance.etaExperiment true

-- At first we work with any `[CommRing k]`, and add the assumption that
-- `[Invertible (Fintype.card G : k)]` when it is required.
variable {k : Type u} [CommRing k] {G : Type u} [Group G]
variable {V : Type v} [AddCommGroup V] [Module k V] [Module (MonoidAlgebra k G) V]
variable [IsScalarTower k (MonoidAlgebra k G) V]
variable {W : Type w} [AddCommGroup W] [Module k W] [Module (MonoidAlgebra k G) W]
variable [IsScalarTower k (MonoidAlgebra k G) W]

variable (π : W →ₗ[k] V)

/-- We define the conjugate of `π` by `g`, as a `k`-linear map. -/
def conjugate (g : G) : W →ₗ[k] V :=
  .comp (.comp (GroupSmul.linearMap k V g⁻¹) π) (GroupSmul.linearMap k W g)
#align linear_map.conjugate LinearMap.conjugate

theorem conjugate_apply (g : G) (v : W) :
    π.conjugate g v = MonoidAlgebra.single g⁻¹ (1 : k) • π (MonoidAlgebra.single g (1 : k) • v) :=
  rfl

variable (i : V →ₗ[MonoidAlgebra k G] W) (h : ∀ v : V, (π : W → V) (i v) = v)

section

theorem conjugate_i (g : G) (v : V) : (conjugate π g : W → V) (i v) = v := by
  rw [conjugate_apply, ← i.map_smul, h, ← mul_smul, single_mul_single, mul_one, mul_left_inv,
    ← one_def, one_smul]
#align linear_map.conjugate_i LinearMap.conjugate_i

end

variable (G) [Fintype G]

/-- The sum of the conjugates of `π` by each element `g : G`, as a `k`-linear map.

(We postpone dividing by the size of the group as long as possible.)
-/
def sumOfConjugates : W →ₗ[k] V :=
  ∑ g : G, π.conjugate g
#align linear_map.sum_of_conjugates LinearMap.sumOfConjugates

lemma sumOfConjugates_apply (v : W) : π.sumOfConjugates G v = ∑ g : G, π.conjugate g v :=
  LinearMap.sum_apply _ _ _

/-- In fact, the sum over `g : G` of the conjugate of `π` by `g` is a `k[G]`-linear map.
-/
def sumOfConjugatesEquivariant : W →ₗ[MonoidAlgebra k G] V :=
  MonoidAlgebra.equivariantOfLinearOfComm (π.sumOfConjugates G) fun g v => by
    simp only [sumOfConjugates_apply, Finset.smul_sum, conjugate_apply]
    refine Fintype.sum_bijective (· * g) (Group.mulRight_bijective g) _ _ fun i ↦ ?_
    simp only [smul_smul, single_mul_single, mul_inv_rev, mul_inv_cancel_left, one_mul]
#align linear_map.sum_of_conjugates_equivariant LinearMap.sumOfConjugatesEquivariant

theorem sumOfConjugatesEquivariant_apply (v : W) :
    π.sumOfConjugatesEquivariant G v = ∑ g : G, π.conjugate g v :=
  π.sumOfConjugates_apply G v

section

variable [Invertible (Fintype.card G : k)]

/-- We construct our `k[G]`-linear retraction of `i` as
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/
def equivariantProjection : W →ₗ[MonoidAlgebra k G] V :=
  ⅟(Fintype.card G : k) • π.sumOfConjugatesEquivariant G
#align linear_map.equivariant_projection LinearMap.equivariantProjection

theorem equivariantProjection_apply (v : W) :
    π.equivariantProjection G v = ⅟(Fintype.card G : k) • ∑ g : G, π.conjugate g v := by
  simp only [equivariantProjection, smul_apply, sumOfConjugatesEquivariant_apply]

theorem equivariantProjection_condition (v : V) : (π.equivariantProjection G) (i v) = v := by
  rw [equivariantProjection_apply]
  simp only [conjugate_i π i h]
  rw [Finset.sum_const, Finset.card_univ, nsmul_eq_smul_cast k, smul_smul,
    Invertible.invOf_mul_self, one_smul]
#align linear_map.equivariant_projection_condition LinearMap.equivariantProjection_condition

end

end LinearMap

end

namespace MonoidAlgebra

-- Now we work over a `[Field k]`.
variable {k : Type u} [Field k] {G : Type u} [Fintype G] [Invertible (Fintype.card G : k)]
variable [Group G]
variable {V : Type u} [AddCommGroup V] [Module k V] [Module (MonoidAlgebra k G) V]
variable [IsScalarTower k (MonoidAlgebra k G) V]
variable {W : Type u} [AddCommGroup W] [Module k W] [Module (MonoidAlgebra k G) W]
variable [IsScalarTower k (MonoidAlgebra k G) W]

theorem exists_leftInverse_of_injective (f : V →ₗ[MonoidAlgebra k G] W)
    (hf : LinearMap.ker f = ⊥) :
    ∃ g : W →ₗ[MonoidAlgebra k G] V, g.comp f = LinearMap.id := by
  obtain ⟨φ, hφ⟩ := (f.restrictScalars k).exists_leftInverse_of_injective <| by
    simp only [hf, Submodule.restrictScalars_bot, LinearMap.ker_restrictScalars]
  refine ⟨φ.equivariantProjection G, FunLike.ext _ _ ?_⟩
  exact φ.equivariantProjection_condition G _ <| FunLike.congr_fun hφ
#align monoid_algebra.exists_left_inverse_of_injective MonoidAlgebra.exists_leftInverse_of_injective

namespace Submodule

theorem exists_isCompl (p : Submodule (MonoidAlgebra k G) V) :
    ∃ q : Submodule (MonoidAlgebra k G) V, IsCompl p q := by
  have : IsScalarTower k (MonoidAlgebra k G) p := p.isScalarTower'
  rcases MonoidAlgebra.exists_leftInverse_of_injective p.subtype p.ker_subtype with ⟨f, hf⟩
  refine ⟨LinearMap.ker f, LinearMap.isCompl_of_proj ?_⟩
  exact FunLike.congr_fun hf
#align monoid_algebra.submodule.exists_is_compl MonoidAlgebra.Submodule.exists_isCompl

/-- This also implies an instance `IsSemisimpleModule (MonoidAlgebra k G) V`. -/
instance complementedLattice : ComplementedLattice (Submodule (MonoidAlgebra k G) V) :=
  ⟨exists_isCompl⟩
#align monoid_algebra.submodule.complemented_lattice MonoidAlgebra.Submodule.complementedLattice

end Submodule

end MonoidAlgebra


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

! This file was ported from Lean 3 source module order.game_add
! leanprover-community/mathlib commit fee218fb033b2fd390c447f8be27754bc9093be9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Sym.Sym2
import Mathlib.Logic.Relation

/-!
# Game addition relation

This file defines, given relations `rα : α → α → Prop` and `rβ : β → β → Prop`, a relation
`Prod.GameAdd` on pairs, such that `GameAdd rα rβ x y` iff `x` can be reached from `y` by
decreasing either entry (with respect to `rα` and `rβ`). It is so called since it models the
subsequency relation on the addition of combinatorial games.

We also define `Sym2.GameAdd`, which is the unordered pair analog of `Prod.GameAdd`.

## Main definitions and results

- `Prod.GameAdd`: the game addition relation on ordered pairs.
- `WellFounded.prod_gameAdd`: formalizes induction on ordered pairs, where exactly one entry
  decreases at a time.

- `Sym2.GameAdd`: the game addition relation on unordered pairs.
- `WellFounded.sym2_gameAdd`: formalizes induction on unordered pairs, where exactly one entry
decreases at a time.
-/

variable {α β : Type _} {rα : α → α → Prop} {rβ : β → β → Prop}

/-! ### `Prod.GameAdd` -/

namespace Prod

variable (rα rβ)

/-- `Prod.GameAdd rα rβ x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relations `rα` and `rβ`.

  It is so called, as it models game addition within combinatorial game theory. If `rα a₁ a₂` means
  that `a₂ ⟶ a₁` is a valid move in game `α`, and `rβ b₁ b₂` means that `b₂ ⟶ b₁` is a valid move
  in game `β`, then `GameAdd rα rβ` specifies the valid moves in the juxtaposition of `α` and `β`:
  the player is free to choose one of the games and make a move in it, while leaving the other game
  unchanged.

  See `Sym2.GameAdd` for the unordered pair analog. -/

inductive GameAdd : α × β → α × β → Prop
  | fst {a₁ a₂ b} : rα a₁ a₂ → GameAdd (a₁, b) (a₂, b)
  | snd {a b₁ b₂} : rβ b₁ b₂ → GameAdd (a, b₁) (a, b₂)
#align prod.game_add Prod.GameAdd

theorem gameAdd_iff {rα rβ} {x y : α × β} :
    GameAdd rα rβ x y ↔ rα x.1 y.1 ∧ x.2 = y.2 ∨ rβ x.2 y.2 ∧ x.1 = y.1 :=
  by
  constructor
  · rintro (@⟨a₁, a₂, b, h⟩ | @⟨a, b₁, b₂, h⟩)
    exacts[Or.inl ⟨h, rfl⟩, Or.inr ⟨h, rfl⟩]
  · revert x y
    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ (⟨h, rfl : b₁ = b₂⟩ | ⟨h, rfl : a₁ = a₂⟩)
    exacts[GameAdd.fst h, GameAdd.snd h]
#align prod.game_add_iff Prod.gameAdd_iff

theorem gameAdd_mk_iff {rα rβ} {a₁ a₂ : α} {b₁ b₂ : β} :
    GameAdd rα rβ (a₁, b₁) (a₂, b₂) ↔ rα a₁ a₂ ∧ b₁ = b₂ ∨ rβ b₁ b₂ ∧ a₁ = a₂ :=
  gameAdd_iff
#align prod.game_add_mk_iff Prod.gameAdd_mk_iff

@[simp]
theorem gameAdd_swap_swap : ∀ a b : α × β, GameAdd rβ rα a.swap b.swap ↔ GameAdd rα rβ a b :=
  fun ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ => by rw [Prod.swap, Prod.swap, gameAdd_mk_iff, gameAdd_mk_iff, or_comm]
#align prod.game_add_swap_swap Prod.gameAdd_swap_swap

theorem gameAdd_swap_swap_mk (a₁ a₂ : α) (b₁ b₂ : β) :
    GameAdd rα rβ (a₁, b₁) (a₂, b₂) ↔ GameAdd rβ rα (b₁, a₁) (b₂, a₂) :=
  gameAdd_swap_swap rβ rα (b₁, a₁) (b₂, a₂)
#align prod.game_add_swap_swap_mk Prod.gameAdd_swap_swap_mk

/-- `Prod.GameAdd` is a subrelation of `Prod.Lex`. -/
theorem gameAdd_le_lex : GameAdd rα rβ ≤ Prod.Lex rα rβ := fun _ _ h =>
  h.rec (Prod.Lex.left _ _) (Prod.Lex.right _)
#align prod.game_add_le_lex Prod.gameAdd_le_lex

/-- `Prod.RProd` is a subrelation of the transitive closure of `Prod.GameAdd`. -/
theorem rprod_le_transGen_gameAdd : RProd rα rβ ≤ Relation.TransGen (GameAdd rα rβ)
  | _, _, h => h.rec (by
      intro _ _ _ _ hα hβ
      exact Relation.TransGen.tail (Relation.TransGen.single $ GameAdd.fst hα) (GameAdd.snd hβ))
#align prod.rprod_le_trans_gen_game_add Prod.rprod_le_transGen_gameAdd

end Prod

/-- If `a` is accessible under `rα` and `b` is accessible under `rβ`, then `(a, b)` is
  accessible under `Prod.GameAdd rα rβ`. Notice that `Prod.lexAccessible` requires the
  stronger condition `∀ b, Acc rβ b`. -/
theorem Acc.prod_gameAdd (ha : Acc rα a) (hb : Acc rβ b) :
    Acc (Prod.GameAdd rα rβ) (a, b) := by
  induction' ha with a _ iha generalizing b
  induction' hb with b hb ihb
  refine' Acc.intro _ fun h => _
  rintro (⟨ra⟩ | ⟨rb⟩)
  exacts[iha _ ra (Acc.intro b hb), ihb _ rb]
#align acc.prod_game_add Acc.prod_gameAdd

/-- The `Prod.GameAdd` relation on well-founded inputs is well-founded.

  In particular, the sum of two well-founded games is well-founded. -/
theorem WellFounded.prod_gameAdd (hα : WellFounded rα) (hβ : WellFounded rβ) :
    WellFounded (Prod.GameAdd rα rβ) :=
  ⟨fun ⟨a, b⟩ => (hα.apply a).prod_gameAdd (hβ.apply b)⟩
#align well_founded.prod_game_add WellFounded.prod_gameAdd

namespace Prod

/-- Recursion on the well-founded `Prod.GameAdd` relation.
  Note that it's strictly more general to recurse on the lexicographic order instead. -/
noncomputable def GameAdd.fix {C : α → β → Sort _} (hα : WellFounded rα) (hβ : WellFounded rβ)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
    C a b :=
  @WellFounded.fix (α × β) (fun x => C x.1 x.2) _ (hα.prod_gameAdd hβ)
    (fun ⟨x₁, x₂⟩ IH' => IH x₁ x₂ fun a' b' => IH' ⟨a', b'⟩) ⟨a, b⟩
#align prod.game_add.fix Prod.GameAdd.fix

theorem GameAdd.fix_eq {C : α → β → Sort _} (hα : WellFounded rα) (hβ : WellFounded rβ)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
    GameAdd.fix hα hβ IH a b = IH a b fun a' b' _ => GameAdd.fix hα hβ IH a' b' :=
  WellFounded.fix_eq _ _ _
#align prod.game_add.fix_eq Prod.GameAdd.fix_eq

/-- Induction on the well-founded `Prod.GameAdd` relation.
  Note that it's strictly more general to induct on the lexicographic order instead. -/
theorem GameAdd.induction {C : α → β → Prop} :
    WellFounded rα →
      WellFounded rβ →
        (∀ a₁ b₁, (∀ a₂ b₂, GameAdd rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
  GameAdd.fix
#align prod.game_add.induction Prod.GameAdd.induction

end Prod

/-! ### `Sym2.GameAdd` -/

namespace Sym2

/-- `Sym2.GameAdd rα x y` means that `x` can be reached from `y` by decreasing either entry with
  respect to the relation `rα`.

  See `Prod.GameAdd` for the ordered pair analog. -/
def GameAdd (rα : α → α → Prop) : Sym2 α → Sym2 α → Prop :=
  Sym2.lift₂
    ⟨fun a₁ b₁ a₂ b₂ => Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂) ∨ Prod.GameAdd rα rα (b₁, a₁) (a₂, b₂),
      fun a₁ b₁ a₂ b₂ =>
      by
      dsimp
      rw [Prod.gameAdd_swap_swap_mk _ _ b₁ b₂ a₁ a₂, Prod.gameAdd_swap_swap_mk _ _ a₁ b₂ b₁ a₂]
      simp [or_comm]⟩
#align sym2.game_add Sym2.GameAdd

theorem gameAdd_iff :
    ∀ {x y : α × α}, GameAdd rα ⟦x⟧ ⟦y⟧ ↔ Prod.GameAdd rα rα x y ∨ Prod.GameAdd rα rα x.swap y :=
  by
  rintro ⟨_, _⟩ ⟨_, _⟩
  rfl
#align sym2.game_add_iff Sym2.gameAdd_iff

theorem gameAdd_mk'_iff {a₁ a₂ b₁ b₂ : α} :
    GameAdd rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ ↔
      Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂) ∨ Prod.GameAdd rα rα (b₁, a₁) (a₂, b₂) :=
  Iff.rfl
#align sym2.game_add_mk_iff Sym2.gameAdd_mk'_iff

theorem _root_.Prod.GameAdd.to_sym2 {a₁ a₂ b₁ b₂ : α} (h : Prod.GameAdd rα rα (a₁, b₁) (a₂, b₂)) :
    Sym2.GameAdd rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ :=
  gameAdd_mk'_iff.2 <| Or.inl <| h
#align prod.game_add.to_sym2 Prod.GameAdd.to_sym2

theorem GameAdd.fst {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(a₁, b)⟧ ⟦(a₂, b)⟧ :=
  (Prod.GameAdd.fst h).to_sym2
#align sym2.game_add.fst Sym2.GameAdd.fst

theorem GameAdd.snd {a b₁ b₂ : α} (h : rα b₁ b₂) : GameAdd rα ⟦(a, b₁)⟧ ⟦(a, b₂)⟧ :=
  (Prod.GameAdd.snd h).to_sym2
#align sym2.game_add.snd Sym2.GameAdd.snd

theorem GameAdd.fst_snd {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(a₁, b)⟧ ⟦(b, a₂)⟧ :=
  by
  rw [Sym2.eq_swap]
  exact GameAdd.snd h
#align sym2.game_add.fst_snd Sym2.GameAdd.fst_snd

theorem GameAdd.snd_fst {a₁ a₂ b : α} (h : rα a₁ a₂) : GameAdd rα ⟦(b, a₁)⟧ ⟦(a₂, b)⟧ :=
  by
  rw [Sym2.eq_swap]
  exact GameAdd.fst h
#align sym2.game_add.snd_fst Sym2.GameAdd.snd_fst

end Sym2

theorem Acc.sym2_gameAdd {a b} (ha : Acc rα a) (hb : Acc rα b) : Acc (Sym2.GameAdd rα) ⟦(a, b)⟧ :=
  by
  induction' ha with a _ iha generalizing b
  induction' hb with b hb ihb
  refine' Acc.intro _ fun s => _
  induction' s using Sym2.inductionOn with c d
  rw [Sym2.GameAdd]
  dsimp
  rintro ((rc | rd) | (rd | rc))
  · exact iha c rc ⟨b, hb⟩
  · exact ihb d rd
  · rw [Sym2.eq_swap]
    exact iha d rd ⟨b, hb⟩
  · rw [Sym2.eq_swap]
    exact ihb c rc
#align acc.sym2_game_add Acc.sym2_gameAdd

/-- The `Sym2.GameAdd` relation on well-founded inputs is well-founded. -/
theorem WellFounded.sym2_gameAdd (h : WellFounded rα) : WellFounded (Sym2.GameAdd rα) :=
  ⟨fun i => Sym2.inductionOn i fun x y => (h.apply x).sym2_gameAdd (h.apply y)⟩
#align well_founded.sym2_game_add WellFounded.sym2_gameAdd

namespace Sym2

/-- Recursion on the well-founded `Sym2.GameAdd` relation. -/
noncomputable def GameAdd.fix {C : α → α → Sort _} (hr : WellFounded rα)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
    C a b :=
  @WellFounded.fix (α × α) (fun x => C x.1 x.2) _ hr.sym2_gameAdd.of_quotient_lift₂
    (fun ⟨x₁, x₂⟩ IH' => IH x₁ x₂ fun a' b' => IH' ⟨a', b'⟩) (a, b)
#align sym2.game_add.fix Sym2.GameAdd.fix

theorem GameAdd.fix_eq {C : α → α → Sort _} (hr : WellFounded rα)
    (IH : ∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
    GameAdd.fix hr IH a b = IH a b fun a' b' _ => GameAdd.fix hr IH a' b' :=
  WellFounded.fix_eq _ _ _
#align sym2.game_add.fix_eq Sym2.GameAdd.fix_eq

/-- Induction on the well-founded `Sym2.GameAdd` relation. -/
theorem GameAdd.induction {C : α → α → Prop} :
    WellFounded rα →
      (∀ a₁ b₁, (∀ a₂ b₂, Sym2.GameAdd rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) →
        ∀ a b, C a b :=
  GameAdd.fix
#align sym2.game_add.induction Sym2.GameAdd.induction

end Sym2


import .quotients

/-!
# Projections, Loopifications and Pseudominors

For a matroid `M` on Type `E` and sets `C,D` in `M`, this file defines matroids `M ⟋ C` and
`M ⟍ D` which are obtained from `M` by contracting `C` and deleting `D` respectively, but then
adding back in `C` (or `D`) as a set containing only loops. We call these operations 'projection'
and 'loopification'.

The advantage of this over taking minors is that we stay in the Type `matroid E` rather than
changing the ground set and having to deal with type equality . In practice it seems
that many proofs that involve manipulating minors can be phrased only in terms of these modified
minor-like-objects, which we call pseudominors.

Kung's theorem and the matroid intersection theorem are currently both proved in this way.
(or at least will be once I fix them again)
-/

noncomputable theory
open set

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

namespace matroid

section project

/-- contract `C` and replace it with a set of loops to get a matroid on the same ground set.
Often more convenient than just contracting `C` because the underlying type is preserved. -/
def project (M : matroid E) (C : set E) :
  matroid E :=
matroid_of_cl
  (λ X, M.cl (X ∪ C))
  (λ X, (subset_union_left _ _).trans (M.subset_cl _))
  (λ X Y hXY, M.cl_mono (union_subset_union_left _ hXY))
  (λ X, by {simp only [cl_union_cl_left_eq_cl_union, union_assoc, union_self]} )
  (λ X e f hf, by {rw [insert_union] at ⊢ hf, exact cl_exchange hf})

infix ` ⟋ ` :75 :=  matroid.project

/-- Project every element outside `R` -/
def project_to (M : matroid E) (R : set E) : matroid E :=
  M ⟋ Rᶜ

@[simp] lemma project_cl_eq (M : matroid E) (C X : set E) :
  (M ⟋ C).cl X = M.cl (X ∪ C) :=
by simp only [project, matroid_of_cl_apply]

@[simp] lemma project_empty (M : matroid E) : M ⟋ ∅ = M :=
eq_of_cl_eq_cl_forall (λ X, by simp_rw [project_cl_eq, union_empty])

@[simp] lemma project_project (M : matroid E) (C₁ C₂ : set E) :
  M ⟋ C₁ ⟋ C₂ = M ⟋ (C₁ ∪ C₂) :=
begin
  refine eq_of_cl_eq_cl_forall (λ X, _),
  simp_rw [project_cl_eq],
  rw [union_right_comm, union_assoc],
end

lemma project_is_quotient (M : matroid E) (C : set E) :
  M ⟋ C ≼ M :=
begin
  simp_rw [is_quotient, project_cl_eq],
  exact λ X, M.cl_mono (subset_union_left _ _),
end

lemma project_weak_image (M : matroid E) (C : set E) :
  M ⟋ C ≤w M :=
(M.project_is_quotient C).weak_image

lemma project_project_comm (M : matroid E) (C₁ C₂ : set E) :
  M ⟋ C₁ ⟋ C₂ = M ⟋ C₂ ⟋ C₁ :=
by rw [project_project, project_project, union_comm]

lemma project_contract_subset_loops (M : matroid E) (C : set E) :
  C ⊆ (M ⟋ C).cl ∅ :=
by {rw [project_cl_eq, empty_union], apply M.subset_cl}

lemma project_indep_disjoint_contract (hI : (M ⟋ C).indep I) :
  disjoint I C :=
begin
  simp_rw [indep_iff_not_mem_cl_diff_forall, project_cl_eq] at hI,
  rw [disjoint_iff_forall_ne],
  rintro x hxI _ hxC rfl,
  exact hI x hxI (M.subset_cl _ (or.inr hxC)),
end

lemma project_indep_disjoint_cl_contract (hI : (M ⟋ C).indep I) :
  disjoint I (M.cl C) :=
begin
  simp_rw [indep_iff_not_mem_cl_diff_forall, project_cl_eq] at hI,
  rw [disjoint_iff_forall_ne],
  rintro x hxI _ hxC rfl,
  exact hI x hxI (mem_of_mem_of_subset hxC (M.cl_mono (subset_union_right _ _))),
end

lemma union_indep_of_project_indep (hI : (M ⟋ C).indep I) (hI₀ : M.basis I₀ C) :
  M.indep (I ∪ I₀) :=
begin
  by_contra h',
  simp_rw [indep_iff_not_mem_cl_diff_forall, project_cl_eq] at hI,
  rw dep_iff_supset_circuit at h',
  obtain ⟨D,hDss,hD⟩ := h',

  have heD : (D ∩ I).nonempty,
  { rw [nonempty_iff_ne_empty, ne.def, ←disjoint_iff_inter_eq_empty],
    exact λ hDI, hD.dep (hI₀.indep.subset (hDI.subset_right_of_subset_union hDss))},

  obtain ⟨x,hx⟩ := heD,
  apply hI x hx.2,
  refine mem_of_mem_of_subset (hD.subset_cl_diff_singleton x hx.1) _,
  rw [←cl_union_cl_right_eq_cl_union, ←hI₀.cl, cl_union_cl_right_eq_cl_union],
  refine cl_subset_cl_of_subset _ (diff_subset_iff.mpr (hDss.trans _)),
  rw [singleton_union, insert_union_distrib, insert_diff_singleton],
  exact union_subset_union (subset_insert _ _) (subset_insert _ _),
end

lemma project_indep_of_union_basis_indep (hI₀ : M.basis I₀ C) (hdj : disjoint I I₀)
(h_ind : M.indep (I ∪ I₀)) :
  (M ⟋ C).indep I :=
begin
  simp_rw [indep_iff_not_mem_cl_diff_forall, project_cl_eq],
  rw [indep_iff_not_mem_cl_diff_forall] at h_ind,
  intros x hxI,
  refine not_mem_subset _ (h_ind _ (or.inl hxI)),
  rw [←cl_union_cl_right_eq_cl_union, ←hI₀.cl, cl_union_cl_right_eq_cl_union, union_diff_distrib,
    diff_singleton_eq_self (disjoint_left.mp hdj hxI)],
  exact rfl.subset,
end

lemma project_indep_iff_exists :
  (M ⟋ C).indep I ↔ ∃ I₀, disjoint I I₀ ∧ M.basis I₀ C ∧ M.indep (I ∪ I₀) :=
begin
  refine ⟨λ h, _,λ h, _⟩,
  { obtain ⟨I₀, hI₀⟩ := M.exists_basis C,
    refine ⟨I₀, disjoint_of_subset_right hI₀.subset (project_indep_disjoint_contract h), hI₀, _⟩,
    exact union_indep_of_project_indep h hI₀},
  obtain ⟨I₀, hII₀, hI₀, hu⟩ := h,
  exact project_indep_of_union_basis_indep hI₀ hII₀ hu,
end

lemma project_indep_iff_forall :
  (M ⟋ C).indep I ↔ disjoint I C ∧ ∀ I₀, M.basis I₀ C → M.indep (I ∪ I₀) :=
begin
  refine ⟨λ hI, ⟨project_indep_disjoint_contract hI, λ I₀ hI₀,
    union_indep_of_project_indep hI hI₀⟩, _⟩,
  rw project_indep_iff_exists,
  rintro ⟨hdj, hbas⟩,
  obtain ⟨I₀, hI₀⟩ := M.exists_basis C,
  exact ⟨I₀, disjoint_of_subset_right hI₀.subset hdj, hI₀, hbas _ hI₀⟩,
end

lemma project_basis_of_basis (hI : M.basis I (X ∪ C)) (hIC : M.basis (I ∩ C) C) :
  (M ⟋ C).basis (I \ C) X :=
begin
  simp_rw [basis_iff_indep_cl, project_cl_eq, diff_union_self, diff_subset_iff],
  refine ⟨project_indep_of_union_basis_indep hIC _ _, _, _⟩,
  { rw disjoint_iff_forall_ne, rintro x ⟨-,hxC⟩ y ⟨-,hyC⟩ rfl, exact hxC hyC},
  { rw diff_union_inter, exact hI.indep},
  { rw [←cl_union_cl_left_eq_cl_union, hI.cl, cl_union_cl_left_eq_cl_union,
      union_assoc, union_self],
    refine subset_trans (subset_union_left _ _) (M.subset_cl _)},
  rw [union_comm],
  exact hI.subset,
end

lemma union_basis_of_project_basis (hI : (M ⟋ C).basis I X) (hI₀ : M.basis I₀ C) :
  M.basis (I ∪ I₀) (X ∪ C) :=
begin
  simp_rw [basis_iff_indep_cl],
  refine ⟨union_indep_of_project_indep hI.indep hI₀, _,
    union_subset_union hI.subset hI₀.subset⟩,
  simp_rw [basis_iff_indep_cl, project_cl_eq] at hI,
  rw [←cl_union_cl_right_eq_cl_union, hI₀.cl, cl_union_cl_right_eq_cl_union],
  exact union_subset hI.2.1 ((subset_union_right _ _).trans (M.subset_cl _)),
end

lemma project_basis_iff_exists :
  (M ⟋ C).basis I X ↔ ∃ I₀, disjoint I I₀ ∧ M.basis I₀ C ∧ M.basis (I ∪ I₀) (X ∪ C) :=
begin
  split,
  { obtain ⟨I₀, hI₀⟩ := M.exists_basis C,
    exact λ h, ⟨I₀, disjoint_of_subset_right hI₀.subset (project_indep_disjoint_contract h.indep),
      hI₀, union_basis_of_project_basis h hI₀⟩},
  rintro ⟨I₀, hII₀, hI₀C, hb⟩,
  have h'' := hI₀C.eq_of_subset_indep (hb.indep.inter_right C)
      (subset_inter (subset_union_right _ _) hI₀C.subset) (inter_subset_right _ _),

  convert project_basis_of_basis hb (h'' ▸ hI₀C),
  have h' := inter_union_diff (I ∪ I₀) C,

  refine subset_antisymm (subset_diff.mpr ⟨subset_union_left _ _,_⟩) (diff_subset_iff.mpr _),
  { rw disjoint_iff_forall_ne,
    rintro x hxI hy hyC rfl,
    exact hII₀.ne_of_mem hxI (((set.ext_iff.mp h'') x).mpr ⟨or.inl hxI, hyC⟩) rfl},
  exact (union_subset_union_right _ hI₀C.subset).trans_eq (union_comm _ _),
end

lemma project_basis_iff_forall :
  (M ⟋ C).basis I X ↔ disjoint I (M.cl C) ∧ ∀ I₀, M.basis I₀ C → M.basis (I ∪ I₀) (X ∪ C) :=
begin
  split,
  { exact λ hI, ⟨project_indep_disjoint_cl_contract hI.indep, λ I₀ hI₀,
      union_basis_of_project_basis hI hI₀⟩},
  rintro ⟨hIdj, h⟩,
  rw project_basis_iff_exists,
  obtain ⟨I₀, hI₀⟩ := M.exists_basis C,
  exact ⟨I₀, disjoint_of_subset_right (hI₀.subset.trans (M.subset_cl _)) hIdj, hI₀, h _ hI₀⟩,
end

@[simp] lemma coe_r_project (M : matroid E) (C X : set E) :
  ((M.project C).r X : ℤ) = M.r (X ∪ C) - M.r C :=
begin
  obtain ⟨I,hI⟩ := (M.project C).exists_basis X,
  obtain ⟨I₀,hI₀⟩ := M.exists_basis C,
  obtain ⟨h1,h2⟩  := project_basis_iff_forall.mp hI,
  specialize h2 _ hI₀,

  rw [←hI.r, hI.indep.r, ←h2.r, ←hI₀.r, hI₀.indep.r, h2.indep.r, ncard_union_eq],
  {rw [nat.cast_add], linarith},
  exact disjoint_of_subset_right (hI₀.subset.trans (M.subset_cl _)) h1,
end

lemma indep.project_indep_iff (hI₀ : M.indep I₀) (hI : M.indep I) :
  (M ⟋ I₀).indep I ↔ disjoint I I₀ ∧ M.indep (I ∪ I₀) :=
begin
  simp_rw [project_indep_iff_exists],
  split,
  { rintro ⟨J, hdj, hJ, hIJ⟩,
    have := hI₀.eq_of_basis hJ, subst this,
    exact ⟨hdj, hIJ⟩},
  rintro ⟨hdj, hI⟩,
  exact ⟨I₀, hdj, hI₀.basis_self, hI⟩,
end

lemma indep_of_project_indep (h : (M ⟋ C).indep I) :
  M.indep I :=
h.weak_image (project_weak_image _ _)

lemma project_cl_eq_project (M : matroid E) (C : set E) :
  M ⟋ (M.cl C) = M ⟋ C  :=
eq_of_cl_eq_cl_forall (λ X, by simp_rw [project_cl_eq, cl_union_cl_right_eq_cl_union])

lemma basis.project_eq_project (hI : M.basis I X) :
  M ⟋ I = M ⟋ X :=
by rw [←project_cl_eq_project, ←M.project_cl_eq_project X, hI.cl]

lemma project_cl_empty_eq :
  (M ⟋ C).cl ∅ = M.cl C :=
by rw [project_cl_eq, empty_union]

lemma loop_of_project_iff :
  (M ⟋ C).loop e ↔ e ∈ M.cl C :=
by rw [loop_iff_mem_cl_empty, project_cl_eq, empty_union]

lemma loop_of_project_mem_cl (he : e ∈ M.cl C) :
  (M ⟋ C).loop e :=
loop_of_project_iff.mpr he

lemma loop_of_project_mem (he : e ∈ C) :
  (M ⟋ C).loop e :=
loop_of_project_iff.mpr (mem_of_mem_of_subset he (M.subset_cl _))

lemma project_eq_of_loops (h : C ⊆ M.cl ∅) :
  (M ⟋ C) = M :=
by rw [←project_cl_eq_project, cl_eq_loops_of_subset h, project_cl_eq_project, project_empty]

lemma project_eq_self_iff_subset_loops :
  M ⟋ C = M ↔ C ⊆ M.cl ∅ :=
begin
  refine ⟨λ h e heC, _, project_eq_of_loops⟩,
  rw [←h, project_cl_empty_eq],
  exact (M.subset_cl C) heC,
end

lemma indep_project_singleton_iff (he : ¬M.loop e) (heI : e ∉ I) :
  (M ⟋ {e}).indep I ↔ M.indep (insert e I) :=
begin
  rw [nonloop_iff_indep] at he,
  split,
  { intro h,
    have := he.project_indep_iff (indep_of_project_indep h),
    rw [this, union_singleton] at h,
    exact h.2},
  intro h,
  rw [he.project_indep_iff (h.subset (subset_insert _ _)), union_singleton,
    disjoint_singleton_right],
  exact ⟨heI, h⟩,
end

lemma r_project_singleton_add_one (he : ¬M.loop e) (X : set E) :
  (M ⟋ {e}).r X  + 1 = M.r (insert e X) :=
by {zify, rw [coe_r_project, nonloop_iff_r.mp he], simp}

lemma coe_r_project_singleton (he : ¬M.loop e) (X : set E) :
  ((M ⟋ {e}).r X : ℤ) = M.r (insert e X) - 1 :=
by {rw ←r_project_singleton_add_one he X, simp}

lemma not_mem_of_indep_project_singleton (h : (M ⟋ {e}).indep I) :
  e ∉ I :=
(loop_of_project_mem (mem_singleton e)).not_mem_indep h

end project

section loopify

/-- The loopification of `D` in a matroid `M` is obtained from `M` by turning all elements of `D`
  into loops. Not very mathematically natural, but often more convenient than deletion because the
  underlying type remains the same. -/
def loopify (M : matroid E) (D : set E) :
  matroid E :=
{ base := (λ I, M.basis I Dᶜ),
  exists_base' := M.exists_basis Dᶜ,
  base_exchange' := λ I₁ I₂ h₁ h₂ e, h₁.exchange h₂}

infix ` ⟍ ` :75 :=  matroid.loopify

@[simp] lemma base_loopify_iff :
  (M ⟍ D).base B ↔ M.basis B Dᶜ  :=
iff.rfl

@[simp] lemma indep_loopify_iff :
  (M ⟍ D).indep I ↔ disjoint I D ∧ M.indep I :=
begin
  simp_rw [indep_iff_subset_base, base_loopify_iff],
  split,
  { rintro ⟨B, hB, hIB⟩,
    exact ⟨disjoint_of_subset_left hIB (subset_compl_iff_disjoint_right.mp hB.subset),
      hB.indep.exists_base_supset.imp (λ B h, ⟨h.1, hIB.trans h.2⟩)⟩},
  rintro ⟨hID, B, hB, hIB⟩,
  obtain ⟨B', hIB', hB'⟩ :=
    (hB.indep.subset hIB).subset_basis_of_subset (subset_compl_iff_disjoint_right.mpr hID),
  use [B',hB',hIB'],
end

lemma indep_of_loopify_indep (h : (M ⟍ D).indep I ):
  M.indep I :=
(indep_loopify_iff.mp h).2

lemma loopify_weak_image (M : matroid E) (D : set E):
  M ⟍ D ≤w M :=
begin
  intros I hI,
  rw indep_loopify_iff at hI,
  exact hI.2,
end

@[simp] lemma loopify_empty (M : matroid E):
  M ⟍ ∅ = M  :=
eq_of_indep_iff_indep_forall (λ I, by simp)

lemma circuit_loopify_iff :
  (M ⟍ D).circuit C ↔ (M.circuit C ∧ disjoint C D) ∨ ∃ e ∈ D, C = {e} :=
begin
  simp_rw [circuit_def, indep_loopify_iff, not_and, exists_prop],
  split,
  { rintro ⟨h₁, h₂⟩,
    obtain (h | ⟨e,heC,heD⟩) := (C ∩ D).eq_empty_or_nonempty,
    { left,
      rw ←disjoint_iff_inter_eq_empty at h,
      exact ⟨⟨h₁ h, λ I hIC, (h₂ I hIC).2⟩,h⟩},
      refine or.inr ⟨e,heD, _⟩,
      obtain (hss | rfl) := (singleton_subset_iff.mpr heC).ssubset_or_eq, swap, refl,
      have hcon := (h₂ _ hss).1,
      rw [disjoint_singleton_left] at hcon,
      exact (hcon heD).elim},
  rintro (⟨⟨hdep, h⟩,hdj⟩  | ⟨e,heD,rfl⟩),
  { exact ⟨λ _, hdep, λ I hIC, ⟨disjoint_of_subset_left hIC.subset hdj, h I hIC⟩⟩},
  refine ⟨λ h, (disjoint_singleton_left.mp h heD).elim, λ I hI, _⟩,
  rw ssubset_singleton_iff at hI,
  subst hI,
  exact ⟨empty_disjoint _, M.empty_indep⟩,
end

lemma circuit_loopify_iff_of_disjoint (hC : disjoint C D) :
  (M ⟍ D).circuit C ↔ M.circuit C :=
begin
  rw [circuit_loopify_iff],
  refine ⟨λ h, h.elim (and.left) _,λ h, (or.inl ⟨h,hC⟩)⟩,
  rintro ⟨e,heD,rfl⟩,
  refine h.elim (and.left) (false.elim ∘ _),
  rintro ⟨f,hfD,hef⟩,
  rw [hef, disjoint_singleton_left] at hC,
  exact hC hfD,
end

@[simp] lemma loopify_cl_eq (D X : set E):
  (M ⟍ D).cl X = M.cl (X \ D) ∪ D :=
begin
  ext e,
  simp_rw [mem_cl_iff_exists_circuit, circuit_loopify_iff],
  split,
  { rintro (heX | ⟨C, ⟨⟨hC,hCD⟩ | ⟨f,hfD,rfl⟩,hC'⟩⟩),
    { exact (em (e ∈ D)).elim or.inr (λ heD,
        or.inl (mem_of_mem_of_subset (⟨heX, heD⟩ : e ∈ X \ D) (M.subset_cl _) ))},
    { refine or.inl (mem_of_mem_of_subset (hC.subset_cl_diff_singleton e hC'.1)
        (M.cl_subset_cl_of_subset _)),
      rw [subset_diff],
      exact ⟨hC'.2, disjoint_of_subset_left (diff_subset _ _) hCD⟩},
    rw ←mem_singleton_iff.mp hC'.1 at hfD,
    exact or.inr hfD},

  by_cases heD : e ∈ D,
  { exact λ _, or.inr ⟨{e}, or.inr ⟨_,heD,rfl⟩, mem_singleton_of_eq rfl, by simp⟩},
  rintro (heX | heD'), swap, exact (heD heD').elim,

  rw mem_cl_iff_exists_circuit at heX,
  obtain ( heXD | ⟨C, hC, heC, hCX⟩) := heX,
  { exact or.inl ((diff_subset _ _) heXD)},
  refine (em (e ∈ X)).elim or.inl (λ heX, or.inr _),
  refine ⟨C, or.inl ⟨hC, _⟩, heC, hCX.trans (diff_subset _ _)⟩,

  rw [←inter_union_diff C {e}, disjoint_union_left, inter_singleton_eq_of_mem heC,
    disjoint_singleton_left],
  rw subset_diff at hCX,
  exact ⟨heD, hCX.2⟩,
end

@[simp] lemma loop_of_loopify_iff :
  (M ⟍ D).loop e ↔ M.loop e ∨ e ∈ D :=
by {simp_rw [loop_iff_mem_cl_empty, loopify_cl_eq, empty_diff], refl}

lemma loopified_subset_loops (M : matroid E) (D : set E) :
  D ⊆ (M ⟍ D).cl ∅ :=
by {rw [loopify_cl_eq], exact subset_union_right _ _}

lemma loop_of_loopify (h : e ∈ D) :
  (M ⟍ D).loop e :=
by {rw loop_iff_mem_cl_empty, exact M.loopified_subset_loops D h}

@[simp] lemma loopify_nonloops (M : matroid E) (D : set E) :
  (M ⟍ D).nonloops = M.nonloops \ D :=
by {ext, simp_rw [mem_diff, mem_nonloops_iff_not_loop, loop_of_loopify_iff, not_or_distrib]}

lemma basis_loopify_iff :
  (M ⟍ D).basis I X ↔ disjoint I D ∧ M.basis I (X \ D) :=
begin
  simp_rw [basis_iff, indep_loopify_iff],
  split,
  { rintro ⟨⟨hdj, hI⟩, hIX, h⟩,
    exact ⟨hdj, hI, (subset_diff.mpr ⟨hIX, hdj⟩), λ J hJ hIJ hJX,
     h J ⟨(disjoint_of_subset_left hJX (disjoint_sdiff_left)),hJ⟩
      hIJ (hJX.trans (diff_subset _ _))⟩},
  rintro ⟨hdj,hI,hIXD,h⟩,
  exact ⟨⟨hdj,hI⟩, hIXD.trans (diff_subset _ _), λ J h' hIJ hJX, h _ h'.2 hIJ
    (subset_diff.mpr ⟨hJX, h'.1⟩)⟩,
end

lemma basis_loopify_iff_of_disjoint (h : disjoint X D) :
  (M ⟍ D).basis I X ↔ M.basis I X :=
begin
  rw [basis_loopify_iff],
  exact ⟨λ hI,
    hI.2.basis_subset (hI.2.subset.trans (diff_subset _ _)) (subset_diff.mpr ⟨subset.rfl, h⟩),
  λ hI, ⟨disjoint_of_subset_left hI.subset h, hI.basis_subset
    (subset_diff.mpr ⟨hI.subset,disjoint_of_subset_left hI.subset h⟩) (diff_subset _ _)⟩⟩,
end

@[simp] lemma r_loopify :
  (M ⟍ D).r X = M.r (X \ D) :=
begin
  obtain ⟨I, hI⟩ := (M ⟍ D).exists_basis X,
  rw [←hI.r, hI.indep.r],
  rw [basis_loopify_iff] at hI,
  rw [←hI.2.r, hI.2.indep.r],
end

lemma loopify_eq_of_loops (h : D ⊆ M.cl ∅) :
  M ⟍ D = M :=
begin
  refine eq_of_indep_iff_indep_forall (λ I, _),
  rw [indep_loopify_iff],
  refine ⟨and.right, λ hI, ⟨disjoint_of_subset_right h hI.disjoint_loops,hI⟩⟩,
end

lemma loopify_eq_self_iff_subset_loops :
  M ⟍ D = M ↔ D ⊆ M.cl ∅ :=
begin
  refine ⟨λ h e heD, _, loopify_eq_of_loops⟩,
  rw [←h, loopify_cl_eq],
  exact or.inr heD,
end

lemma r_loopify_of_disjoint (h : disjoint X D) :
  (M ⟍ D).r X = M.r X :=
by rw [r_loopify, sdiff_eq_left.mpr h]

lemma loopify_loopify (M : matroid E) (D D' : set E) :
  M ⟍ D ⟍ D' = M ⟍ (D ∪ D') :=
begin
  refine eq_of_indep_iff_indep_forall (λ I, _),
  rw [indep_loopify_iff, indep_loopify_iff, indep_loopify_iff, ←and_assoc, and_comm (disjoint _ _)],
  convert iff.rfl,
  rw [disjoint_union_right],
end

lemma loopify_loopify_comm (M : matroid E) (D D' : set E) :
  M ⟍ D ⟍ D' = M ⟍ D' ⟍ D :=
by rw [loopify_loopify, union_comm, loopify_loopify]

lemma not_mem_of_indep_loopify_singleton (h : (M ⟍ {e}).indep I) :
  e ∉ I :=
(loop_of_loopify (mem_singleton e)).not_mem_indep h

end loopify

section lrestrict

/-- loopify all elements of M outside R -/
def lrestrict (M : matroid E) (R : set E) : matroid E := M ⟍ Rᶜ

infix ` ‖ `  :75 :=  matroid.lrestrict

@[simp] lemma lrestrict_r (M : matroid E) (R X : set E) :
  (M ‖ R).r X = M.r (X ∩ R) :=
by simp [lrestrict]

lemma loopify_eq_lrestrict_compl (M : matroid E) (D : set E) :
  (M ⟍ D) = (M ‖ Dᶜ) :=
by rw [lrestrict, compl_compl]

lemma loopify_compl_le_lrestrict (M : matroid E) (D : set E) :
  M ⟍ Dᶜ = M ‖ D :=
rfl

@[simp] lemma lrestrict.nonloops (M : matroid E) (R : set E):
  (M ‖ R).nonloops = M.nonloops ∩ R :=
by rw [lrestrict, loopify_nonloops, diff_compl]

@[simp] lemma indep_lrestrict_iff :
  (M ‖ R).indep I ↔ M.indep I ∧ I ⊆ R :=
by simp [lrestrict, disjoint_compl_right_iff_subset, and_comm]

end lrestrict

section pseudominor

lemma project_loopify_swap (M : matroid E) (C D : set E) :
  M ⟋ C ⟍ D = M ⟍ (D \ C) ⟋ C :=
begin
  refine eq_of_cl_eq_cl_forall (λ X, _),
  simp only [project_cl_eq, loopify_cl_eq],
  rw [union_diff_distrib, diff_diff_cancel_right, @diff_eq_compl_inter _ D C,
    @diff_eq_compl_inter _ X (Cᶜ ∩ D), compl_inter, compl_compl, inter_distrib_right,
    union_right_comm, union_eq_right_iff_subset.mpr (inter_subset_left _ _), ←diff_eq_compl_inter,
    union_comm C, union_eq_union_iff_left],
  refine ⟨_,(inter_subset_right _ _).trans (subset_union_right _ _)⟩,
  rw [←diff_eq_compl_inter],
  nth_rewrite 0 [←inter_union_diff D C],
  refine union_subset
    ((inter_subset_right _ _).trans (subset_union_of_subset_left _ _)) (subset_union_right _ _),
  exact (subset_union_right _ _).trans (M.subset_cl _),
end

lemma loopify_project_swap (M : matroid E) (C D : set E) :
  M ⟍ D ⟋ C = M ⟋ (C \ D) ⟍ D :=
begin
  rw [project_loopify_swap, diff_diff_cancel_right],
  nth_rewrite 0 ←inter_union_diff C D,
  rw [union_comm, ←project_project],
  apply project_eq_of_loops,
  simp only [project_cl_eq, empty_union, loopify_cl_eq, sdiff_idem],
  exact (inter_subset_right _ _).trans (subset_union_right _ _),
end

lemma project_loopify_comm (M : matroid E) {C D : set E} (hCD : disjoint C D) :
  M ⟋ C ⟍ D = M ⟍ D ⟋ C :=
by {convert project_loopify_swap _ _ _, rwa [eq_comm, sdiff_eq_left, disjoint.comm]}

lemma project_loopify_eq_self_iff_subset_loops :
  M ⟋ C ⟍ D = M ↔ C ∪ D ⊆ M.cl ∅ :=
begin
  refine ⟨λ h, _,λ h, _⟩,
  { rw ←h,
    simp only [loopify_cl_eq, empty_diff, project_cl_eq, empty_union, union_subset_iff,
      subset_union_right, and_true],
    exact subset_union_of_subset_left (M.subset_cl _) _},
  rw [loopify_eq_self_iff_subset_loops.mpr, project_eq_self_iff_subset_loops.mpr],
  { exact (subset_union_left _ _).trans h},
  simp only [project_cl_eq, empty_union],
  exact (subset_union_right _ _).trans (h.trans (M.cl_mono (empty_subset C))),
end

/-- a pminor (pseudominor) of a matroid M is a matroid on the same ground set arising
-- from loopifications and/or projections of M  -/
def pminor (N M : matroid E) :=
  ∃ C D, N = M ⟋ C ⟍ D

def strict_pminor (N M : matroid E) :=
  pminor N M ∧ N ≠ M

infix ` ≤p ` :75 :=  matroid.pminor

infix ` <p ` :75 :=  matroid.strict_pminor

lemma strict_pminor.pminor (h : N <p M) :
  N ≤p M :=
h.1

lemma strict_pminor.ne (h : N <p M) :
  N ≠ M :=
h.2

lemma pminor.strict_pminor_of_ne (h : N ≤p M) (hne : N ≠ M) :
  N <p M :=
⟨h,hne⟩

lemma pminor.weak_image (h : N ≤p M) :
  N ≤w M :=
by {obtain ⟨C,D,rfl⟩ := h, exact (loopify_weak_image _ _).trans (project_weak_image _ _)}

lemma project_pminor (M : matroid E) (C : set E) :
  M ⟋ C ≤p M :=
⟨C, ∅, by simp⟩

lemma loopify_pminor (M : matroid E) (D : set E) :
  M ⟍ D ≤p M :=
⟨∅, D, by simp⟩

lemma project_loopify_pminor (M : matroid E) (C D : set E) :
  M ⟋ C ⟍ D ≤p M :=
⟨C,D,rfl⟩

lemma loopify_project_pminor (M : matroid E) (C D : set E) :
  M ⟍ D ⟋ C ≤p M :=
⟨C \D,D, by {rw loopify_project_swap}⟩

/-- This doesn't include co-independence of `D`. TODO -/
lemma exists_canonical_pminor_of_pminor (h : N ≤p M) :
  ∃ C D, N = M ⟋ C ⟍ D ∧ M.indep C ∧ disjoint D (M.cl C) :=
begin
  obtain ⟨C', D', rfl⟩ := h,
  obtain ⟨C, hC⟩ := M.exists_basis C',
  refine ⟨C, D' \ M.cl C, _, hC.indep, disjoint_sdiff_left⟩ ,
  nth_rewrite 0 ←inter_union_diff D' (M.cl C),
  rw [hC.project_eq_project, union_comm, ←loopify_loopify, loopify_eq_self_iff_subset_loops,
    loopify_cl_eq, empty_diff, project_cl_eq, empty_union, hC.cl],
  exact (inter_subset_right _ _).trans (subset_union_left _ _),
end

lemma pminor_trans {M₀ M₁ M₂ : matroid E} (h₀ : M₀ ≤p M₁) (h₁ : M₁ ≤p M₂) :
  M₀ ≤p M₂ :=
begin
  obtain ⟨C₁,D₁,rfl, hC₁,hD₁⟩ := exists_canonical_pminor_of_pminor h₁,
  obtain ⟨C₀,D₀,rfl, hC₀,hD₀⟩ := exists_canonical_pminor_of_pminor h₀,

  have hdj : disjoint (C₀ ∪ C₁) (D₀ ∪ D₁),
  { rw [disjoint_union_right, disjoint.comm],
    split,
    { refine disjoint_of_subset_right _ hD₀,
      rw [loopify_cl_eq, project_cl_eq, union_subset_iff],
      split,
      { nth_rewrite 0 ←inter_union_diff C₀ D₁,
        rw [union_comm],
        exact union_subset_union ((subset_union_left _ _).trans (M₂.subset_cl _))
            (inter_subset_right _ _)},
      exact subset_union_of_subset_left ((subset_union_right _ _).trans (M₂.subset_cl _)) _},
    rw [disjoint_union_left],
    refine ⟨_, (disjoint_of_subset_left (M₂.subset_cl _) hD₁.symm)⟩,
    simp only [indep_loopify_iff] at hC₀,
    exact hC₀.1},

  rw [project_loopify_comm, project_loopify_comm, project_loopify_comm, project_project,
     loopify_loopify, ←project_loopify_comm],
  { exact ⟨_,_,rfl⟩},
  { rwa [union_comm, union_comm D₁]},
  { exact disjoint_of_subset (subset_union_right _ _) (subset_union_left _ _) hdj},
  { exact disjoint_of_subset (subset_union_right _ _) (subset_union_right _ _) hdj},
  exact disjoint_of_subset (subset_union_left _ _) (subset_union_left _ _) hdj,
end

lemma pminor_antisymm (h : N ≤p M) (h' : M ≤p N) :
  M = N :=
h'.weak_image.antisymm h.weak_image

lemma pminor.eq_of_loops_subset_loops (h : N ≤p M) (h_loops : N.cl ∅ ⊆ M.cl ∅) :
  N = M :=
begin
  obtain ⟨C, D, rfl⟩:= h,
  rw project_loopify_eq_self_iff_subset_loops,
  simp only [loopify_cl_eq, project_cl_eq, empty_diff, empty_union] at *,
  exact (union_subset_union_left D (M.subset_cl C)).trans h_loops,
end

lemma strict_pminor_of_project_nonloop (he : ¬M.loop e) :
  M ⟋ {e} <p M :=
begin
  refine (project_pminor M {e}).strict_pminor_of_ne (λ h, he _),
  rwa [project_eq_self_iff_subset_loops, singleton_subset_iff, ←loop_iff_mem_cl_empty] at h,
end

lemma strict_pminor_of_loopify_nonloop (he : ¬M.loop e) :
  M ⟍ {e} <p M :=
begin
  refine (loopify_pminor M {e}).strict_pminor_of_ne (λ h, he _),
  rwa [loopify_eq_self_iff_subset_loops, singleton_subset_iff, ←loop_iff_mem_cl_empty] at h,
end

lemma strict_pminor_of_project_loopify_r_ne_zero (h : M.r (C ∪ D) ≠ 0) :
  M ⟋ C ⟍ D <p M :=
begin
  refine (project_loopify_pminor _ _ _).strict_pminor_of_ne
    (λ hC, h (r_zero_iff_subset_loops.mpr _)),
  rwa [project_loopify_eq_self_iff_subset_loops] at hC,
end

lemma strict_pminor_of_project_r_ne_zero (h : M.r (C) ≠ 0) :
  M ⟋ C <p M :=
begin
  refine (project_pminor _ _).strict_pminor_of_ne (λ hC, h (r_zero_iff_subset_loops.mpr _)),
  rwa [project_eq_self_iff_subset_loops] at hC,
end

lemma pminor.loops_supset_loops (h : N ≤p M) :
  M.cl ∅ ⊆ N.cl ∅ :=
begin
  obtain ⟨C,D,rfl⟩ := h,
  simp only [loopify_cl_eq, empty_diff, project_cl_eq, empty_union],
  exact subset_union_of_subset_left (M.cl_mono (empty_subset C)) _,
end

lemma pminor.nonloops_subset_nonloops (h : N ≤p M) :
  N.nonloops ⊆ M.nonloops :=
begin
  obtain ⟨C,D,rfl⟩ := @id _ h,
  rw [nonloops, nonloops, compl_subset_compl],
  exact h.loops_supset_loops,
end

lemma strict_pminor.nonloops_ssubset_nonloops (h : N <p M) :
  N.nonloops ⊂ M.nonloops :=
begin
  refine (h.pminor.nonloops_subset_nonloops).ssubset_of_ne (λ he, h.ne _),
  rw [nonloops, nonloops, compl_inj_iff] at he,
  exact h.pminor.eq_of_loops_subset_loops he.subset,
end

end pseudominor

end matroid

-- lemma project_makes_loops (M : matroid E) (C : set E) : loops M ∪ C ⊆ loops (M ⟋ C)  :=
-- by rw [←rank_zero_iff_subset_loops, project_r, union_assoc, union_self,
--         union_comm, rank_eq_rank_union_rank_zero C (rank_loops M), sub_self]

-- lemma loop_of_project (M : matroid E )(he : e ∈ C) : (M ⟋ C).is_loop e :=
-- loop_iff_mem_loops.mpr (mem_of_mem_of_subset (by {exact or.inr he}) (project_makes_loops M C))

-- lemma projected_set_rank_zero (M : matroid E) (C : set E) : (M ⟋ C).r C = 0 :=
-- by rw [project_r, union_self, sub_self]

-- lemma projected_set_union_rank_zero (M : matroid E) (C : set E){X : set E} (hX : M.r X = 0) :
--   (M ⟋ C).r (X ∪ C) = 0 :=
-- by rwa [project_r, union_assoc, union_self, union_comm, rank_eq_rank_union_rank_zero, sub_self]

-- lemma project_rank_zero_eq (h : M.r C = 0) : M ⟋ C = M :=
-- by {ext X, rw [project_r, rank_eq_rank_union_rank_zero X h, h, sub_zero]}

-- lemma project_rank_zero_of_rank_zero (C : set E) (hX : M.r X = 0) : (M ⟋ C).r X = 0 :=
-- by {apply rank_eq_zero_of_le_zero, rw ←hX, apply project_is_weak_image}

-- lemma project_nonloops_eq (C : set E): (M ⟋ C).nonloops = M.nonloops \ M.cl C :=
-- begin
--   ext x,
--   rw [mem_diff, ← nonloop_iff_mem_nonloops, ← nonloop_iff_mem_nonloops, nonloop_iff_r, project_r,
--     nonmem_cl_iff_r, union_comm],
--   refine ⟨λ h, ⟨by_contra (λ hn, _), by linarith⟩, λ h, by linarith [h.2]⟩,
--   rw [← loop_iff_not_nonloop, loop_iff_r] at hn,
--   rw [rank_eq_rank_union_rank_zero _ hn, sub_self] at h,
--   exact zero_ne_one h,
-- end

-- lemma indep_union_project_set_of_project_indep
-- (hX : is_indep (M ⟋ C) X) (hC : is_indep M C) :
-- is_indep M (X ∪ C) :=
-- by {simp_rw [indep_iff_r, project_r] at *,
--     linarith [M.R1 (X ∪ C), size_modular X C, size_nonneg (X ∩ C)]}

-- lemma project_nonloop_fewer_nonloops (he : M.is_nonloop e): (M ⟋ {e}).nonloops ⊂ M.nonloops :=
-- begin
--   simp_rw [nonloops_eq_compl_loops],
--   apply ssubset_compl_commpl.mpr,
--   rw ssubset_iff_subset_ne,
--   refine ⟨subset.trans (subset_union_left _ _) (project_makes_loops M {e}), λ hn, _⟩,
--   rw ext_iff at hn,
--   have h' := (not_iff_not.mpr (hn e)).mp (nonloop_iff_not_mem_loops.mp he),
--   exact h' (loop_iff_mem_loops.mp (loop_of_project M (mem_singleton e))),
-- end

-- lemma indep_of_project_indep (h: is_indep (M ⟋ C) X) : is_indep M X :=
-- indep_of_weak_image_indep (project_is_weak_image M C) h

-- lemma project_as_project_to (M : matroid E) (C : set E) : (M ⟋ C) = M.project_to Cᶜ :=
-- by rw [project_to, compl_compl]

-- lemma project_to_r (M : matroid E) (R X : set E) : (M.project_to R).r X = M.r (X ∪ Rᶜ) - M.r Rᶜ :=
-- by rw [project_to, project_r]

-- lemma indep_project_iff : (M ⟋ C).is_indep X ↔ M.is_indep X ∧ M.r (X ∪ C) = M.r X + M.r C :=
-- begin
--   rw [indep_iff_r,project_r, indep_iff_r],
--   refine ⟨λ h, ⟨_,_⟩, λ h, _⟩,
--   { refine le_antisymm (M.rank_le_size _) _, rw ←h, linarith [rank_subadditive M X C]},
--   { refine le_antisymm (M.rank_subadditive X C) _,
--     rw (by linarith : M.r (X ∪ C) = M.r C + size X),
--     linarith [M.rank_le_size X], },
--   rw [←h.1, h.2], simp,
-- end

-- lemma flat_of_flat_project (h : (M ⟋ C).is_flat F) : M.is_flat F :=
-- flat_of_quotient_flat (project_is_quotient _ _) h

-- lemma flat_project_iff : (M ⟋ C).is_flat F ↔ M.is_flat F ∧ C ⊆ F :=
-- begin
--   refine ⟨λ h, ⟨flat_of_flat_project h,_⟩, λ h, _⟩,
--   { refine subset.trans _ (loops_subset_flat _ h),
--     rw ←rank_zero_iff_subset_loops,
--     apply projected_set_rank_zero, },
--   simp_rw [flat_iff_r, project_r, union_comm F C, subset_iff_union_eq_left.mp h.2],
--   intros Y hFY,
--   suffices : M.r F < M.r Y, linarith [rank_mono_union_left M Y C],
--   exact h.1 _ hFY,
-- end

-- lemma point_project_nonloop_iff { e : E } (he : M.is_nonloop e){X : set E}:
--   (M ⟋ {e}).is_point X ↔ M.is_line X ∧ e ∈ X :=
-- begin
--   dsimp only  [is_point, is_line, is_rank_k_flat, project_r],
--   rw [flat_project_iff, rank_nonloop he, singleton_subset_iff],
--   split,
--   { rintros ⟨⟨hF,he⟩,hX⟩,
--     rw [union_mem_singleton he] at hX,
--     exact ⟨⟨hF, eq_add_of_sub_eq hX⟩, he⟩ },
--   rintros ⟨⟨hF, hX⟩, he⟩,
--   rw [union_mem_singleton he, hX],
--   tidy,
-- end

-- end project

-- section loopify

-- variables {E : Type*} [fintype E] {e f : E} {M : matroid E} {X Y D C I R S : set E}

-- /-- Replace D with loops to get a matroid on the same ground set. Often more
-- convenient than deleting D -/
-- def loopify (M : matroid E) (D : set E) : matroid E :=
-- { r := λ X, M.r (X \ D),
--   R0 := λ X, M.R0 _,
--   R1 := λ X, by linarith [M.R1 (X \ D), size_diff_le_size X D],
--   R2 := λ X Y hXY, M.rank_mono (diff_subset_diff_left hXY),
--   R3 := λ X Y, by {simp only [diff_eq], rw [inter_distrib_right, inter_distrib_inter_left],
--                     linarith [M.rank_submod (X ∩ Dᶜ) (Y ∩ Dᶜ)], }}

-- infix ` ⟍ ` :75 :=  matroid.loopify

-- /-- loopify all elements of M outside R -/
-- def lrestrict (M : matroid E) (R : set E) : matroid E := M ⟍ (Rᶜ)

-- infix ` ‖ `  :75 :=  matroid.lrestrict

-- @[simp] lemma loopify_r (M : matroid E) (D X : set E) : (M ⟍ D).r X = M.r (X \ D) := rfl
-- @[simp] lemma loopify_empty (M : matroid E) : M ⟍ ∅ = M :=
-- by { ext X, rw [loopify_r, diff_empty]}

-- lemma loopify_is_weak_image (M : matroid E) (D : set E) :
--   M ⟍ D ≤ M :=
-- λ X, rank_mono_diff _ _ _

-- lemma loopify_loopify (M : matroid E) (D D' : set E) :
--    M ⟍ D ⟍ D' = M ⟍ (D ∪ D') :=
-- by {ext X, simp [diff_eq, ←inter_assoc, inter_right_comm]}

-- lemma loopify_loops_eq (M : matroid E) (D : set E) :
--   M.loops ∪ D = (M ⟍ D).loops :=
-- begin
--   refine subset.antisymm _ (λ x hx, _),
--   { rw [←rank_zero_iff_subset_loops, loopify_r, rank_zero_iff_subset_loops], tidy,},

--   rw [← loop_iff_mem_loops, loop_iff_r, loopify_r] at hx,
--   by_contra hn,
--   rw [mem_union_eq, not_or_distrib, ← nonloop_iff_not_mem_loops, nonloop_iff_r] at hn,
--   have hxD : {x} \ D = {x},
--   { ext,
--     simp only [mem_singleton_iff, and_iff_left_iff_imp, mem_diff],
--     rintro rfl,
--     exact hn.2},
--   rw [hxD,hn.1] at hx,
--   exact one_ne_zero hx,
-- end

-- lemma loops_subset_loopify_loops_eq (M : matroid E)(D : set E):
--   M.loops ⊆ (M ⟍ D).loops :=
-- by {rw ← loopify_loops_eq, apply subset_union_left}

-- lemma loop_of_loopify (M : matroid E) (he : e ∈ D) :
--   (M ⟍ D).is_loop e :=
-- by {rw [loop_iff_mem_loops, ← loopify_loops_eq], exact or.inr he}

-- lemma loopify_nonloops_eq (M : matroid E) (D : set E):
--   (M ⟍ D).nonloops = M.nonloops \ D :=
-- by rw [nonloops_eq_compl_loops, nonloops_eq_compl_loops, ← loopify_loops_eq, compl_union, diff_eq]

-- lemma loopify_nonloop_fewer_nonloops (he : M.is_nonloop e):
--   (M ⟍ {e}).nonloops ⊂ M.nonloops :=
-- begin
--   simp_rw [nonloops_eq_compl_loops],
--   apply ssubset_compl_commpl.mpr,
--   rw ← loopify_loops_eq,
--   exact ssubset_of_add_nonmem_iff.mp (nonloop_iff_not_mem_loops.mp he),
-- end

-- lemma loopify_rank_zero_eq (h : M.r D = 0) :
--   M ⟍ D = M :=
-- by {ext X, rw [loopify_r, rank_eq_rank_diff_rank_zero X h]}

-- lemma loopified_set_rank_zero (M : matroid E) (D : set E) :
--   (M ⟍ D).r D = 0 :=
-- by rw [loopify_r, set.diff_self, rank_empty]

-- lemma loopified_set_union_rank_zero (M : matroid E) (D : set E){X : set E} (h: M.r X = 0) :
--   (M ⟍ D).r (X ∪ D) = 0 :=
-- by {rw [loopify_r, union_diff_right], exact rank_zero_of_subset_rank_zero (diff_subset _ _) h}

-- lemma loopify_rank_zero_of_rank_zero (D : set E)(hX : M.r X = 0) :
--   (M ⟍ D).r X = 0 :=
-- by {apply rank_eq_zero_of_le_zero, rw ←hX, apply loopify_is_weak_image}

-- lemma loopify_rank_of_disjoint (M : matroid E) (h : D ∩ X = ∅) :
--   (M ⟍ D).r X = M.r X :=
-- by {rw loopify_r, congr, rwa [inter_comm, disjoint_iff_diff_eq_left] at h}

-- lemma indep_of_loopify_indep (hX : is_indep (M ⟍ D) X) :
--   is_indep M X :=
-- indep_of_weak_image_indep (loopify_is_weak_image M D) hX

-- lemma indep_loopify_iff :
--   (M ⟍ D).is_indep X ↔ M.is_indep X ∧ X ∩ D = ∅ :=
-- by rw [loopify_as_lrestrict, indep_lrestrict_iff, subset_compl_iff_disjoint]

-- lemma indep_of_indep_lrestrict (hI : (M ‖ R).is_indep I) :
--   M.is_indep I :=
-- (indep_lrestrict_iff.mp hI).1

-- lemma indep_lrestrict_subset_is_indep
-- (hSR: S ⊆ R) (hI: (M ‖ S).is_indep I ) :
--   (M ‖ R).is_indep I :=
-- by {simp_rw [indep_lrestrict_iff] at *, exact ⟨hI.1, subset.trans hI.2 hSR⟩}

-- lemma lrestrict_eq_lrestrict_iff {M N : matroid E}:
--   M ‖ S = N ‖ S ↔ (∀ X ⊆ S, M.r X = N.r X) :=
-- begin
--   refine ⟨λ h, λ X hX, _, λ h, _⟩,
--   { rw [← (subset_iff_inter_eq_left.mp hX), ← lrestrict_r, ← lrestrict_r, h]},
--   ext Y : 2 ,
--   rw [lrestrict_r, lrestrict_r, h _ (inter_subset_right _ _)],
-- end

-- end loopify

-- section pminor

-- variables {E : Type*} [fintype E] { M N : matroid E } {C D : set E}

-- /-- a pminor (pseudominor) of a matroid M is a matroid on the same ground set arising
-- from loopifications and/or projections of M  -/
-- def is_pminor_of (N M : matroid E) :=
--   ∃ C D, N = M ⟋ C ⟍ D

-- lemma pr_is_pminor (M : matroid E) (C : set E):
--   (M ⟋ C).is_pminor_of M :=
-- ⟨C, ∅, by simp⟩

-- lemma lp_is_pminor (M : matroid E) (D : set E):
--   (M ⟍ D).is_pminor_of M :=
-- ⟨∅, D, by simp⟩

-- lemma pr_lp_eq_lp_pr (M : matroid E) (C D : set E) :
--   M ⟋ C ⟍ D = M ⟍ (D \ C) ⟋ C :=
-- by {ext X, simp only [loopify_r, project_r], convert rfl; {ext, simp, tauto! }}

-- lemma lp_pr_eq_pr_lp (M : matroid E) (C D : set E) :
--   M ⟍ D ⟋ C = M ⟋ (C \ D) ⟍ D :=
-- by {ext X, simp only [loopify_r, project_r], convert rfl; {ext, simp, tauto! }}

-- lemma rank_zero_of_lp_pr (M : matroid E) (C D : set E) :
--   (M ⟍ D ⟋ C).r (C ∪ D) = 0 :=
-- begin
--   apply rank_zero_of_union_rank_zero, apply projected_set_rank_zero,
--   apply project_rank_zero_of_rank_zero, apply loopified_set_rank_zero,
-- end

-- lemma rank_zero_of_pr_lp (M : matroid E) (C D : set E) :
--   (M ⟋ C ⟍ D).r (C ∪ D) = 0 :=
-- begin
--   apply rank_zero_of_union_rank_zero,
--   apply loopify_rank_zero_of_rank_zero, apply projected_set_rank_zero,
--   apply loopified_set_rank_zero,
-- end

-- lemma pminor_iff_exists_lp_pr_disjoint {N M : matroid E} :
--   N.is_pminor_of M ↔ ∃ C D, C ∩ D = ∅ ∧ N = M ⟍ D ⟋ C :=
-- begin
--   split, rintros ⟨C,D,h⟩, refine ⟨C,D \ C, ⟨by simp ,_⟩ ⟩, rwa ←pr_lp_eq_lp_pr,
--   rintros ⟨C,D,hCD,h⟩, refine ⟨C \ D, D, _⟩, rwa ←lp_pr_eq_pr_lp,
-- end

-- lemma pminor_iff_exists_pr_lp_disjoint {N M : matroid E} :
--   N.is_pminor_of M ↔ ∃ C D, C ∩ D = ∅ ∧ N = M ⟋ C ⟍ D :=
-- begin
--   split, swap, rintros ⟨C,D,hCD,h⟩, exact ⟨C, D, h⟩,
--   rintros ⟨C,D,h⟩, refine ⟨C,D \ C, ⟨by simp ,_⟩ ⟩,
--   rw [h, ←loopify_rank_zero_eq (_ : (M ⟋ C ⟍ (D \ C)).r (C ∩ D) = 0), loopify_loopify],
--   { congr, ext, simp, tauto!, },
--   refine rank_zero_of_subset_rank_zero _ (rank_zero_of_pr_lp _ _ _),
--   intro x, simp, tauto,
-- end

-- end pminor

-- end matroid