-- From Patrick Massot

import analysis.real
import linear_algebra.prod_module

noncomputable theory

local notation f `→_{`:50 a `}`:0 b := filter.tendsto f (nhds a) (nhds b)

class normed_group (α : Type*) extends add_comm_group α, metric_space α :=
(norm : α → ℝ)
(dist_eq : ∀ x y, dist x y = norm (x - y))

def norm {G : Type*} [normed_group G] : G → ℝ := normed_group.norm
notation `∥` e `∥` := norm e

section normed_group
variables {E : Type*} [normed_group E]
variables {F : Type*} [normed_group F]
variables {G : Type*} [normed_group G] {H : Type*} [normed_group H]

def add : (E → F) → (E → F) → (E → F) := λ f g, (λ e, f e + g e)
instance normed_group_add : has_add (E → F) := ⟨add⟩
@[simp] theorem add_eval : Π (f g : E → F) e, (f + g) e = f e + g e
| f g e := rfl

lemma norm_dist' { g h : G} : dist g h = ∥g - h∥ :=
normed_group.dist_eq _ _

@[simp]
lemma norm_dist { g : G} : dist g 0 = ∥g∥ :=
by { rw[norm_dist'], simp }

lemma norm_triangle (g h : G) : ∥g + h∥ ≤ ∥g∥ + ∥h∥ :=
calc ∥g + h∥ = ∥g - (-h)∥             : by simp
         ... = dist g (-h)            : by simp[norm_dist']
         ... ≤ dist g 0 + dist 0 (-h) : by apply dist_triangle
         ... = ∥g∥ + ∥h∥               : by simp[norm_dist']

@[simp]
lemma norm_nonneg {g : G} : 0 ≤ ∥g∥ :=
by { rw[←norm_dist], exact dist_nonneg }

lemma norm_zero_iff_zero {g : G} : ∥g∥ = 0 ↔ g = 0 :=
by { rw[←norm_dist], exact dist_eq_zero }

@[simp]
lemma zero_norm_zero : ∥(0:G)∥ = 0 :=
norm_zero_iff_zero.2 (by simp)

lemma norm_pos_iff {g : G} : ∥ g ∥  > 0 ↔ g ≠ 0 :=
begin
  split ; intro h ; rw[←norm_dist] at *,
  { exact dist_pos.1 h },
  { exact dist_pos.2 h }
end

lemma norm_le_zero_iff {g : G} : ∥g∥ ≤ 0 ↔ g = 0 :=
by { rw[←norm_dist], exact dist_le_zero }

@[simp]
lemma norm_neg {g : G} : ∥-g∥ = ∥g∥ :=
calc ∥-g∥ = ∥0 - g∥ : by simp
      ... = dist 0 g : norm_dist'.symm
      ... = dist g 0 : dist_comm _ _
      ... = ∥g - 0∥ : norm_dist'
      ... = ∥g∥ : by simp

lemma norm_triangle' (g h : G) : abs(∥g∥ - ∥h∥) ≤ ∥g - h∥ :=
begin
  have ng := calc ∥g∥ = ∥g - h + h∥ : by simp
  ... ≤ ∥g-h∥ + ∥h∥ : norm_triangle _ _,
  replace ng := sub_right_le_of_le_add ng,
  have nh := calc ∥h∥ = ∥h - g + g∥ : by simp
  ... ≤ ∥h - g∥ + ∥g∥ : norm_triangle _ _
  ... = ∥-(g - h)∥ + ∥g∥ : by simp
  ... = ∥g - h∥ + ∥g∥ : by { rw [show ∥-(g - h)∥ = ∥g-h∥, from norm_neg] },
  replace nh := sub_right_le_of_le_add nh,
  replace nh : -(∥g∥ - ∥h∥) ≤ ∥g - h∥ := by simpa using nh,
  replace nh : -∥g - h∥ ≤ ∥g∥ - ∥h∥ := by simpa using neg_le_neg nh,
  exact abs_le.2 ⟨nh, ng⟩
end

instance prod.normed_group {F : Type*} [normed_group F] : normed_group (G × F) :=
{ norm := λ x, max ∥x.1∥ ∥x.2∥,
  dist_eq := assume x y, by { simp, repeat {rw norm_dist'}, simp } }

lemma norm_proj1_le (x : G × H) : ∥x.1∥ ≤ ∥x∥ :=
begin  have : ∥x∥ = max  (∥x.fst∥) ( ∥x.snd∥) := rfl, rw this, simp[le_max_left], end

lemma norm_proj2_le (x : G × H) : ∥x.2∥ ≤ ∥x∥ :=
begin  have : ∥x∥ = max  (∥x.fst∥) ( ∥x.snd∥) := rfl, rw this, simp[le_max_right], end

lemma tendsto_iff_norm_tendsto_zero {f : G → H} {a : G} {b : H} : (f →_{a} b) ↔ ((λ e, ∥ f e - b ∥) →_{a} 0) :=
begin
  simp only [norm_dist'.symm],
  exact tendsto_iff_dist_tendsto_zero
end

lemma lim_norm (x: G) : ((λ g, ∥g-x∥) : G → ℝ) →_{x} 0 :=
begin
  apply tendsto_iff_norm_tendsto_zero.1,
  apply continuous_iff_tendsto.1,
  simp[show (λ e : G , e) = id, from rfl, continuous_id]
end

lemma lim_norm_zero  : ((λ g, ∥g∥) : G → ℝ) →_{0} 0 :=
by simpa using lim_norm (0:G)

lemma squeeze_zero {T : Type*} [metric_space T] (f g : T → ℝ) (t₀ : T) :
(∀ t : T, 0 ≤ f t) → (∀ t : T, f t ≤ g t) → (g →_{t₀} 0) → (f →_{t₀} 0) :=
begin
  intros _ _ g0,
  apply tendsto_of_tendsto_of_tendsto_of_le_of_le (tendsto_const_nhds) g0;
  simp [*]; exact filter.univ_mem_sets
end

lemma norm_continuous {G : Type*} [normed_group G]: continuous ((λ g, ∥g∥) : G → ℝ) :=
begin
  apply continuous_iff_tendsto.2,
  intro x,
  have : (λ (g : G), dist ∥g∥ ∥x∥) →_{x} 0 :=
    squeeze_zero (λ g, dist ∥g∥ ∥x∥) _ x (λ t, abs_nonneg _) (λ t, norm_triangle' _ _) (lim_norm x),
  exact tendsto_iff_dist_tendsto_zero.2 this
end

instance normed_top_monoid  : topological_add_monoid G  :=
⟨begin
  apply continuous_iff_tendsto.2 _,
  intro x,
  apply tendsto_iff_norm_tendsto_zero.2,

  simp,
  have ineq := λ e: G × G, calc
  ∥e.fst + (e.snd + (-x.fst + -x.snd))∥ = ∥(e.fst-x.fst) + (e.snd - x.snd)∥ : by simp
  ... ≤ ∥e.fst - x.fst∥ + ∥ e.snd - x.snd ∥  : norm_triangle (e.fst-x.fst) (e.snd - x.snd),

  apply squeeze_zero _ _ x (by simp) ineq,
  have ineq1 : ∀ e : G × G, ∥ e.fst - x.fst∥ ≤ ∥e - x∥ := assume e, norm_proj1_le (e-x),
  have lim1 : (λ e : G × G, ∥ e.fst - x.fst∥) →_{x} 0 := squeeze_zero _ _ x (by simp) ineq1 _,
  clear ineq1,

  have ineq2 : ∀ e : G × G, ∥ e.snd - x.snd∥ ≤ ∥e - x∥ := assume e, norm_proj2_le (e-x),
  have lim2 : (λ e : G × G, ∥ e.snd - x.snd∥) →_{x} 0 := squeeze_zero _ _ x (by simp) ineq2 _,
  clear ineq2,
  have := tendsto_add lim1 lim2,
  simpa using this,

  exact lim_norm x,
  exact lim_norm x,
end⟩

instance normed_top_group  : topological_add_group G  :=
{ continuous_neg := begin
    apply continuous_iff_tendsto.2,
    intro x,
    apply tendsto_iff_norm_tendsto_zero.2,
    simp,
    have neg := λ (e : G), calc
    ∥ x + -e∥ = ∥ -(e -x)∥ : by simp
    ... =  ∥e - x∥ : norm_neg,
    conv in _ {rw [neg]},

    have lim_negx : (λ (e : G), -x )→_{x} -x:= tendsto_const_nhds,
    have lim_e : (λ (e : G), e )→_{x} x := continuous_iff_tendsto.1 continuous_id x,
    have := tendsto_add lim_negx lim_e,
    simp at this,
    simpa using filter.tendsto.comp this lim_norm_zero
  end }

end normed_group

section normed_ring
class normed_ring (α : Type*) extends ring α, metric_space α :=
(norm : α → ℝ)
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b)

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

instance normed_ring.to_normed_group [H : normed_ring α] : normed_group α := { ..H }

lemma norm_mul {α : Type*} [normed_ring α] (a b : α) : (∥a*b∥) ≤ (∥a∥) * (∥b∥) :=
normed_ring.norm_mul _ _

instance prod.ring [ring α] [ring β] : ring (α × β) :=
{ left_distrib := assume x y z, calc
    x*(y+z) = (x.1, x.2) * (y.1 + z.1, y.2 + z.2) : rfl
    ... = (x.1*(y.1 + z.1), x.2*(y.2 + z.2)) : rfl
    ... = (x.1*y.1 + x.1*z.1, x.2*y.2 + x.2*z.2) : by simp[left_distrib],
  right_distrib := assume x y z, calc
    (x+y)*z = (x.1 + y.1, x.2 + y.2)*(z.1, z.2) : rfl
    ... = ((x.1 + y.1)*z.1, (x.2 + y.2)*z.2) : rfl
    ... = (x.1*z.1 + y.1*z.1, x.2*z.2 + y.2*z.2) : by simp[right_distrib],
  ..prod.monoid,
  ..prod.add_comm_group}

instance prod.normed_ring [normed_ring α] [normed_ring β] : normed_ring (α × β) :=
{ norm_mul := assume x y,
  calc
    ∥x * y∥ = ∥(x.1*y.1, x.2*y.2)∥ : rfl
        ... = (max ∥x.1*y.1∥  ∥x.2*y.2∥) : rfl
        ... ≤ (max (∥x.1∥*∥y.1∥) (∥x.2∥*∥y.2∥)) : max_le_max (norm_mul (x.1) (y.1)) (norm_mul (x.2) (y.2))
        ... = (max (∥x.1∥*∥y.1∥) (∥y.2∥*∥x.2∥)) : by simp[mul_comm]
        ... ≤ (max (∥x.1∥) (∥x.2∥)) * (max (∥y.2∥) (∥y.1∥)) : by { apply max_mul_mul_le_max_mul_max; simp [norm_nonneg] }
        ... = (max (∥x.1∥) (∥x.2∥)) * (max (∥y.1∥) (∥y.2∥)) : by simp[max_comm]
        ... = (∥x∥*∥y∥) : rfl,
  ..prod.normed_group }
end normed_ring

section normed_field
variables {α : Type*}

class normed_field (α : Type*) extends discrete_field α, metric_space α :=
(norm : α → ℝ)
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) = norm a * norm b)

instance normed_field.to_normed_ring [H : normed_field α] : normed_ring α :=
{ norm_mul := by finish[H.norm_mul], ..H }

instance : normed_field ℝ :=
{ norm := λ x, abs x,
  dist_eq := assume x y, rfl,
  norm_mul := abs_mul}

end normed_field

section normed_space

class normed_space (α : out_param $ Type*) (β : Type*) [out_param $ normed_field α] extends vector_space α β, metric_space β :=
(norm : β → ℝ)
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_smul : ∀ a b, norm (a • b) = normed_field.norm a * norm b)

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

instance normed_space.to_normed_group [H : normed_space α β] : normed_group β :=
by refine { add := (+),
            dist_eq := normed_space.dist_eq,
            zero := 0,
            neg := λ x, -x,
            ..H, .. }; simp

variable [normed_space α β]

lemma norm_smul (s : α) (x : β) : ∥s • x∥ = ∥s∥ * ∥x∥ :=
normed_space.norm_smul _ _

variables {E : Type*} {F : Type*} [normed_space α E] [normed_space α F]

lemma tendsto_smul {f : E → α} { g : E → F} {e : E} {s : α} {b : F} :
(f →_{e} s) → (g →_{e} b) → ((λ e, (f e) • (g e)) →_{e} s • b) :=
begin
  intros limf limg,
  apply tendsto_iff_norm_tendsto_zero.2,
  have ineq := λ x : E, calc
      ∥f x • g x - s • b∥ = ∥(f x • g x - s • g x) + (s • g x - s • b)∥ : by simp[add_assoc]
                      ... ≤ ∥f x • g x - s • g x∥ + ∥s • g x - s • b∥ : norm_triangle (f x • g x - s • g x) (s • g x - s • b)
                      ... ≤ ∥f x - s∥*∥g x∥ + ∥s∥*∥g x - b∥ : by { rw [←smul_sub, ←sub_smul, norm_smul, norm_smul] },
  apply squeeze_zero,
  { intro t, exact norm_nonneg },
  { exact ineq },
  { clear ineq,
    have limf': (λ (x : E), ∥f x - s∥)→_{e}0 := tendsto_iff_norm_tendsto_zero.1 limf,
    have limg' := filter.tendsto.comp limg (continuous_iff_tendsto.1 norm_continuous _),
    have limg'' : (λ (x : E), ∥g x∥)→_{e} ∥b∥, simp[limg'], clear limg',

    have lim1  := tendsto_mul limf' limg'', simp at lim1,
    have limg3 := tendsto_iff_norm_tendsto_zero.1 limg,
    have lim2  := tendsto_mul tendsto_const_nhds limg3, swap, exact ∥s∥,
    simp at lim2,

    have :=  tendsto_add lim1 lim2,
    rw [show (0:ℝ) + 0 = 0, by simp] at this,
    exact this }
end

/- Do we want the following? I have difficulties with instances to set it up
class topological_vector_space (E : Type*) [topological_space E] [vector_space α E]
  extends topological_add_group E : Prop :=
  (continuous_smul : continuous (λ x : α×E, x.1• x.2))
-/

instance product_normed_space : normed_space α (E × F) :=
{ norm_smul :=
  begin
    intros s x,
    cases x with x₁ x₂,
    exact calc
      ∥s • (x₁, x₂)∥ = ∥ (s • x₁, s• x₂)∥ : rfl
      ... = max (∥s • x₁∥) (∥ s• x₂∥) : rfl
      ... = max (∥s∥ * ∥x₁∥) (∥s∥ * ∥x₂∥) : by simp[norm_smul s x₁, norm_smul s x₂]
      ... = ∥s∥ * max (∥x₁∥) (∥x₂∥) : by simp[mul_max_of_nonneg]
  end,

  add_smul := by simp[add_smul],
  -- I have no idea why by simp[smul_add] is not enough for the next goal
  smul_add := assume r x y,  show (r•(x+y).fst, r•(x+y).snd)  = (r•x.fst+r•y.fst, r•x.snd+r•y.snd),
               by simp[smul_add],
  ..prod.normed_group,
  ..prod.vector_space }
end normed_space


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

namespace Mathlib

/-!
# Bitwise operations on natural numbers

In the first half of this file, we provide theorems for reasoning about natural numbers from their
bitwise properties. In the second half of this file, we show properties of the bitwise operations
`lor`, `land` and `lxor`, which are defined in core.

## Main results
* `eq_of_test_bit_eq`: two natural numbers are equal if they have equal bits at every position.
* `exists_most_significant_bit`: if `n ≠ 0`, then there is some position `i` that contains the most
  significant `1`-bit of `n`.
* `lt_of_test_bit`: if `n` and `m` are numbers and `i` is a position such that the `i`-th bit of
  of `n` is zero, the `i`-th bit of `m` is one, and all more significant bits are equal, then
  `n < m`.

## Future work

There is another way to express bitwise properties of natural number: `digits 2`. The two ways
should be connected.

## Keywords

bitwise, and, or, xor
-/

namespace nat

@[simp] theorem bit_ff : bit false = bit0 :=
  rfl

@[simp] theorem bit_tt : bit tt = bit1 :=
  rfl

@[simp] theorem bit_eq_zero {n : ℕ} {b : Bool} : bit b n = 0 ↔ n = 0 ∧ b = false := sorry

theorem zero_of_test_bit_eq_ff {n : ℕ} (h : ∀ (i : ℕ), test_bit n i = false) : n = 0 := sorry

@[simp] theorem zero_test_bit (i : ℕ) : test_bit 0 i = false := sorry

/-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/
theorem eq_of_test_bit_eq {n : ℕ} {m : ℕ} (h : ∀ (i : ℕ), test_bit n i = test_bit m i) : n = m := sorry

theorem exists_most_significant_bit {n : ℕ} (h : n ≠ 0) : ∃ (i : ℕ), test_bit n i = tt ∧ ∀ (j : ℕ), i < j → test_bit n j = false := sorry

theorem lt_of_test_bit {n : ℕ} {m : ℕ} (i : ℕ) (hn : test_bit n i = false) (hm : test_bit m i = tt) (hnm : ∀ (j : ℕ), i < j → test_bit n j = test_bit m j) : n < m := sorry

/-- If `f` is a commutative operation on bools such that `f ff ff = ff`, then `bitwise f` is also
    commutative. -/
theorem bitwise_comm {f : Bool → Bool → Bool} (hf : ∀ (b b' : Bool), f b b' = f b' b) (hf' : f false false = false) (n : ℕ) (m : ℕ) : bitwise f n m = bitwise f m n := sorry

theorem lor_comm (n : ℕ) (m : ℕ) : lor n m = lor m n :=
  bitwise_comm bool.bor_comm rfl n m

theorem land_comm (n : ℕ) (m : ℕ) : land n m = land m n :=
  bitwise_comm bool.band_comm rfl n m

theorem lxor_comm (n : ℕ) (m : ℕ) : lxor n m = lxor m n :=
  bitwise_comm bool.bxor_comm rfl n m

@[simp] theorem zero_lxor (n : ℕ) : lxor 0 n = n :=
  rfl

@[simp] theorem lxor_zero (n : ℕ) : lxor n 0 = n :=
  lxor_comm 0 n ▸ rfl

@[simp] theorem zero_land (n : ℕ) : land 0 n = 0 :=
  rfl

@[simp] theorem land_zero (n : ℕ) : land n 0 = 0 :=
  land_comm 0 n ▸ rfl

@[simp] theorem zero_lor (n : ℕ) : lor 0 n = n :=
  rfl

@[simp] theorem lor_zero (n : ℕ) : lor n 0 = n :=
  lor_comm 0 n ▸ rfl

/-- Proving associativity of bitwise operations in general essentially boils down to a huge case
    distinction, so it is shorter to use this tactic instead of proving it in the general case. -/
theorem lxor_assoc (n : ℕ) (m : ℕ) (k : ℕ) : lxor (lxor n m) k = lxor n (lxor m k) := sorry

theorem land_assoc (n : ℕ) (m : ℕ) (k : ℕ) : land (land n m) k = land n (land m k) := sorry

theorem lor_assoc (n : ℕ) (m : ℕ) (k : ℕ) : lor (lor n m) k = lor n (lor m k) := sorry

@[simp] theorem lxor_self (n : ℕ) : lxor n n = 0 := sorry

theorem lxor_right_inj {n : ℕ} {m : ℕ} {m' : ℕ} (h : lxor n m = lxor n m') : m = m' := sorry

theorem lxor_left_inj {n : ℕ} {n' : ℕ} {m : ℕ} (h : lxor n m = lxor n' m) : n = n' :=
  lxor_right_inj
    (eq.mp (Eq._oldrec (Eq.refl (lxor m n = lxor n' m)) (lxor_comm n' m))
      (eq.mp (Eq._oldrec (Eq.refl (lxor n m = lxor n' m)) (lxor_comm n m)) h))

theorem lxor_eq_zero {n : ℕ} {m : ℕ} : lxor n m = 0 ↔ n = m :=
  { mp := eq.mpr (id (Eq._oldrec (Eq.refl (lxor n m = 0 → n = m)) (Eq.symm (lxor_self m)))) lxor_left_inj,
    mpr := fun (ᾰ : n = m) => Eq._oldrec (lxor_self n) ᾰ }

theorem lxor_trichotomy {a : ℕ} {b : ℕ} {c : ℕ} (h : lxor a (lxor b c) ≠ 0) : lxor b c < a ∨ lxor a c < b ∨ lxor a b < c := sorry


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.multiset.nodup
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.Nodup
import Mathlib.Data.Multiset.Bind
import Mathlib.Data.Multiset.Range

/-!
# The `Nodup` predicate for multisets without duplicate elements.
-/

namespace Multiset

open Function List

variable {α β γ : Type _} {r : α → α → Prop} {s t : Multiset α} {a : α}

-- nodup
/-- `Nodup s` means that `s` has no duplicates, i.e. the multiplicity of
  any element is at most 1. -/
def Nodup (s : Multiset α) : Prop :=
  Quot.liftOn s List.Nodup fun _ _ p => propext p.nodup_iff
#align multiset.nodup Multiset.Nodup

@[simp]
theorem coe_nodup {l : List α} : @Nodup α l ↔ l.Nodup :=
  Iff.rfl
#align multiset.coe_nodup Multiset.coe_nodup

@[simp]
theorem nodup_zero : @Nodup α 0 :=
  Pairwise.nil
#align multiset.nodup_zero Multiset.nodup_zero

@[simp]
theorem nodup_cons {a : α} {s : Multiset α} : Nodup (a ::ₘ s) ↔ a ∉ s ∧ Nodup s :=
  Quot.induction_on s fun _ => List.nodup_cons
#align multiset.nodup_cons Multiset.nodup_cons

theorem Nodup.cons (m : a ∉ s) (n : Nodup s) : Nodup (a ::ₘ s) :=
  nodup_cons.2 ⟨m, n⟩
#align multiset.nodup.cons Multiset.Nodup.cons

@[simp]
theorem nodup_singleton : ∀ a : α, Nodup ({a} : Multiset α) :=
  List.nodup_singleton
#align multiset.nodup_singleton Multiset.nodup_singleton

theorem Nodup.of_cons (h : Nodup (a ::ₘ s)) : Nodup s :=
  (nodup_cons.1 h).2
#align multiset.nodup.of_cons Multiset.Nodup.of_cons

theorem Nodup.not_mem (h : Nodup (a ::ₘ s)) : a ∉ s :=
  (nodup_cons.1 h).1
#align multiset.nodup.not_mem Multiset.Nodup.not_mem

theorem nodup_of_le {s t : Multiset α} (h : s ≤ t) : Nodup t → Nodup s :=
  Multiset.leInductionOn h fun {_ _} => Nodup.sublist
#align multiset.nodup_of_le Multiset.nodup_of_le

theorem not_nodup_pair : ∀ a : α, ¬Nodup (a ::ₘ a ::ₘ 0) :=
  List.not_nodup_pair
#align multiset.not_nodup_pair Multiset.not_nodup_pair

theorem nodup_iff_le {s : Multiset α} : Nodup s ↔ ∀ a : α, ¬a ::ₘ a ::ₘ 0 ≤ s :=
  Quot.induction_on s fun _ =>
    nodup_iff_sublist.trans <| forall_congr' fun a => not_congr (@replicate_le_coe _ a 2 _).symm
#align multiset.nodup_iff_le Multiset.nodup_iff_le

theorem nodup_iff_ne_cons_cons {s : Multiset α} : s.Nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t :=
  nodup_iff_le.trans
    ⟨fun h a t s_eq => h a (s_eq.symm ▸ cons_le_cons a (cons_le_cons a (zero_le _))), fun h a le =>
      let ⟨t, s_eq⟩ := le_iff_exists_add.mp le
      h a t (by rwa [cons_add, cons_add, zero_add] at s_eq)⟩
#align multiset.nodup_iff_ne_cons_cons Multiset.nodup_iff_ne_cons_cons

theorem nodup_iff_count_le_one [DecidableEq α] {s : Multiset α} : Nodup s ↔ ∀ a, count a s ≤ 1 :=
  Quot.induction_on s fun _l => by
    simp only [quot_mk_to_coe'', coe_nodup, mem_coe, coe_count]
    apply List.nodup_iff_count_le_one
#align multiset.nodup_iff_count_le_one Multiset.nodup_iff_count_le_one

@[simp]
theorem count_eq_one_of_mem [DecidableEq α] {a : α} {s : Multiset α} (d : Nodup s) (h : a ∈ s) :
    count a s = 1 :=
  le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)
#align multiset.count_eq_one_of_mem Multiset.count_eq_one_of_mem

theorem count_eq_of_nodup [DecidableEq α] {a : α} {s : Multiset α} (d : Nodup s) :
    count a s = if a ∈ s then 1 else 0 :=
  by
  split_ifs with h
  · exact count_eq_one_of_mem d h
  · exact count_eq_zero_of_not_mem h
#align multiset.count_eq_of_nodup Multiset.count_eq_of_nodup

theorem nodup_iff_pairwise {α} {s : Multiset α} : Nodup s ↔ Pairwise (· ≠ ·) s :=
  Quotient.inductionOn s fun _ => (pairwise_coe_iff_pairwise fun _ _ => Ne.symm).symm
#align multiset.nodup_iff_pairwise Multiset.nodup_iff_pairwise

protected

theorem Pairwise.forall (H : Symmetric r) (hs : Pairwise r s) :
    ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → a ≠ b → r a b :=
  let ⟨_, hl₁, hl₂⟩ := hs
  hl₁.symm ▸ hl₂.forall H
#align multiset.pairwise.forall Multiset.Pairwise.forall

theorem nodup_add {s t : Multiset α} : Nodup (s + t) ↔ Nodup s ∧ Nodup t ∧ Disjoint s t :=
  Quotient.inductionOn₂ s t fun _ _ => nodup_append
#align multiset.nodup_add Multiset.nodup_add

theorem disjoint_of_nodup_add {s t : Multiset α} (d : Nodup (s + t)) : Disjoint s t :=
  (nodup_add.1 d).2.2
#align multiset.disjoint_of_nodup_add Multiset.disjoint_of_nodup_add

theorem Nodup.add_iff (d₁ : Nodup s) (d₂ : Nodup t) : Nodup (s + t) ↔ Disjoint s t := by
  simp [nodup_add, d₁, d₂]
#align multiset.nodup.add_iff Multiset.Nodup.add_iff

theorem Nodup.of_map (f : α → β) : Nodup (map f s) → Nodup s :=
  Quot.induction_on s fun _ => List.Nodup.of_map f
#align multiset.nodup.of_map Multiset.Nodup.of_map

theorem Nodup.map_on {f : α → β} :
    (∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y) → Nodup s → Nodup (map f s) :=
  Quot.induction_on s fun _ => List.Nodup.map_on
#align multiset.nodup.map_on Multiset.Nodup.map_on

theorem Nodup.map {f : α → β} {s : Multiset α} (hf : Injective f) : Nodup s → Nodup (map f s) :=
  Nodup.map_on fun _ _ _ _ h => hf h
#align multiset.nodup.map Multiset.Nodup.map

theorem inj_on_of_nodup_map {f : α → β} {s : Multiset α} :
    Nodup (map f s) → ∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y :=
  Quot.induction_on s fun _ => List.inj_on_of_nodup_map
#align multiset.inj_on_of_nodup_map Multiset.inj_on_of_nodup_map

theorem nodup_map_iff_inj_on {f : α → β} {s : Multiset α} (d : Nodup s) :
    Nodup (map f s) ↔ ∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y :=
  ⟨inj_on_of_nodup_map, fun h => d.map_on h⟩
#align multiset.nodup_map_iff_inj_on Multiset.nodup_map_iff_inj_on

theorem Nodup.filter (p : α → Prop) [DecidablePred p] {s} : Nodup s → Nodup (filter p s) :=
  Quot.induction_on s fun _ => List.Nodup.filter (p ·)
#align multiset.nodup.filter Multiset.Nodup.filter

@[simp]
theorem nodup_attach {s : Multiset α} : Nodup (attach s) ↔ Nodup s :=
  Quot.induction_on s fun _ => List.nodup_attach
#align multiset.nodup_attach Multiset.nodup_attach

theorem Nodup.pmap {p : α → Prop} {f : ∀ a, p a → β} {s : Multiset α} {H}
    (hf : ∀ a ha b hb, f a ha = f b hb → a = b) : Nodup s → Nodup (pmap f s H) :=
  Quot.induction_on s (fun _ _ => List.Nodup.pmap hf) H
#align multiset.nodup.pmap Multiset.Nodup.pmap

instance nodupDecidable [DecidableEq α] (s : Multiset α) : Decidable (Nodup s) :=
  Quotient.recOnSubsingleton s fun l => l.nodupDecidable
#align multiset.nodup_decidable Multiset.nodupDecidable

theorem Nodup.erase_eq_filter [DecidableEq α] (a : α) {s} :
    Nodup s → s.erase a = Multiset.filter (· ≠ a) s :=
  Quot.induction_on s fun _ d =>
    congr_arg ((↑) : List α → Multiset α) <| List.Nodup.erase_eq_filter d a
#align multiset.nodup.erase_eq_filter Multiset.Nodup.erase_eq_filter

theorem Nodup.erase [DecidableEq α] (a : α) {l} : Nodup l → Nodup (l.erase a) :=
  nodup_of_le (erase_le _ _)
#align multiset.nodup.erase Multiset.Nodup.erase

theorem Nodup.mem_erase_iff [DecidableEq α] {a b : α} {l} (d : Nodup l) :
    a ∈ l.erase b ↔ a ≠ b ∧ a ∈ l := by
  rw [d.erase_eq_filter b, mem_filter, and_comm]
#align multiset.nodup.mem_erase_iff Multiset.Nodup.mem_erase_iff

theorem Nodup.not_mem_erase [DecidableEq α] {a : α} {s} (h : Nodup s) : a ∉ s.erase a := fun ha =>
  (h.mem_erase_iff.1 ha).1 rfl
#align multiset.nodup.not_mem_erase Multiset.Nodup.not_mem_erase

protected theorem Nodup.product {t : Multiset β} : Nodup s → Nodup t → Nodup (product s t) :=
  Quotient.inductionOn₂ s t fun l₁ l₂ d₁ d₂ => by simp [List.Nodup.product d₁ d₂]
#align multiset.nodup.product Multiset.Nodup.product

protected theorem Nodup.sigma {σ : α → Type _} {t : ∀ a, Multiset (σ a)} :
    Nodup s → (∀ a, Nodup (t a)) → Nodup (s.sigma t) :=
  Quot.induction_on s fun l₁ => by
    choose f hf using fun a => Quotient.exists_rep (t a)
    simpa [←funext hf] using List.Nodup.sigma
#align multiset.nodup.sigma Multiset.Nodup.sigma

protected theorem Nodup.filterMap (f : α → Option β) (H : ∀ a a' b, b ∈ f a → b ∈ f a' → a = a') :
    Nodup s → Nodup (filterMap f s) :=
  Quot.induction_on s fun _ => List.Nodup.filterMap H
#align multiset.nodup.filter_map Multiset.Nodup.filterMap

theorem nodup_range (n : ℕ) : Nodup (range n) :=
  List.nodup_range _
#align multiset.nodup_range Multiset.nodup_range

theorem Nodup.inter_left [DecidableEq α] (t) : Nodup s → Nodup (s ∩ t) :=
  nodup_of_le <| inter_le_left _ _
#align multiset.nodup.inter_left Multiset.Nodup.inter_left

theorem Nodup.inter_right [DecidableEq α] (s) : Nodup t → Nodup (s ∩ t) :=
  nodup_of_le <| inter_le_right _ _
#align multiset.nodup.inter_right Multiset.Nodup.inter_right

@[simp]
theorem nodup_union [DecidableEq α] {s t : Multiset α} : Nodup (s ∪ t) ↔ Nodup s ∧ Nodup t :=
  ⟨fun h => ⟨nodup_of_le (le_union_left _ _) h, nodup_of_le (le_union_right _ _) h⟩, fun ⟨h₁, h₂⟩ =>
    nodup_iff_count_le_one.2 fun a => by
      rw [count_union]
      exact max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩
#align multiset.nodup_union Multiset.nodup_union

@[simp]
theorem nodup_bind {s : Multiset α} {t : α → Multiset β} :
    Nodup (bind s t) ↔ (∀ a ∈ s, Nodup (t a)) ∧ s.Pairwise fun a b => Disjoint (t a) (t b) :=
  have h₁ : ∀ a, ∃ l : List β, t a = l := fun a => Quot.induction_on (t a) fun l => ⟨l, rfl⟩
  let ⟨t', h'⟩ := Classical.axiom_of_choice h₁
  have : t = fun a => ofList (t' a) := funext h'
  have hd : Symmetric fun a b => List.Disjoint (t' a) (t' b) := fun a b h => h.symm
  Quot.induction_on s <| by simp [this, List.nodup_bind, pairwise_coe_iff_pairwise hd]
#align multiset.nodup_bind Multiset.nodup_bind

theorem Nodup.ext {s t : Multiset α} : Nodup s → Nodup t → (s = t ↔ ∀ a, a ∈ s ↔ a ∈ t) :=
  Quotient.inductionOn₂ s t fun _ _ d₁ d₂ => Quotient.eq.trans <| perm_ext d₁ d₂
#align multiset.nodup.ext Multiset.Nodup.ext

theorem le_iff_subset {s t : Multiset α} : Nodup s → (s ≤ t ↔ s ⊆ t) :=
  Quotient.inductionOn₂ s t fun _ _ d => ⟨subset_of_le, d.subperm⟩
#align multiset.le_iff_subset Multiset.le_iff_subset

theorem range_le {m n : ℕ} : range m ≤ range n ↔ m ≤ n :=
  (le_iff_subset (nodup_range _)).trans range_subset
#align multiset.range_le Multiset.range_le

theorem mem_sub_of_nodup [DecidableEq α] {a : α} {s t : Multiset α} (d : Nodup s) :
    a ∈ s - t ↔ a ∈ s ∧ a ∉ t :=
  ⟨fun h =>
    ⟨mem_of_le tsub_le_self h, fun h' => by
      refine' count_eq_zero.1 _ h
      rw [count_sub a s t, tsub_eq_zero_iff_le]
      exact le_trans (nodup_iff_count_le_one.1 d _) (count_pos.2 h')⟩,
    fun ⟨h₁, h₂⟩ => Or.resolve_right (mem_add.1 <| mem_of_le le_tsub_add h₁) h₂⟩
#align multiset.mem_sub_of_nodup Multiset.mem_sub_of_nodup

theorem map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : Multiset α} {t : Multiset β}
    (hs : s.Nodup) (ht : t.Nodup) (i : ∀ a ∈ s, β) (hi : ∀ a ha, i a ha ∈ t)
    (h : ∀ a ha, f a = g (i a ha)) (i_inj : ∀ a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂)
    (i_surj : ∀ b ∈ t, ∃ a ha, b = i a ha) : s.map f = t.map g :=
  have : t = s.attach.map fun x => i x.1 x.2 :=
    (ht.ext <|
          (nodup_attach.2 hs).map <|
            show Injective fun x : { x // x ∈ s } => i x x.2 from fun x y hxy =>
              Subtype.ext <| i_inj x y x.2 y.2 hxy).2
      fun x => by
        simp only [mem_map, true_and_iff, Subtype.exists, eq_comm, mem_attach]
        exact ⟨i_surj _, fun ⟨y, hy⟩ => hy.snd.symm ▸ hi _ _⟩
  calc
    s.map f = s.pmap (fun x _ => f x) fun _ => id := by rw [pmap_eq_map]
    _ = s.attach.map fun x => f x.1 := by rw [pmap_eq_map_attach]
    _ = t.map g := by rw [this, Multiset.map_map]; exact map_congr rfl fun x _ => h _ _

#align multiset.map_eq_map_of_bij_of_nodup Multiset.map_eq_map_of_bij_of_nodup

end Multiset


import .matroid

variables {E : Type*} [finite E] {M : matroid E} {I J I' J' I₁ I₂ B B' X Y : set E} {e f : E}

open set
namespace matroid

section indep

lemma indep_iff_subset_base :
  M.indep I ↔ ∃ B, M.base B ∧ I ⊆ B :=
iff.rfl

lemma empty_indep (M : matroid E) : M.indep ∅ :=
  exists.elim M.exists_base (λ B hB, ⟨_, hB, B.empty_subset⟩)

lemma indep_mono {M : matroid E} {I J : set E} (hIJ : I ⊆ J) (hJ : M.indep J) : M.indep I :=
by {obtain ⟨B, hB, hJB⟩ := hJ, exact ⟨B, hB, hIJ.trans hJB⟩}

lemma indep.exists_base_supset (hI : M.indep I) :
  ∃ B, M.base B ∧ I ⊆ B :=
hI

lemma indep.subset (hJ : M.indep J) (hIJ : I ⊆ J) : M.indep I :=
by {obtain ⟨B, hB, hJB⟩ := hJ, exact ⟨B, hB, hIJ.trans hJB⟩}

lemma indep.inter_right (hI : M.indep I) (X : set E) :
  M.indep (I ∩ X) :=
hI.subset (inter_subset_left _ _)

lemma indep.inter_left (hI : M.indep I) (X : set E) :
  M.indep (X ∩ I) :=
hI.subset (inter_subset_right _ _)

lemma indep.diff (hI : M.indep I) (X : set E) :
  M.indep (I \ X) :=
hI.subset (diff_subset _ _)

/-- The independence augmentation axiom; given independent sets `I,J` with `I` smaller than `J`,
  there is an element `e` of `J \ I` whose insertion into `e` is an independent set.  -/
lemma indep.augment (hI : M.indep I) (hJ : M.indep J) (hIJ : I.ncard < J.ncard) :
  ∃ x ∈ J, x ∉ I ∧ M.indep (insert x I) :=
begin
  suffices h_mod : ∀ {p} {I₁ I₂ B₁ B₂}, M.base B₁ → M.base B₂ → I₁ ⊆ B₁ → I₂ ⊆ B₂ →
    I₁.ncard < I₂.ncard → (B₂ \ (I₂ ∪ B₁)).ncard = p → ∃ x ∈ I₂, x ∉ I₁ ∧ M.indep (insert x I₁),
  { obtain ⟨⟨BI,hBI,hIBI⟩,⟨BJ, hBJ, hJBJ⟩⟩ := ⟨hI,hJ⟩,
    exact h_mod hBI hBJ hIBI hJBJ hIJ rfl },
  clear hI hJ hIJ I J,
  intro p, induction p with p IH,
  all_goals
  { intros _ _ _ _ hB₁ hB₂ hI₁B₁ hI₂B₂ h_lt h_le} ,
  { rw [ncard_eq_zero, diff_eq_empty] at h_le,
    by_contra' h_con,
    apply h_lt.not_le,
    have h₁₂ : B₂ \ B₁ = I₂ \ I₁,
    { apply subset_antisymm,
      {  calc _ ⊆ _  : diff_subset_diff_left h_le
            ... = _  : union_diff_right
             ... ⊆ _ : diff_subset_diff_right hI₁B₁},
      rintros x ⟨hxI₂, hxI₁⟩,
      exact ⟨mem_of_mem_of_subset hxI₂ hI₂B₂,
        λ hxB₁, h_con _ hxI₂ hxI₁ ⟨B₁, hB₁, insert_subset.mpr ⟨ hxB₁,hI₁B₁⟩⟩⟩},

    have hB₁ss : B₁ ⊆ I₁ ∪ B₂,
    { intros y hyB₁,
      rw [mem_union, or_iff_not_imp_right],
      intro hyB₂,
      obtain ⟨x,hx, hB'⟩ := hB₁.exchange hB₂ ⟨hyB₁, hyB₂⟩,
      obtain (hxI₂ | hxB₁') := mem_of_mem_of_subset hx.1 h_le,
      swap, exact (hx.2 hxB₁').elim,
      by_contradiction hyI₁,
      refine h_con x hxI₂ (not_mem_subset hI₁B₁ hx.2)
        ⟨_, hB', insert_subset.mpr ⟨by simp, subset_trans _ (subset_insert _ _)⟩⟩,
      apply subset_diff_singleton hI₁B₁ hyI₁},
    have hss₁ := calc B₁ \ B₂ ⊆ _       : diff_subset_diff_left hB₁ss
                          ... = _       : union_diff_right
                          ... ⊆ I₁ \ I₂ : diff_subset_diff_right hI₂B₂,

    have hle₁ := ncard_le_of_subset hss₁,

    rwa [(ncard_eq_ncard_iff_ncard_diff_eq_ncard_diff (to_finite _) (to_finite _)).mp
      (hB₁.card_eq_card_of_base hB₂), h₁₂, ← ncard_le_ncard_iff_ncard_diff_le_ncard_diff] at hle₁,

    -- , h₁₂,
    --   ← ncard_le_ncard_iff_ncard_diff_le_ncard_diff] at hle₁

      },
  have h_ne : (B₂ \ (I₂ ∪ B₁)).nonempty,
  { rw [←ncard_pos, h_le], apply nat.succ_pos _},
  obtain ⟨x, hxB₂, hx'⟩ := h_ne,
  rw [set.mem_union, not_or_distrib] at hx', obtain ⟨hxI₂, hxB₁⟩:= hx',
  obtain ⟨y, ⟨hyB₁, hyB₂⟩, hB'⟩ := hB₂.exchange hB₁ ⟨hxB₂,hxB₁⟩,
  have hI₂B' : I₂ ⊆ insert y (B₂ \ {x}),
  { rw ←union_singleton,
    apply set.subset_union_of_subset_left, apply subset_diff_singleton hI₂B₂ hxI₂},

  refine IH hB₁ hB' hI₁B₁ hI₂B' h_lt _,
  suffices h_set_eq : (insert y (B₂ \ {x})) \ (I₂ ∪ B₁) = (B₂ \ (I₂ ∪ B₁)) \ {x},
  { rw [←nat.succ_inj', h_set_eq, ←h_le, nat.succ_eq_add_one, ncard_diff_singleton_add_one],
    exact ⟨hxB₂, not_or hxI₂ hxB₁⟩},
  rw [insert_diff_of_mem _ (mem_union_right _ hyB₁)],
  rw [diff_diff_comm],
end

/-- The independence augmentation axiom in a form that finds a strict superset -/
lemma indep.ssubset_indep_of_card_lt (hI : M.indep I) (hJ : M.indep J) (hIJ : I.ncard < J.ncard) :
  ∃ I', M.indep I' ∧ I ⊂ I' ∧ I' ⊆ I ∪ J :=
begin
  obtain ⟨e, heJ, heI, hI'⟩ := hI.augment hJ hIJ,
  exact ⟨_, hI', ssubset_insert heI, insert_subset.mpr ⟨or.inr heJ,subset_union_left _ _⟩⟩,
end

lemma base.indep (hB : M.base B) : M.indep B := ⟨B, hB, subset_rfl⟩

lemma base.eq_of_subset_indep (hB : M.base B) (hI : M.indep I) (hBI : B ⊆ I) :
  B = I :=
begin
  apply eq_of_subset_of_ncard_le hBI,
  obtain ⟨B', hB', hIB'⟩ := hI,
  rw hB.card_eq_card_of_base hB',
  exact ncard_le_of_subset hIB',
end

lemma base_iff_maximal_indep :
  M.base B ↔ M.indep B ∧ ∀ I, M.indep I → B ⊆ I → B = I :=
begin
  refine ⟨λ h, ⟨h.indep, λ _, h.eq_of_subset_indep ⟩,λ h, _⟩,
  obtain ⟨⟨B', hB', hBB'⟩, h⟩ := h,
  rwa h _ hB'.indep hBB',
end

lemma base.dep_of_ssubset (hB : M.base B) (h : B ⊂ X) :
  ¬M.indep X :=
λ hX, h.ne (hB.eq_of_subset_indep hX h.subset)

lemma base.dep_of_insert (hB : M.base B) (he : e ∉ B) :
  ¬M.indep (insert e B) :=
hB.dep_of_ssubset (ssubset_insert he)

lemma indep_not_base :
  M.base B → M.indep B' → B' ⊂ B → ¬ M.base B' :=
begin
  intros hB hB' hBB',
    by_contra,
    apply (ne_of_ssubset hBB') (base.eq_of_subset_base h hB (subset_of_ssubset hBB')),
end

/- This proof deliberately avoids cardinality -/
lemma base.exchange_base_of_indep (hB : M.base B) (he : e ∈ B) (hf : f ∉ B)
(hI : M.indep (insert f (B \ {e}))) :
  M.base (insert f (B \ {e})) :=
begin
  obtain ⟨B', hB', hIB'⟩ := hI,
  have hBeB' := (subset_insert _ _).trans hIB',
  have heB' : e ∉ B',
  { intro heB',
    have hBB' : B ⊆ B',
    { refine subset_trans _ (insert_subset.mpr ⟨heB',hIB'⟩),
      rw [insert_comm, insert_diff_singleton],
      refine (subset_insert _ _).trans (subset_insert _ _)},
    rw ←hB.eq_of_subset_indep hB'.indep hBB' at hIB',
    exact hf (hIB' (mem_insert _ _))},
  obtain ⟨y,hy,hy'⟩ := hB.exchange hB' ⟨he,heB'⟩,
  rw ←hy'.eq_of_subset_base hB' (insert_subset.mpr ⟨hy.1, hBeB'⟩) at hIB',
  have : f = y,
  { exact (mem_insert_iff.mp (hIB' (mem_insert _ _))).elim id
      (λ h', (hf (diff_subset _ _ h')).elim)},
  rwa this,
end

lemma indep_not_base_ssubset : M.indep B' → ¬ M.base B' → ∃ (B : set E), M.base B ∧ B' ⊂ B :=
begin
  intros hB' hBn',
  rw indep_iff_subset_base at hB',
  rcases hB' with ⟨B, ⟨hB1, hB2⟩⟩,
  use B,
  refine ⟨hB1, _⟩,
  apply ssubset_of_ne_of_subset _ hB2,
  by_contra,
  apply hBn',
  rw ← h at hB1,
  exact hB1,
end

lemma base_of_ncard_eq_indep : M.base B → M.indep B' ∧ B'.ncard = B.ncard → M.base B' :=
begin
  rintros hB ⟨hB', hBB'⟩,
  by_contra,
  rcases indep_not_base_ssubset hB' h with ⟨B2, ⟨hB21, hB22⟩⟩,
  have h2 := ncard_lt_ncard hB22,
  rw hBB' at h2,
  apply ne_of_lt h2,
  exact base.card_eq_card_of_base hB hB21,
end

lemma base.insert_dep (hB : M.base B) (h : e ∉ B) : ¬ M.indep (insert e B) :=
  λ h', (insert_ne_self.mpr h).symm ((base_iff_maximal_indep.mp hB).2 _ h' (subset_insert _ _))

lemma base.ssubset_dep (hB : M.base B) (h : B ⊂ X) : ¬ M.indep X :=
  λ h', h.ne ((base_iff_maximal_indep.mp hB).2 _ h' h.subset)

lemma eq_of_indep_iff_indep_forall {M₁ M₂ : matroid E} (h : ∀ I, (M₁.indep I ↔ M₂.indep I)) :
  M₁ = M₂ :=
begin
  ext B,
  have hI : M₁.indep = M₂.indep, by { ext ,apply h},
  simp_rw [base_iff_maximal_indep, hI],
end

end indep

section basis

lemma basis.indep (hI : M.basis I X) : M.indep I := hI.1

lemma basis.subset (hI : M.basis I X) : I ⊆ X := hI.2.1

lemma basis_iff :
  M.basis I X ↔ M.indep I ∧ I ⊆ X ∧ ∀ J, M.indep J → I ⊆ J → J ⊆ X → I = J :=
iff.rfl

@[simp] lemma basis_empty_iff (M : matroid E) :
  M.basis I ∅ ↔ I = ∅ :=
begin
  refine ⟨λ h, subset_empty_iff.mp h.subset, _⟩,
  rintro rfl,
  exact ⟨M.empty_indep, empty_subset _, λ J h h' hJ, h'.antisymm hJ⟩,
end

lemma empty_basis_empty (M : matroid E) :
  M.basis ∅ ∅ :=
M.basis_empty_iff.mpr rfl

lemma basis.eq_of_subset_indep (hI : M.basis I X) {J : set E} (hJ : M.indep J) (hIJ : I ⊆ J)
(hJX : J ⊆ X) :
  I = J :=
hI.2.2 J hJ hIJ hJX

lemma basis.basis_subset (hI : M.basis I X) (hIY : I ⊆ Y) (hYX : Y ⊆ X) :
  M.basis I Y :=
⟨hI.indep, hIY, λ J hJ hIJ hJY, hI.eq_of_subset_indep hJ hIJ (hJY.trans hYX)⟩

lemma basis.dep_of_ssubset (hI : M.basis I X) {Y : set E} (hIY : I ⊂ Y) (hYX : Y ⊆ X) :
  ¬ M.indep Y :=
λ hY, hIY.ne (hI.eq_of_subset_indep hY hIY.subset hYX)

lemma basis.insert_dep (hI : M.basis I X) (he : e ∈ X \ I) :
  ¬M.indep (insert e I) :=
hI.dep_of_ssubset (ssubset_insert he.2) (insert_subset.mpr ⟨he.1,hI.subset⟩)

lemma basis.not_basis_of_ssubset (hI : M.basis I X) (hJI : J ⊂ I) :
  ¬ M.basis J X :=
λ h, hJI.ne (h.eq_of_subset_indep hI.indep hJI.subset hI.subset)

lemma indep.subset_basis_of_subset (hI : M.indep I) (hIX : I ⊆ X) :
  ∃ J, I ⊆ J ∧ M.basis J X :=
begin
  obtain ⟨J, ⟨hJ,hIJ,hJX⟩, hJmax⟩ := finite.exists_maximal (λ J, M.indep J ∧ I ⊆ J ∧ J ⊆ X)
    ⟨I, hI, rfl.subset, hIX⟩,
  exact ⟨J, hIJ, hJ, hJX, λ K hK hJK hKX, hJmax K ⟨hK, hIJ.trans hJK, hKX⟩ hJK⟩,
end

lemma indep.le_card_basis (hI : M.indep I) (hIX : I ⊆ X) (hJX : M.basis J X) :
  I.ncard ≤ J.ncard :=
begin
  refine le_of_not_lt (λ hlt, _),
  obtain ⟨I', hI'⟩ := hJX.indep.ssubset_indep_of_card_lt hI hlt,
  have := hJX.eq_of_subset_indep hI'.1 hI'.2.1.subset (hI'.2.2.trans (union_subset hJX.subset hIX)),
  subst this,
  exact hI'.2.1.ne rfl,
end

lemma indep.eq_of_basis (hI : M.indep I) (hJ : M.basis J I) :
  J = I :=
hJ.eq_of_subset_indep hI hJ.subset subset.rfl

lemma indep.basis_self (hI : M.indep I) :
  M.basis I I :=
⟨hI, rfl.subset, λ J hJ, subset_antisymm⟩

@[simp] lemma basis_self_iff_indep :
  M.basis I I ↔ M.indep I :=
⟨basis.indep, indep.basis_self⟩

lemma exists_basis (M : matroid E) (X : set E) :
  ∃ I, M.basis I X :=
by {obtain ⟨I, -, hI⟩ := M.empty_indep.subset_basis_of_subset (empty_subset X), exact ⟨_,hI⟩, }

lemma basis.exists_base (hI : M.basis I X) :
  ∃ B, M.base B ∧ I = B ∩ X :=
begin
  obtain ⟨B,hB, hIB⟩ := hI.indep,
  refine ⟨B, hB, subset_antisymm (subset_inter hIB hI.subset) _⟩,
  rw hI.eq_of_subset_indep (hB.indep.inter_right X) (subset_inter hIB hI.subset)
    (inter_subset_right _ _),
end

lemma basis_iff_base_inter :
  M.basis I X ↔ ∃ B, M.base B ∧ I = B ∩ X ∧
    ∀ B', M.base B' → B ∩ X ⊆ B' ∩ X → B ∩ X = B' ∩ X :=
begin
  refine ⟨λ h, _,_⟩,
  { obtain ⟨B,hB,rfl⟩ := h.exists_base,
    refine ⟨B,hB,rfl,λ B' hB' hss,
      h.eq_of_subset_indep (hB'.indep.inter_right X) hss (inter_subset_right _ _)⟩},
  rintros ⟨B,hB,rfl,hBmax⟩,
  refine ⟨hB.indep.inter_right X, inter_subset_right _ _, _⟩,
  rintros J ⟨B',hB',hB'J⟩ hBXJ hJX ,
  refine hBXJ.antisymm _,
  rw hBmax B' hB' (subset_inter (hBXJ.trans hB'J) (inter_subset_right _ _)),
  exact subset_inter hB'J hJX,
end

lemma base_iff_basis_univ :
  M.base B ↔ M.basis B univ :=
by {rw [base_iff_maximal_indep, basis], simp}

lemma base.basis_univ (hB : M.base B) :
  M.basis B univ :=
base_iff_basis_univ.mp hB

end basis

end matroid

section from_axioms

/-- A collection of sets satisfying the independence axioms determines a matroid -/
def matroid_of_indep (indep : set E → Prop)
(exists_ind : ∃ I, indep I)
(ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
(ind_aug : ∀ I J, indep I → indep J → I.ncard < J.ncard →
  ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) :
  matroid E :=
{ base := λ B, indep B ∧ ∀ X, indep X → B ⊆ X → X = B,
  exists_base' :=
    by exact
      (@set.finite.exists_maximal_wrt (set E) (set E) _ id indep (to_finite _) exists_ind).imp
      (λ B hB, exists.elim hB (λ hB h, ⟨hB, λ X hX hBX, (h X hX hBX).symm⟩)),
  base_exchange' :=
  begin
    set is_base := λ (B : set E), indep B ∧ ∀ X, indep X → B ⊆ X → X = B with hbase,
    rintro B₁ B₂ hB₁ hB₂ x ⟨hxB₁,hxB₂⟩,

    have h_base_iff : ∀ B B' (hB' : is_base B'),
      is_base B ↔ indep B ∧ B'.ncard ≤ B.ncard,
    { intros B B' hB', split,
      { refine λ hB, ⟨hB.1, le_of_not_lt (λ hlt, _)⟩,
        obtain ⟨e,heB,heB',he⟩ := ind_aug B B' hB.1 hB'.1 hlt,
        exact heB' (by simpa using hB.2 _ he (subset_insert _ _))},
      rintros ⟨hBI, hB'B⟩ ,
      refine ⟨hBI, λ J hJ hBJ, (hBJ.antisymm (by_contra (λhJB, _))).symm⟩,
      have hss := ssubset_of_subset_not_subset hBJ hJB,
      obtain ⟨e,heJ,heB',he⟩ :=
        ind_aug B' J hB'.1 hJ (hB'B.trans_lt (ncard_lt_ncard hss)),
      exact heB' (by simpa using hB'.2 _ he (subset_insert _ _))},

    simp_rw [h_base_iff _ _ hB₁, mem_diff],
    have hcard : (B₁ \ {x}).ncard < B₂.ncard,
    { rw [nat.lt_iff_add_one_le, ncard_diff_singleton_add_one hxB₁],
      exact ((h_base_iff _ _ hB₁).mp hB₂).2},

    obtain ⟨e,heB₂,heB₁x,he⟩ :=
      ind_aug (B₁ \ {x}) B₂ (ind_mono _ _ (diff_subset _ _) hB₁.1) hB₂.1 hcard,
    have hex : e ≠ x := by {rintro rfl, exact hxB₂ heB₂},
    have heB₁ : e ∉ B₁,
    { simp only [mem_diff, mem_singleton_iff, not_and, not_not] at heB₁x,
      exact λ h', hex (heB₁x h')},

    refine ⟨e,⟨heB₂,heB₁⟩,he,_⟩,
    rwa [ncard_insert_of_not_mem heB₁x, ncard_diff_singleton_add_one],
  end  }

@[simp] lemma matroid_of_indep_base_iff {indep : set E → Prop}
  (exists_ind : ∃ I, indep I)
  (ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
  (ind_aug : ∀ I J, indep I → indep J → I.ncard < J.ncard →
    ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) {B : set E }:
(matroid_of_indep indep exists_ind ind_mono ind_aug).base B ↔
  indep B ∧ ∀ X, indep X → B ⊆ X → X = B :=
iff.rfl

@[simp] lemma matroid_of_indep_apply {indep : set E → Prop}
  (exists_ind : ∃ I, indep I)
  (ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
  (ind_aug : ∀ I J, indep I → indep J → I.ncard < J.ncard →
    ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) :
  (matroid_of_indep indep exists_ind ind_mono ind_aug).indep = indep :=
begin
  ext I,
  simp_rw [matroid.indep_iff_subset_base, matroid_of_indep],
  split,
  { rintro ⟨B, ⟨hBi,hB⟩, hIB⟩,
    exact ind_mono _ _ hIB hBi},
  intro hI,
  obtain ⟨B,hBi, hB⟩ :=
    @set.finite.exists_maximal_wrt (set E) (set E) _ id {J | I ⊆ J ∧ indep J} (to_finite _)
    ⟨I, subset_refl I, hI⟩,
  simp only [mem_set_of_eq, id.def, le_eq_subset, and_imp] at hB hBi,
  exact ⟨B, ⟨hBi.2, λ X hX hBX, (hB _ (hBi.1.trans hBX) hX hBX).symm⟩, hBi.1⟩,
end

end from_axioms

/- Another version of the independence axioms that doesn't mention cardinality. TODO -/
-- def matroid_of_indep' (indep : set E → Prop) (exists_ind : ∃ I, indep I)
-- (ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
-- (ind_aug : ∀ I J, indep I → indep J → (∃ I', I ⊂ I' ∧ indep I') → (∀ J', J ⊂ J' → ¬indep J')
--   → (∃ x ∈ J \ I, indep (insert x I))) :
--   matroid E :=
-- { base := λ B, indep B ∧ ∀ I, B ⊆ I → indep I → I = B,
--   exists_base' :=
--   begin
--     obtain ⟨B,hB,hBmax⟩ := finite.exists_maximal indep exists_ind,
--     exact ⟨B, hB, λ I hBI hI, (hBmax _ hI hBI).symm⟩,
--   end,
--   base_exchange' :=
--   begin
--     rintro B₁ B₂ ⟨hB₁,hB₁max⟩ ⟨hB₂,hB₂max⟩ x hx,
--     obtain ⟨y,hy,hyI⟩ := ind_aug (B₁ \ {x}) B₂ (ind_mono _ _ (diff_subset _ _) hB₁) hB₂
--       ⟨B₁, diff_singleton_ssubset hx.1, hB₁⟩
--       (λ J hB₂J hJ, hB₂J.ne ((hB₂max _ hB₂J.subset hJ).symm)),
--     refine ⟨y, mem_of_mem_of_subset hy _, hyI, λ I hyI hI, _⟩  ,
--     { rw [diff_diff_right, inter_singleton_eq_empty.mpr hx.2, union_empty]},

--     -- rintro I J hI hJ hImax ⟨J',hJJ',hJ'⟩,


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.nat.interval
import data.nat.prime
import group_theory.perm.sign
import tactic.fin_cases

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  simp, assumption,
  simp, assumption,
  simp, assumption,
end

example (f : ℕ → Prop) (p : fin 0) : f p.val :=
by fin_cases *

example (f : ℕ → Prop) (p : fin 1) (h : f 0) : f p.val :=
begin
  fin_cases p,
  assumption
end

example (x2 : fin 2) (x3 : fin 3) (n : nat) (y : fin n) : x2.val * x3.val = x3.val * x2.val :=
begin
  fin_cases x2;
  fin_cases x3,
  success_if_fail { fin_cases * },
  success_if_fail { fin_cases y },
  all_goals { refl },
end

open finset
example (x : ℕ) (h : x ∈ Ico 2 5) : x = 2 ∨ x = 3 ∨ x = 4 :=
begin
  fin_cases h,
  all_goals { simp }
end

open nat
example (x : ℕ) (h : x ∈ [2,3,5,7]) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h,
  all_goals { simp }
end

example (x : ℕ) (h : x ∈ [2,3,5,7]) : true :=
begin
  success_if_fail { fin_cases h with [3,3,5,7] },
  trivial
end

example (x : list ℕ) (h : x ∈ [[1],[2]]) : x.length = 1 :=
begin
  fin_cases h with [[1],[1+1]],
  simp,
  guard_target (list.length [1 + 1] = 1),
  simp
end

 -- testing that `with` arguments are elaborated with respect to the expected type:
example (x : ℤ) (h : x ∈ ([2,3] : list ℤ)) : x = 2 ∨ x = 3 :=
begin
  fin_cases h with [2,3],
  all_goals { simp }
end

instance (n : ℕ) : decidable (nat.prime n) := decidable_prime_1 n
example (x : ℕ) (h : x ∈ (range 10).filter nat.prime) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h; exact dec_trivial
end

open equiv.perm
example (x : (Σ (a : fin 4), fin 4)) (h : x ∈ fin_pairs_lt 4) : x.1.val < 4 :=
begin
  fin_cases h; simp,
  any_goals { exact dec_trivial },
end

example (x : fin 3) : x.val < 5 :=
begin
  fin_cases x; exact dec_trivial
end

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  all_goals { assumption }
end

example (n : ℕ) (h : n % 3 ∈ [0,1]) : true :=
begin
  fin_cases h,
  guard_hyp h : n % 3 = 0, trivial,
  guard_hyp h : n % 3 = 1, trivial,
end

/-
In some circumstances involving `let`,
the temporary hypothesis that `fin_cases` creates does not get deleted.
We test that this is correctly named and that the name can be changed.
-/
example (f : ℕ → fin 3) : true :=
begin
  let a := f 3,
  fin_cases a,
  guard_hyp a := f 3,
  guard_hyp this : a = (0 : fin 3),
  trivial, trivial,

  let b := f 2,
  fin_cases b using what,
  guard_hyp what : b = (0 : fin 3),

  all_goals {trivial}
end

/-
The behavior above can be worked around with `fin_cases with`.
-/
example (f : ℕ → fin 3) : true :=
begin
  let a := f 3,
  fin_cases a with [0, 1, 2],
  guard_hyp a := f 3,
  guard_hyp this : a = 0,
  trivial,
  guard_hyp this : a = 1,
  trivial,
  guard_hyp this : a = 2,
  let b := f 2,
  fin_cases b with [0, 1, 2] using what,
  guard_hyp what : b = 0,
  all_goals {trivial}
end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen
-/
import algebra.group.hom
import algebra.module.basic
import algebra.group_action_hom

/-!
# Linear maps and linear equivalences

In this file we define

* `linear_map R M M₂`, `M →ₗ[R] M₂` : a linear map between two R-`module`s.

* `is_linear_map R f` : predicate saying that `f : M → M₂` is a linear map.

* `linear_equiv R M ₂`, `M ≃ₗ[R] M₂`: an invertible linear map

## Tags

linear map, linear equiv, linear equivalences, linear isomorphism, linear isomorphic
-/

open function
open_locale big_operators

universes u u' v w x y z
variables {R : Type u} {k : Type u'} {S : Type v} {M : Type w} {M₂ : Type x} {M₃ : Type y}
  {ι : Type z}

/-- A map `f` between modules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. The predicate `is_linear_map R f` asserts this
property. A bundled version is available with `linear_map`, and should be favored over
`is_linear_map` most of the time. -/
structure is_linear_map (R : Type u) {M : Type v} {M₂ : Type w}
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂]
  (f : M → M₂) : Prop :=
(map_add : ∀ x y, f (x + y) = f x + f y)
(map_smul : ∀ (c : R) x, f (c • x) = c • f x)

section

set_option old_structure_cmd true

/-- A map `f` between modules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. Elements of `linear_map R M M₂` (available under
the notation `M →ₗ[R] M₂`) are bundled versions of such maps. An unbundled version is available with
the predicate `is_linear_map`, but it should be avoided most of the time. -/
structure linear_map (R : Type u) (M : Type v) (M₂ : Type w)
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂]
  extends add_hom M M₂, M →[R] M₂

end

/-- The `add_hom` underlying a `linear_map`. -/
add_decl_doc linear_map.to_add_hom

/-- The `mul_action_hom` underlying a `linear_map`. -/
add_decl_doc linear_map.to_mul_action_hom

infixr ` →ₗ `:25 := linear_map _
notation M ` →ₗ[`:25 R:25 `] `:0 M₂:0 := linear_map R M M₂

namespace linear_map

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃]

section
variables [module R M] [module R M₂]

/-- The `distrib_mul_action_hom` underlying a `linear_map`. -/
def to_distrib_mul_action_hom (f : M →ₗ[R] M₂) : distrib_mul_action_hom R M M₂ :=
{ map_zero' := zero_smul R (0 : M) ▸ zero_smul R (f.to_fun 0) ▸ f.map_smul' 0 0, ..f }

instance : has_coe_to_fun (M →ₗ[R] M₂) := ⟨_, to_fun⟩

initialize_simps_projections linear_map (to_fun → apply)

@[simp] lemma coe_mk (f : M → M₂) (h₁ h₂) :
  ((linear_map.mk f h₁ h₂ : M →ₗ[R] M₂) : M → M₂) = f := rfl

/-- Identity map as a `linear_map` -/
def id : M →ₗ[R] M :=
⟨id, λ _ _, rfl, λ _ _, rfl⟩

lemma id_apply (x : M) :
  @id R M _ _ _ x = x := rfl

@[simp, norm_cast] lemma id_coe : ((linear_map.id : M →ₗ[R] M) : M → M) = _root_.id :=
by { ext x, refl }

end

section
variables [module R M] [module R M₂]
variables (f g : M →ₗ[R] M₂)

@[simp] lemma to_fun_eq_coe : f.to_fun = ⇑f := rfl

theorem is_linear : is_linear_map R f := ⟨f.2, f.3⟩

variables {f g}

theorem coe_injective : injective (λ f : M →ₗ[R] M₂, show M → M₂, from f) :=
by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr

@[ext] theorem ext (H : ∀ x, f x = g x) : f = g :=
coe_injective $ funext H

protected lemma congr_arg : Π {x x' : M}, x = x' → f x = f x'
| _ _ rfl := rfl

/-- If two linear maps are equal, they are equal at each point. -/
protected lemma congr_fun (h : f = g) (x : M) : f x = g x := h ▸ rfl

theorem ext_iff : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

@[simp] lemma mk_coe (f : M →ₗ[R] M₂) (h₁ h₂) :
  (linear_map.mk f h₁ h₂ : M →ₗ[R] M₂) = f := ext $ λ _, rfl

variables (f g)

@[simp] lemma map_add (x y : M) : f (x + y) = f x + f y := f.map_add' x y

@[simp] lemma map_smul (c : R) (x : M) : f (c • x) = c • f x := f.map_smul' c x

@[simp] lemma map_zero : f 0 = 0 :=
f.to_distrib_mul_action_hom.map_zero

variables (M M₂)
/--
A typeclass for `has_scalar` structures which can be moved through a `linear_map`.
This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that
we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if
`R` does not support negation.
-/
class compatible_smul (R S : Type*) [semiring S] [has_scalar R M]
  [module S M] [has_scalar R M₂] [module S M₂] :=
(map_smul : ∀ (f : M →ₗ[S] M₂) (c : R) (x : M), f (c • x) = c • f x)
variables {M M₂}

@[priority 100]
instance is_scalar_tower.compatible_smul
  {R S : Type*} [semiring S] [has_scalar R S]
  [has_scalar R M] [module S M] [is_scalar_tower R S M]
  [has_scalar R M₂] [module S M₂] [is_scalar_tower R S M₂] : compatible_smul M M₂ R S :=
⟨λ f c x, by rw [← smul_one_smul S c x, ← smul_one_smul S c (f x), map_smul]⟩

@[simp, priority 900]
lemma map_smul_of_tower {R S : Type*} [semiring S] [has_scalar R M]
  [module S M] [has_scalar R M₂] [module S M₂]
  [compatible_smul M M₂ R S] (f : M →ₗ[S] M₂) (c : R) (x : M) :
  f (c • x) = c • f x :=
compatible_smul.map_smul f c x

instance : is_add_monoid_hom f :=
{ map_add := map_add f,
  map_zero := map_zero f }

/-- convert a linear map to an additive map -/
def to_add_monoid_hom : M →+ M₂ :=
{ to_fun := f,
  map_zero' := f.map_zero,
  map_add' := f.map_add }

@[simp] lemma to_add_monoid_hom_coe : ⇑f.to_add_monoid_hom = f := rfl

variable (R)

/-- If `M` and `M₂` are both `R`-modules and `S`-modules and `R`-module structures
are defined by an action of `R` on `S` (formally, we have two scalar towers), then any `S`-linear
map from `M` to `M₂` is `R`-linear.

See also `linear_map.map_smul_of_tower`. -/
def restrict_scalars {S : Type*} [semiring S] [module S M] [module S M₂]
  [compatible_smul M M₂ R S] (f : M →ₗ[S] M₂) : M →ₗ[R] M₂ :=
{ to_fun := f,
  map_add' := f.map_add,
  map_smul' := f.map_smul_of_tower }

variable {R}

@[simp] lemma map_sum {ι} {t : finset ι} {g : ι → M} :
  f (∑ i in t, g i) = (∑ i in t, f (g i)) :=
f.to_add_monoid_hom.map_sum _ _

theorem to_add_monoid_hom_injective :
  function.injective (to_add_monoid_hom : (M →ₗ[R] M₂) → (M →+ M₂)) :=
λ f g h, ext $ add_monoid_hom.congr_fun h

/-- If two `R`-linear maps from `R` are equal on `1`, then they are equal. -/
@[ext] theorem ext_ring {f g : R →ₗ[R] M} (h : f 1 = g 1) : f = g :=
ext $ λ x, by rw [← mul_one x, ← smul_eq_mul, f.map_smul, g.map_smul, h]

theorem ext_ring_iff {f g : R →ₗ[R] M} : f = g ↔ f 1 = g 1 :=
⟨λ h, h ▸ rfl, ext_ring⟩

end

section

variables {module_M : module R M} {module_M₂ : module R M₂}
{module_M₃ : module R M₃}
variables (f : M₂ →ₗ[R] M₃) (g : M →ₗ[R] M₂)

/-- Composition of two linear maps is a linear map -/
def comp : M →ₗ[R] M₃ := ⟨f ∘ g, by simp, by simp⟩

lemma comp_apply (x : M) : f.comp g x = f (g x) := rfl

@[simp, norm_cast] lemma coe_comp : (f.comp g : M → M₃) = f ∘ g := rfl

@[simp] theorem comp_id : f.comp id = f :=
linear_map.ext $ λ x, rfl

@[simp] theorem id_comp : id.comp f = f :=
linear_map.ext $ λ x, rfl

end

/-- If a function `g` is a left and right inverse of a linear map `f`, then `g` is linear itself. -/
def inverse [module R M] [module R M₂]
  (f : M →ₗ[R] M₂) (g : M₂ → M) (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
  M₂ →ₗ[R] M :=
by dsimp [left_inverse, function.right_inverse] at h₁ h₂; exact
  ⟨g, λ x y, by { rw [← h₁ (g (x + y)), ← h₁ (g x + g y)]; simp [h₂] },
      λ a b, by { rw [← h₁ (g (a • b)), ← h₁ (a • g b)]; simp [h₂] }⟩

end add_comm_monoid

section add_comm_group

variables [semiring R] [add_comm_group M] [add_comm_group M₂]
variables {module_M : module R M} {module_M₂ : module R M₂}
variables (f : M →ₗ[R] M₂)

@[simp] lemma map_neg (x : M) : f (- x) = - f x :=
f.to_add_monoid_hom.map_neg x

@[simp] lemma map_sub (x y : M) : f (x - y) = f x - f y :=
f.to_add_monoid_hom.map_sub x y

instance : is_add_group_hom f :=
{ map_add := map_add f }

instance compatible_smul.int_module
  {S : Type*} [semiring S] [module S M] [module S M₂] : compatible_smul M M₂ ℤ S :=
⟨λ f c x, begin
  induction c using int.induction_on,
  case hz : { simp },
  case hp : n ih { simp [add_smul, ih] },
  case hn : n ih { simp [sub_smul, ih] }
end⟩

end add_comm_group

end linear_map

namespace is_linear_map

section add_comm_monoid
variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂]
variables [module R M] [module R M₂]
include R

/-- Convert an `is_linear_map` predicate to a `linear_map` -/
def mk' (f : M → M₂) (H : is_linear_map R f) : M →ₗ M₂ := ⟨f, H.1, H.2⟩

@[simp] theorem mk'_apply {f : M → M₂} (H : is_linear_map R f) (x : M) :
  mk' f H x = f x := rfl

lemma is_linear_map_smul {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
  (c : R) :
  is_linear_map R (λ (z : M), c • z) :=
begin
  refine is_linear_map.mk (smul_add c) _,
  intros _ _,
  simp only [smul_smul, mul_comm]
end

lemma is_linear_map_smul' {R M : Type*} [semiring R] [add_comm_monoid M] [module R M] (a : M) :
  is_linear_map R (λ (c : R), c • a) :=
is_linear_map.mk (λ x y, add_smul x y a) (λ x y, mul_smul x y a)

variables {f : M → M₂} (lin : is_linear_map R f)
include M M₂ lin

lemma map_zero : f (0 : M) = (0 : M₂) := (lin.mk' f).map_zero

end add_comm_monoid

section add_comm_group

variables [semiring R] [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R M₂]
include R

lemma is_linear_map_neg :
  is_linear_map R (λ (z : M), -z) :=
is_linear_map.mk neg_add (λ x y, (smul_neg x y).symm)

variables {f : M → M₂} (lin : is_linear_map R f)
include M M₂ lin

lemma map_neg (x : M) : f (- x) = - f x := (lin.mk' f).map_neg x

lemma map_sub (x y) : f (x - y) = f x - f y := (lin.mk' f).map_sub x y

end add_comm_group

end is_linear_map

/-- Linear endomorphisms of a module, with associated ring structure
`linear_map.endomorphism_semiring` and algebra structure `module.endomorphism_algebra`. -/
abbreviation module.End (R : Type u) (M : Type v)
  [semiring R] [add_comm_monoid M] [module R M] := M →ₗ[R] M

/-- Reinterpret an additive homomorphism as a `ℤ`-linear map. -/
def add_monoid_hom.to_int_linear_map [add_comm_group M] [add_comm_group M₂] (f : M →+ M₂) :
  M →ₗ[ℤ] M₂ :=
⟨f, f.map_add, f.map_int_module_smul⟩

/-- Reinterpret an additive homomorphism as a `ℚ`-linear map. -/
def add_monoid_hom.to_rat_linear_map [add_comm_group M] [module ℚ M]
  [add_comm_group M₂] [module ℚ M₂] (f : M →+ M₂) :
  M →ₗ[ℚ] M₂ :=
{ map_smul' := f.map_rat_module_smul, ..f }

/-! ### Linear equivalences -/
section
set_option old_structure_cmd true

/-- A linear equivalence is an invertible linear map. -/
@[nolint has_inhabited_instance]
structure linear_equiv (R : Type u) (M : Type v) (M₂ : Type w)
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂]
  extends M →ₗ[R] M₂, M ≃+ M₂
end

attribute [nolint doc_blame] linear_equiv.to_linear_map
attribute [nolint doc_blame] linear_equiv.to_add_equiv

infix ` ≃ₗ ` := linear_equiv _
notation M ` ≃ₗ[`:50 R `] ` M₂ := linear_equiv R M M₂

namespace linear_equiv

section add_comm_monoid

variables {M₄ : Type*}
variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]

section
variables [module R M] [module R M₂] [module R M₃]
include R

instance : has_coe (M ≃ₗ[R] M₂) (M →ₗ[R] M₂) := ⟨to_linear_map⟩
-- see Note [function coercion]
instance : has_coe_to_fun (M ≃ₗ[R] M₂) := ⟨_, λ f, f.to_fun⟩

@[simp] lemma coe_mk {to_fun inv_fun map_add map_smul left_inv right_inv } :
  ⇑(⟨to_fun, map_add, map_smul, inv_fun, left_inv, right_inv⟩ : M ≃ₗ[R] M₂) = to_fun :=
rfl

-- This exists for compatibility, previously `≃ₗ[R]` extended `≃` instead of `≃+`.
@[nolint doc_blame]
def to_equiv : (M ≃ₗ[R] M₂) → M ≃ M₂ := λ f, f.to_add_equiv.to_equiv

lemma to_equiv_injective : function.injective (to_equiv : (M ≃ₗ[R] M₂) → M ≃ M₂) :=
λ ⟨_, _, _, _, _, _⟩ ⟨_, _, _, _, _, _⟩ h, linear_equiv.mk.inj_eq.mpr (equiv.mk.inj h)

@[simp] lemma to_equiv_inj {e₁ e₂ : M ≃ₗ[R] M₂} : e₁.to_equiv = e₂.to_equiv ↔ e₁ = e₂ :=
to_equiv_injective.eq_iff

lemma to_linear_map_injective : function.injective (coe : (M ≃ₗ[R] M₂) → (M →ₗ[R] M₂)) :=
λ e₁ e₂ H, to_equiv_injective $ equiv.ext $ linear_map.congr_fun H

@[simp, norm_cast] lemma to_linear_map_inj {e₁ e₂ : M ≃ₗ[R] M₂} :
  (e₁ : M →ₗ[R] M₂) = e₂ ↔ e₁ = e₂ :=
to_linear_map_injective.eq_iff

end

section
variables {module_M : module R M} {module_M₂ : module R M₂}
variables (e e' : M ≃ₗ[R] M₂)

lemma to_linear_map_eq_coe : e.to_linear_map = ↑e := rfl

@[simp, norm_cast] theorem coe_coe : ⇑(e : M →ₗ[R] M₂) = e := rfl

@[simp] lemma coe_to_equiv : ⇑e.to_equiv = e := rfl

@[simp] lemma coe_to_linear_map : ⇑e.to_linear_map = e := rfl

@[simp] lemma to_fun_eq_coe : e.to_fun = e := rfl

section
variables {e e'}
@[ext] lemma ext (h : ∀ x, e x = e' x) : e = e' :=
to_equiv_injective (equiv.ext h)

protected lemma congr_arg : Π {x x' : M}, x = x' → e x = e x'
| _ _ rfl := rfl

protected lemma congr_fun (h : e = e') (x : M) : e x = e' x := h ▸ rfl

lemma ext_iff : e = e' ↔ ∀ x, e x = e' x :=
⟨λ h x, h ▸ rfl, ext⟩

end

section
variables (M R)

/-- The identity map is a linear equivalence. -/
@[refl]
def refl [module R M] : M ≃ₗ[R] M := { .. linear_map.id, .. equiv.refl M }
end

@[simp] lemma refl_apply [module R M] (x : M) : refl R M x = x := rfl

/-- Linear equivalences are symmetric. -/
@[symm]
def symm : M₂ ≃ₗ[R] M :=
{ .. e.to_linear_map.inverse e.inv_fun e.left_inv e.right_inv,
  .. e.to_equiv.symm }

/-- See Note [custom simps projection] -/
def simps.symm_apply [module R M] [module R M₂] (e : M ≃ₗ[R] M₂) : M₂ → M := e.symm

initialize_simps_projections linear_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp] lemma inv_fun_eq_symm : e.inv_fun = e.symm := rfl

variables {module_M₃ : module R M₃} (e₁ : M ≃ₗ[R] M₂) (e₂ : M₂ ≃ₗ[R] M₃)

/-- Linear equivalences are transitive. -/
@[trans]
def trans : M ≃ₗ[R] M₃ :=
{ .. e₂.to_linear_map.comp e₁.to_linear_map,
  .. e₁.to_equiv.trans e₂.to_equiv }

@[simp] lemma coe_to_add_equiv : ⇑(e.to_add_equiv) = e := rfl

/-- The two paths coercion can take to an `add_monoid_hom` are equivalent -/
lemma to_add_monoid_hom_commutes :
  e.to_linear_map.to_add_monoid_hom = e.to_add_equiv.to_add_monoid_hom :=
rfl

@[simp] theorem trans_apply (c : M) :
  (e₁.trans e₂) c = e₂ (e₁ c) := rfl
@[simp] theorem apply_symm_apply (c : M₂) : e (e.symm c) = c := e.6 c
@[simp] theorem symm_apply_apply (b : M) : e.symm (e b) = b := e.5 b
@[simp] lemma symm_trans_apply (c : M₃) : (e₁.trans e₂).symm c = e₁.symm (e₂.symm c) := rfl

@[simp] lemma trans_refl : e.trans (refl R M₂) = e := to_equiv_injective e.to_equiv.trans_refl
@[simp] lemma refl_trans : (refl R M).trans e = e := to_equiv_injective e.to_equiv.refl_trans

lemma symm_apply_eq {x y} : e.symm x = y ↔ x = e y := e.to_equiv.symm_apply_eq

lemma eq_symm_apply {x y} : y = e.symm x ↔ e y = x := e.to_equiv.eq_symm_apply

@[simp] lemma trans_symm [module R M] [module R M₂] (f : M ≃ₗ[R] M₂) :
  f.trans f.symm = linear_equiv.refl R M :=
by { ext x, simp }

@[simp] lemma symm_trans [module R M] [module R M₂] (f : M ≃ₗ[R] M₂) :
  f.symm.trans f = linear_equiv.refl R M₂ :=
by { ext x, simp }

@[simp, norm_cast] lemma refl_to_linear_map [module R M] :
  (linear_equiv.refl R M : M →ₗ[R] M) = linear_map.id :=
rfl

@[simp, norm_cast]
lemma comp_coe [module R M] [module R M₂] [module R M₃] (f :  M ≃ₗ[R] M₂)
  (f' :  M₂ ≃ₗ[R] M₃) : (f' : M₂ →ₗ[R] M₃).comp (f : M →ₗ[R] M₂) = (f.trans f' : M →ₗ[R] M₃) :=
rfl

@[simp] lemma mk_coe (h₁ h₂ f h₃ h₄) :
  (linear_equiv.mk e h₁ h₂ f h₃ h₄ : M ≃ₗ[R] M₂) = e := ext $ λ _, rfl

@[simp] theorem map_add (a b : M) : e (a + b) = e a + e b := e.map_add' a b
@[simp] theorem map_zero : e 0 = 0 := e.to_linear_map.map_zero
@[simp] theorem map_smul (c : R) (x : M) : e (c • x) = c • e x := e.map_smul' c x

@[simp] lemma map_sum {s : finset ι} (u : ι → M) : e (∑ i in s, u i) = ∑ i in s, e (u i) :=
e.to_linear_map.map_sum

@[simp] theorem map_eq_zero_iff {x : M} : e x = 0 ↔ x = 0 :=
e.to_add_equiv.map_eq_zero_iff
theorem map_ne_zero_iff {x : M} : e x ≠ 0 ↔ x ≠ 0 :=
e.to_add_equiv.map_ne_zero_iff

@[simp] theorem symm_symm : e.symm.symm = e := by { cases e, refl }

lemma symm_bijective [module R M] [module R M₂] :
  function.bijective (symm : (M ≃ₗ[R] M₂) → (M₂ ≃ₗ[R] M)) :=
equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩

@[simp] lemma mk_coe' (f h₁ h₂ h₃ h₄) :
  (linear_equiv.mk f h₁ h₂ ⇑e h₃ h₄ : M₂ ≃ₗ[R] M) = e.symm :=
symm_bijective.injective $ ext $ λ x, rfl

@[simp] theorem symm_mk (f h₁ h₂ h₃ h₄) :
  (⟨e, h₁, h₂, f, h₃, h₄⟩ : M ≃ₗ[R] M₂).symm =
  { to_fun := f, inv_fun := e,
    ..(⟨e, h₁, h₂, f, h₃, h₄⟩ : M ≃ₗ[R] M₂).symm } := rfl

protected lemma bijective : function.bijective e := e.to_equiv.bijective
protected lemma injective : function.injective e := e.to_equiv.injective
protected lemma surjective : function.surjective e := e.to_equiv.surjective
protected lemma image_eq_preimage (s : set M) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

end

/-- An involutive linear map is a linear equivalence. -/
def of_involutive [module R M] (f : M →ₗ[R] M) (hf : involutive f) : M ≃ₗ[R] M :=
{ .. f, .. hf.to_equiv f  }

@[simp] lemma coe_of_involutive [module R M] (f : M →ₗ[R] M) (hf : involutive f) :
  ⇑(of_involutive f hf) = f :=
rfl

end add_comm_monoid

end linear_equiv


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

/-!
# The antidiagonal on a multiset.

The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
such that `t₁ + t₂ = s`. These pairs are counted with multiplicities.
-/

namespace multiset
open list

variables {α β : Type*}

/-- The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
    such that `t₁ + t₂ = s`. These pairs are counted with multiplicities. -/
def antidiagonal (s : multiset α) : multiset (multiset α × multiset α) :=
quot.lift_on s
  (λ l, (revzip (powerset_aux l) : multiset (multiset α × multiset α)))
  (λ l₁ l₂ h, quot.sound (revzip_powerset_aux_perm h))

theorem antidiagonal_coe (l : list α) :
  @antidiagonal α l = revzip (powerset_aux l) := rfl

@[simp] theorem antidiagonal_coe' (l : list α) :
  @antidiagonal α l = revzip (powerset_aux' l) :=
quot.sound revzip_powerset_aux_perm_aux'

/-- A pair `(t₁, t₂)` of multisets is contained in `antidiagonal s`
    if and only if `t₁ + t₂ = s`. -/
@[simp] theorem mem_antidiagonal {s : multiset α} {x : multiset α × multiset α} :
  x ∈ antidiagonal s ↔ x.1 + x.2 = s :=
quotient.induction_on s $ λ l, begin
  simp [antidiagonal_coe], refine ⟨λ h, revzip_powerset_aux h, λ h, _⟩,
  haveI := classical.dec_eq α,
  simp [revzip_powerset_aux_lemma l revzip_powerset_aux, h.symm],
  cases x with x₁ x₂,
  dsimp only,
  exact ⟨x₁, le_add_right _ _, by rw add_tsub_cancel_left x₁ x₂⟩
end

@[simp] theorem antidiagonal_map_fst (s : multiset α) :
  (antidiagonal s).map prod.fst = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_map_snd (s : multiset α) :
  (antidiagonal s).map prod.snd = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_zero : @antidiagonal α 0 = {(0, 0)} := rfl

@[simp] theorem antidiagonal_cons (a : α) (s) : antidiagonal (a ::ₘ s) =
  map (prod.map id (cons a)) (antidiagonal s) +
  map (prod.map (cons a) id) (antidiagonal s) :=
quotient.induction_on s $ λ l, begin
  simp only [revzip, reverse_append, quot_mk_to_coe, coe_eq_coe, powerset_aux'_cons, cons_coe,
    coe_map, antidiagonal_coe', coe_add],
  rw [← zip_map, ← zip_map, zip_append, (_ : _++_=_)],
  {congr; simp}, {simp}
end

@[simp] theorem card_antidiagonal (s : multiset α) :
  card (antidiagonal s) = 2 ^ card s :=
by have := card_powerset s;
   rwa [← antidiagonal_map_fst, card_map] at this

lemma prod_map_add [comm_semiring β] {s : multiset α} {f g : α → β} :
  prod (s.map (λa, f a + g a)) =
  sum ((antidiagonal s).map (λp, (p.1.map f).prod * (p.2.map g).prod)) :=
begin
  refine s.induction_on _ _,
  { simp },
  { assume a s ih,
    have := @sum_map_mul_left α β _,
    simp [ih, add_mul, mul_comm, mul_left_comm (f a), mul_left_comm (g a), mul_assoc,
      sum_map_mul_left.symm],
    cc },
end

end multiset


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.apply_fun
import algebra.ordered_ring
import algebra.big_operators.basic
import data.equiv.ring

/-!
# Star monoids and star rings

We introduce the basic algebraic notions of star monoids, and star rings.
Star algebras are introduced in `algebra.algebra.star`.

These are implemented as "mixin" typeclasses, so to summon a star ring (for example)
one needs to write `(R : Type) [ring R] [star_ring R]`.
This avoids difficulties with diamond inheritance.

For now we simply do not introduce notations,
as different users are expected to feel strongly about the relative merits of
`r^*`, `r†`, `rᘁ`, and so on.

Our star rings are actually star semirings, but of course we can prove
`star_neg : star (-r) = - star r` when the underlying semiring is a ring.
-/

universes u v

/--
Notation typeclass (with no default notation!) for an algebraic structure with a star operation.
-/
class has_star (R : Type u) :=
(star : R → R)

variables {R : Type u}

/--
A star operation (e.g. complex conjugate).
-/
def star [has_star R] (r : R) : R := has_star.star r

/--
Typeclass for a star operation with is involutive.
-/
class has_involutive_star (R : Type u) extends has_star R :=
(star_involutive : function.involutive star)

@[simp] lemma star_star [has_involutive_star R] (r : R) : star (star r) = r :=
has_involutive_star.star_involutive _

lemma star_injective [has_involutive_star R] : function.injective (star : R → R) :=
has_involutive_star.star_involutive.injective

/--
A `*`-monoid is a monoid `R` with an involutive operations `star`
so `star (r * s) = star s * star r`.
-/
class star_monoid (R : Type u) [monoid R] extends has_involutive_star R :=
(star_mul : ∀ r s : R, star (r * s) = star s * star r)

@[simp] lemma star_mul [monoid R] [star_monoid R] (r s : R) : star (r * s) = star s * star r :=
star_monoid.star_mul r s

/-- `star` as an `mul_equiv` from `R` to `Rᵒᵖ` -/
@[simps apply]
def star_mul_equiv [monoid R] [star_monoid R] : R ≃* Rᵒᵖ :=
{ to_fun := λ x, opposite.op (star x),
  map_mul' := λ x y, (star_mul x y).symm ▸ (opposite.op_mul _ _),
  ..(has_involutive_star.star_involutive.to_equiv star).trans opposite.equiv_to_opposite}

variables (R)

@[simp] lemma star_one [monoid R] [star_monoid R] : star (1 : R) = 1 :=
begin
  have := congr_arg opposite.unop (star_mul_equiv : R ≃* Rᵒᵖ).map_one,
  rwa [star_mul_equiv_apply, opposite.unop_op, opposite.unop_one] at this,
end

variables {R}

/--
A `*`-ring `R` is a (semi)ring with an involutive `star` operation which is additive
which makes `R` with its multiplicative structure into a `*`-monoid
(i.e. `star (r * s) = star s * star r`).
-/
class star_ring (R : Type u) [semiring R] extends star_monoid R :=
(star_add : ∀ r s : R, star (r + s) = star r + star s)

@[simp] lemma star_add [semiring R] [star_ring R] (r s : R) : star (r + s) = star r + star s :=
star_ring.star_add r s

/-- `star` as an `add_equiv` -/
@[simps apply]
def star_add_equiv [semiring R] [star_ring R] : R ≃+ R :=
{ to_fun := star,
  map_add' := star_add,
  ..(has_involutive_star.star_involutive.to_equiv star)}

variables (R)

@[simp] lemma star_zero [semiring R] [star_ring R] : star (0 : R) = 0 :=
(star_add_equiv : R ≃+ R).map_zero

variables {R}

/-- `star` as an `ring_equiv` from `R` to `Rᵒᵖ` -/
@[simps apply]
def star_ring_equiv [semiring R] [star_ring R] : R ≃+* Rᵒᵖ :=
{ to_fun := λ x, opposite.op (star x),
  ..star_add_equiv.trans (opposite.op_add_equiv : R ≃+ Rᵒᵖ),
  ..star_mul_equiv}

section
open_locale big_operators

@[simp] lemma star_sum [semiring R] [star_ring R] {α : Type*}
  (s : finset α) (f : α → R):
  star (∑ x in s, f x) = ∑ x in s, star (f x) :=
(star_add_equiv : R ≃+ R).map_sum _ _

end

@[simp] lemma star_neg [ring R] [star_ring R] (r : R) : star (-r) = - star r :=
(star_add_equiv : R ≃+ R).map_neg _

@[simp] lemma star_sub [ring R] [star_ring R] (r s : R) : star (r - s) = star r - star s :=
(star_add_equiv : R ≃+ R).map_sub _ _

@[simp] lemma star_bit0 [ring R] [star_ring R] (r : R) : star (bit0 r) = bit0 (star r) :=
by simp [bit0]

@[simp] lemma star_bit1 [ring R] [star_ring R] (r : R) : star (bit1 r) = bit1 (star r) :=
by simp [bit1]

/--
Any commutative semiring admits the trivial `*`-structure.
-/
def star_ring_of_comm {R : Type*} [comm_semiring R] : star_ring R :=
{ star := id,
  star_involutive := λ x, by simp,
  star_mul := by simp [mul_comm],
  star_add := by simp, }

section
local attribute [instance] star_ring_of_comm

@[simp] lemma star_id_of_comm {R : Type*} [comm_semiring R] {x : R} : star x = x := rfl

end

/--
An ordered `*`-ring is a ring which is both an ordered ring and a `*`-ring,
and `0 ≤ star r * r` for every `r`.

(In a Banach algebra, the natural ordering is given by the positive cone
which is the closure of the sums of elements `star r * r`.
This ordering makes the Banach algebra an ordered `*`-ring.)
-/
class star_ordered_ring (R : Type u) [ordered_semiring R] extends star_ring R :=
(star_mul_self_nonneg : ∀ r : R, 0 ≤ star r * r)

lemma star_mul_self_nonneg [ordered_semiring R] [star_ordered_ring R] {r : R} : 0 ≤ star r * r :=
star_ordered_ring.star_mul_self_nonneg r


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

! This file was ported from Lean 3 source module order.minimal
! leanprover-community/mathlib commit f16e7a22e11fc09c71f25446ac1db23a24e8a0bd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Antichain
import Mathbin.Order.UpperLower.Basic

/-!
# Minimal/maximal elements of a set

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

This file defines minimal and maximal of a set with respect to an arbitrary relation.

## Main declarations

* `maximals r s`: Maximal elements of `s` with respect to `r`.
* `minimals r s`: Minimal elements of `s` with respect to `r`.

## TODO

Do we need a `finset` version?
-/

open Function Set

variable {α : Type _} (r r₁ r₂ : α → α → Prop) (s t : Set α) (a b : α)

#print maximals /-
/-- Turns a set into an antichain by keeping only the "maximal" elements. -/
def maximals : Set α :=
  { a ∈ s | ∀ ⦃b⦄, b ∈ s → r a b → r b a }
#align maximals maximals
-/

#print minimals /-
/-- Turns a set into an antichain by keeping only the "minimal" elements. -/
def minimals : Set α :=
  { a ∈ s | ∀ ⦃b⦄, b ∈ s → r b a → r a b }
#align minimals minimals
-/

#print maximals_subset /-
theorem maximals_subset : maximals r s ⊆ s :=
  sep_subset _ _
#align maximals_subset maximals_subset
-/

#print minimals_subset /-
theorem minimals_subset : minimals r s ⊆ s :=
  sep_subset _ _
#align minimals_subset minimals_subset
-/

#print maximals_empty /-
@[simp]
theorem maximals_empty : maximals r ∅ = ∅ :=
  sep_empty _
#align maximals_empty maximals_empty
-/

#print minimals_empty /-
@[simp]
theorem minimals_empty : minimals r ∅ = ∅ :=
  sep_empty _
#align minimals_empty minimals_empty
-/

#print maximals_singleton /-
@[simp]
theorem maximals_singleton : maximals r {a} = {a} :=
  (maximals_subset _ _).antisymm <|
    singleton_subset_iff.2 <|
      ⟨rfl, by
        rintro b (rfl : b = a)
        exact id⟩
#align maximals_singleton maximals_singleton
-/

#print minimals_singleton /-
@[simp]
theorem minimals_singleton : minimals r {a} = {a} :=
  maximals_singleton _ _
#align minimals_singleton minimals_singleton
-/

#print maximals_swap /-
theorem maximals_swap : maximals (swap r) s = minimals r s :=
  rfl
#align maximals_swap maximals_swap
-/

#print minimals_swap /-
theorem minimals_swap : minimals (swap r) s = maximals r s :=
  rfl
#align minimals_swap minimals_swap
-/

section IsAntisymm

variable {r s t a b} [IsAntisymm α r]

#print eq_of_mem_maximals /-
theorem eq_of_mem_maximals (ha : a ∈ maximals r s) (hb : b ∈ s) (h : r a b) : a = b :=
  antisymm h <| ha.2 hb h
#align eq_of_mem_maximals eq_of_mem_maximals
-/

#print eq_of_mem_minimals /-
theorem eq_of_mem_minimals (ha : a ∈ minimals r s) (hb : b ∈ s) (h : r b a) : a = b :=
  antisymm (ha.2 hb h) h
#align eq_of_mem_minimals eq_of_mem_minimals
-/

variable (r s)

#print maximals_antichain /-
theorem maximals_antichain : IsAntichain r (maximals r s) := fun a ha b hb hab h =>
  hab <| eq_of_mem_maximals ha hb.1 h
#align maximals_antichain maximals_antichain
-/

#print minimals_antichain /-
theorem minimals_antichain : IsAntichain r (minimals r s) :=
  haveI := IsAntisymm.swap r
  (maximals_antichain _ _).symm
#align minimals_antichain minimals_antichain
-/

end IsAntisymm

#print maximals_eq_minimals /-
theorem maximals_eq_minimals [IsSymm α r] : maximals r s = minimals r s :=
  by
  congr
  ext (a b)
  exact comm
#align maximals_eq_minimals maximals_eq_minimals
-/

variable {r r₁ r₂ s t a}

#print Set.Subsingleton.maximals_eq /-
theorem Set.Subsingleton.maximals_eq (h : s.Subsingleton) : maximals r s = s :=
  h.inductionOn (minimals_empty _) (maximals_singleton _)
#align set.subsingleton.maximals_eq Set.Subsingleton.maximals_eq
-/

#print Set.Subsingleton.minimals_eq /-
theorem Set.Subsingleton.minimals_eq (h : s.Subsingleton) : minimals r s = s :=
  h.maximals_eq
#align set.subsingleton.minimals_eq Set.Subsingleton.minimals_eq
-/

#print maximals_mono /-
theorem maximals_mono [IsAntisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
    maximals r₂ s ⊆ maximals r₁ s := fun a ha =>
  ⟨ha.1, fun b hb hab => by
    have := eq_of_mem_maximals ha hb (h _ _ hab)
    subst this
    exact hab⟩
#align maximals_mono maximals_mono
-/

#print minimals_mono /-
theorem minimals_mono [IsAntisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
    minimals r₂ s ⊆ minimals r₁ s := fun a ha =>
  ⟨ha.1, fun b hb hab => by
    have := eq_of_mem_minimals ha hb (h _ _ hab)
    subst this
    exact hab⟩
#align minimals_mono minimals_mono
-/

/- warning: maximals_union -> maximals_union is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (maximals.{u1} α r (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) (maximals.{u1} α r s) (maximals.{u1} α r t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (maximals.{u1} α r (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) (maximals.{u1} α r s) (maximals.{u1} α r t))
Case conversion may be inaccurate. Consider using '#align maximals_union maximals_unionₓ'. -/
theorem maximals_union : maximals r (s ∪ t) ⊆ maximals r s ∪ maximals r t :=
  by
  intro a ha
  obtain h | h := ha.1
  · exact Or.inl ⟨h, fun b hb => ha.2 <| Or.inl hb⟩
  · exact Or.inr ⟨h, fun b hb => ha.2 <| Or.inr hb⟩
#align maximals_union maximals_union

/- warning: minimals_union -> minimals_union is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (minimals.{u1} α r (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) (minimals.{u1} α r s) (minimals.{u1} α r t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (minimals.{u1} α r (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) (minimals.{u1} α r s) (minimals.{u1} α r t))
Case conversion may be inaccurate. Consider using '#align minimals_union minimals_unionₓ'. -/
theorem minimals_union : minimals r (s ∪ t) ⊆ minimals r s ∪ minimals r t :=
  maximals_union
#align minimals_union minimals_union

/- warning: maximals_inter_subset -> maximals_inter_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) (maximals.{u1} α r s) t) (maximals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) (maximals.{u1} α r s) t) (maximals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align maximals_inter_subset maximals_inter_subsetₓ'. -/
theorem maximals_inter_subset : maximals r s ∩ t ⊆ maximals r (s ∩ t) := fun a ha =>
  ⟨⟨ha.1.1, ha.2⟩, fun b hb => ha.1.2 hb.1⟩
#align maximals_inter_subset maximals_inter_subset

/- warning: minimals_inter_subset -> minimals_inter_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) (minimals.{u1} α r s) t) (minimals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) (minimals.{u1} α r s) t) (minimals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align minimals_inter_subset minimals_inter_subsetₓ'. -/
theorem minimals_inter_subset : minimals r s ∩ t ⊆ minimals r (s ∩ t) :=
  maximals_inter_subset
#align minimals_inter_subset minimals_inter_subset

/- warning: inter_maximals_subset -> inter_maximals_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s (maximals.{u1} α r t)) (maximals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s (maximals.{u1} α r t)) (maximals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align inter_maximals_subset inter_maximals_subsetₓ'. -/
theorem inter_maximals_subset : s ∩ maximals r t ⊆ maximals r (s ∩ t) := fun a ha =>
  ⟨⟨ha.1, ha.2.1⟩, fun b hb => ha.2.2 hb.2⟩
#align inter_maximals_subset inter_maximals_subset

/- warning: inter_minimals_subset -> inter_minimals_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s (minimals.{u1} α r t)) (minimals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s (minimals.{u1} α r t)) (minimals.{u1} α r (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t))
Case conversion may be inaccurate. Consider using '#align inter_minimals_subset inter_minimals_subsetₓ'. -/
theorem inter_minimals_subset : s ∩ minimals r t ⊆ minimals r (s ∩ t) :=
  inter_maximals_subset
#align inter_minimals_subset inter_minimals_subset

#print IsAntichain.maximals_eq /-
theorem IsAntichain.maximals_eq (h : IsAntichain r s) : maximals r s = s :=
  (maximals_subset _ _).antisymm fun a ha =>
    ⟨ha, fun b hb hab => by
      have := h.eq ha hb hab
      subst this
      exact hab⟩
#align is_antichain.maximals_eq IsAntichain.maximals_eq
-/

#print IsAntichain.minimals_eq /-
theorem IsAntichain.minimals_eq (h : IsAntichain r s) : minimals r s = s :=
  (minimals_subset _ _).antisymm fun a ha =>
    ⟨ha, fun b hb hab => by
      have := h.eq hb ha hab
      subst this
      exact hab⟩
#align is_antichain.minimals_eq IsAntichain.minimals_eq
-/

#print maximals_idem /-
@[simp]
theorem maximals_idem : maximals r (maximals r s) = maximals r s :=
  (maximals_subset _ _).antisymm fun a ha => ⟨ha, fun b hb => ha.2 hb.1⟩
#align maximals_idem maximals_idem
-/

#print minimals_idem /-
@[simp]
theorem minimals_idem : minimals r (minimals r s) = minimals r s :=
  maximals_idem
#align minimals_idem minimals_idem
-/

/- warning: is_antichain.max_maximals -> IsAntichain.max_maximals is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, (IsAntichain.{u1} α r t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (maximals.{u1} α r s) t) -> (forall {{a : α}}, (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a t) -> (Exists.{succ u1} α (fun (b : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b (maximals.{u1} α r s)) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b (maximals.{u1} α r s)) => r b a)))) -> (Eq.{succ u1} (Set.{u1} α) (maximals.{u1} α r s) t)
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, (IsAntichain.{u1} α r t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (maximals.{u1} α r s) t) -> (forall {{a : α}}, (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a t) -> (Exists.{succ u1} α (fun (b : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) b (maximals.{u1} α r s)) (r b a)))) -> (Eq.{succ u1} (Set.{u1} α) (maximals.{u1} α r s) t)
Case conversion may be inaccurate. Consider using '#align is_antichain.max_maximals IsAntichain.max_maximalsₓ'. -/
/-- If `maximals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
theorem IsAntichain.max_maximals (ht : IsAntichain r t) (h : maximals r s ⊆ t)
    (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ maximals r s, r b a) : maximals r s = t :=
  by
  refine' h.antisymm fun a ha => _
  obtain ⟨b, hb, hr⟩ := hs ha
  rwa [of_not_not fun hab => ht (h hb) ha (Ne.symm hab) hr]
#align is_antichain.max_maximals IsAntichain.max_maximals

/- warning: is_antichain.max_minimals -> IsAntichain.max_minimals is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, (IsAntichain.{u1} α r t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (minimals.{u1} α r s) t) -> (forall {{a : α}}, (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a t) -> (Exists.{succ u1} α (fun (b : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b (minimals.{u1} α r s)) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b (minimals.{u1} α r s)) => r a b)))) -> (Eq.{succ u1} (Set.{u1} α) (minimals.{u1} α r s) t)
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} {s : Set.{u1} α} {t : Set.{u1} α}, (IsAntichain.{u1} α r t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (minimals.{u1} α r s) t) -> (forall {{a : α}}, (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a t) -> (Exists.{succ u1} α (fun (b : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) b (minimals.{u1} α r s)) (r a b)))) -> (Eq.{succ u1} (Set.{u1} α) (minimals.{u1} α r s) t)
Case conversion may be inaccurate. Consider using '#align is_antichain.max_minimals IsAntichain.max_minimalsₓ'. -/
/-- If `minimals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
theorem IsAntichain.max_minimals (ht : IsAntichain r t) (h : minimals r s ⊆ t)
    (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ minimals r s, r a b) : minimals r s = t :=
  by
  refine' h.antisymm fun a ha => _
  obtain ⟨b, hb, hr⟩ := hs ha
  rwa [of_not_not fun hab => ht ha (h hb) hab hr]
#align is_antichain.max_minimals IsAntichain.max_minimals

variable [PartialOrder α]

#print IsLeast.mem_minimals /-
theorem IsLeast.mem_minimals (h : IsLeast s a) : a ∈ minimals (· ≤ ·) s :=
  ⟨h.1, fun b hb _ => h.2 hb⟩
#align is_least.mem_minimals IsLeast.mem_minimals
-/

#print IsGreatest.mem_maximals /-
theorem IsGreatest.mem_maximals (h : IsGreatest s a) : a ∈ maximals (· ≤ ·) s :=
  ⟨h.1, fun b hb _ => h.2 hb⟩
#align is_greatest.mem_maximals IsGreatest.mem_maximals
-/

#print IsLeast.minimals_eq /-
theorem IsLeast.minimals_eq (h : IsLeast s a) : minimals (· ≤ ·) s = {a} :=
  eq_singleton_iff_unique_mem.2 ⟨h.mem_minimals, fun b hb => eq_of_mem_minimals hb h.1 <| h.2 hb.1⟩
#align is_least.minimals_eq IsLeast.minimals_eq
-/

#print IsGreatest.maximals_eq /-
theorem IsGreatest.maximals_eq (h : IsGreatest s a) : maximals (· ≤ ·) s = {a} :=
  eq_singleton_iff_unique_mem.2 ⟨h.mem_maximals, fun b hb => eq_of_mem_maximals hb h.1 <| h.2 hb.1⟩
#align is_greatest.maximals_eq IsGreatest.maximals_eq
-/

#print IsAntichain.minimals_upperClosure /-
theorem IsAntichain.minimals_upperClosure (hs : IsAntichain (· ≤ ·) s) :
    minimals (· ≤ ·) (upperClosure s : Set α) = s :=
  hs.max_minimals
    (fun a ⟨⟨b, hb, hba⟩, h⟩ => by rwa [eq_of_mem_minimals ‹a ∈ _› (subset_upperClosure hb) hba])
    fun a ha =>
    ⟨a, ⟨subset_upperClosure ha, fun b ⟨c, hc, hcb⟩ hba => by rwa [hs.eq' ha hc (hcb.trans hba)]⟩,
      le_rfl⟩
#align is_antichain.minimals_upper_closure IsAntichain.minimals_upperClosure
-/

#print IsAntichain.maximals_lowerClosure /-
theorem IsAntichain.maximals_lowerClosure (hs : IsAntichain (· ≤ ·) s) :
    maximals (· ≤ ·) (lowerClosure s : Set α) = s :=
  hs.toDual.minimals_upperClosure
#align is_antichain.maximals_lower_closure IsAntichain.maximals_lowerClosure
-/