/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Weak and strict order preserving maps.

TODO: we will probably eventually want versions restricted to smaller domains,
"nondecreasing_on" etc. Maybe we can do this with subtypes.
-/
import .order
open eq eq.ops function

variables {A B C : Type}

section
  variables [weak_order A] [weak_order B] [weak_order C]

  definition nondecreasing (f : A → B) : Prop := ∀ ⦃a₁ a₂⦄, a₁ ≤ a₂ → f a₁ ≤ f a₂

  definition nonincreasing (f : A → B) : Prop := ∀ ⦃a₁ a₂⦄, a₁ ≤ a₂ → f a₁ ≥ f a₂

  theorem nondecreasing_id : nondecreasing (@id A) := take a₁ a₂, assume H, H

  theorem nondecreasing_comp_nondec_nondec {g : B → C} {f : A → B}
      (Hg : nondecreasing g) (Hf : nondecreasing f) : nondecreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem nondecreasing_comp_noninc_noninc {g : B → C} {f : A → B}
      (Hg : nonincreasing g) (Hf : nonincreasing f) : nondecreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem nonincreasing_comp_noninc_nondec {g : B → C} {f : A → B}
      (Hg : nonincreasing g) (Hf : nondecreasing f) : nonincreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem nonincreasing_comp_nondec_noninc {g : B → C} {f : A → B}
      (Hg : nondecreasing g) (Hf : nonincreasing f) : nonincreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)
end

section
  variables [strict_order A] [strict_order B] [strict_order C]

  definition strictly_increasing (f : A → B) : Prop :=
  ∀ ⦃a₁ a₂⦄, a₁ < a₂ → f a₁ < f a₂

  definition strictly_decreasing (f : A → B) : Prop :=
  ∀ ⦃a₁ a₂⦄, a₁ < a₂ → f a₁ > f a₂

  theorem strictly_increasing_id : strictly_increasing (@id A) := take a₁ a₂, assume H, H

  theorem strictly_increasing_comp_inc_inc {g : B → C} {f : A → B}
      (Hg : strictly_increasing g) (Hf : strictly_increasing f) : strictly_increasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem strictly_increasing_comp_dec_dec {g : B → C} {f : A → B}
      (Hg : strictly_decreasing g) (Hf : strictly_decreasing f) : strictly_increasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem strictly_decreasing_comp_inc_dec {g : B → C} {f : A → B}
      (Hg : strictly_increasing g) (Hf : strictly_decreasing f) : strictly_decreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)

  theorem strictly_decreasing_comp_dec_inc {g : B → C} {f : A → B}
      (Hg : strictly_decreasing g) (Hf : strictly_increasing f) : strictly_decreasing (g ∘ f) :=
  take a₁ a₂, assume H, Hg (Hf H)
end

section
  variables [strong_order_pair A] [strong_order_pair B]

  theorem nondecreasing_of_strictly_increasing {f : A → B} (H : strictly_increasing f) :
    nondecreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  show f a₁ ≤ f a₂, from or.elim (lt_or_eq_of_le this)
    (suppose a₁ < a₂, le_of_lt (H this))
    (suppose a₁ = a₂, le_of_eq (congr_arg f this))

  theorem nonincreasing_of_strictly_decreasing {f : A → B} (H : strictly_decreasing f) :
    nonincreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  show f a₁ ≥ f a₂, from or.elim (lt_or_eq_of_le this)
    (suppose a₁ < a₂, le_of_lt (H this))
    (suppose a₁ = a₂, le_of_eq (congr_arg f this⁻¹))
end

section
  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [linear_strong_order_pair C]

  theorem lt_of_strictly_increasing {f : A → B} {a₁ a₂ : A} (H : strictly_increasing f)
    (H' : f a₁ < f a₂) : a₁ < a₂ :=
  lt_of_not_ge (suppose a₂ ≤ a₁,
    have f a₂ ≤ f a₁, from nondecreasing_of_strictly_increasing H this,
    show false, from not_le_of_gt H' this)

  theorem lt_iff_of_strictly_increasing {f : A → B} (a₁ a₂ : A) (H : strictly_increasing f) :
    f a₁ < f a₂ ↔ a₁ < a₂ :=
  iff.intro (lt_of_strictly_increasing H) (@H a₁ a₂)

  theorem le_of_strictly_increasing {f : A → B} {a₁ a₂ : A} (H : strictly_increasing f)
    (H' : f a₁ ≤ f a₂) : a₁ ≤ a₂ :=
  le_of_not_gt (suppose a₂ < a₁, not_le_of_gt (H this) H')

  theorem le_iff_of_strictly_increasing {f : A → B} (a₁ a₂ : A) (H : strictly_increasing f) :
    f a₁ ≤ f a₂ ↔ a₁ ≤ a₂ :=
  iff.intro (le_of_strictly_increasing H) (λ H', nondecreasing_of_strictly_increasing H H')

  theorem lt_of_strictly_decreasing {f : A → B} {a₁ a₂ : A} (H : strictly_decreasing f)
    (H' : f a₁ > f a₂) : a₁ < a₂ :=
  lt_of_not_ge (suppose a₂ ≤ a₁,
    have f a₂ ≥ f a₁, from nonincreasing_of_strictly_decreasing H this,
    show false, from not_le_of_gt H' this)

  theorem gt_iff_of_strictly_decreasing {f : A → B} (a₁ a₂ : A) (H : strictly_decreasing f) :
    f a₁ > f a₂ ↔ a₁ < a₂ :=
  iff.intro (lt_of_strictly_decreasing H) (@H a₁ a₂)

  theorem le_of_strictly_decreasing {f : A → B} {a₁ a₂ : A} (H : strictly_decreasing f)
    (H' : f a₁ ≥ f a₂) : a₁ ≤ a₂ :=
  le_of_not_gt (suppose a₂ < a₁, not_le_of_gt (H this) H')

  theorem ge_iff_of_strictly_decreasing {f : A → B} (a₁ a₂ : A) (H : strictly_decreasing f) :
    f a₁ ≥ f a₂ ↔ a₁ ≤ a₂ :=
  iff.intro (le_of_strictly_decreasing H) (λ H', nonincreasing_of_strictly_decreasing H H')

  theorem strictly_increasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
      (H' : strictly_increasing g) : strictly_increasing f :=
  take a₁ a₂, suppose a₁ < a₂,
  have g (f a₁) < g (f a₂), by rewrite *H; apply this,
  lt_of_strictly_increasing H' this

  theorem strictly_decreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
      (H' : strictly_decreasing g) : strictly_decreasing f :=
  take b₁ b₂, suppose b₁ < b₂,
  have g (f b₁) < g (f b₂), by rewrite *H; apply this,
  lt_of_strictly_decreasing H' this

  theorem nondecreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
      (H' : strictly_increasing g) : nondecreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have g (f a₁) ≤ g (f a₂), by rewrite *H; apply this,
  le_of_strictly_increasing H' this

  theorem nonincreasing_of_left_inverse {g : B → A} {f : A → B} (H : left_inverse g f)
      (H' : strictly_decreasing g) : nonincreasing f :=
  take b₁ b₂, suppose b₁ ≤ b₂,
  have g (f b₁) ≤ g (f b₂), by rewrite *H; apply this,
  le_of_strictly_decreasing H' this
end

/- composition rules for strict orders -/

section
  variables [strict_order A] [strict_order B] [strict_order C]

  theorem strictly_increasing_of_strictly_increasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) (H₃ : strictly_increasing (g ∘ f)) :
    strictly_increasing f :=
  take a₁ a₂, suppose a₁ < a₂,
  have h (g (f a₁)) < h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ < f a₂, by rewrite *H₁ at this; apply this

  theorem strictly_decreasing_of_strictly_increasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) (H₃ : strictly_increasing (g ∘ f)) :
    strictly_decreasing f :=
  take a₁ a₂, suppose a₁ < a₂,
  have h (g (f a₁)) > h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ > f a₂, by rewrite *H₁ at this; apply this

  theorem strictly_decreasing_of_strictly_decreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) (H₃ : strictly_decreasing (g ∘ f)) :
    strictly_decreasing f :=
  take a₁ a₂, suppose a₁ < a₂,
  have h (g (f a₁)) > h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ > f a₂, by rewrite *H₁ at this; apply this

  theorem strictly_increasing_of_strictly_decreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) (H₃ : strictly_decreasing (g ∘ f)) :
    strictly_increasing f :=
  take a₁ a₂, suppose a₁ < a₂,
  have h (g (f a₁)) < h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ < f a₂, by rewrite *H₁ at this; apply this

  theorem strictly_increasing_of_strictly_decreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing h) (H₃ : strictly_decreasing (g ∘ f)) :
    strictly_increasing g :=
  take a₁ a₂, suppose a₁ < a₂,
  have g (f (h a₁)) < g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ < g a₂, by rewrite *H₁ at this; apply this

  theorem strictly_decreasing_of_strictly_decreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing h) (H₃ : strictly_decreasing (g ∘ f)) :
    strictly_decreasing g :=
  take a₁ a₂, suppose a₁ < a₂,
  have g (f (h a₁)) > g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ > g a₂, by rewrite *H₁ at this; apply this

  theorem strictly_increasing_of_strictly_increasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing h) (H₃ : strictly_increasing (g ∘ f)) :
    strictly_increasing g :=
  take a₁ a₂, suppose a₁ < a₂,
  have g (f (h a₁)) < g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ < g a₂, by rewrite *H₁ at this; apply this

  theorem strictly_decreasing_of_strictly_increasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing h) (H₃ : strictly_increasing (g ∘ f)) :
    strictly_decreasing g :=
  take a₁ a₂, suppose a₁ < a₂,
  have g (f (h a₁)) > g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ > g a₂, by rewrite *H₁ at this; apply this
end

section
  variables [strict_order A] [linear_strong_order_pair B] [linear_strong_order_pair C]

  theorem strictly_increasing_comp_iff_strictly_increasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
    strictly_increasing (g ∘ f) ↔ strictly_increasing f :=
  have H₃ : strictly_increasing g, from strictly_increasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_increasing_of_strictly_increasing_comp_right H₁ H₂)
    (strictly_increasing_comp_inc_inc H₃)

  theorem strictly_increasing_comp_iff_strictly_decreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
    strictly_increasing (g ∘ f) ↔ strictly_decreasing f :=
  have H₃ : strictly_decreasing g, from strictly_decreasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_decreasing_of_strictly_increasing_comp_right H₁ H₂)
    (strictly_increasing_comp_dec_dec H₃)

  theorem strictly_decreasing_comp_iff_strictly_decreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
    strictly_decreasing (g ∘ f) ↔ strictly_decreasing f :=
  have H₃ : strictly_increasing g, from strictly_increasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_decreasing_of_strictly_decreasing_comp_right H₁ H₂)
    (strictly_decreasing_comp_inc_dec H₃)

  theorem strictly_decreasing_comp_iff_strictly_increasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
    strictly_decreasing (g ∘ f) ↔ strictly_increasing f :=
  have H₃ : strictly_decreasing g, from strictly_decreasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_increasing_of_strictly_decreasing_comp_right H₁ H₂)
    (strictly_decreasing_comp_dec_inc H₃)
end

section
  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [strict_order C]

  theorem strictly_increasing_comp_iff_strinctly_increasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
    strictly_increasing (g ∘ f) ↔ strictly_increasing g :=
  have H₃ : strictly_increasing h, from strictly_increasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_increasing_of_strictly_increasing_comp_left H₁ H₃)
    (λ H, strictly_increasing_comp_inc_inc H H₂)

  theorem strictly_increasing_comp_iff_strictly_decreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
    strictly_increasing (g ∘ f) ↔ strictly_decreasing g :=
  have H₃ : strictly_decreasing h, from strictly_decreasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_decreasing_of_strictly_increasing_comp_left H₁ H₃)
    (λ H, strictly_increasing_comp_dec_dec H H₂)

  theorem strictly_decreasing_comp_iff_strictly_increasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
    strictly_decreasing (g ∘ f) ↔ strictly_increasing g :=
  have H₃ : strictly_decreasing h, from strictly_decreasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_increasing_of_strictly_decreasing_comp_left H₁ H₃)
    (λ H, strictly_decreasing_comp_inc_dec H H₂)

  theorem strictly_decreasing_comp_iff_strictly_decreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
    strictly_decreasing (g ∘ f) ↔ strictly_decreasing g :=
  have H₃ : strictly_increasing h, from strictly_increasing_of_left_inverse H₁ H₂,
  iff.intro
    (strictly_decreasing_of_strictly_decreasing_comp_left H₁ H₃)
    (λ H, strictly_decreasing_comp_dec_inc H H₂)
end

/- composition rules for weak orders -/

section
  variables [weak_order A] [weak_order B] [weak_order C]

  theorem nondecreasing_of_nondecreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : nondecreasing h) (H₃ : nondecreasing (g ∘ f)) :
    nondecreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have h (g (f a₁)) ≤ h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ ≤ f a₂, by rewrite *H₁ at this; apply this

  theorem nonincreasing_of_nondecreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : nonincreasing h) (H₃ : nondecreasing (g ∘ f)) :
    nonincreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have h (g (f a₁)) ≥ h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ ≥ f a₂, by rewrite *H₁ at this; apply this

  theorem nonincreasing_of_nonincreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : nondecreasing h) (H₃ : nonincreasing (g ∘ f)) :
    nonincreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have h (g (f a₁)) ≥ h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ ≥ f a₂, by rewrite *H₁ at this; apply this

  theorem nondecreasing_of_nonincreasing_comp_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : nonincreasing h) (H₃ : nonincreasing (g ∘ f)) :
    nondecreasing f :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have h (g (f a₁)) ≤ h (g (f a₂)), from H₂ (H₃ this),
  show f a₁ ≤ f a₂, by rewrite *H₁ at this; apply this

  theorem nondecreasing_of_nondecreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : nondecreasing h) (H₃ : nondecreasing (g ∘ f)) :
    nondecreasing g :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have g (f (h a₁)) ≤ g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ ≤ g a₂, by rewrite *H₁ at this; apply this

  theorem nonincreasing_of_nondecreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : nonincreasing h) (H₃ : nondecreasing (g ∘ f)) :
    nonincreasing g :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have g (f (h a₁)) ≥ g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ ≥ g a₂, by rewrite *H₁ at this; apply this

  theorem nondecreasing_of_nonincreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : nonincreasing h) (H₃ : nonincreasing (g ∘ f)) :
    nondecreasing g :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have g (f (h a₁)) ≤ g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ ≤ g a₂, by rewrite *H₁ at this; apply this

  theorem nonincreasing_of_nonincreasing_comp_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : nondecreasing h) (H₃ : nonincreasing (g ∘ f)) :
    nonincreasing g :=
  take a₁ a₂, suppose a₁ ≤ a₂,
  have g (f (h a₁)) ≥ g (f (h a₂)), from H₃ (H₂ this),
  show g a₁ ≥ g a₂, by rewrite *H₁ at this; apply this
end

section
  variables [weak_order A] [linear_strong_order_pair B] [linear_strong_order_pair C]

  theorem nondecreasing_comp_iff_nondecreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
    nondecreasing (g ∘ f) ↔ nondecreasing f :=
  have H₃ : nondecreasing g, from nondecreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nondecreasing_of_nondecreasing_comp_right H₁ (nondecreasing_of_strictly_increasing H₂))
    (nondecreasing_comp_nondec_nondec H₃)

  theorem nondecreasing_comp_iff_nonincreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
    nondecreasing (g ∘ f) ↔ nonincreasing f :=
  have H₃ : nonincreasing g, from nonincreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nonincreasing_of_nondecreasing_comp_right H₁ (nonincreasing_of_strictly_decreasing H₂))
    (nondecreasing_comp_noninc_noninc H₃)

  theorem nonincreasing_comp_iff_nonincreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_increasing h) :
    nonincreasing (g ∘ f) ↔ nonincreasing f :=
  have H₃ : nondecreasing g, from nondecreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nonincreasing_of_nonincreasing_comp_right H₁ (nondecreasing_of_strictly_increasing H₂))
    (nonincreasing_comp_nondec_noninc H₃)

  theorem nonincreasing_comp_iff_nondecreasing_right {g : B → C} {f : A → B} {h : C → B}
      (H₁ : left_inverse h g) (H₂ : strictly_decreasing h) :
    nonincreasing (g ∘ f) ↔ nondecreasing f :=
  have H₃ : nonincreasing g, from nonincreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nondecreasing_of_nonincreasing_comp_right H₁ (nonincreasing_of_strictly_decreasing H₂))
    (nonincreasing_comp_noninc_nondec H₃)
end

section
  variables [linear_strong_order_pair A] [linear_strong_order_pair B] [weak_order C]

  theorem nondecreasing_comp_iff_nondecreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
    nondecreasing (g ∘ f) ↔ nondecreasing g :=
  have H₃ : nondecreasing h, from nondecreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nondecreasing_of_nondecreasing_comp_left H₁ H₃)
    (λ H, nondecreasing_comp_nondec_nondec H (nondecreasing_of_strictly_increasing H₂))

  theorem nondecreasing_comp_iff_nonincreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
    nondecreasing (g ∘ f) ↔ nonincreasing g :=
  have H₃ : nonincreasing h, from nonincreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nonincreasing_of_nondecreasing_comp_left H₁ H₃)
    (λ H, nondecreasing_comp_noninc_noninc H (nonincreasing_of_strictly_decreasing H₂))

  theorem nonincreasing_comp_iff_nondecreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_decreasing f) :
    nonincreasing (g ∘ f) ↔ nondecreasing g :=
  have H₃ : nonincreasing h, from nonincreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nondecreasing_of_nonincreasing_comp_left H₁ H₃)
    (λ H, nonincreasing_comp_nondec_noninc H (nonincreasing_of_strictly_decreasing H₂))

  theorem nonincreasing_comp_iff_nonincreasing_left {g : B → C} {f : A → B} {h : B → A}
      (H₁ : left_inverse f h) (H₂ : strictly_increasing f) :
    nonincreasing (g ∘ f) ↔ nonincreasing g :=
  have H₃ : nondecreasing h, from nondecreasing_of_left_inverse H₁ H₂,
  iff.intro
    (nonincreasing_of_nonincreasing_comp_left H₁ H₃)
    (λ H, nonincreasing_comp_noninc_nondec H (nondecreasing_of_strictly_increasing H₂))
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad
-/
import data.finset.basic
import tactic.by_contra

/-!
# Cardinality of a finite set

This defines the cardinality of a `finset` and provides induction principles for finsets.

## Main declarations

* `finset.card`: `s.card : ℕ` returns the cardinality of `s : finset α`.

### Induction principles

* `finset.strong_induction`: Strong induction
* `finset.strong_induction_on`
* `finset.strong_downward_induction`
* `finset.strong_downward_induction_on`
* `finset.case_strong_induction_on`

## TODO

Should we add a noncomputable version?
-/

open function multiset nat

variables {α β : Type*}

namespace finset
variables {s t : finset α} {a b : α}

/-- `s.card` is the number of elements of `s`, aka its cardinality. -/
def card (s : finset α) : ℕ := s.1.card

lemma card_def (s : finset α) : s.card = s.1.card := rfl

@[simp] lemma card_mk {m nodup} : (⟨m, nodup⟩ : finset α).card = m.card := rfl

@[simp] lemma card_empty : card (∅ : finset α) = 0 := rfl

lemma card_le_of_subset : s ⊆ t → s.card ≤ t.card := multiset.card_le_of_le ∘ val_le_iff.mpr

@[mono] lemma card_mono : monotone (@card α) := by apply card_le_of_subset

@[simp] lemma card_eq_zero : s.card = 0 ↔ s = ∅ := card_eq_zero.trans val_eq_zero

lemma card_pos : 0 < s.card ↔ s.nonempty :=
pos_iff_ne_zero.trans $ (not_congr card_eq_zero).trans nonempty_iff_ne_empty.symm

alias card_pos ↔ _ nonempty.card_pos

lemma card_ne_zero_of_mem (h : a ∈ s) : s.card ≠ 0 := (not_congr card_eq_zero).2 $ ne_empty_of_mem h

@[simp] lemma card_singleton (a : α) : card ({a} : finset α) = 1 := card_singleton _

lemma card_singleton_inter [decidable_eq α] : ({a} ∩ s).card ≤ 1 :=
begin
  cases (finset.decidable_mem a s),
  { simp [finset.singleton_inter_of_not_mem h] },
  { simp [finset.singleton_inter_of_mem h] }
end

@[simp] lemma card_cons (h : a ∉ s) : (s.cons a h).card = s.card + 1 := card_cons _ _

section insert_erase
variables [decidable_eq α]

@[simp] lemma card_insert_of_not_mem (h : a ∉ s) : (insert a s).card = s.card + 1 :=
by rw [←cons_eq_insert _ _ h, card_cons]

lemma card_insert_of_mem (h : a ∈ s) : card (insert a s) = s.card := by rw insert_eq_of_mem h

lemma card_insert_le (a : α) (s : finset α) : card (insert a s) ≤ s.card + 1 :=
by by_cases a ∈ s; [{rw insert_eq_of_mem h, exact nat.le_succ _ }, rw card_insert_of_not_mem h]

/-- If `a ∈ s` is known, see also `finset.card_insert_of_mem` and `finset.card_insert_of_not_mem`.
-/
lemma card_insert_eq_ite : card (insert a s) = if a ∈ s then s.card else s.card + 1 :=
begin
  by_cases h : a ∈ s,
  { rw [card_insert_of_mem h, if_pos h] },
  { rw [card_insert_of_not_mem h, if_neg h] }
end

@[simp] lemma card_doubleton (h : a ≠ b) : ({a, b} : finset α).card = 2 :=
by rw [card_insert_of_not_mem (not_mem_singleton.2 h), card_singleton]

@[simp] lemma card_erase_of_mem : a ∈ s → (s.erase a).card = s.card - 1 := card_erase_of_mem
@[simp] lemma card_erase_add_one : a ∈ s → (s.erase a).card + 1 = s.card := card_erase_add_one

lemma card_erase_lt_of_mem : a ∈ s → (s.erase a).card < s.card := card_erase_lt_of_mem

lemma card_erase_le : (s.erase a).card ≤ s.card := card_erase_le

lemma pred_card_le_card_erase : s.card - 1 ≤ (s.erase a).card :=
begin
  by_cases h : a ∈ s,
  { exact (card_erase_of_mem h).ge },
  { rw erase_eq_of_not_mem h,
    exact nat.sub_le _ _ }
end

/-- If `a ∈ s` is known, see also `finset.card_erase_of_mem` and `finset.erase_eq_of_not_mem`. -/
lemma card_erase_eq_ite : (s.erase a).card = if a ∈ s then s.card - 1 else s.card :=
card_erase_eq_ite

end insert_erase

@[simp] lemma card_range (n : ℕ) : (range n).card = n := card_range n

@[simp] lemma card_attach : s.attach.card = s.card := multiset.card_attach

end finset

section to_list_multiset
variables [decidable_eq α] (m : multiset α) (l : list α)

lemma multiset.card_to_finset : m.to_finset.card = m.dedup.card := rfl

lemma multiset.to_finset_card_le : m.to_finset.card ≤ m.card := card_le_of_le $ dedup_le _

lemma multiset.to_finset_card_of_nodup {m : multiset α} (h : m.nodup) : m.to_finset.card = m.card :=
congr_arg card $ multiset.dedup_eq_self.mpr h

lemma list.card_to_finset : l.to_finset.card = l.dedup.length := rfl

lemma list.to_finset_card_le : l.to_finset.card ≤ l.length := multiset.to_finset_card_le ⟦l⟧

lemma list.to_finset_card_of_nodup {l : list α} (h : l.nodup) : l.to_finset.card = l.length :=
multiset.to_finset_card_of_nodup h

end to_list_multiset

namespace finset
variables {s t : finset α} {f : α → β} {n : ℕ}

@[simp] lemma length_to_list (s : finset α) : s.to_list.length = s.card :=
by { rw [to_list, ←multiset.coe_card, multiset.coe_to_list], refl }

lemma card_image_le [decidable_eq β] : (s.image f).card ≤ s.card :=
by simpa only [card_map] using (s.1.map f).to_finset_card_le

lemma card_image_of_inj_on [decidable_eq β] (H : set.inj_on f s) : (s.image f).card = s.card :=
by simp only [card, image_val_of_inj_on H, card_map]

lemma inj_on_of_card_image_eq [decidable_eq β] (H : (s.image f).card = s.card) : set.inj_on f s :=
begin
  change (s.1.map f).dedup.card = s.1.card at H,
  have : (s.1.map f).dedup = s.1.map f,
  { refine multiset.eq_of_le_of_card_le (multiset.dedup_le _) _,
    rw H,
    simp only [multiset.card_map] },
  rw multiset.dedup_eq_self at this,
  exact inj_on_of_nodup_map this,
end

lemma card_image_iff [decidable_eq β] : (s.image f).card = s.card ↔ set.inj_on f s :=
⟨inj_on_of_card_image_eq, card_image_of_inj_on⟩

lemma card_image_of_injective [decidable_eq β] (s : finset α) (H : injective f) :
  (s.image f).card = s.card :=
card_image_of_inj_on $ λ x _ y _ h, H h

lemma fiber_card_ne_zero_iff_mem_image (s : finset α) (f : α → β) [decidable_eq β] (y : β) :
  (s.filter (λ x, f x = y)).card ≠ 0 ↔ y ∈ s.image f :=
by { rw [←pos_iff_ne_zero, card_pos, fiber_nonempty_iff_mem_image] }

@[simp] lemma card_map (f : α ↪ β) : (s.map f).card = s.card := multiset.card_map _ _

@[simp] lemma card_subtype (p : α → Prop) [decidable_pred p] (s : finset α) :
  (s.subtype p).card = (s.filter p).card :=
by simp [finset.subtype]

lemma card_filter_le (s : finset α) (p : α → Prop) [decidable_pred p] :
  (s.filter p).card ≤ s.card :=
card_le_of_subset $ filter_subset _ _

lemma eq_of_subset_of_card_le {s t : finset α} (h : s ⊆ t) (h₂ : t.card ≤ s.card) : s = t :=
eq_of_veq $ multiset.eq_of_le_of_card_le (val_le_iff.mpr h) h₂

lemma map_eq_of_subset {f : α ↪ α} (hs : s.map f ⊆ s) : s.map f = s :=
eq_of_subset_of_card_le hs (card_map _).ge

lemma filter_card_eq {p : α → Prop} [decidable_pred p] (h : (s.filter p).card = s.card) (x : α)
  (hx : x ∈ s) :
  p x :=
begin
  rw [←eq_of_subset_of_card_le (s.filter_subset p) h.ge, mem_filter] at hx,
  exact hx.2,
end

lemma card_lt_card (h : s ⊂ t) : s.card < t.card := card_lt_of_lt $ val_lt_iff.2 h

lemma card_eq_of_bijective (f : ∀ i, i < n → α) (hf : ∀ a ∈ s, ∃ i, ∃ h : i < n, f i h = a)
  (hf' : ∀ i (h : i < n), f i h ∈ s) (f_inj : ∀ i j (hi : i < n)
  (hj : j < n), f i hi = f j hj → i = j) :
  s.card = n :=
begin
  classical,
  have : ∀ (a : α), a ∈ s ↔ ∃ i (hi : i ∈ range n), f i (mem_range.1 hi) = a,
    from λ a, ⟨λ ha, let ⟨i, hi, eq⟩ := hf a ha in ⟨i, mem_range.2 hi, eq⟩,
      λ ⟨i, hi, eq⟩, eq ▸ hf' i (mem_range.1 hi)⟩,
  have : s = ((range n).attach.image $ λi, f i.1 (mem_range.1 i.2)),
    by simpa only [ext_iff, mem_image, exists_prop, subtype.exists, mem_attach, true_and],
  calc s.card = card ((range n).attach.image $ λ i, f i.1 (mem_range.1 i.2)) :
      by rw this
    ... = card ((range n).attach) :
      card_image_of_injective _ $ λ ⟨i, hi⟩ ⟨j, hj⟩ eq,
        subtype.eq $ f_inj i j (mem_range.1 hi) (mem_range.1 hj) eq
    ... = card (range n) : card_attach
    ... = n : card_range n
end

lemma card_congr {t : finset β} (f : Π a ∈ s, β) (h₁ : ∀ a ha, f a ha ∈ t)
  (h₂ : ∀ a b ha hb, f a ha = f b hb → a = b) (h₃ : ∀ b ∈ t, ∃ a ha, f a ha = b) :
  s.card = t.card :=
by classical;
calc s.card = s.attach.card : card_attach.symm
... = (s.attach.image (λ (a : {a // a ∈ s}), f a.1 a.2)).card
    : eq.symm (card_image_of_injective _ $ λ a b h, subtype.eq $ h₂ _ _ _ _ h)
... = t.card : congr_arg card (finset.ext $ λ b,
    ⟨λ h, let ⟨a, ha₁, ha₂⟩ := mem_image.1 h in ha₂ ▸ h₁ _ _,
      λ h, let ⟨a, ha₁, ha₂⟩ := h₃ b h in mem_image.2 ⟨⟨a, ha₁⟩, by simp [ha₂]⟩⟩)

lemma card_le_card_of_inj_on {t : finset β} (f : α → β) (hf : ∀ a ∈ s, f a ∈ t)
  (f_inj : ∀ a₁ ∈ s, ∀ a₂ ∈ s, f a₁ = f a₂ → a₁ = a₂) :
  s.card ≤ t.card :=
by classical;
  calc s.card = (s.image f).card : (card_image_of_inj_on f_inj).symm
    ... ≤ t.card : card_le_of_subset $ image_subset_iff.2 hf

/-- If there are more pigeons than pigeonholes, then there are two pigeons in the same pigeonhole.
-/
lemma exists_ne_map_eq_of_card_lt_of_maps_to {t : finset β} (hc : t.card < s.card)
  {f : α → β} (hf : ∀ a ∈ s, f a ∈ t) :
  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
begin
  classical,
  by_contra' hz,
  refine hc.not_le (card_le_card_of_inj_on f hf _),
  intros x hx y hy, contrapose, exact hz x hx y hy,
end

lemma le_card_of_inj_on_range (f : ℕ → α) (hf : ∀ i < n, f i ∈ s)
  (f_inj : ∀ (i < n) (j < n), f i = f j → i = j) :
  n ≤ s.card :=
calc n = card (range n) : (card_range n).symm
  ... ≤ s.card : card_le_card_of_inj_on f (by simpa only [mem_range]) (by simpa only [mem_range])

lemma surj_on_of_inj_on_of_card_le {t : finset β} (f : Π a ∈ s, β) (hf : ∀ a ha, f a ha ∈ t)
  (hinj : ∀ a₁ a₂ ha₁ ha₂, f a₁ ha₁ = f a₂ ha₂ → a₁ = a₂) (hst : t.card ≤ s.card) :
  ∀ b ∈ t, ∃ a ha, b = f a ha :=
begin
  classical,
  intros b hb,
  have h : (s.attach.image $ λ (a : {a // a ∈ s}), f a a.prop).card = s.card,
  { exact @card_attach _ s ▸ card_image_of_injective _
      (λ ⟨a₁, ha₁⟩ ⟨a₂, ha₂⟩ h, subtype.eq $ hinj _ _ _ _ h) },
  have h' : image (λ a : {a // a ∈ s}, f a a.prop) s.attach = t,
  { exact eq_of_subset_of_card_le (λ b h, let ⟨a, ha₁, ha₂⟩ := mem_image.1 h in
      ha₂ ▸ hf _ _) (by simp [hst, h]) },
  rw ←h' at hb,
  obtain ⟨a, ha₁, ha₂⟩ := mem_image.1 hb,
  exact ⟨a, a.2, ha₂.symm⟩,
end

lemma inj_on_of_surj_on_of_card_le {t : finset β} (f : Π a ∈ s, β) (hf : ∀ a ha, f a ha ∈ t)
  (hsurj : ∀ b ∈ t, ∃ a ha, b = f a ha) (hst : s.card ≤ t.card) ⦃a₁ a₂⦄ (ha₁ : a₁ ∈ s)
  (ha₂ : a₂ ∈ s) (ha₁a₂: f a₁ ha₁ = f a₂ ha₂) :
  a₁ = a₂ :=
by haveI : inhabited {x // x ∈ s} := ⟨⟨a₁, ha₁⟩⟩; exact
let f' : {x // x ∈ s} → {x // x ∈ t} := λ x, ⟨f x.1 x.2, hf x.1 x.2⟩ in
let g : {x // x ∈ t} → {x // x ∈ s} :=
  @surj_inv _ _ f'
    (λ x, let ⟨y, hy₁, hy₂⟩ := hsurj x.1 x.2 in ⟨⟨y, hy₁⟩, subtype.eq hy₂.symm⟩) in
have hg : injective g, from injective_surj_inv _,
have hsg : surjective g, from λ x,
  let ⟨y, hy⟩ := surj_on_of_inj_on_of_card_le (λ (x : {x // x ∈ t}) (hx : x ∈ t.attach), g x)
    (λ x _, show (g x) ∈ s.attach, from mem_attach _ _)
    (λ x y _ _ hxy, hg hxy) (by simpa) x (mem_attach _ _) in
  ⟨y, hy.snd.symm⟩,
have hif : injective f',
  from (left_inverse_of_surjective_of_right_inverse hsg
      (right_inverse_surj_inv _)).injective,
subtype.ext_iff_val.1 (@hif ⟨a₁, ha₁⟩ ⟨a₂, ha₂⟩ (subtype.eq ha₁a₂))

@[simp] lemma card_disj_union (s t : finset α) (h) : (s.disj_union t h).card = s.card + t.card :=
multiset.card_add _ _

/-! ### Lattice structure -/

section lattice
variables [decidable_eq α]

lemma card_union_add_card_inter (s t : finset α) : (s ∪ t).card + (s ∩ t).card = s.card + t.card :=
finset.induction_on t (by simp) $ λ a r har, by by_cases a ∈ s; simp *; cc

lemma card_union_le (s t : finset α) : (s ∪ t).card ≤ s.card + t.card :=
card_union_add_card_inter s t ▸ nat.le_add_right _ _

lemma card_union_eq (h : disjoint s t) : (s ∪ t).card = s.card + t.card :=
by rw [←disj_union_eq_union s t $ disjoint_left.mp h, card_disj_union _ _ _]

@[simp] lemma card_disjoint_union (h : disjoint s t) : card (s ∪ t) = s.card + t.card :=
card_union_eq h

lemma card_sdiff (h : s ⊆ t) : card (t \ s) = t.card - s.card :=
suffices card (t \ s) = card ((t \ s) ∪ s) - s.card, by rwa sdiff_union_of_subset h at this,
by rw [card_disjoint_union sdiff_disjoint, add_tsub_cancel_right]

lemma card_sdiff_add_card_eq_card {s t : finset α} (h : s ⊆ t) : card (t \ s) + card s = card t :=
((nat.sub_eq_iff_eq_add (card_le_of_subset h)).mp (card_sdiff h).symm).symm

lemma le_card_sdiff (s t : finset α) : t.card - s.card ≤ card (t \ s) :=
calc card t - card s
      ≤ card t - card (s ∩ t) : tsub_le_tsub_left (card_le_of_subset (inter_subset_left s t)) _
  ... = card (t \ (s ∩ t)) : (card_sdiff (inter_subset_right s t)).symm
  ... ≤ card (t \ s) : by rw sdiff_inter_self_right t s

lemma card_sdiff_add_card : (s \ t).card + t.card = (s ∪ t).card :=
by rw [←card_disjoint_union sdiff_disjoint, sdiff_union_self_eq_union]

end lattice

lemma filter_card_add_filter_neg_card_eq_card (p : α → Prop) [decidable_pred p] :
  (s.filter p).card + (s.filter (not ∘ p)).card = s.card :=
by { classical, simp [←card_union_eq, filter_union_filter_neg_eq, disjoint_filter] }

/-- Given a set `A` and a set `B` inside it, we can shrink `A` to any appropriate size, and keep `B`
inside it. -/
lemma exists_intermediate_set {A B : finset α} (i : ℕ) (h₁ : i + card B ≤ card A) (h₂ : B ⊆ A) :
  ∃ (C : finset α), B ⊆ C ∧ C ⊆ A ∧ card C = i + card B :=
begin
  classical,
  rcases nat.le.dest h₁ with ⟨k, _⟩,
  clear h₁,
  induction k with k ih generalizing A,
  { exact ⟨A, h₂, subset.refl _, h.symm⟩ },
  have : (A \ B).nonempty,
  { rw [←card_pos, card_sdiff h₂, ←h, nat.add_right_comm,
        add_tsub_cancel_right, nat.add_succ],
    apply nat.succ_pos },
  rcases this with ⟨a, ha⟩,
  have z : i + card B + k = card (erase A a),
  { rw [card_erase_of_mem (mem_sdiff.1 ha).1, ←h],
    refl },
  rcases ih _ z with ⟨B', hB', B'subA', cards⟩,
  { exact ⟨B', hB', trans B'subA' (erase_subset _ _), cards⟩ },
  { rintro t th,
    apply mem_erase_of_ne_of_mem _ (h₂ th),
    rintro rfl,
    exact not_mem_sdiff_of_mem_right th ha }
end

/-- We can shrink `A` to any smaller size. -/
lemma exists_smaller_set (A : finset α) (i : ℕ) (h₁ : i ≤ card A) :
  ∃ (B : finset α), B ⊆ A ∧ card B = i :=
let ⟨B, _, x₁, x₂⟩ := exists_intermediate_set i (by simpa) (empty_subset A) in ⟨B, x₁, x₂⟩

lemma exists_subset_or_subset_of_two_mul_lt_card [decidable_eq α] {X Y : finset α} {n : ℕ}
  (hXY : 2 * n < (X ∪ Y).card) :
  ∃ C : finset α, n < C.card ∧ (C ⊆ X ∨ C ⊆ Y) :=
begin
  have h₁ : (X ∩ (Y \ X)).card = 0 := finset.card_eq_zero.mpr (finset.inter_sdiff_self X Y),
  have h₂ : (X ∪ Y).card = X.card + (Y \ X).card,
  { rw [←card_union_add_card_inter X (Y \ X), finset.union_sdiff_self_eq_union, h₁, add_zero] },
  rw [h₂, two_mul] at hXY,
  rcases lt_or_lt_of_add_lt_add hXY with h|h,
  { exact ⟨X, h, or.inl (finset.subset.refl X)⟩ },
  { exact ⟨Y \ X, h, or.inr (finset.sdiff_subset Y X)⟩ }
end

/-! ### Explicit description of a finset from its card -/

lemma card_eq_one : s.card = 1 ↔ ∃ a, s = {a} :=
by cases s; simp only [multiset.card_eq_one, finset.card, ←val_inj, singleton_val]

lemma exists_eq_insert_iff [decidable_eq α] {s t : finset α} :
  (∃ a ∉ s, insert a s = t) ↔ s ⊆ t ∧ s.card + 1 = t.card :=
begin
  split,
  { rintro ⟨a, ha, rfl⟩,
    exact ⟨subset_insert _ _, (card_insert_of_not_mem ha).symm⟩ },
  { rintro ⟨hst, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a},
    { exact card_eq_one.1 (by rw [card_sdiff hst, ←h, add_tsub_cancel_left]) },
    refine ⟨a, λ hs, (_ : a ∉ {a}) $ mem_singleton_self _,
      by rw [insert_eq, ←ha, sdiff_union_of_subset hst]⟩,
    rw ←ha,
    exact not_mem_sdiff_of_mem_right hs }
end

lemma card_le_one : s.card ≤ 1 ↔ ∀ (a ∈ s) (b ∈ s), a = b :=
begin
  obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty,
  { simp },
  refine (nat.succ_le_of_lt (card_pos.2 ⟨x, hx⟩)).le_iff_eq.trans (card_eq_one.trans ⟨_, _⟩),
  { rintro ⟨y, rfl⟩,
    simp },
  { exact λ h, ⟨x, eq_singleton_iff_unique_mem.2 ⟨hx, λ y hy, h _ hy _ hx⟩⟩ }
end

lemma card_le_one_iff : s.card ≤ 1 ↔ ∀ {a b}, a ∈ s → b ∈ s → a = b := by { rw card_le_one, tauto }

lemma card_le_one_iff_subset_singleton [nonempty α] : s.card ≤ 1 ↔ ∃ (x : α), s ⊆ {x} :=
begin
  refine ⟨λ H, _, _⟩,
  { obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty,
    { exact ⟨classical.arbitrary α, empty_subset _⟩ },
    { exact ⟨x, λ y hy, by rw [card_le_one.1 H y hy x hx, mem_singleton]⟩ } },
  { rintro ⟨x, hx⟩,
    rw ←card_singleton x,
    exact card_le_of_subset hx }
end

/-- A `finset` of a subsingleton type has cardinality at most one. -/
lemma card_le_one_of_subsingleton [subsingleton α] (s : finset α) : s.card ≤ 1 :=
finset.card_le_one_iff.2 $ λ _ _ _ _, subsingleton.elim _ _

lemma one_lt_card : 1 < s.card ↔ ∃ (a ∈ s) (b ∈ s), a ≠ b :=
by { rw ←not_iff_not, push_neg, exact card_le_one }

lemma one_lt_card_iff : 1 < s.card ↔ ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
by { rw one_lt_card, simp only [exists_prop, exists_and_distrib_left] }

lemma two_lt_card_iff : 2 < s.card ↔ ∃ a b c, a ∈ s ∧ b ∈ s ∧ c ∈ s ∧ a ≠ b ∧ a ≠ c ∧ b ≠ c :=
begin
  classical,
  refine ⟨λ h, _, _⟩,
  { obtain ⟨c, hc⟩ := card_pos.mp (zero_lt_two.trans h),
    have : 1 < (s.erase c).card := by rwa [←add_lt_add_iff_right 1, card_erase_add_one hc],
    obtain ⟨a, b, ha, hb, hab⟩ := one_lt_card_iff.mp this,
    exact ⟨a, b, c, mem_of_mem_erase ha, mem_of_mem_erase hb, hc,
      hab, ne_of_mem_erase ha, ne_of_mem_erase hb⟩ },
  { rintros ⟨a, b, c, ha, hb, hc, hab, hac, hbc⟩,
    rw [←card_erase_add_one hc, ←card_erase_add_one (mem_erase_of_ne_of_mem hbc hb),
        ←card_erase_add_one (mem_erase_of_ne_of_mem hab (mem_erase_of_ne_of_mem hac ha))],
    apply nat.le_add_left },
end

lemma two_lt_card : 2 < s.card ↔ ∃ (a ∈ s) (b ∈ s) (c ∈ s), a ≠ b ∧ a ≠ c ∧ b ≠ c :=
by simp_rw [two_lt_card_iff, exists_prop, exists_and_distrib_left]

lemma exists_ne_of_one_lt_card (hs : 1 < s.card) (a : α) : ∃ b, b ∈ s ∧ b ≠ a :=
begin
  obtain ⟨x, hx, y, hy, hxy⟩ := finset.one_lt_card.mp hs,
  by_cases ha : y = a,
  { exact ⟨x, hx, ne_of_ne_of_eq hxy ha⟩ },
  { exact ⟨y, hy, ha⟩ }
end

lemma card_eq_succ [decidable_eq α] : s.card = n + 1 ↔ ∃ a t, a ∉ t ∧ insert a t = s ∧ t.card = n :=
⟨λ h,
  let ⟨a, has⟩ := card_pos.mp (h.symm ▸ nat.zero_lt_succ _ : 0 < s.card) in
    ⟨a, s.erase a, s.not_mem_erase a, insert_erase has,
      by simp only [h, card_erase_of_mem has, add_tsub_cancel_right]⟩,
  λ ⟨a, t, hat, s_eq, n_eq⟩, s_eq ▸ n_eq ▸ card_insert_of_not_mem hat⟩

lemma card_eq_two [decidable_eq α] : s.card = 2 ↔ ∃ x y, x ≠ y ∧ s = {x, y} :=
begin
  split,
  { rw card_eq_succ,
    simp_rw [card_eq_one],
    rintro ⟨a, _, hab, rfl, b, rfl⟩,
    exact ⟨a, b, not_mem_singleton.1 hab, rfl⟩ },
  { rintro ⟨x, y, h, rfl⟩,
    exact card_doubleton h }
end

lemma card_eq_three [decidable_eq α] :
  s.card = 3 ↔ ∃ x y z, x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ s = {x, y, z} :=
begin
  split,
  { rw card_eq_succ,
    simp_rw [card_eq_two],
    rintro ⟨a, _, abc, rfl, b, c, bc, rfl⟩,
    rw [mem_insert, mem_singleton, not_or_distrib] at abc,
    exact ⟨a, b, c, abc.1, abc.2, bc, rfl⟩ },
  { rintro ⟨x, y, z, xy, xz, yz, rfl⟩,
    simp only [xy, xz, yz, mem_insert, card_insert_of_not_mem, not_false_iff, mem_singleton,
      or_self, card_singleton] }
end

/-! ### Inductions -/

/-- Suppose that, given objects defined on all strict subsets of any finset `s`, one knows how to
define an object on `s`. Then one can inductively define an object on all finsets, starting from
the empty set and iterating. This can be used either to define data, or to prove properties. -/
def strong_induction {p : finset α → Sort*} (H : ∀ s, (∀ t ⊂ s, p t) → p s) :
  ∀ (s : finset α), p s
| s := H s (λ t h, have t.card < s.card, from card_lt_card h, strong_induction t)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf card⟩]}

lemma strong_induction_eq {p : finset α → Sort*} (H : ∀ s, (∀ t ⊂ s, p t) → p s) (s : finset α) :
  strong_induction H s = H s (λ t h, strong_induction H t) :=
by rw strong_induction

/-- Analogue of `strong_induction` with order of arguments swapped. -/
@[elab_as_eliminator] def strong_induction_on {p : finset α → Sort*} (s : finset α) :
  (∀ s, (∀ t ⊂ s, p t) → p s) → p s :=
λ H, strong_induction H s

lemma strong_induction_on_eq {p : finset α → Sort*} (s : finset α) (H : ∀ s, (∀ t ⊂ s, p t) → p s) :
  s.strong_induction_on H = H s (λ t h, t.strong_induction_on H) :=
by { dunfold strong_induction_on, rw strong_induction }

@[elab_as_eliminator] lemma case_strong_induction_on [decidable_eq α] {p : finset α → Prop}
  (s : finset α) (h₀ : p ∅) (h₁ : ∀ a s, a ∉ s → (∀ t ⊆ s, p t) → p (insert a s)) :
  p s :=
finset.strong_induction_on s $ λ s,
finset.induction_on s (λ _, h₀) $ λ a s n _ ih, h₁ a s n $
λ t ss, ih _ (lt_of_le_of_lt ss (ssubset_insert n) : t < _)

/-- Suppose that, given that `p t` can be defined on all supersets of `s` of cardinality less than
`n`, one knows how to define `p s`. Then one can inductively define `p s` for all finsets `s` of
cardinality less than `n`, starting from finsets of card `n` and iterating. This
can be used either to define data, or to prove properties. -/
def strong_downward_induction {p : finset α → Sort*} {n : ℕ} (H : ∀ t₁, (∀ {t₂ : finset α},
  t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  ∀ (s : finset α), s.card ≤ n → p s
| s := H s (λ t ht h, have n - t.card < n - s.card,
     from (tsub_lt_tsub_iff_left_of_le ht).2 (finset.card_lt_card h),
  strong_downward_induction t ht)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ (t : finset α), n - t.card)⟩]}

lemma strong_downward_induction_eq {p : finset α → Sort*}
  (H : ∀ t₁, (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁)
  (s : finset α) :
  strong_downward_induction H s = H s (λ t ht hst, strong_downward_induction H t ht) :=
by rw strong_downward_induction

/-- Analogue of `strong_downward_induction` with order of arguments swapped. -/
@[elab_as_eliminator] def strong_downward_induction_on {p : finset α → Sort*} (s : finset α)
  (H : ∀ t₁, (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  s.card ≤ n → p s :=
strong_downward_induction H s

lemma strong_downward_induction_on_eq {p : finset α → Sort*} (s : finset α) (H : ∀ t₁,
  (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  s.strong_downward_induction_on H = H s (λ t ht h, t.strong_downward_induction_on H ht) :=
by { dunfold strong_downward_induction_on, rw strong_downward_induction }

lemma lt_wf {α} : well_founded (@has_lt.lt (finset α) _) :=
have H : subrelation (@has_lt.lt (finset α) _)
    (inv_image ( < ) card),
  from λ x y hxy, card_lt_card hxy,
subrelation.wf H $ inv_image.wf _ $ nat.lt_wf

end finset


import data.real.basic
#check le_antisymm

-- BEGIN
example {x y : ℝ} (h : x ≤ y ∧ x ≠ y) : ¬ y ≤ x :=
begin
  cases h with h₀ h₁,
  sorry,
end

/- you will see that by_contra h' is equivalent to intro h' -/
example {x y : ℝ} : x ≤ y ∧ x ≠ y → ¬ y ≤ x :=
begin
  intro h,
  cases h with h₀ h₁,
  intro h',
  exact h₁ (le_antisymm h₀ h'),
end

/- using rcases instead of intros and cases -/
example {x y : ℝ} : x ≤ y ∧ x ≠ y → ¬ y ≤ x :=
begin
  rintros ⟨h₀, h₁⟩ h',
  exact h₁ (le_antisymm h₀ h'),
end

/- using λ abstraction -/
example {x y : ℝ} : x ≤ y ∧ x ≠ y → ¬ y ≤ x :=
λ ⟨h₀, h₁⟩ h', h₁ (le_antisymm h₀ h')

-- END


/-
Copyright (c) 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/
import topology.homeomorph

/-!
# Topological space structure on the opposite monoid and on the units group

In this file we define `topological_space` structure on `Mᵐᵒᵖ`, `Mᵃᵒᵖ`, `Mˣ`, and `add_units M`.
This file does not import definitions of a topological monoid and/or a continuous multiplicative
action, so we postpone the proofs of `has_continuous_mul Mᵐᵒᵖ` etc till we have these definitions.

## Tags

topological space, opposite monoid, units
-/

variables {M X : Type*}

open filter
open_locale topological_space

namespace mul_opposite

/-- Put the same topological space structure on the opposite monoid as on the original space. -/
@[to_additive] instance [topological_space M] : topological_space Mᵐᵒᵖ :=
topological_space.induced (unop : Mᵐᵒᵖ → M) ‹_›

variables [topological_space M]

@[continuity, to_additive] lemma continuous_unop : continuous (unop : Mᵐᵒᵖ → M) :=
continuous_induced_dom

@[continuity, to_additive] lemma continuous_op : continuous (op : M → Mᵐᵒᵖ) :=
continuous_induced_rng continuous_id

/-- `mul_opposite.op` as a homeomorphism. -/
@[to_additive "`add_opposite.op` as a homeomorphism."]
def op_homeomorph : M ≃ₜ Mᵐᵒᵖ :=
{ to_equiv := op_equiv,
  continuous_to_fun := continuous_op,
  continuous_inv_fun := continuous_unop }

@[simp, to_additive] lemma map_op_nhds (x : M) : map (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (op x) :=
op_homeomorph.map_nhds_eq x

@[simp, to_additive] lemma map_unop_nhds (x : Mᵐᵒᵖ) : map (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.symm.map_nhds_eq x

@[simp, to_additive] lemma comap_op_nhds (x : Mᵐᵒᵖ) : comap (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.comap_nhds_eq x

@[simp, to_additive]

end mul_opposite

namespace units

open mul_opposite

variables [topological_space M] [monoid M]

/-- The units of a monoid are equipped with a topology, via the embedding into `M × M`. -/
@[to_additive] instance : topological_space Mˣ :=
topological_space.induced (embed_product M) prod.topological_space

@[to_additive] lemma continuous_embed_product : continuous (embed_product M) :=
continuous_induced_dom

@[to_additive] lemma continuous_coe : continuous (coe : Mˣ → M) :=
(@continuous_embed_product M _ _).fst

end units


/- LoVe Exercise 4: Functional Programming -/

import .love04_functional_programming_demo

namespace LoVe

/- Question 1: Reverse of a List -/

/- We define a new accumulator-based version of `reverse`. The first argument
serves as the accumulator. This definition is _tail-recursive_, meaning that
compilers and interpreters can easily optimize the recursion away, resulting in
more efficient code. -/

def areverse {α : Type} : list α → list α → list α
| ys []        := ys
| ys (x :: xs) := areverse (x :: ys) xs

/- 1.1. Our intention is that `areverse [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using pattern
matching or the `induction` tactic): -/

lemma areverse_eq_reverse_append {α : Type} :
  ∀ys xs : list α, areverse ys xs = reverse xs ++ ys
:= sorry

/- 1.2. Derive the desired equation. -/

lemma areverse_eq_reverse {α : Type} (xs : list α) :
  areverse [] xs = reverse xs :=
sorry

/- 1.3. Prove the following property. Hint: A one-line inductionless proof is
 possible. -/

lemma areverse_areverse {α : Type} (xs : list α) :
  areverse [] (areverse [] xs) = xs :=
sorry

/- Question 2: Drop and Take -/

/- The `drop` function removes the first `n` elements from the front of a
list. -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

/- Its relative `take` returns a list consisting of the the first `n` elements
at the front of a list. -/

/- 2.1. Define `take`. -/

/- To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

def take {α : Type} : ℕ → list α → list α
:= sorry

#reduce take 0 [3, 7, 11]  -- expected: []
#reduce take 1 [3, 7, 11]  -- expected: [3]
#reduce take 2 [3, 7, 11]  -- expected: [3, 7]
#reduce take 3 [3, 7, 11]  -- expected: [3, 7, 11]
#reduce take 4 [3, 7, 11]  -- expected: [3, 7, 11]

-- when `#reduce` fails for some obscure reason, try `#eval`:
#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/- 2.2. Prove the following lemmas. Notice that they are registered as
simplification rules thanks to the `@[simp]` attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = []
:= sorry

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = []
:= sorry

/- 2.3. Follow the recursion pattern of `drop` and `take` to prove the following
lemmas. In other words, for each lemma, there should be three cases, and the
third case will need to invoke the induction hypothesis.

The first case is shown for `drop_drop`. Beware of the fact that there are three
variables in the `drop_drop` lemma (but only two arguments to `drop`).

Hint: The `refl` tactic might be useful in the third case of `drop_drop`. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
-- supply the two missing cases here

lemma take_take {α : Type} :
  ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
:= sorry

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
:= sorry

/- Question 3: λ-Terms -/

/- 3.1. Define an inductive type corresponding to the untyled λ-terms, as given
by the following context-free grammar:

<lam> ::= 'var' <string>
        | 'abs' <string> <lam>
        | 'app' <lam> <lam> -/

-- enter your definition here

/- 3.2. Register a textual representation of the type `lam`. Make sure to supply
enough parentheses to guarantee that the output is unambiguous. -/

def lam.repr : lam → string
-- enter your answer here

instance : has_repr lam :=
⟨lam.repr⟩

/- Question 4 (**optional**): Concatenation -/

/- Consider the following Lean definition of 2–3 trees as an inductive type: -/

inductive tttree (α : Type) : Type
| empty {} : tttree
| bin      : α → tttree → tttree → tttree
| ter      : α → tttree → tttree → tttree → tttree

export tttree (empty bin ter)

/- 4.1 (**optional**). Complete the following Lean definition. The `map_tree`
function should apply its argument `f` to all values of type α stored in the
tree and otherwise preserve the tree's structure. -/

-- enter your definition here

/- 4.2 (**optional**). Prove the following lemma about your definition of
`map_tree`. -/

lemma map_tttree_id {α : Type} :
  ∀t : tttree α, map_tttree (λx : α, x) t = t
:= sorry

/- 4.3 (**optional**). Complete the following Lean definition. The `set_tree`
function should return the set of all values of type α stored in the tree. In
your answer, you may use traditional set notations regardless of whether they
are actually supported by Lean. -/

def set_tttree {α : Type} : tttree α → set α
:= sorry

/- A _congruence rule_ is a lemma that can be used to lift an equivalence
relation between terms to the same terms occurring under a common context.
Congruence rules for equality are built into Lean's logic. In the following
example, the equivalence relation is `=`, the terms are `f` and `g`, and the
context is `map_tree … t`: -/

lemma map_tttree_congr_weak {α β : Type} (f g : α → β) (f = g) (t : tttree α) :
  map_tttree f t = map_tttree g t :=
by simp *

/- 4.4 (**optional**). The above rule is not as flexible as it could be,
because it requires `f = g`. As long as `f` and `g` are equal for all values
`x : α` stored in `t`, we have `map_tree f t = map_tree g t`, even if `f` and
`g` disagree on other `α` values. Inspired by this observation, prove the
following stronger congruence rule. -/

lemma map_tttree_congr_strong {α β : Type} (f g : α → β) :
  ∀t : tttree α, (∀x, x ∈ set_tttree t → f x = g x) →
  map_tttree f t = map_tttree g t
:= sorry

end LoVe


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa, Junyan Xu
-/
import data.dfinsupp.order
import data.dfinsupp.ne_locus
import order.well_founded_set

/-!
# Lexicographic order on finitely supported dependent functions

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

This file defines the lexicographic order on `dfinsupp`.
-/

variables {ι : Type*} {α : ι → Type*}

namespace dfinsupp

section has_zero

variable [Π i, has_zero (α i)]

/-- `dfinsupp.lex r s` is the lexicographic relation on `Π₀ i, α i`, where `ι` is ordered by `r`,
and `α i` is ordered by `s i`.
The type synonym `lex (Π₀ i, α i)` has an order given by `dfinsupp.lex (<) (λ i, (<))`.
-/
protected def lex (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) (x y : Π₀ i, α i) : Prop :=
pi.lex r s x y

lemma _root_.pi.lex_eq_dfinsupp_lex {r : ι → ι → Prop} {s : Π i, α i → α i → Prop}
  (a b : Π₀ i, α i) : pi.lex r s (a : Π i, α i) b = dfinsupp.lex r s a b := rfl

lemma lex_def {r : ι → ι → Prop} {s : Π i, α i → α i → Prop} {a b : Π₀ i, α i} :
  dfinsupp.lex r s a b ↔ ∃ j, (∀ d, r d j → a d = b d) ∧ s j (a j) (b j) := iff.rfl

instance [has_lt ι] [Π i, has_lt (α i)] : has_lt (lex (Π₀ i, α i)) :=
⟨λ f g, dfinsupp.lex (<) (λ i, (<)) (of_lex f) (of_lex g)⟩

lemma lex_lt_of_lt_of_preorder [Π i, preorder (α i)] (r) [is_strict_order ι r]
  {x y : Π₀ i, α i} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i :=
begin
  obtain ⟨hle, j, hlt⟩ := pi.lt_def.1 hlt, classical,
  have : (x.ne_locus y : set ι).well_founded_on r := (x.ne_locus y).finite_to_set.well_founded_on,
  obtain ⟨i, hi, hl⟩ := this.has_min {i | x i < y i} ⟨⟨j, mem_ne_locus.2 hlt.ne⟩, hlt⟩,
  exact ⟨i, λ k hk, ⟨hle k, of_not_not $ λ h,
    hl ⟨k, mem_ne_locus.2 (ne_of_not_le h).symm⟩ ((hle k).lt_of_not_le h) hk⟩, hi⟩,
end

lemma lex_lt_of_lt [Π i, partial_order (α i)] (r) [is_strict_order ι r]
  {x y : Π₀ i, α i} (hlt : x < y) : pi.lex r (λ i, (<)) x y :=
by { simp_rw [pi.lex, le_antisymm_iff], exact lex_lt_of_lt_of_preorder r hlt }

instance lex.is_strict_order [linear_order ι] [Π i, partial_order (α i)] :
  is_strict_order (lex (Π₀ i, α i)) (<) :=
let i : is_strict_order (lex (Π i, α i)) (<) := pi.lex.is_strict_order in
{ irrefl := to_lex.surjective.forall.2 $ λ a, @irrefl _ _ i.to_is_irrefl a,
  trans := to_lex.surjective.forall₃.2 $ λ a b c, @trans _ _ i.to_is_trans a b c }

variables [linear_order ι]

/-- The partial order on `dfinsupp`s obtained by the lexicographic ordering.
See `dfinsupp.lex.linear_order` for a proof that this partial order is in fact linear. -/
instance lex.partial_order [Π i, partial_order (α i)] : partial_order (lex (Π₀ i, α i)) :=
partial_order.lift (λ x, to_lex ⇑(of_lex x)) dfinsupp.coe_fn_injective

section linear_order

variable [Π i, linear_order (α i)]

/-- Auxiliary helper to case split computably. There is no need for this to be public, as it
can be written with `or.by_cases` on `lt_trichotomy` once the instances below are constructed. -/
private def lt_trichotomy_rec {P : lex (Π₀ i, α i) → lex (Π₀ i, α i) → Sort*}
  (h_lt : Π {f g}, to_lex f < to_lex g → P (to_lex f) (to_lex g))
  (h_eq : Π {f g}, to_lex f = to_lex g → P (to_lex f) (to_lex g))
  (h_gt : Π {f g}, to_lex g < to_lex f → P (to_lex f) (to_lex g)) :
  Π f g, P f g :=
lex.rec $ λ f, lex.rec $ λ g,
  match _, rfl : ∀ y, (f.ne_locus g).min = y → _ with
  | ⊤, h := h_eq (ne_locus_eq_empty.mp $ finset.min_eq_top.mp h)
  | (wit : ι), h := (mem_ne_locus.mp $ finset.mem_of_min h).lt_or_lt.by_cases
      (λ hwit, h_lt ⟨wit, λ j hj, not_mem_ne_locus.mp (finset.not_mem_of_lt_min hj h), hwit⟩)
      (λ hwit, h_gt ⟨wit, λ j hj, not_mem_ne_locus.mp
        (finset.not_mem_of_lt_min hj $ by rwa ne_locus_comm), hwit⟩)
  end

@[irreducible] instance lex.decidable_le : @decidable_rel (lex (Π₀ i, α i)) (≤) :=
lt_trichotomy_rec
  (λ f g h, is_true $ or.inr h)
  (λ f g h, is_true $ or.inl $ congr_arg _ h)
  (λ f g h, is_false $ λ h', (lt_irrefl _ (h.trans_le h')).elim)

@[irreducible] instance lex.decidable_lt : @decidable_rel (lex (Π₀ i, α i)) (<) :=
lt_trichotomy_rec
  (λ f g h, is_true h)
  (λ f g h, is_false h.not_lt)
  (λ f g h, is_false h.asymm)

/--  The linear order on `dfinsupp`s obtained by the lexicographic ordering. -/
instance lex.linear_order : linear_order (lex (Π₀ i, α i)) :=
{ le_total := lt_trichotomy_rec
    (λ f g h, or.inl h.le)
    (λ f g h, or.inl h.le)
    (λ f g h, or.inr h.le),
  decidable_lt := by apply_instance,
  decidable_le := by apply_instance,
  decidable_eq := by apply_instance,
  ..lex.partial_order }

end linear_order

variable [Π i, partial_order (α i)]

lemma to_lex_monotone : monotone (@to_lex (Π₀ i, α i)) :=
λ a b h, le_of_lt_or_eq $ or_iff_not_imp_right.2 $ λ hne, by classical; exact
  ⟨finset.min' _ (nonempty_ne_locus_iff.2 hne),
    λ j hj, not_mem_ne_locus.1 (λ h, (finset.min'_le _ _ h).not_lt hj),
    (h _).lt_of_ne (mem_ne_locus.1 $ finset.min'_mem _ _)⟩

lemma lt_of_forall_lt_of_lt (a b : lex (Π₀ i, α i)) (i : ι) :
  (∀ j < i, of_lex a j = of_lex b j) → of_lex a i < of_lex b i → a < b :=
λ h1 h2, ⟨i, h1, h2⟩

end has_zero

section covariants
variables [linear_order ι] [Π i, add_monoid (α i)] [Π i, linear_order (α i)]

/-!  We are about to sneak in a hypothesis that might appear to be too strong.
We assume `covariant_class` with *strict* inequality `<` also when proving the one with the
*weak* inequality `≤`.  This is actually necessary: addition on `lex (Π₀ i, α i)` may fail to be
monotone, when it is "just" monotone on `α i`. -/
section left
variables [Π i, covariant_class (α i) (α i) (+) (<)]

instance lex.covariant_class_lt_left :
  covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (+) (<) :=
⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg ((+) _) (lta j ja), add_lt_add_left ha _⟩⟩

instance lex.covariant_class_le_left :
  covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (+) (≤) := has_add.to_covariant_class_left _

end left

section right
variables [Π i, covariant_class (α i) (α i) (function.swap (+)) (<)]

instance lex.covariant_class_lt_right :
  covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (function.swap (+)) (<) :=
⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg (+ (of_lex f j)) (lta j ja), add_lt_add_right ha _⟩⟩

instance lex.covariant_class_le_right :
  covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (function.swap (+)) (≤) :=
has_add.to_covariant_class_right _

end right

end covariants

end dfinsupp


import data.set.basic
import data.set.finite
import automata.epsnfa
import languages.basic
import languages.star

open set epsnfa languages option

namespace epsnfa.star

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

def epsnfa_star (e : epsNFA S Q) : epsNFA S (option Q) := {
    start := none,
    term := none,
    next := λ q c, option.rec_on q ∅ (λ q', some '' (e.next q' c)),
    eps := λ q, option.rec_on q {some e.start} (λ r,
        if (q = e.term) then (some '' e.eps r ∪ {none}) else (some '' e.eps r))
}

lemma epsnfa_star_go_inside {e : epsNFA S Q} {a b : Q} {w : list S}
    :  go e a w b → go (epsnfa_star e) (some a) w (some b) :=
begin
    intro go_inside,
    induction go_inside, {
        exact go.finish,
    }, {
        refine go.step _ go_inside_ih,
        dsimp [epsnfa_star],
        simpa only [mem_image, exists_eq_right],
    }, {
        refine go.eps _ go_inside_ih,
        dsimp [epsnfa_star],
        split_ifs,
        { simpa using go_inside_h, },
        { simpa using go_inside_h, },
    }
end

lemma epsnfa_star_power {e : epsNFA S Q} {L : set (list S)} (hl : L = lang_of_epsnfa e) {n : ℕ}
    : L^n ⊆ lang_of_epsnfa (epsnfa_star e) :=
begin
    subst hl,
    induction n, {
        simp only [epsnfa_accepts_word, lang_of_epsnfa, mem_set_of_eq, one_def, singleton_subset_iff, pow_zero],
        use go.finish,
    }, {
        rintro w ⟨left, right, hleft, hright, rfl⟩,
        replace hright := n_ih hright,
        refine epsnfa_go_trans _ hright,

        convert go.eps _ (epsnfa_go_trans (epsnfa_star_go_inside hleft) (go.eps _ go.finish)),
        all_goals {
            simp only [list.append_nil, epsnfa_star, set.mem_singleton_iff],
        },
        split_ifs,
        { simp, },
        { simpa using h, },
    }
end

lemma epsnfa_star_list_join {e : epsNFA S Q} {w : list S} {u : option Q}
    : go (epsnfa_star e) u w none
        → ∃ pref l, (pref ++ list.join l = w) ∧
            (pref = [] ∧ u = none ∨ ∃ (q : Q), u = some q ∧ go e q pref e.term)
            ∧ (∀ x, x ∈ l → x ∈ lang_of_epsnfa e) :=
begin
    intro go_star,
    generalize hst : (none : option Q) = fi,
    rw hst at go_star,
    induction go_star,
    case epsnfa.go.finish : {
        subst hst,
        use [list.nil, list.nil],
        simp,
    },
    case epsnfa.go.step : head tail q nxt f hnxt go_tail ih {
        subst hst,
        specialize ih rfl,
        rcases ih with ⟨pref, l, rfl, hpref, hlist⟩,
        use [head :: pref, l, list.cons_append _ _ _],
        split, {
            right,
            cases q, {
                -- finish, contradiction
                exfalso, simpa [epsnfa_star] using hnxt,
            }, {
                -- inside
                use [q, rfl],
                rcases hpref with ⟨rfl, rfl⟩ | ⟨qnxt, rfl, qnxt_go⟩,
                -- impossible case
                simpa [epsnfa_star] using hnxt,
                simp only [epsnfa_star, mem_image, exists_eq_right] at hnxt,
                exact go.step hnxt qnxt_go,
            }
        }, {
            exact hlist,
        }
    },
    case epsnfa.go.eps : tail q nxt f hnxt go_tail ih {
        subst hst,
        specialize ih rfl,
        rcases ih with ⟨pref, l, rfl, hpref, hlist⟩,
        cases q, {
            -- finish, start new string
            use [list.nil, pref :: l],
            simp,
            rcases hpref with ⟨rfl, rfl⟩ | ⟨qnxt, rfl, qnxt_go⟩,
            simpa [epsnfa_star] using hnxt,
            simp only [epsnfa_star, mem_singleton_iff] at hnxt,
            rw hnxt at qnxt_go,
            use [qnxt_go, hlist],
        }, {
            -- inside, continue old one
            use [pref, l],
            simp,
            rcases hpref with ⟨rfl, rfl⟩ | ⟨qnxt, rfl, qnxt_go⟩, {
                simp only [epsnfa_star, union_singleton] at hnxt,
                split_ifs at hnxt, {
                    cases h, cases h,
                    exact ⟨go.finish, λ x xl, hlist x xl⟩,
                }, {
                    simpa only [mem_image, exists_false, and_false] using hnxt,
                }
            }, {
                refine ⟨go.eps _ _ qnxt_go, hlist⟩,
                simp only [epsnfa_star, dite_eq_ite, union_singleton] at hnxt,
                split_ifs at hnxt;
                simpa only [mem_image, false_or, mem_insert_iff, exists_eq_right] using hnxt,
            }
        }
    }
end

lemma epsnfa_star_list_join_aux {e : epsNFA S Q} {w : list S} {L : set (list S)} :
    L = lang_of_epsnfa (epsnfa_star e) → w ∈ L → ∃ l (h : ∀ x, x ∈ l → x ∈ lang_of_epsnfa e), w = list.join l :=
begin
    rintro rfl hw,
    replace hw := epsnfa_star_list_join hw,
    rcases hw with ⟨pref, l, rfl, hpref, hlist⟩,
    use l,
    rcases hpref with ⟨rfl, hstart⟩ | ⟨qnxt, hstart, qnxt_go⟩, {
        use [hlist, rfl],
    }, {
        exfalso, simpa [epsnfa_star] using hstart,
    }
end

theorem epsnfa_star_correct {e : epsNFA S Q} :
    lang_of_epsnfa (epsnfa_star e) = kleene_star (lang_of_epsnfa e) :=
begin
    apply subset.antisymm, {
        rintro w hw,
        replace hw := epsnfa_star_list_join_aux rfl hw,
        rwa star_eq_list_join,
    }, {
        rintro w ⟨n, hw⟩,
        exact epsnfa_star_power rfl hw,
    }
end

theorem star_is_epsnfa {L : set (list S)}: epsnfa_lang L → epsnfa_lang (kleene_star L) :=
begin
    rintro ⟨Q, fQ, dQ, enl, rfl⟩,
    letI := fQ,
    existsi [U Q, _, _, epsnfa_star enl],
    exact epsnfa_star_correct,
end

end epsnfa.star


import linear_algebra.eigenspace
import linear_algebra.tensor_product
import rnd_var
import shannon_theory

import to_mathlib_maybe.Hilbert_space
import to_mathlib_maybe.pTrace

import to_qShannon_theory_maybe.state

---- QUANTUM ENTROPY

open rnd_var

open_locale tensor_product big_operators

noncomputable theory

variables
{ℋ : Type} [complex_hilbert_space ℋ]
{ℋ₁ : Type} [complex_hilbert_space ℋ₁]
{ℋ₂ : Type} [complex_hilbert_space ℋ₂]

universe x

variables
{ι : Type x} -- indexing type
[fintype ι] -- tell Lean that the set of all elements ι is finite.

/-
Logarithm of a linear operator.
-/
def log (ρ : ℋ →ₗ[ℂ] ℋ) : ℋ →ₗ[ℂ] ℋ := sorry

local notation A ` ∘ ` B := linear_map.comp A B

def entropy (ρ : module.End ℂ ℋ) : ℝ :=
( Tr ( ρ ∘ (log ρ) ) ).re

notation `H(`ρ`)` := entropy(ρ)

variables {ρ : module.End ℂ ℋ} [quantum_state ρ]

/-
The range of e is the set of eigenvalues of ρ.
-/
variables {e : ι → ℝ} [decidable_eq ι] [∀ r : ℝ, (∃ i, e i = r) ↔ (ρ.has_eigenvalue r)]
include e -- there is an error without this, I don't know why.

/--
Quantum entropy is nonnegative
-/
theorem entropy_nonneg : entropy ρ ≥ 0 :=
begin
    have : entropy ρ = - ∑ i, (e i) * real.log(e i), {sorry},
    rw this,
    clear this,
    -- All the eignevalues are nonnegative because the state is positive semidefinite
    have he_nonneg : ∀ i, (e i) ≥ 0, {
        intros,
        apply quantum_state.pos_semidef (e i),
        exact he i,
        assumption,
    },
    -- The eigenvalues sum to 1 because the state has trace 1.
    have he_sum_eq_one : ∑ i, (e i) = 1, {
        apply sum_eigenvalues_eq_one_of_trace_one ρ quantum_state.trace_one,
        apply he,
    },
    -- The remaining term looks like Shannon entropy.
    -- So we use that Shannon entropy is nonegative to finish.
    sorry,
    -- apply Shannon_entropy_nonneg, simp,
    -- {exact he_nonneg},
    -- {exact he_sum_eq_one},
end

variables {U : module.End ℂ ℋ} [unitary U]

local notation U`†`:100 := dagger_of_unitary U

/--
Entropy is invariant under unitaries:
-/
lemma entropy_unitary_evolution_eq_entropy_self :
H(U ∘ ρ ∘ U†) = H(ρ) := sorry

variables
{ρ₁ : module.End ℂ ℋ₁} [quantum_state ρ₁]
{ρ₂ : module.End ℂ ℋ₂} [quantum_state ρ₂]

/--
Entropy of tensor product of states is equal to the sum of the entropies:
-/
lemma entropy_tmul_eq_add_entropy :
H(ρ₁ ⊗ ρ₂) = H(ρ₁) + H(ρ₂) := sorry

variables
{ρ₁₂ : (module.End ℂ (ℋ₁ ⊗[ℂ] ℋ₂))} [quantum_state ρ₁₂]

open bipartite
/--
Entropy is subadditive:
-/
lemma entropy_subadditive :
H(ρ₁₂) ≤ H(Tr₂(ρ₁₂)) + H(Tr₁(ρ₁₂)) := sorry


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.lattice
import logic.relation

/-!
# Relations holding pairwise

This file defines pairwise relations and pairwise disjoint indexed sets.

## Main declarations

* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
* `set.pairwise_disjoint`: `s.pairwise_disjoint f` states that images under `f` of distinct elements
  of `s` are either equal or `disjoint`.
-/

open set

variables {α ι ι' : Type*} {r p q : α → α → Prop}

section pairwise
variables {f : ι → α} {s t u : set α} {a b : α}

/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
def pairwise (r : α → α → Prop) := ∀ i j, i ≠ j → r i j

lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
λ i j hij, h $ hr i j hij

lemma pairwise_on_bool (hr : symmetric r) {a b : α} : pairwise (r on (λ c, cond c a b)) ↔ r a b :=
by simpa [pairwise, function.on_fun] using @hr a b

lemma pairwise_disjoint_on_bool [semilattice_inf α] [order_bot α] {a b : α} :
  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
pairwise_on_bool disjoint.symm

lemma symmetric.pairwise_on [linear_order ι] (hr : symmetric r) (f : ι → α) :
  pairwise (r on f) ↔ ∀ m n, m < n → r (f m) (f n) :=
⟨λ h m n hmn, h m n hmn.ne, λ h m n hmn, begin
  obtain hmn' | hmn' := hmn.lt_or_lt,
  { exact h _ _ hmn' },
  { exact hr (h _ _ hmn') }
end⟩

lemma pairwise_disjoint_on [semilattice_inf α] [order_bot α] [linear_order ι] (f : ι → α) :
  pairwise (disjoint on f) ↔ ∀ m n, m < n → disjoint (f m) (f n) :=
symmetric.pairwise_on disjoint.symm f

namespace set

/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
protected def pairwise (s : set α) (r : α → α → Prop) := ∀ x ∈ s, ∀ y ∈ s, x ≠ y → r x y

lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
λ a _ b _ _, h a b

lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
  s.pairwise p :=
λ a ha b hb hab, hrp a ha b hb hab (h a ha b hb hab)

lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
h.imp_on $ pairwise_of_forall s _ hpq

lemma pairwise.mono (h : t ⊆ s) (hs : s.pairwise r) : t.pairwise r :=
λ x xt y yt, hs x (h xt) y (h yt)

lemma pairwise.mono' (H : r ≤ p) (hr : s.pairwise r) : s.pairwise p := hr.imp H

lemma pairwise_top (s : set α) : s.pairwise ⊤ := pairwise_of_forall s _ (λ a b, trivial)

protected lemma subsingleton.pairwise (h : s.subsingleton) (r : α → α → Prop) :
  s.pairwise r :=
λ x hx y hy hne, (hne (h hx hy)).elim

@[simp] lemma pairwise_empty (r : α → α → Prop) : (∅ : set α).pairwise r :=
subsingleton_empty.pairwise r

@[simp] lemma pairwise_singleton (a : α) (r : α → α → Prop) : set.pairwise {a} r :=
subsingleton_singleton.pairwise r

lemma nonempty.pairwise_iff_exists_forall [is_equiv α r] {s : set ι} (hs : s.nonempty) :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  fsplit,
  { rcases hs with ⟨y, hy⟩,
    refine λ H, ⟨f y, λ x hx, _⟩,
    rcases eq_or_ne x y with rfl|hne,
    { apply is_refl.refl },
    { exact H _ hx _ hy hne } },
  { rintro ⟨z, hz⟩ x hx y hy hne,
    exact @is_trans.trans α r _ (f x) z (f y) (hz _ hx) (is_symm.symm _ _ $ hz _ hy) }
end

/-- For a nonempty set `s`, a function `f` takes pairwise equal values on `s` if and only if
for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.pairwise_eq_iff_exists_eq` for a version that assumes `[nonempty ι]` instead of
`set.nonempty s`. -/
lemma nonempty.pairwise_eq_iff_exists_eq {s : set α} (hs : s.nonempty) {f : α → ι} :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
hs.pairwise_iff_exists_forall

lemma pairwise_iff_exists_forall [nonempty ι] (s : set α) (f : α → ι) {r : ι → ι → Prop}
  [is_equiv ι r] :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hne,
  { simp },
  { exact hne.pairwise_iff_exists_forall }
end

/-- A function `f : α → ι` with nonempty codomain takes pairwise equal values on a set `s` if and
only if for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.nonempty.pairwise_eq_iff_exists_eq` for a version that assumes `set.nonempty s` instead of
`[nonempty ι]`. -/
lemma pairwise_eq_iff_exists_eq [nonempty ι] (s : set α) (f : α → ι) :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
pairwise_iff_exists_forall s f

lemma pairwise_union :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b ∧ r b a :=
begin
  simp only [set.pairwise, mem_union_eq, or_imp_distrib, forall_and_distrib],
  exact ⟨λ H, ⟨H.1.1, H.2.2, H.2.1, λ x hx y hy hne, H.1.2 y hy x hx hne.symm⟩,
    λ H, ⟨⟨H.1, λ x hx y hy hne, H.2.2.2 y hy x hx hne.symm⟩, H.2.2.1, H.2.1⟩⟩
end

lemma pairwise_union_of_symmetric (hr : symmetric r) :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b :=
pairwise_union.trans $ by simp only [hr.iff, and_self]

lemma pairwise_insert :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b ∧ r b a :=
by simp only [insert_eq, pairwise_union, pairwise_singleton, true_and,
  mem_singleton_iff, forall_eq]

lemma pairwise_insert_of_symmetric (hr : symmetric r) :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b :=
by simp only [pairwise_insert, hr.iff a, and_self]

lemma pairwise_pair : set.pairwise {a, b} r ↔ (a ≠ b → r a b ∧ r b a) :=
by simp [pairwise_insert]

lemma pairwise_pair_of_symmetric (hr : symmetric r) : set.pairwise {a, b} r ↔ (a ≠ b → r a b) :=
by simp [pairwise_insert_of_symmetric hr]

lemma pairwise_univ : (univ : set α).pairwise r ↔ pairwise r :=
by simp only [set.pairwise, pairwise, mem_univ, forall_const]

lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
  (hfs : ∀ x, f x ∈ s) :
  pairwise (r on f) :=
λ i j hij, hs _ (hfs i) _ (hfs j) (hf.ne hij)

lemma inj_on.pairwise_image {s : set ι} (h : s.inj_on f) :
  (f '' s).pairwise r ↔ s.pairwise (r on f) :=
by simp [h.eq_iff, set.pairwise] {contextual := tt}

lemma pairwise_Union {f : ι → set α} (h : directed (⊆) f) :
  (⋃ n, f n).pairwise r ↔ ∀ n, (f n).pairwise r :=
begin
  split,
  { assume H n,
    exact pairwise.mono (subset_Union _ _) H },
  { assume H i hi j hj hij,
    rcases mem_Union.1 hi with ⟨m, hm⟩,
    rcases mem_Union.1 hj with ⟨n, hn⟩,
    rcases h m n with ⟨p, mp, np⟩,
    exact H p i (mp hm) j (np hn) hij }
end

lemma pairwise_sUnion {r : α → α → Prop} {s : set (set α)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise r ↔ (∀ a ∈ s, set.pairwise a r) :=
by { rw [sUnion_eq_Union, pairwise_Union (h.directed_coe), set_coe.forall], refl }

end set

lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy, h x y

end pairwise

lemma pairwise_subtype_iff_pairwise_set {α : Type*} (s : set α) (r : α → α → Prop) :
  pairwise (λ (x : s) (y : s), r x y) ↔ s.pairwise r :=
begin
  split,
  { assume h x hx y hy hxy,
    exact h ⟨x, hx⟩ ⟨y, hy⟩ (by simpa only [subtype.mk_eq_mk, ne.def]) },
  { rintros h ⟨x, hx⟩ ⟨y, hy⟩ hxy,
    simp only [subtype.mk_eq_mk, ne.def] at hxy,
    exact h x hx y hy hxy }
end

alias pairwise_subtype_iff_pairwise_set ↔ pairwise.set_of_subtype set.pairwise.subtype

namespace set
section semilattice_inf_bot
variables [semilattice_inf α] [order_bot α] {s t : set ι} {f g : ι → α}

/-- A set is `pairwise_disjoint` under `f`, if the images of any distinct two elements under `f`
are disjoint. -/
def pairwise_disjoint (s : set ι) (f : ι → α) : Prop := s.pairwise (disjoint on f)

lemma pairwise_disjoint.subset (ht : t.pairwise_disjoint f) (h : s ⊆ t) : s.pairwise_disjoint f :=
pairwise.mono h ht

lemma pairwise_disjoint.mono_on (hs : s.pairwise_disjoint f) (h : ∀ ⦃i⦄, i ∈ s → g i ≤ f i) :
  s.pairwise_disjoint g :=
λ a ha b hb hab, (hs a ha b hb hab).mono (h ha) (h hb)

lemma pairwise_disjoint.mono (hs : s.pairwise_disjoint f) (h : g ≤ f) : s.pairwise_disjoint g :=
hs.mono_on (λ i _, h i)

@[simp] lemma pairwise_disjoint_empty : (∅ : set ι).pairwise_disjoint f := pairwise_empty _

@[simp] lemma pairwise_disjoint_singleton (i : ι) (f : ι → α) : pairwise_disjoint {i} f :=
pairwise_singleton i _

lemma pairwise_disjoint_insert {i : ι} :
  (insert i s).pairwise_disjoint f
    ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, i ≠ j → disjoint (f i) (f j) :=
set.pairwise_insert_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.insert (hs : s.pairwise_disjoint f) {i : ι}
  (h : ∀ j ∈ s, i ≠ j → disjoint (f i) (f j)) :
  (insert i s).pairwise_disjoint f :=
set.pairwise_disjoint_insert.2 ⟨hs, h⟩

lemma pairwise_disjoint.image_of_le (hs : s.pairwise_disjoint f) {g : ι → ι} (hg : f ∘ g ≤ f) :
  (g '' s).pairwise_disjoint f :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ h,
  exact (hs a ha b hb $ ne_of_apply_ne _ h).mono (hg a) (hg b),
end

lemma inj_on.pairwise_disjoint_image {g : ι' → ι} {s : set ι'} (h : s.inj_on g) :
  (g '' s).pairwise_disjoint f ↔ s.pairwise_disjoint (f ∘ g) :=
h.pairwise_image

lemma pairwise_disjoint.range (g : s → ι) (hg : ∀ (i : s), f (g i) ≤ f i)
  (ht : s.pairwise_disjoint f) :
  (range g).pairwise_disjoint f :=
begin
  rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ hxy,
  exact (ht _ x.2 _ y.2 $ λ h, hxy $ congr_arg g $ subtype.ext h).mono (hg x) (hg y),
end

lemma pairwise_disjoint_union :
  (s ∪ t).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ t.pairwise_disjoint f ∧
    ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j) :=
pairwise_union_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.union (hs : s.pairwise_disjoint f) (ht : t.pairwise_disjoint f)
  (h : ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j)) :
  (s ∪ t).pairwise_disjoint f :=
pairwise_disjoint_union.2 ⟨hs, ht, h⟩

lemma pairwise_disjoint_Union {g : ι' → set ι} (h : directed (⊆) g) :
  (⋃ n, g n).pairwise_disjoint f ↔ ∀ ⦃n⦄, (g n).pairwise_disjoint f :=
pairwise_Union h

lemma pairwise_disjoint_sUnion {s : set (set ι)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise_disjoint f ↔ ∀ ⦃a⦄, a ∈ s → set.pairwise_disjoint a f :=
pairwise_sUnion h

-- classical
lemma pairwise_disjoint.elim (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : ¬ disjoint (f i) (f j)) :
  i = j :=
of_not_not $ λ hij, h $ hs _ hi _ hj hij

-- classical
lemma pairwise_disjoint.elim' (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : f i ⊓ f j ≠ ⊥) :
  i = j :=
hs.elim hi hj $ λ hij, h hij.eq_bot

end semilattice_inf_bot

section complete_lattice
variables [complete_lattice α]

/-- Bind operation for `set.pairwise_disjoint`. If you want to only consider finsets of indices, you
can use `set.pairwise_disjoint.bUnion_finset`. -/
lemma pairwise_disjoint.bUnion {s : set ι'} {g : ι' → set ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', ⨆ i ∈ g i', f i))
  (hg : ∀ i ∈ s, (g i).pairwise_disjoint f) :
  (⋃ i ∈ s, g i).pairwise_disjoint f :=
begin
  rintro a ha b hb hab,
  simp_rw set.mem_Union at ha hb,
  obtain ⟨c, hc, ha⟩ := ha,
  obtain ⟨d, hd, hb⟩ := hb,
  obtain hcd | hcd := eq_or_ne (g c) (g d),
  { exact hg d hd a (hcd ▸ ha) b hb hab },
  { exact (hs _ hc _ hd (ne_of_apply_ne _ hcd)).mono (le_bsupr a ha) (le_bsupr b hb) }
end

end complete_lattice

/-! ### Pairwise disjoint set of sets -/

lemma pairwise_disjoint_range_singleton :
  (set.range (singleton : ι → set ι)).pairwise_disjoint id :=
begin
  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
end

lemma pairwise_disjoint_fiber (f : ι → α) (s : set α) : s.pairwise_disjoint (λ a, f ⁻¹' {a}) :=
λ a _ b _ h i ⟨hia, hib⟩, h $ (eq.symm hia).trans hib

-- classical
lemma pairwise_disjoint.elim_set {s : set ι} {f : ι → set α} (hs : s.pairwise_disjoint f) {i j : ι}
  (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i) (haj : a ∈ f j) : i = j :=
hs.elim hi hj $ not_disjoint_iff.2 ⟨a, hai, haj⟩

lemma bUnion_diff_bUnion_eq {s t : set ι} {f : ι → set α} (h : (s ∪ t).pairwise_disjoint f) :
  (⋃ i ∈ s, f i) \ (⋃ i ∈ t, f i) = (⋃ i ∈ s \ t, f i) :=
begin
  refine (bUnion_diff_bUnion_subset f s t).antisymm
    (bUnion_subset $ λ i hi a ha, (mem_diff _).2 ⟨mem_bUnion hi.1 ha, _⟩),
  rw mem_bUnion_iff, rintro ⟨j, hj, haj⟩,
  exact h i (or.inl hi.1) j (or.inr hj) (ne_of_mem_of_not_mem hj hi.2).symm ⟨ha, haj⟩,
end

/-- Equivalence between a disjoint bounded union and a dependent sum. -/
noncomputable def bUnion_eq_sigma_of_disjoint {s : set ι} {f : ι → set α}
  (h : s.pairwise (disjoint on f)) :
  (⋃ i ∈ s, f i) ≃ (Σ i : s, f i) :=
(equiv.set_congr (bUnion_eq_Union _ _)).trans $ Union_eq_sigma_of_disjoint $
  λ ⟨i, hi⟩ ⟨j, hj⟩ ne, h _ hi _ hj $ λ eq, ne $ subtype.eq eq

end set

lemma pairwise_disjoint_fiber (f : ι → α) : pairwise (disjoint on (λ a : α, f ⁻¹' {a})) :=
set.pairwise_univ.1 $ set.pairwise_disjoint_fiber f univ


import tactic -- this shows that mathlib is getting imported correctly.
import data.real.basic
-- This is a file for running random snippets of lean code
/-this is a docstring.

Write longer comments like this.-/

-- We can define functions

-- We can define types. And then terms of that types.
-- Inductive types
-- Structures (a special type of inductive type).

/-! Today we will be talking about Recursion.
    -----------------------------------------

Functional programming languages do not have loops (for and while).
Here we do everything with recursion instead.

Recursion = a function calling itself (with some different arguments).

-/
namespace recursion -- we open a namespace so as to avoid name clashes

open nat

def add : ℕ → ℕ → ℕ      -- here m is "unbundled".
| m 0        := m
| m (succ n) := succ (add m n)

def add' (m : ℕ) : ℕ → ℕ  -- here m is "bundled".
| zero     := m
| (succ n) := succ (add' n)

#check add
#check add'
#reduce add 100 200
#eval add 100 200

def fac : ℕ → ℕ
| 0       := 1
| (n + 1) := (n + 1) * fac n

def fac1 : ℕ → ℕ
| 0 := 1
| n := sorry -- n * fac' (n - 1)  -- This fails!

/-! Factorial using accumulator (more efficient).
This uses tail recursion.
-/
def go : ℕ → ℕ → ℕ
| 0 acc        := acc
| (n + 1) acc := go n ((n+1)*acc)
-- This is called "tail" recursion because we make a single recursive
-- call at the very end in the function go.
def fac2 (n : ℕ) := go n 1

#eval fac2 4

/-! Another example to illistrate tail recursion.
Note: good resource on tail recursion is Computerphile's video on tail recursion:
[[https://youtu.be/_JtPhF8MshA]].

First we define fib without tail recursion.-/
def fib : ℕ → ℕ  -- compute the n-th Fibonacci number.
| 0       := 0
| 1       := 1
| (n + 2) := fib (n + 1) + fib n

#eval fib 15  -- don't use big numbers. Not very efficient.

/-Now we try to make this more efficient using tail recursion.-/
def go' : ℕ → ℕ → ℕ → ℕ
|  0    a b := a
|  1    a b := b
| (n+1) a b := go' n b (a+b)
def fib' (n : ℕ) : ℕ := go' n 0 1

#eval fib' 15

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := succ $ length xs

#eval length [1, 2, 12]

-- Sum the elements in a list
def sum {α : Type} [has_add α] [has_zero α] : list α → α
| [] := 0
| (x :: xs) := x + sum xs

-- Multiply the elements in a list
def mul {α : Type} [has_mul α] [has_one α] : list α → α
| [] := 1
| (x :: xs) := x * mul xs

#eval mul [7, 9, 2] -- output: 126

#exit

def max {α : Type} [decidable_linear_order α]: list α → α
| []        := sorry
| (x :: xs) := if x < max xs then max xs else x

#print decidable_linear_order
#eval max [14, 17]

def max' {α : Type} [decidable_linear_order α] : list α → option α
| []        := none
| (x :: xs) := match (max' xs) with
               | none := x
               | some m := if x < m then m else x
               end

#eval max [1, 3, 20, 5, 10]
#eval max' [1, 3, 20, 5, 10]

#print list
end recursion


import matroid.rankfun set_tactic.solver matroid.submatroid.order

/-!
# Projections, Loopifications and Pseudominors

For a matroid `M` on Type `α` 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 α` rather than
changing the ground set and having to deal with the type theory that results. 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.
-/

open set
open matroid

universes u v w

namespace matroid

section project
variables {α : Type*} [fintype α] {e f : α} {M : matroid α} {X Y D C F I R: set α}

/-- 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  -/
def project (M : matroid α) (C : set α) : matroid α :=
{ r := λ X, M.r (X ∪ C) - M.r C,
  R0 := λ X, by {simp only, linarith [M.rank_mono (subset_union_right X C)]},
  R1 := λ X, by {simp only, linarith [M.R0 (X ∩ C), M.R3 X C, M.R1 X]},
  R2 := λ X Y hXY, by {simp only, linarith [M.rank_mono (union_subset_union_left C hXY)]},
  R3 := λ X Y, by {simp_rw [union_comm _ C], linarith [submod_three_sets M C X Y]} }

infix ` ⟋ ` :75 :=  matroid.project

/-- project all elements of M outside R -/
def project_to (M : matroid α) (R : set α) : matroid α := M ⟋ (Rᶜ)

@[simp] lemma project_r (M : matroid α) (C X : set α) : (M ⟋ C).r X = M.r (X ∪ C) - M.r C := rfl

@[simp] lemma project_empty (M : matroid α) : M ⟋ ∅ = M :=
by { ext X, rw [project_r, union_empty, rank_empty, sub_zero], }

lemma project_rank (M : matroid α) (C : set α) : (M ⟋ C).r univ = M.r univ - M.r C :=
by rw [project_r, univ_union]

lemma project_is_weak_image (M : matroid α) (C : set α) : M ⟋ C ≤ M :=
λ X, by {rw project_r, linarith [M.rank_subadditive X C]}

lemma project_project (M : matroid α) (C C' : set α) : M ⟋ C ⟋ C' = M ⟋ (C ∪ C') :=
by {rw union_comm, ext X, simp only [project_r, ←union_assoc], linarith, }

lemma project_is_quotient (M : matroid α) (C : set α) : M ⟋ C ≼ M :=
begin
  intros X Y hXY, simp_rw project_r,
  have hY := (union_diff_cancel hXY).symm,
  have hle : (M ⟋ Y) ≤ (M ⟋ X) := by {rw [hY, ←project_project],apply project_is_weak_image },
  specialize hle C,
  simp only [project_r, union_comm C] at hle,
  linarith,
end

lemma project_makes_loops (M : matroid α) (C : set α) : 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 α )(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 α) (C : set α) : (M ⟋ C).r C = 0 :=
by rw [project_r, union_self, sub_self]

lemma projected_set_union_rank_zero (M : matroid α) (C : set α){X : set α} (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 α) (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 α): (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 α) (C : set α) : (M ⟋ C) = M.project_to Cᶜ :=
by rw [project_to, compl_compl]

lemma project_to_r (M : matroid α) (R X : set α) : (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 : α } (he : M.is_nonloop e){X : set α}:
  (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 {α : Type*} [fintype α] {e f : α} {M : matroid α} {X Y D C I R S : set α}

/-- Replace D with loops to get a matroid on the same ground set. Often more
convenient than deleting D -/
def loopify (M : matroid α) (D : set α) : matroid α :=
{ 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 loopify_to (M : matroid α) (R : set α) : matroid α := M ⟍ (Rᶜ)

infix ` ‖ `  :75 :=  matroid.loopify_to

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

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

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

lemma loopify_loops_eq (M : matroid α) (D : set α) :
  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 α)(D : set α):
  M.loops ⊆ (M ⟍ D).loops :=
by {rw ← loopify_loops_eq, apply subset_union_left}

lemma loop_of_loopify (M : matroid α) (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 α) (D : set α):
  (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 α) (D : set α) :
  (M ⟍ D).r D = 0 :=
by rw [loopify_r, set.diff_self, rank_empty]

lemma loopified_set_union_rank_zero (M : matroid α) (D : set α){X : set α} (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 α)(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 α) (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 loopify_to_r (M : matroid α) (R X : set α) :
  (M ‖ R).r X = M.r (X ∩ R) :=
by simp [diff_eq, loopify_to, loopify_r]

lemma loopify_as_loopify_to (M : matroid α) (D : set α) :
  (M ⟍ D) = (M ‖ Dᶜ) :=
by rw [loopify_to, compl_compl]

lemma loopify_to.nonloops (M : matroid α) (R : set α):
  (M ‖ R).nonloops = M.nonloops ∩ R :=
by rw [loopify_to, loopify_nonloops_eq, diff_eq, compl_compl]

lemma indep_loopify_to_iff :
  (M ‖ R).is_indep I ↔ M.is_indep I ∧ I ⊆ R :=
begin
  rw [indep_iff_r, loopify_to_r, indep_iff_r],
  refine ⟨λ h, _, λ h, by {cases h with h h', rwa subset_iff_inter_eq_left.mp h'}⟩,
  have h' : I ∩ R = I,
  { refine eq_of_eq_size_subset (inter_subset_left _ _) _,
    refine le_antisymm (size_mono_inter_left _ _) _,
    rw ←h, apply rank_le_size,},
  rw [←h, h', subset_iff_inter_eq_left],
  simpa,
end

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

lemma indep_of_indep_loopify_to (hI : (M ‖ R).is_indep I) :
  M.is_indep I :=
(indep_loopify_to_iff.mp hI).1

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

lemma loopify_to_eq_loopify_to_iff {M N : matroid α}:
  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), ← loopify_to_r, ← loopify_to_r, h]},
  ext Y : 2 ,
  rw [loopify_to_r, loopify_to_r, h _ (inter_subset_right _ _)],
end

end loopify

section pminor

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

/-- 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 α) :=
  ∃ C D, N = M ⟋ C ⟍ D

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

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

lemma pr_lp_eq_lp_pr (M : matroid α) (C D : set α) :
  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 α) (C D : set α) :
  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 α) (C D : set α) :
  (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 α) (C D : set α) :
  (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 α} :
  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 α} :
  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