/-
Copyright (c) 2021 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca

! This file was ported from Lean 3 source module linear_algebra.free_module.basic
! leanprover-community/mathlib commit 4e7e7009099d4a88a750de710909b95487bf0124
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.DirectSum.Finsupp
import Mathbin.Logic.Small.Basic
import Mathbin.LinearAlgebra.StdBasis
import Mathbin.LinearAlgebra.FinsuppVectorSpace
import Mathbin.LinearAlgebra.TensorProductBasis

/-!

# Free modules

We introduce a class `module.free R M`, for `R` a `semiring` and `M` an `R`-module and we provide
several basic instances for this class.

Use `finsupp.total_id_surjective` to prove that any module is the quotient of a free module.

## Main definition

* `module.free R M` : the class of free `R`-modules.

-/

universe u v w z

variable {ι : Type _} (R : Type u) (M : Type v) (N : Type z)

open TensorProduct DirectSum BigOperators

section Basic

variable [Semiring R] [AddCommMonoid M] [Module R M]

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`exists_basis] [] -/
/-- `module.free R M` is the statement that the `R`-module `M` is free.-/
class Module.Free : Prop where
  exists_basis : Nonempty (ΣI : Type v, Basis I R M)
#align module.free Module.Free

/- If `M` fits in universe `w`, then freeness is equivalent to existence of a basis in that
universe.

Note that if `M` does not fit in `w`, the reverse direction of this implication is still true as
`module.free.of_basis`. -/
theorem Module.free_def [Small.{w} M] : Module.Free R M ↔ ∃ I : Type w, Nonempty (Basis I R M) :=
  ⟨fun h =>
    ⟨Shrink (Set.range h.exists_basis.some.2),
      ⟨(Basis.reindexRange h.exists_basis.some.2).reindex (equivShrink _)⟩⟩,
    fun h => ⟨(nonempty_sigma.2 h).map fun ⟨i, b⟩ => ⟨Set.range b, b.reindexRange⟩⟩⟩
#align module.free_def Module.free_def

theorem Module.free_iff_set : Module.Free R M ↔ ∃ S : Set M, Nonempty (Basis S R M) :=
  ⟨fun h => ⟨Set.range h.exists_basis.some.2, ⟨Basis.reindexRange h.exists_basis.some.2⟩⟩,
    fun ⟨S, hS⟩ => ⟨nonempty_sigma.2 ⟨S, hS⟩⟩⟩
#align module.free_iff_set Module.free_iff_set

variable {R M}

theorem Module.Free.of_basis {ι : Type w} (b : Basis ι R M) : Module.Free R M :=
  (Module.free_def R M).2 ⟨Set.range b, ⟨b.reindexRange⟩⟩
#align module.free.of_basis Module.Free.of_basis

end Basic

namespace Module.Free

section Semiring

variable (R M) [Semiring R] [AddCommMonoid M] [Module R M] [Module.Free R M]

variable [AddCommMonoid N] [Module R N]

/-- If `module.free R M` then `choose_basis_index R M` is the `ι` which indexes the basis
  `ι → M`. -/
def ChooseBasisIndex :=
  (exists_basis R M).some.1
#align module.free.choose_basis_index Module.Free.ChooseBasisIndex

/-- If `module.free R M` then `choose_basis : ι → M` is the basis.
Here `ι = choose_basis_index R M`. -/
noncomputable def chooseBasis : Basis (ChooseBasisIndex R M) R M :=
  (exists_basis R M).some.2
#align module.free.choose_basis Module.Free.chooseBasis

/-- The isomorphism `M ≃ₗ[R] (choose_basis_index R M →₀ R)`. -/
noncomputable def repr : M ≃ₗ[R] ChooseBasisIndex R M →₀ R :=
  (chooseBasis R M).repr
#align module.free.repr Module.Free.repr

/-- The universal property of free modules: giving a functon `(choose_basis_index R M) → N`, for `N`
an `R`-module, is the same as giving an `R`-linear map `M →ₗ[R] N`.

This definition is parameterized over an extra `semiring S`,
such that `smul_comm_class R S M'` holds.
If `R` is commutative, you can set `S := R`; if `R` is not commutative,
you can recover an `add_equiv` by setting `S := ℕ`.
See library note [bundled maps over different rings]. -/
noncomputable def constr {S : Type z} [Semiring S] [Module S N] [SMulCommClass R S N] :
    (ChooseBasisIndex R M → N) ≃ₗ[S] M →ₗ[R] N :=
  Basis.constr (chooseBasis R M) S
#align module.free.constr Module.Free.constr

instance (priority := 100) noZeroSMulDivisors [NoZeroDivisors R] : NoZeroSMulDivisors R M :=
  let ⟨⟨_, b⟩⟩ := exists_basis R M
  b.NoZeroSMulDivisors
#align module.free.no_zero_smul_divisors Module.Free.noZeroSMulDivisors

instance [Nontrivial M] : Nonempty (Module.Free.ChooseBasisIndex R M) :=
  (Module.Free.chooseBasis R M).index_nonempty

variable {R M N}

theorem of_equiv (e : M ≃ₗ[R] N) : Module.Free R N :=
  of_basis <| (chooseBasis R M).map e
#align module.free.of_equiv Module.Free.of_equiv

/-- A variation of `of_equiv`: the assumption `module.free R P` here is explicit rather than an
instance. -/
theorem of_equiv' {P : Type v} [AddCommMonoid P] [Module R P] (h : Module.Free R P)
    (e : P ≃ₗ[R] N) : Module.Free R N :=
  of_equiv e
#align module.free.of_equiv' Module.Free.of_equiv'

variable (R M N)

/-- The module structure provided by `semiring.to_module` is free. -/
instance self : Module.Free R R :=
  of_basis (Basis.singleton Unit R)
#align module.free.self Module.Free.self

instance prod [Module.Free R N] : Module.Free R (M × N) :=
  of_basis <| (chooseBasis R M).Prod (chooseBasis R N)
#align module.free.prod Module.Free.prod

/-- The product of finitely many free modules is free. -/
instance pi (M : ι → Type _) [Finite ι] [∀ i : ι, AddCommMonoid (M i)] [∀ i : ι, Module R (M i)]
    [∀ i : ι, Module.Free R (M i)] : Module.Free R (∀ i, M i) :=
  let ⟨_⟩ := nonempty_fintype ι
  of_basis <| Pi.basis fun i => choose_basis R (M i)
#align module.free.pi Module.Free.pi

/-- The module of finite matrices is free. -/
instance matrix {m n : Type _} [Finite m] [Finite n] : Module.Free R (Matrix m n M) :=
  Module.Free.pi R _
#align module.free.matrix Module.Free.matrix

variable (ι)

/-- The product of finitely many free modules is free (non-dependent version to help with typeclass
search). -/
instance function [Finite ι] : Module.Free R (ι → M) :=
  Free.pi _ _
#align module.free.function Module.Free.function

instance finsupp : Module.Free R (ι →₀ M) :=
  of_basis (Finsupp.basis fun i => chooseBasis R M)
#align module.free.finsupp Module.Free.finsupp

variable {ι}

instance (priority := 100) of_subsingleton [Subsingleton N] : Module.Free R N :=
  of_basis (Basis.empty N : Basis PEmpty R N)
#align module.free.of_subsingleton Module.Free.of_subsingleton

instance (priority := 100) of_subsingleton' [Subsingleton R] : Module.Free R N :=
  letI := Module.subsingleton R N
  Module.Free.of_subsingleton R N
#align module.free.of_subsingleton' Module.Free.of_subsingleton'

instance dfinsupp {ι : Type _} (M : ι → Type _) [∀ i : ι, AddCommMonoid (M i)]
    [∀ i : ι, Module R (M i)] [∀ i : ι, Module.Free R (M i)] : Module.Free R (Π₀ i, M i) :=
  of_basis <| Dfinsupp.basis fun i => chooseBasis R (M i)
#align module.free.dfinsupp Module.Free.dfinsupp

instance directSum {ι : Type _} (M : ι → Type _) [∀ i : ι, AddCommMonoid (M i)]
    [∀ i : ι, Module R (M i)] [∀ i : ι, Module.Free R (M i)] : Module.Free R (⨁ i, M i) :=
  Module.Free.dfinsupp R M
#align module.free.direct_sum Module.Free.directSum

end Semiring

section CommRing

variable [CommRing R] [AddCommGroup M] [Module R M] [Module.Free R M]

variable [AddCommGroup N] [Module R N] [Module.Free R N]

instance tensor : Module.Free R (M ⊗[R] N) :=
  let ⟨bM⟩ := exists_basis R M
  let ⟨bN⟩ := exists_basis R N
  of_basis (bM.2.TensorProduct bN.2)
#align module.free.tensor Module.Free.tensor

end CommRing

section DivisionRing

variable [DivisionRing R] [AddCommGroup M] [Module R M]

instance (priority := 100) of_divisionRing : Module.Free R M :=
  of_basis (Basis.ofVectorSpace R M)
#align module.free.of_division_ring Module.Free.of_divisionRing

end DivisionRing

end Module.Free


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/

import data.real.nnreal
import data.real.ennreal

import data.complex.exponential
import formal_ml.nat
import formal_ml.real
import formal_ml.rat

lemma nnreal_add_sub_right (a b c:nnreal):a + b = c → c - b = a :=
begin
  intro A1,
  --apply linarith [A1],
  have A2:(a + b) - b = a,
  {
    apply nnreal.add_sub_cancel,
  },
  rw A1 at A2,
  exact A2,
end

lemma nnreal_add_sub_left (a b c:nnreal):a + b = c → c - a = b :=
begin
  intro A1,
  apply nnreal_add_sub_right,
  rw nnreal.comm_semiring.add_comm,
  exact A1,
end

lemma nnreal_sub_le_left (a b c:nnreal):b ≤ c → (a - c ≤ a - b) :=
begin
  intro A1,
  apply nnreal.of_real_le_of_real,
  apply sub_le_sub_left,
  apply A1,
end

noncomputable def nnreal.exp (x:real):nnreal := nnreal.of_real (real.exp x)

@[simp]
lemma nnreal_exp_eq (x:real):↑(nnreal.exp x) = real.exp x :=
begin
  unfold nnreal.exp,
  rw nnreal.coe_of_real,
  apply le_of_lt,
  apply real.exp_pos,
end

@[simp]
lemma nnreal.exp_zero_eq_one:(nnreal.exp 0) = 1 :=
begin
  unfold nnreal.exp,
  --rw nnreal.coe_eq_coe,
  have h1:(1:nnreal) = (nnreal.of_real 1),
  { simp },
  rw h1,
  simp,
end

-- This one is hard (and technically has nothing to do with nnreal).
-- The rest are easy after it is finished.
-- A standard proof would be to calculate the first and second derivative.
-- If you prove that the second derivative is non-negative, then there is a minimum
-- where the first derivative is zero. In this way you can establish that the minimum
-- is at zero, and it is zero.
-- Note this should solve the problem. however, there is a TODO.
-- My current thinking about the proof:

lemma nnreal_pow_succ (x:nnreal) (k:ℕ):x ^ nat.succ k = x * (x ^ k) :=
begin
  refl,
end

lemma nnreal_pow_mono (x y:nnreal) (k:ℕ):x ≤ y → x^k ≤ y^k :=
begin
  intro A1,
  induction k,
  {
    simp,
  },
  {
    rw nnreal_pow_succ,
    rw nnreal_pow_succ,
    apply mul_le_mul,
    {
      exact A1,
    },
    {
      apply k_ih,
    },
    {
      simp,
    },
    {
      simp,
    },
  }
end

lemma nnreal_eq (x y:nnreal):(x:real) = (y:real) → x = y :=
begin
  intro A1,
  apply nnreal.eq,
  apply A1,
end
lemma nnreal_exp_pow (x:real) (k:ℕ): nnreal.exp (k * x) = (nnreal.exp x)^k :=
begin
  apply nnreal.eq,
  rw nnreal.coe_pow,
  rw nnreal_exp_eq,
  rw nnreal_exp_eq,
  apply real.exp_nat_mul,
end

lemma to_ennreal_def (x:nnreal):(x:ennreal)= some x :=
begin
  refl
end

lemma nnreal_lt_ennreal_top (x:nnreal):(x:ennreal) < (⊤:ennreal) :=
begin
  rw to_ennreal_def,
  apply with_top.some_lt_none,
end

lemma nnreal_lt_some_ennreal (x y:nnreal):(x < y) → (x:ennreal) < (some y:ennreal) :=
begin
  intro A1,
  apply ennreal.coe_lt_coe.mpr,
  apply A1,
end

lemma some_ennreal_lt_nnreal (x y:nnreal):(x:ennreal) < (some y:ennreal) → (x < y) :=
begin
  intro A1,
  apply ennreal.coe_lt_coe.mp,
  apply A1,
end

lemma nnreal_add_eq_zero_iff (a b:nnreal): a + b = 0 ↔ a = 0 ∧ b = 0 :=
begin
  simp,
end

--Holds true for all commutative semirings?
lemma nnreal_add_monoid_smul_def{n:ℕ} {c:nnreal}:  n •ℕ c = ↑(n) * c :=
begin
  induction n,
  {
    simp,
  },
  {
    simp,
  }
end

lemma nnreal_sub_le_sub_of_le {a b c:nnreal}:b ≤ c → a - c ≤ a - b :=
begin
  intro A1,
  have A2:(a ≤ b)∨ (b ≤ a) := linear_order.le_total a b,
  have A3:(a ≤ c)∨ (c ≤ a) := linear_order.le_total a c,
  cases A2,
  {
    rw nnreal.sub_eq_zero,
    simp,
    apply le_trans A2 A1,
  },
  {
    cases A3,
    {
      rw nnreal.sub_eq_zero,
      simp,
      exact A3,
    },
    rw ← nnreal.coe_le_coe,
    rw nnreal.coe_sub,
    rw nnreal.coe_sub,
    apply sub_le_sub_left,
    rw nnreal.coe_le_coe,
    exact A1,
    exact A2,
    exact A3,
  },
end

lemma nnreal_sub_lt_sub_of_lt {a b c:nnreal}:b < c → b < a → a - c < a - b :=
begin
  intros A1 A2,
  --have A2:(a ≤ b)∨ (b ≤ a) := linear_order.le_total a b,
  have A3:(a ≤ c)∨ (c ≤ a) := linear_order.le_total a c,
  {
    cases A3,
    {
      rw nnreal.sub_eq_zero A3,
      apply nnreal.sub_pos.mpr A2,
    },
    rw ← nnreal.coe_lt_coe,
    rw nnreal.coe_sub,
    rw nnreal.coe_sub,
    apply sub_lt_sub_left,
    rw nnreal.coe_lt_coe,
    exact A1,
    apply (le_of_lt A2),
    exact A3,
  },
end

lemma nnreal.lt_of_add_le_of_pos {x y z:nnreal}:x + y ≤ z → 0 < y → x < z :=
begin
  cases x, cases y, cases z,
  repeat {rw ← nnreal.coe_lt_coe}, rw ← nnreal.coe_le_coe,repeat {rw nnreal.coe_add},
  simp, intros A1 A2,
  linarith [A1, A2],
end

lemma nnreal.not_add_le_of_lt {a b:nnreal}:
   (0 < b) → ¬(a + b) ≤ a :=
begin
  intros A1 A2,
  simp at A2,
  subst A2,
  apply lt_irrefl _ A1,
end

lemma nnreal.sub_lt_of_pos_of_pos {a b:nnreal}:(0 < a) →
    (0 < b) → (a - b) < a :=
begin
  intros A1 A2,
  cases (le_total a b) with A3 A3,
  {
    rw nnreal.sub_eq_zero A3,
    apply A1,
  },
  {
    rw ← nnreal.coe_lt_coe,
    rw nnreal.coe_sub A3,
    rw ← nnreal.coe_lt_coe at A2,
    rw sub_lt_self_iff,
    apply A2,
  }
end

lemma nnreal.sub_eq_of_add_of_le {a b c:nnreal}:a = b + c →
  c ≤ a → a - c = b :=
begin
  intros A1 A2,
  have A3:a - c + c = b + c,
  {
    rw nnreal.sub_add_cancel_of_le A2,
    apply A1,
  },
  apply add_right_cancel A3,
end

lemma nnreal.inverse_le_of_le {a b:nnreal}:
  0 < a →
  a ≤ b →
  b⁻¹ ≤ a⁻¹ :=
begin
  intros A1 A2,
  have B1: (a⁻¹ * b⁻¹) * a ≤  (a⁻¹ * b⁻¹) * b,
  {
    apply mul_le_mul,
    apply le_refl _,
    apply A2,
    simp,
    simp,
  },
  rw mul_comm a⁻¹  b⁻¹ at B1,
  rw mul_assoc at B1,
  rw inv_mul_cancel at B1,
  rw mul_comm b⁻¹  a⁻¹ at B1,
  rw mul_assoc at B1,
  rw mul_one at B1,
  rw inv_mul_cancel at B1,
  rw mul_one at B1,
  apply B1,
  {
    have B1A := lt_of_lt_of_le A1 A2,
    intro B1B,
    subst b,
    simp at B1A,
    apply B1A,
  },
  {
    intro C1,
    subst a,
    simp at A1,
    apply A1,
  },
end

lemma nnreal.unit_frac_pos (n:ℕ):0 < (1/((n:nnreal) + 1)) :=
begin
  apply nnreal.div_pos,
  apply zero_lt_one,
  have A1:(0:nnreal) < (0:nnreal) + (1:nnreal),
  {
    simp,
    apply zero_lt_one,
  },
  apply lt_of_lt_of_le A1,
  rw add_comm (0:nnreal) 1,
  rw add_comm _ (1:nnreal),
  apply add_le_add_left,
  simp,
end

lemma nnreal.real_le_real {q r:ℝ}:q ≤ r → (nnreal.of_real q ≤ nnreal.of_real r) :=
begin
  intro A1,
  cases (le_total 0 q) with A2 A2,
  {
    have A3 := le_trans A2 A1,
    rw ←  @nnreal.coe_le_coe,
    rw nnreal.coe_of_real q A2,
    rw nnreal.coe_of_real r A3,
    apply A1,
  },
  {
    have B1 := nnreal.of_real_of_nonpos A2,
    rw B1,
    simp,
  },
end

lemma nnreal.rat_le_rat {q r:ℚ}:q ≤ r → (nnreal.of_real q ≤ nnreal.of_real r) :=
begin
  rw real.rat_le_rat_iff,
  apply nnreal.real_le_real,
end

lemma nnreal.real_lt_nnreal_of_real_le_real_of_real_lt_nnreal {q r:real} {s:nnreal}:
  q ≤ r → (nnreal.of_real r) < s → (nnreal.of_real q) < s :=
begin
  intros A1 A2,
  apply lt_of_le_of_lt _ A2,
  apply nnreal.real_le_real,
  apply A1,
end

lemma nnreal.rat_lt_nnreal_of_rat_le_rat_of_rat_lt_nnreal {q r:ℚ} {s:nnreal}:
  q ≤ r → (nnreal.of_real r) < s → (nnreal.of_real q) < s :=
begin

  intros A1 A2,
  rw real.rat_le_rat_iff at A1,
  apply nnreal.real_lt_nnreal_of_real_le_real_of_real_lt_nnreal A1 A2,
end

lemma nnreal.of_real_inv_eq_inv_of_real {x:real}:(0 ≤ x) →
    nnreal.of_real x⁻¹ = (nnreal.of_real x)⁻¹ :=
begin
  intro A1,
  rw ← nnreal.eq_iff,
  simp,
  have A2:0 ≤ x⁻¹,
  {
    apply inv_nonneg.2 A1,
  },
  rw nnreal.coe_of_real x A1,
  rw nnreal.coe_of_real _ A2,
end

/--TODO: replace with div_eq_mul_inv.-/
lemma nnreal.div_def {x y:nnreal}:x/y = x * y⁻¹ := begin
  rw div_eq_mul_inv,
end

lemma nnreal.one_div_eq_inv {x:nnreal}:1/x = x⁻¹ :=
begin
  rw nnreal.div_def,
  rw one_mul,
end

lemma nnreal.exists_unit_frac_lt_pos {ε:nnreal}:0 < ε → (∃ n:ℕ, (1/((n:nnreal) + 1)) < ε) :=
begin
  intro A1,
  have A2 := A1,
  rw nnreal.lt_iff_exists_rat_btwn at A2,
  cases A2 with q A2,
  cases A2 with A2 A3,
  cases A3 with A3 A4,
  simp at A3,
  have A5 := rat.exists_unit_frac_le_pos A3,
  cases A5 with n A5,
  apply exists.intro n,
  simp at A5,
  rw nnreal.one_div_eq_inv,
  have B2:(0:ℝ) ≤ 1,
  {
    apply le_of_lt,
    apply zero_lt_one,
  },
  have A7:nnreal.of_real 1 = (1:nnreal),
  {
    rw ← nnreal.coe_eq,
    rw nnreal.coe_of_real,
    rw nnreal.coe_one,
    apply B2,
  },
  rw ← A7,
  have A8:nnreal.of_real n = n,
  {
    rw ← nnreal.coe_eq,
    rw nnreal.coe_of_real,
    simp,
    simp,
  },
  rw ← A8,
  have B1:(0:ℝ) ≤ n,
  {
    simp,
  },
  have B3:(0:ℝ) ≤ n + (1:ℝ),
  {
    apply le_trans B1,
    simp,
    apply B2
  },

  rw ← nnreal.of_real_add B1 B2,
  rw ← nnreal.of_real_inv_eq_inv_of_real B3,
  have A9 := nnreal.rat_le_rat A5,
  have A10:((n:ℝ) + 1)⁻¹ = (↑((n:ℚ) + 1)⁻¹:ℝ),
  {
    simp,
  },
  rw A10,
  apply lt_of_le_of_lt A9 A4,
end

lemma nnreal.of_real_eq_coe_nat {n:ℕ}:nnreal.of_real n = n :=
begin
  rw ← nnreal.coe_eq,
  rw nnreal.coe_of_real,
  repeat {simp},
end

lemma nnreal.sub_le_sub_of_le {a b c:nnreal}:b ≤ a →
  c - a ≤ c - b :=
begin
  intro A1,
  cases (classical.em (a ≤ c)) with B1 B1,
  {
    rw ← nnreal.coe_le_coe,
    rw nnreal.coe_sub B1,
    have B2:=le_trans A1 B1,
    rw nnreal.coe_sub B2,
    rw ← nnreal.coe_le_coe at A1,
    linarith [A1],
  },
  {
    simp only [not_le] at B1,
    have C1:= le_of_lt B1,
    rw nnreal.sub_eq_zero C1,
    simp
  },
end

--Replace c < b with c ≤ a.
lemma nnreal.sub_lt_sub_of_lt_of_lt {a b c:nnreal}:a < b →
  c ≤ a →
  a - c < b - c :=
begin
  intros A1 A2,
  rw ← nnreal.coe_lt_coe,
  rw nnreal.coe_sub A2,
  have B1:=lt_of_le_of_lt A2 A1,
  have B2 := le_of_lt B1,
  rw nnreal.coe_sub B2,
  apply real.sub_lt_sub_of_lt,
  rw nnreal.coe_lt_coe,
  apply A1,
end

lemma nnreal.sub_lt_sub_of_lt_of_le {a b c d:nnreal}:a < b →
  c ≤ d →
  d ≤ a →
  a - d < b - c :=
begin
  intros A1 A2 A3,
  have A3:a - d < b - d,
  {
    apply nnreal.sub_lt_sub_of_lt_of_lt A1 A3,
  },
  apply lt_of_lt_of_le A3,
  apply nnreal.sub_le_sub_of_le A2,
end

lemma nnreal.eq_add_of_sub_eq {a b c:nnreal}:b ≤ a →
  a - b = c → a = b + c :=
begin
  intros A1 A2,
  apply nnreal.eq,
  rw  nnreal.coe_add,
  rw ← nnreal.eq_iff at A2,
  rw  nnreal.coe_sub A1 at A2,
  apply real.eq_add_of_sub_eq A2,
end

lemma nnreal.sub_add_sub {a b c:nnreal}:c ≤ b → b ≤ a → (a - b) + (b - c) = a - c :=
begin
  intros A1 A2,
  rw ← nnreal.coe_eq,
  rw nnreal.coe_add,
  repeat {rw nnreal.coe_sub},
  apply real.sub_add_sub,
  apply le_trans A1 A2,
  apply A1,
  apply A2,
end

lemma nnreal.add_lt_of_lt_sub {a b c:nnreal}:a < b - c → a + c < b :=
begin
  cases (decidable.em (c ≤ b)) with B1 B1,
  {
    repeat {rw ← nnreal.coe_lt_coe <|> rw nnreal.coe_add},
    rw nnreal.coe_sub B1,
    intro B2,
    linarith,
  },
  {
    intros A1,
    rw nnreal.sub_eq_zero at A1,
    exfalso,
    simp at A1,
    apply A1,
    apply le_of_not_le B1,
  },
end

lemma nnreal.lt_sub_of_add_lt {a b c:nnreal}:a + c < b → a < b - c :=
begin
  intro A1,
  have B1:c ≤ b,
  {
    have B1A := le_of_lt A1,
    have B1B:a + c ≤ a + b,
    {
      have B1BA:b ≤ a + b,
      {
        rw add_comm,
        apply le_add_nonnegative _ _,
      },
      apply le_trans B1A B1BA,
    },
    simp at B1B,
    apply B1B,
  },
  revert A1,
  repeat {rw ← nnreal.coe_lt_coe <|> rw nnreal.coe_add},
  rw nnreal.coe_sub B1,
  intros,
  linarith,
end

lemma nnreal.le_sub_add {a b c:nnreal}:b ≤ c → c ≤ a →
a ≤ a - b + c :=
begin
  repeat {rw ← nnreal.coe_le_coe},
  repeat {rw nnreal.coe_add},
  intros A1 A2,
  repeat {rw nnreal.coe_sub},
  linarith,
  apply le_trans A1 A2,
end

lemma nnreal.le_sub_add' {a b:nnreal}:a ≤ a - b + b :=
begin
  cases decidable.em (b ≤ a),
  { apply nnreal.le_sub_add,
    apply le_refl _,
    apply h },
  { have h2:a≤ b,
    { apply le_of_not_ge h }, rw nnreal.sub_eq_zero,
    rw zero_add,
    apply h2,
    apply h2 },
end

lemma nnreal.lt_of_add_le_of_le_of_sub_lt {a b c d e:nnreal}:
    a + b ≤ c → d ≤ b → c - e < a → d < e :=
begin
  rw ← nnreal.coe_le_coe,
  rw ← nnreal.coe_le_coe,
  rw ← nnreal.coe_lt_coe,
  rw ← nnreal.coe_lt_coe,
  rw nnreal.coe_add,
  cases (le_or_lt e c) with B1 B1,
  {
    rw nnreal.coe_sub B1,
    rw ← nnreal.coe_le_coe at B1,
    intros,linarith,
  },
  {
    rw nnreal.sub_eq_zero (le_of_lt B1),
    rw ← nnreal.coe_lt_coe at B1,
    rw nnreal.coe_zero,
    intros,linarith,
  },
end

lemma nnreal.inv_as_fraction {c:nnreal}:(1)/(c) = (c)⁻¹ :=
begin
  rw nnreal.div_def,
  rw one_mul,
end

lemma nnreal.lt_of_add_lt_of_pos {a b c:nnreal}:
      b + c ≤ a →
      0 < b →
      c < a :=
begin
  rw ← nnreal.coe_le_coe,
  rw ← nnreal.coe_lt_coe,
  rw ← nnreal.coe_lt_coe,
  rw nnreal.coe_add,
  rw nnreal.coe_zero,
  intros,
  linarith,
end

lemma nnreal.mul_le_mul_of_le_left {a b c:nnreal}:
  a ≤ b → c * a ≤ c * b :=
begin
  intro A1,
  apply ordered_comm_monoid.mul_le_mul_left,
  apply A1,
end

----- From Radon Nikodym ---------------------------------

lemma nnreal.mul_lt_mul_of_pos_of_lt
    {a b c:nnreal}:(0 < a) → (b < c) → (a * b < a * c) :=
begin
  intros A1 A2,
  apply mul_lt_mul',
  apply le_refl _,
  apply A2,
  simp,
  apply A1,
end

lemma canonically_ordered_add_monoid.zero_lt_iff_ne_zero
  {α:Type*} [canonically_ordered_add_monoid α] {x:α}:0 < x ↔ x ≠ 0 :=
begin
  split,
  { intros h_zero_lt h_eq_zero,
    rw h_eq_zero at h_zero_lt,
    apply lt_irrefl _ h_zero_lt },
  { intros h_ne,
    rw lt_iff_le_and_ne,
    split,
    apply zero_le,
    symmetry,
    apply h_ne },
end

lemma nnreal.zero_lt_iff_ne_zero {x:nnreal}:0 < x ↔ x ≠ 0 := begin
  rw canonically_ordered_add_monoid.zero_lt_iff_ne_zero,
end

/-
  It is hard to generalize this.
 -/
lemma nnreal.mul_pos_iff_pos_pos
    {a b:nnreal}:(0 < a * b) ↔ (0 < a)∧ (0 < b) :=
begin
  split;intros A1,
  {
    rw nnreal.zero_lt_iff_ne_zero at A1,
    repeat {rw nnreal.zero_lt_iff_ne_zero},
    split;intro B1;apply A1,
    {
       rw B1,
       rw zero_mul,
    },
    {
      rw B1,
      rw mul_zero,
    },
  },
  {
    have C1:0 ≤ a * 0,
    {
      simp,
    },
    apply lt_of_le_of_lt C1,
    apply nnreal.mul_lt_mul_of_pos_of_lt,
    apply A1.left,
    apply A1.right,
  },
end

lemma nnreal.inv_mul_eq_inv_mul_inv {a b:nnreal}:(a * b)⁻¹=a⁻¹ * b⁻¹ :=
begin
  rw nnreal.mul_inv,
  rw mul_comm,
end

-- TODO: replace with zero_lt_iff_ne_zero.
lemma nnreal.pos_iff {a:nnreal}:0 < a ↔ a ≠ 0 :=
begin
  rw nnreal.zero_lt_iff_ne_zero,
end

lemma nnreal.add_pos_le_false {x ε:nnreal}: (0 < ε) → (x + ε ≤ x) → false :=
begin
  cases x, cases ε,
  rw ← nnreal.coe_le_coe,
  rw ← nnreal.coe_lt_coe,
  rw nnreal.coe_add,
  simp,
  intros h1 h2,
  linarith [h1, h2],
end

lemma nnreal.lt_add_pos {x ε:nnreal}: (0 < ε) → (x < x + ε)  :=
begin
  cases ε; cases x; simp,
end


/-
Copyright (c) 2022 Mantas Bakšys. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mantas Bakšys
-/
import algebra.order.module
import data.prod.lex
import group_theory.perm.support
import order.monovary
import tactic.abel

/-!
# Rearrangement inequality

This file proves the rearrangement inequality and deduces the conditions for equality and strict
inequality.

The rearrangement inequality tells you that for two functions `f g : ι → α`, the sum
`∑ i, f i * g (σ i)` is maximized over all `σ : perm ι` when `g ∘ σ` monovaries with `f` and
minimized when `g ∘ σ` antivaries with `f`.

The inequality also tells you that `∑ i, f i * g (σ i) = ∑ i, f i * g i` if and only if `g ∘ σ`
monovaries with `f` when `g` monovaries with `f`. The above equality also holds if and only if
`g ∘ σ` antivaries with `f` when `g` antivaries with `f`.

From the above two statements, we deduce that the inequality is strict if and only if `g ∘ σ` does
not monovary with `f` when `g` monovaries with `f`. Analogously, the inequality is strict if and
only if `g ∘ σ` does not antivary with `f` when `g` antivaries with `f`.

## Implementation notes

In fact, we don't need much compatibility between the addition and multiplication of `α`, so we can
actually decouple them by replacing multiplication with scalar multiplication and making `f` and `g`
land in different types.
As a bonus, this makes the dual statement trivial. The multiplication versions are provided for
convenience.

The case for `monotone`/`antitone` pairs of functions over a `linear_order` is not deduced in this
file because it is easily deducible from the `monovary` API.
-/

open equiv equiv.perm finset function order_dual
open_locale big_operators

variables {ι α β : Type*}

/-! ### Scalar multiplication versions -/

section smul
variables [linear_ordered_ring α] [linear_ordered_add_comm_group β] [module α β]
  [ordered_smul α β] {s : finset ι} {σ : perm ι} {f : ι → α} {g : ι → β}

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_smul_comp_perm_le_sum_smul (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g (σ i) ≤ ∑ i in s, f i • g i :=
begin
  classical,
  revert hσ σ hfg,
  apply finset.induction_on_max_value (λ i, to_lex (g i, f i)) s,
  { simp only [le_rfl, finset.sum_empty, implies_true_iff] },
  intros a s has hamax hind σ hfg hσ,
  set τ : perm ι := σ.trans (swap a (σ a)) with hτ,
  have hτs : {x | τ x ≠ x} ⊆ s,
  { intros x hx,
    simp only [ne.def, set.mem_set_of_eq, equiv.coe_trans, equiv.swap_comp_apply] at hx,
    split_ifs at hx with h₁ h₂ h₃,
    { obtain rfl | hax := eq_or_ne x a,
      { contradiction },
      { exact mem_of_mem_insert_of_ne (hσ $ λ h, hax $ h.symm.trans h₁) hax } },
    { exact (hx $ σ.injective h₂.symm).elim },
    { exact mem_of_mem_insert_of_ne (hσ hx) (ne_of_apply_ne _ h₂) } },
  specialize hind (hfg.subset $ subset_insert _ _) hτs,
  simp_rw sum_insert has,
  refine le_trans _ (add_le_add_left hind _),
  obtain hσa | hσa := eq_or_ne a (σ a),
  { rw [hτ, ←hσa, swap_self, trans_refl] },
  have h1s : σ⁻¹ a ∈ s,
  { rw [ne.def, ←inv_eq_iff_eq] at hσa,
    refine mem_of_mem_insert_of_ne (hσ $ λ h, hσa _) hσa,
    rwa [apply_inv_self, eq_comm] at h },
  simp only [← s.sum_erase_add _ h1s, add_comm],
  rw [← add_assoc, ← add_assoc],
  simp only [hτ, swap_apply_left, function.comp_app, equiv.coe_trans, apply_inv_self],
  refine add_le_add (smul_add_smul_le_smul_add_smul' _ _) (sum_congr rfl $ λ x hx, _).le,
  { specialize hamax (σ⁻¹ a) h1s,
    rw prod.lex.le_iff at hamax,
    cases hamax,
    { exact hfg (mem_insert_of_mem h1s) (mem_insert_self _ _) hamax },
    { exact hamax.2 } },
  { specialize hamax (σ a) (mem_of_mem_insert_of_ne (hσ $ σ.injective.ne hσa.symm) hσa.symm),
    rw prod.lex.le_iff at hamax,
    cases hamax,
    { exact hamax.le },
    { exact hamax.1.le } },
  { rw [mem_erase, ne.def, eq_inv_iff_eq] at hx,
    rw swap_apply_of_ne_of_ne hx.1 (σ.injective.ne _),
    rintro rfl,
    exact has hx.2 }
end

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_smul_comp_perm_eq_sum_smul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g (σ i) = ∑ i in s, f i • g i ↔ monovary_on f (g ∘ σ) s :=
begin
  classical,
  refine ⟨not_imp_not.1 $ λ h, _, λ h, (hfg.sum_smul_comp_perm_le_sum_smul hσ).antisymm _⟩,
  { rw monovary_on at h,
    push_neg at h,
    obtain ⟨x, hx, y, hy, hgxy, hfxy⟩ := h,
    set τ : perm ι := (swap x y).trans σ,
    have hτs : {x | τ x ≠ x} ⊆ s,
    { refine (set_support_mul_subset σ $ swap x y).trans (set.union_subset hσ $ λ z hz, _),
      obtain ⟨_, rfl | rfl⟩ := swap_apply_ne_self_iff.1 hz; assumption },
    refine ((hfg.sum_smul_comp_perm_le_sum_smul hτs).trans_lt' _).ne,
    obtain rfl | hxy := eq_or_ne x y,
    { cases lt_irrefl _ hfxy },
    simp only [←s.sum_erase_add _ hx, ←(s.erase x).sum_erase_add _ (mem_erase.2 ⟨hxy.symm, hy⟩),
      add_assoc, equiv.coe_trans, function.comp_app, swap_apply_right, swap_apply_left],
    refine add_lt_add_of_le_of_lt (finset.sum_congr rfl $ λ z hz, _).le
      (smul_add_smul_lt_smul_add_smul hfxy hgxy),
    simp_rw mem_erase at hz,
    rw swap_apply_of_ne_of_ne hz.2.1 hz.1 },
  { convert h.sum_smul_comp_perm_le_sum_smul ((set_support_inv_eq _).subset.trans hσ) using 1,
    simp_rw [function.comp_app, apply_inv_self] }
end

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_smul_comp_perm_lt_sum_smul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g (σ i) < ∑ i in s, f i • g i ↔ ¬ monovary_on f (g ∘ σ) s :=
by simp [←hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ,
  lt_iff_le_and_ne, hfg.sum_smul_comp_perm_le_sum_smul hσ]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_smul_le_sum_smul (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) • g i ≤ ∑ i in s, f i • g i :=
begin
  convert hfg.sum_smul_comp_perm_le_sum_smul
    (show {x | σ⁻¹ x ≠ x} ⊆ s, by simp only [set_support_inv_eq, hσ]) using 1,
  exact σ.sum_comp' s (λ i j, f i • g j) hσ,
end

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_smul_eq_sum_smul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) • g i = ∑ i in s, f i • g i ↔ monovary_on (f ∘ σ) g s :=
begin
  have hσinv : {x | σ⁻¹ x ≠ x} ⊆ s := (set_support_inv_eq _).subset.trans hσ,
  refine (iff.trans _ $ hfg.sum_smul_comp_perm_eq_sum_smul_iff hσinv).trans ⟨λ h, _, λ h, _⟩,
  { simpa only [σ.sum_comp' s (λ i j, f i • g j) hσ] },
  { convert h.comp_right σ,
    { rw [comp.assoc, inv_def, symm_comp_self, comp.right_id] },
    { rw [σ.eq_preimage_iff_image_eq, set.image_perm hσ] } },
  { convert h.comp_right σ.symm,
    { rw [comp.assoc, self_comp_symm, comp.right_id] },
    { rw σ.symm.eq_preimage_iff_image_eq,
      exact set.image_perm hσinv } }
end

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_smul_lt_sum_smul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) • g i < ∑ i in s, f i • g i ↔ ¬ monovary_on (f ∘ σ) g s :=
by simp [←hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ,
  lt_iff_le_and_ne, hfg.sum_comp_perm_smul_le_sum_smul hσ]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_smul_le_sum_smul_comp_perm (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g i ≤ ∑ i in s, f i • g (σ i) :=
hfg.dual_right.sum_smul_comp_perm_le_sum_smul hσ

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_smul_eq_sum_smul_comp_perm_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g (σ i) = ∑ i in s, f i • g i ↔ antivary_on f (g ∘ σ) s :=
(hfg.dual_right.sum_smul_comp_perm_eq_sum_smul_iff hσ).trans monovary_on_to_dual_right

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_smul_lt_sum_smul_comp_perm_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g i < ∑ i in s, f i • g (σ i) ↔ ¬ antivary_on f (g ∘ σ) s :=
by simp [←hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ, lt_iff_le_and_ne, eq_comm,
  hfg.sum_smul_le_sum_smul_comp_perm hσ]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_smul_le_sum_comp_perm_smul (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g i ≤ ∑ i in s, f (σ i) • g i :=
hfg.dual_right.sum_comp_perm_smul_le_sum_smul hσ

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_smul_eq_sum_comp_perm_smul_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) • g i = ∑ i in s, f i • g i ↔ antivary_on (f ∘ σ) g s :=
(hfg.dual_right.sum_comp_perm_smul_eq_sum_smul_iff hσ).trans monovary_on_to_dual_right

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_smul_lt_sum_comp_perm_smul_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g i < ∑ i in s, f (σ i) • g i ↔ ¬ antivary_on (f ∘ σ) g s :=
by simp [←hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ, eq_comm, lt_iff_le_and_ne,
  hfg.sum_smul_le_sum_comp_perm_smul hσ]

variables [fintype ι]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_smul_comp_perm_le_sum_smul (hfg : monovary f g) :
  ∑ i, f i • g (σ i) ≤ ∑ i, f i • g i :=
(hfg.monovary_on _).sum_smul_comp_perm_le_sum_smul $ λ i _, mem_univ _

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_smul_comp_perm_eq_sum_smul_iff (hfg : monovary f g) :
  ∑ i, f i • g (σ i) = ∑ i, f i • g i ↔ monovary f (g ∘ σ) :=
by simp [(hfg.monovary_on _).sum_smul_comp_perm_eq_sum_smul_iff (λ i _, mem_univ _)]

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_smul_comp_perm_lt_sum_smul_iff (hfg : monovary f g) :
  ∑ i, f i • g (σ i) < ∑ i, f i • g i ↔ ¬ monovary f (g ∘ σ) :=
by simp [(hfg.monovary_on _).sum_smul_comp_perm_lt_sum_smul_iff (λ i _, mem_univ _)]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `f`. -/
lemma monovary.sum_comp_perm_smul_le_sum_smul (hfg : monovary f g) :
  ∑ i, f (σ i) • g i ≤ ∑ i, f i • g i :=
(hfg.monovary_on _).sum_comp_perm_smul_le_sum_smul $ λ i _, mem_univ _

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_comp_perm_smul_eq_sum_smul_iff (hfg : monovary f g) :
  ∑ i, f (σ i) • g i = ∑ i, f i • g i ↔ monovary (f ∘ σ) g :=
by simp [(hfg.monovary_on _).sum_comp_perm_smul_eq_sum_smul_iff (λ i _, mem_univ _)]

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_comp_perm_smul_lt_sum_smul_iff (hfg : monovary f g) :
   ∑ i, f (σ i) • g i < ∑ i, f i • g i ↔ ¬ monovary (f ∘ σ) g :=
by simp [(hfg.monovary_on _).sum_comp_perm_smul_lt_sum_smul_iff (λ i _, mem_univ _)]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_smul_le_sum_smul_comp_perm (hfg : antivary f g) :
  ∑ i, f i • g i ≤ ∑ i, f i • g (σ i) :=
(hfg.antivary_on _).sum_smul_le_sum_smul_comp_perm $ λ i _, mem_univ _

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_smul_eq_sum_smul_comp_perm_iff (hfg : antivary f g) :
  ∑ i, f i • g (σ i) = ∑ i, f i • g i ↔ antivary f (g ∘ σ) :=
by simp [(hfg.antivary_on _).sum_smul_eq_sum_smul_comp_perm_iff (λ i _, mem_univ _)]

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_smul_lt_sum_smul_comp_perm_iff (hfg : antivary f g) :
  ∑ i, f i • g i < ∑ i, f i • g (σ i) ↔ ¬ antivary f (g ∘ σ) :=
by simp [(hfg.antivary_on _).sum_smul_lt_sum_smul_comp_perm_iff (λ i _, mem_univ _)]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_smul_le_sum_comp_perm_smul (hfg : antivary f g) :
  ∑ i, f i • g i ≤ ∑ i, f (σ i) • g i :=
(hfg.antivary_on _).sum_smul_le_sum_comp_perm_smul $ λ i _, mem_univ _

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_smul_eq_sum_comp_perm_smul_iff (hfg : antivary f g) :
  ∑ i, f (σ i) • g i = ∑ i, f i • g i ↔ antivary (f ∘ σ) g :=
by simp [(hfg.antivary_on _).sum_smul_eq_sum_comp_perm_smul_iff (λ i _, mem_univ _)]

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_smul_lt_sum_comp_perm_smul_iff (hfg : antivary f g) :
  ∑ i, f i • g i < ∑ i, f (σ i) • g i ↔ ¬ antivary (f ∘ σ) g :=
by simp [(hfg.antivary_on _).sum_smul_lt_sum_comp_perm_smul_iff (λ i _, mem_univ _)]

end smul

/-!
### Multiplication versions

Special cases of the above when scalar multiplication is actually multiplication.
-/

section mul
variables [linear_ordered_ring α] {s : finset ι} {σ : perm ι} {f g : ι → α}

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_mul_comp_perm_le_sum_mul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g (σ i) ≤ ∑ i in s, f i * g i :=
hfg.sum_smul_comp_perm_le_sum_smul hσ

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_mul_comp_perm_eq_sum_mul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g (σ i) = ∑ i in s, f i * g i ↔ monovary_on f (g ∘ σ) s :=
hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary_on.sum_mul_comp_perm_lt_sum_mul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i • g (σ i) < ∑ i in s, f i • g i ↔ ¬ monovary_on f (g ∘ σ) s :=
hfg.sum_smul_comp_perm_lt_sum_smul_iff hσ

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_mul_le_sum_mul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) * g i ≤ ∑ i in s, f i * g i :=
hfg.sum_comp_perm_smul_le_sum_smul hσ

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_mul_eq_sum_mul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) * g i = ∑ i in s, f i * g i ↔ monovary_on (f ∘ σ) g s :=
hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/
lemma monovary_on.sum_comp_perm_mul_lt_sum_mul_iff (hfg : monovary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) * g i < ∑ i in s, f i * g i ↔ ¬ monovary_on (f ∘ σ) g s :=
hfg.sum_comp_perm_smul_lt_sum_smul_iff hσ

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_mul_le_sum_mul_comp_perm (hfg : antivary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g i ≤ ∑ i in s, f i * g (σ i) :=
hfg.sum_smul_le_sum_smul_comp_perm hσ

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_mul_eq_sum_mul_comp_perm_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g (σ i) = ∑ i in s, f i * g i ↔ antivary_on f (g ∘ σ) s :=
hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
lemma antivary_on.sum_mul_lt_sum_mul_comp_perm_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g i < ∑ i in s, f i * g (σ i) ↔ ¬ antivary_on f (g ∘ σ) s :=
hfg.sum_smul_lt_sum_smul_comp_perm_iff hσ

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_mul_le_sum_comp_perm_mul (hfg : antivary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g i ≤ ∑ i in s, f (σ i) * g i :=
hfg.sum_smul_le_sum_comp_perm_smul hσ

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_mul_eq_sum_comp_perm_mul_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f (σ i) * g i = ∑ i in s, f i * g i ↔ antivary_on (f ∘ σ) g s :=
hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
lemma antivary_on.sum_mul_lt_sum_comp_perm_mul_iff (hfg : antivary_on f g s)
  (hσ : {x | σ x ≠ x} ⊆ s) :
  ∑ i in s, f i * g i < ∑ i in s, f (σ i) * g i ↔ ¬ antivary_on (f ∘ σ) g s :=
hfg.sum_smul_lt_sum_comp_perm_smul_iff hσ

variables [fintype ι]

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_mul_comp_perm_le_sum_mul (hfg : monovary f g) :
  ∑ i, f i * g (σ i) ≤ ∑ i, f i * g i :=
hfg.sum_smul_comp_perm_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_mul_comp_perm_eq_sum_mul_iff (hfg : monovary f g) :
  ∑ i, f i * g (σ i) = ∑ i, f i * g i ↔ monovary f (g ∘ σ) :=
hfg.sum_smul_comp_perm_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_mul_comp_perm_lt_sum_mul_iff (hfg : monovary f g) :
  ∑ i, f i * g (σ i) < ∑ i, f i * g i ↔ ¬ monovary f (g ∘ σ) :=
hfg.sum_smul_comp_perm_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `f`. -/
lemma monovary.sum_comp_perm_mul_le_sum_mul (hfg : monovary f g) :
  ∑ i, f (σ i) * g i ≤ ∑ i, f i * g i :=
hfg.sum_comp_perm_smul_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_comp_perm_mul_eq_sum_mul_iff (hfg : monovary f g) :
  ∑ i, f (σ i) * g i = ∑ i, f i * g i ↔ monovary (f ∘ σ) g :=
hfg.sum_comp_perm_smul_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
lemma monovary.sum_comp_perm_mul_lt_sum_mul_iff (hfg : monovary f g) :
   ∑ i, f (σ i) * g i < ∑ i, f i * g i ↔ ¬ monovary (f ∘ σ) g :=
hfg.sum_comp_perm_smul_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_mul_le_sum_mul_comp_perm (hfg : antivary f g) :
  ∑ i, f i * g i ≤ ∑ i, f i * g (σ i) :=
hfg.sum_smul_le_sum_smul_comp_perm

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_mul_eq_sum_mul_comp_perm_iff (hfg : antivary f g) :
  ∑ i, f i * g (σ i) = ∑ i, f i * g i ↔ antivary f (g ∘ σ) :=
hfg.sum_smul_eq_sum_smul_comp_perm_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
lemma antivary.sum_mul_lt_sum_mul_comp_perm_iff (hfg : antivary f g) :
  ∑ i, f i • g i < ∑ i, f i • g (σ i) ↔ ¬ antivary f (g ∘ σ) :=
hfg.sum_smul_lt_sum_smul_comp_perm_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_mul_le_sum_comp_perm_mul (hfg : antivary f g) :
  ∑ i, f i * g i ≤ ∑ i, f (σ i) * g i :=
hfg.sum_smul_le_sum_comp_perm_smul

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_mul_eq_sum_comp_perm_mul_iff (hfg : antivary f g) :
  ∑ i, f (σ i) * g i = ∑ i, f i * g i ↔ antivary (f ∘ σ) g :=
hfg.sum_smul_eq_sum_comp_perm_smul_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
lemma antivary.sum_mul_lt_sum_comp_perm_mul_iff (hfg : antivary f g) :
  ∑ i, f i * g i < ∑ i, f (σ i) * g i ↔ ¬ antivary (f ∘ σ) g :=
hfg.sum_smul_lt_sum_comp_perm_smul_iff

end mul


/-

C* algebras and related concepts.

Classes defined here:
  star_ring R - has an involution * or ∗
  comm_star_ring R - for example, complex.comm_star_ring
  normed_star_ring R - normed_ring with the norm_star property, norm (x∗) = norm x
  c_star_ring R - normed_ring with the norm_mul_norm_le_norm_star_mul property, norm x * norm x ≤ norm (x∗ * x)
    This implies equality (norm_star_mul) as well as norm_star.
  star_algebra R A - analogous to algebra R A
  normed_star_algebra [R] A - a star_algebra which is also a normed_star_ring
  star_banach_algebra [R] A - like normed_star_algebra and a complete_space
  c_star_algebra [R] A - a star_algebra which is also a c_star_ring and a complete_space
-/

import analysis.normed_space.basic
import algebra.invertible algebra.group.units

-- variables (𝕜 : Type*) [normed_field 𝕜]
variables {R : Type*}

set_option default_priority 50
-- class banach_algebra (A : Type*) [normed_ring A] [complete_space A] extends normed_algebra 𝕜 A

/-- Auxilliary class stating that `α` has a star-operation, a postfix operation `∗`, which can be typed using `\ast`. -/
class has_star (α : Type*) :=
  (star : α → α)

postfix `∗`:(max+10) := has_star.star -- type ∗ using \ast

section star_ring
/-- A star ring, *-ring or involutive ring is a ring with an involution `∗`. -/
class star_ring (R : Type*) extends ring R, has_star R :=
  (add_star : ∀ x y : R, (x + y)∗ = x∗ + y∗)
  (mul_star : ∀ x y : R, (x * y)∗ = y∗ * x∗)
  (one_star : (1 : R)∗ = 1)
  (star_star : ∀ x : R, x∗∗ = x)

variables [star_ring R] {x y z : R}

lemma add_star : (x + y)∗ = x∗ + y∗ := star_ring.add_star x y

lemma mul_star : (x * y)∗ = y∗ * x∗ := star_ring.mul_star x y

lemma one_star : (1 : R)∗ = 1 := star_ring.one_star

@[simp] lemma star_star : x∗∗ = x := star_ring.star_star x

@[simp] lemma zero_star : (0 : R)∗ = 0 :=
by { rw ←add_right_eq_self, symmetry, convert @add_star R _ 0 0, rw add_zero }

lemma neg_star : (- x)∗ = - x∗ :=
by { rw [eq_neg_iff_add_eq_zero, ←add_star, add_left_neg, zero_star] }

lemma sub_star : (x - y)∗ = x∗ - y∗ := by simp only [sub_eq_add_neg, add_star, neg_star]

end star_ring

section comm_star_ring
/--
  A commutative *-ring.

  This definition should be
  `class comm_star_ring (R : Type*) extends comm_ring R, star_ring R`
  but that doesn't work for technical reasons relating to the old structure command.
-/
-- Workaround for
class comm_star_ring (R : Type*) extends comm_ring R, has_star R :=
  (add_star : ∀ x y : R, (x + y)∗ = x∗ + y∗)
  (mul_star : ∀ x y : R, (x * y)∗ = y∗ * x∗)
  (one_star : (1 : R)∗ = 1)
  (star_star : ∀ x : R, x∗∗ = x)

variables [comm_star_ring R] {x y z : R}

@[priority 150] instance comm_star_ring.to_star_ring : star_ring R := { .._inst_1 }

lemma mul_star' : (x * y)∗ = x∗ * y∗ := by rw [mul_star, mul_comm]

instance complex.has_star : has_star ℂ := ⟨complex.conj⟩

noncomputable instance complex.comm_star_ring : comm_star_ring ℂ :=
{ add_star := complex.conj_add,
  mul_star := by { intros x y, rw [mul_comm], apply complex.conj_mul },
  one_star := complex.conj_one,
  star_star := complex.conj_conj,
  ..complex.field, ..complex.has_star }

end comm_star_ring

section normed_star_ring
/--
  A normed *-ring, the part of the structure of a normed involutive algebra that does
  not mention the ring over which it lies.

  This definition should be
  ```
  class normed_star_ring (R : Type*) extends normed_ring R, star_ring R :=
  (norm_star : ∀ x : R, norm (x∗) = norm x)
  ```
  but that doesn't work for technical reasons relating to the old structure command.
-/
class normed_star_ring (R : Type*) extends normed_ring R, has_star R :=
  (add_star : ∀ x y : R, (x + y)∗ = x∗ + y∗)
  (mul_star : ∀ x y : R, (x * y)∗ = y∗ * x∗)
  (one_star : (1 : R)∗ = 1)
  (star_star : ∀ x : R, x∗∗ = x)
  (norm_star : ∀ x : R, norm (x∗) = norm x)

variables [normed_star_ring R] {x y z : R}

@[priority 150] instance normed_star_ring.to_star_ring : star_ring R := { .._inst_1 }

@[simp] lemma norm_star : norm (x∗) = norm x := normed_star_ring.norm_star x

end normed_star_ring

section c_star_ring

/--
  A C*-ring, the part of the structure of a C*-algebra that does not mention the ring
  over which it lies.

  This definition should be
  ```
  class c_star_ring (R : Type*) extends normed_ring R, star_ring R :=
  (norm_mul_norm_le_norm_star_mul : ∀ x : R, norm x * norm x ≤ norm (x∗ * x))
  ```
  but that doesn't work for technical reasons relating to the old structure command.
-/
class c_star_ring (R : Type*) extends normed_ring R, has_star R :=
  (add_star : ∀ x y : R, (x + y)∗ = x∗ + y∗)
  (mul_star : ∀ x y : R, (x * y)∗ = y∗ * x∗)
  (one_star : (1 : R)∗ = 1)
  (star_star : ∀ x : R, x∗∗ = x)
  (norm_mul_norm_le_norm_star_mul : ∀ x : R, norm x * norm x ≤ norm (x∗ * x))

variables [c_star_ring R] {x y z : R}

lemma norm_mul_norm_le_norm_star_mul (x : R) : norm x * norm x ≤ norm (x∗ * x) :=
c_star_ring.norm_mul_norm_le_norm_star_mul x

/-- Every C*-ring is a *-ring. -/
def c_star_ring.to_star_ring : star_ring R := { .._inst_1 }

local attribute [instance, priority 10] c_star_ring.to_star_ring

lemma norm_le_norm_star (x : R) : norm x ≤ norm (x∗) :=
begin
  classical,
  by_cases x = 0, { simp [h] },
  apply le_of_mul_le_mul_right,
  exact le_trans (c_star_ring.norm_mul_norm_le_norm_star_mul x) (norm_mul_le _ _),
  simp [norm_pos_iff, h]
end

@[priority 100] instance c_star_ring.to_normed_star_ring : normed_star_ring R :=
{ norm_star :=
    begin
    intro x, apply le_antisymm,
    { convert norm_le_norm_star x∗, rw star_star },
    { apply norm_le_norm_star }
    end,
  .._inst_1 }

lemma norm_star_mul : norm (x∗ * x) = norm x * norm x :=
begin
  apply le_antisymm,
  { convert norm_mul_le _ _ using 2, rw norm_star },
  { exact c_star_ring.norm_mul_norm_le_norm_star_mul x }
end

lemma norm_mul_star : norm (x * x∗) = norm x * norm x :=
by { convert @norm_star_mul _ _ x∗ using 2; simp only [norm_star, star_star] }

end c_star_ring

/- algebras -/

section star_algebra

/-- A star algebra or *-algebra over a commutative star ring `R` -/
class star_algebra (R : Type*) [comm_star_ring R] (A : Type*) [star_ring A] extends algebra R A :=
  (smul_star : ∀ r : R, ∀ x : A, (r • x)∗ = r∗ • x∗)

variables [comm_star_ring R] {A : Type*} [star_ring A] [star_algebra R A]

/- TODO: lemmas -/

end star_algebra

section normed_star_algebra

/- The following hypotheses state `A` is an normed star algebra or normed involutive algebra over `R` -/
variables [comm_star_ring R] {A : Type*} [normed_star_ring A] [star_algebra R A]

/- TODO: lemmas -/

end normed_star_algebra

section star_banach_algebra

/- The following hypotheses state `A` is an star Banach algebra or involutive Banach algebra over `R` -/

variables [comm_star_ring R] {A : Type*} [normed_star_ring A] [complete_space A] [star_algebra R A]
variables (a b c : A)
variable (R)

def spectrum (a : A) : set R := { x : R | ¬ is_unit ( x • 1 - a ) }
def non_zero_spectrum (a : A) : set R := { x : R | x≠0 ∧ ¬ is_unit ( x • 1 - a ) }

#check spectrum R (a * b)

open_locale classical

lemma reorder_resolvent (a b : A) [h : invertible (1-a*b)] : invertible (1-b*a) :=
begin
  have h1 : h.inv_of - a*b*h.inv_of = 1 := by sorry,
  apply_fun (λ x, 1 - b*a + b*x*a) at h1,
  simp at h1,
  have h2 : h.inv_of - h.inv_of*a*b = 1 := by sorry,
  apply_fun (λ x, 1 - b*a + b*x*a) at h2,
  simp at h2,
  exact ⟨1+b*h.inv_of*a, by simp *, by simp *⟩
 end

variable {R}
lemma spectrum_comm (a b : A) : non_zero_spectrum R (a * b) = non_zero_spectrum R (b * a) :=
begin unfold non_zero_spectrum, ext, simp,
  by_cases x=0, repeat {simp [h]},
  haveI inv_x : invertible x := by sorry,--apply invertible_of_nonzero h,
  rw [ ← not_iff_not_of_iff], split,
  { intro, apply is_unit_of_invertible _,
    -- apply invertible_mul x ((1 : A) - ⅟x • a * b), exact inv_x,
    sorry
    },
end

end star_banach_algebra

section c_star_algebra

/-The following hypotheses state that `A` is a C*-algebra over `R` -/
variables [comm_star_ring R] {A : Type*} [c_star_ring A] [complete_space A] [star_algebra R A]

/- TODO: lemmas -/

end c_star_algebra


namespace prop_10

variables A B : Prop

theorem prop_10 : ¬ (A ∨ ¬ B) ∨ (¬ A ∧ ¬ B) → ¬ A :=
assume h1: ¬ (A ∨ ¬ B) ∨ (¬ A ∧ ¬ B),
assume h2: A,
show false, from or.elim h1
    (assume h3: ¬(A ∨ ¬B),
     h3 (or.inl h2))
    (assume h4: ¬A ∧ ¬B,
     have h5: ¬ A, from and.left h4,
     h5 h2)

-- end namespace
end prop_10


import data.set.basic
open set

variable {α : Type}
variables s t u : set α

example :
  s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
sorry


import data.real.basic
import data.set.intervals
import tactic.norm_num

-- nonempty is a class but let's have it working on set ℝ

namespace real_number_game

-- hide (need to choose this or P)
class nonemptyT (S : set ℝ) : Type :=
(x : ℝ)
(thm : x ∈ S)

-- hide (need to choose this or T)
class nonemptyP (S : set ℝ) : Prop :=
(thm' : ∃ x : ℝ, x ∈ S)

def nonemptyP.thm (S : set ℝ) [nonemptyP S] :
  ∃ x : ℝ, x ∈ S :=
nonemptyP.thm'

-- irrelevant example
example : ∃ x: ℝ, x < 1 := ⟨0.5, by norm_num⟩
example : (0.5 : ℝ) < 1 := by norm_num

-- irrelevant example
noncomputable example : nonemptyT (set.Icc 0 1) :=
{ x := 0.5,
  thm := by {simp,split;norm_num}
}

-- show
def is_upper_bound (S : set ℝ) (b : ℝ) : Prop := ∀ s ∈ S, s ≤ b

-- hide this def
class bounded_aboveT (S : set ℝ) : Type :=
(b : ℝ)
(thm : is_upper_bound S b)

-- hide this def
class bounded_aboveP (S : set ℝ) : Prop :=
(thm' : ∃ b : ℝ, is_upper_bound S b)

def bounded_aboveP.thm (S : set ℝ) [bounded_aboveP S] :
  ∃ b : ℝ, is_upper_bound S b :=
bounded_aboveP.thm'

-- example (for me only)
instance : bounded_aboveT (set.Icc 0 1) :=
{ b := 2,
  thm := λ r ⟨h1, h2⟩, le_trans h2 (by norm_num)
}

-- hide
noncomputable def Sup (S : set ℝ) [nonemptyP S] [bounded_aboveP S] := Sup S

-- state as axiom; hide proof
theorem le_Sup {S : set ℝ} [nonemptyP S] [bounded_aboveP S] : ∀ x ∈ S, x ≤ Sup S :=
begin
  apply real.le_Sup,
  cases bounded_aboveP.thm S with b hb,
  use b,
  exact hb,
end

-- state as axiom; hide proof
theorem Sup_le {S : set ℝ} [nonemptyP S] [bounded_aboveP S] :
  ∀ b : ℝ, is_upper_bound S b → Sup S ≤ b :=
begin
  intros b hb,
  show has_Sup.Sup S ≤ b,
  rw real.Sup_le,
  { exact hb},
  { cases nonemptyP.thm S with c hc, use c, exact hc},
  { use b, exact hb}
end

-- other axioms: ℤ unbounded, linearly ordered field.
-- Might need to introduce later.

end real_number_game


import propositional_logic.lanugage
import data.set
import data.finset
import data.finset.order
import order.zorn
open formula

open classical

namespace syntactics

@[derive [has_mem Formula, has_union, has_subset]]
def Axioms := set Formula

inductive deduction_consequence (ax : Axioms) (T : Theory) : Formula → Prop
| is_theory : ∀ {φ : Formula}, φ ∈ T → deduction_consequence φ
| is_axiom : ∀ {φ : Formula}, φ ∈ ax → deduction_consequence φ
| is_modus_ponens : ∀ {φ ψ : Formula}, deduction_consequence φ → deduction_consequence (φ →ᶠ ψ) → deduction_consequence ψ

def P1 : Axioms :=
{ ζ : Formula | ∃ φ ψ   : Formula, ζ = φ →ᶠ (ψ →ᶠ φ)}
def P2 : Axioms :=
{ ζ : Formula | ∃ φ ψ ξ : Formula, ζ = (φ →ᶠ (ψ →ᶠ ξ)) →ᶠ ((φ →ᶠ ψ) →ᶠ (φ →ᶠ ξ))}
def P3 : Axioms :=
{ ζ : Formula | ∃ φ ψ   : Formula, ζ = (¬ᶠφ →ᶠ ¬ᶠψ) →ᶠ (ψ →ᶠ φ) }

def classical_axioms : Axioms :=
P1 ∪ P2 ∪ P3

section classical_axioms

variables {φ ψ ξ : Formula}

lemma p1_subset_classical_axioms : P1 ⊆ classical_axioms :=
set.subset.trans (set.subset_union_left _ P2) (set.subset_union_left _ P3)

lemma p2_subset_classical_axioms : P2 ⊆ classical_axioms :=
set.subset.trans (set.subset_union_right P1 _) (set.subset_union_left _ P3)

lemma p3_subset_classical_axioms : P3 ⊆ classical_axioms :=
set.subset_union_right _ P3

lemma mem_P1 : φ →ᶠ (ψ →ᶠ φ) ∈ P1 := ⟨φ, ψ, rfl⟩

lemma mem_P2 : (φ →ᶠ (ψ →ᶠ ξ)) →ᶠ ((φ →ᶠ ψ) →ᶠ (φ →ᶠ ξ)) ∈ P2 := ⟨φ, ψ, ξ, rfl⟩

lemma mem_P3 : (¬ᶠφ →ᶠ ¬ᶠψ) →ᶠ (ψ →ᶠ φ) ∈ P3 := ⟨φ, ψ, rfl⟩

end classical_axioms

def consequence : Theory → Formula → Prop :=
deduction_consequence classical_axioms

section basics

variables {T S : Theory} (φ ψ ξ : Formula)

infix ` ⊢ `:50 := consequence

lemma is_theory : φ ∈ T → consequence T φ :=
λ _, deduction_consequence.is_theory ‹_›

lemma is_axiom : φ ∈ classical_axioms → consequence T φ :=
λ _, deduction_consequence.is_axiom ‹_›

lemma is_modus_ponens : consequence T φ → consequence T (φ →ᶠ ψ) → consequence T ψ :=
λ _  _, deduction_consequence.is_modus_ponens ‹_› ‹_›

variables {φ ψ ξ}

lemma is_P1 : T ⊢ φ →ᶠ (ψ →ᶠ φ) := is_axiom _ (p1_subset_classical_axioms mem_P1)

lemma is_P2 : T ⊢ (φ →ᶠ (ψ →ᶠ ξ)) →ᶠ ((φ →ᶠ ψ) →ᶠ (φ →ᶠ ξ)) :=
is_axiom _ (p2_subset_classical_axioms mem_P2)

lemma is_P3 : T ⊢ (¬ᶠφ →ᶠ ¬ᶠψ) →ᶠ (ψ →ᶠ φ) :=
is_axiom _ (p3_subset_classical_axioms mem_P3)

lemma consequence_mem (h : φ ∈ T) : T ⊢ φ := deduction_consequence.is_theory ‹_›

lemma consequence_self : {φ} ⊢ φ := consequence_mem (set.mem_singleton _)

lemma consequence_cut (h : ∀ ψ ∈ S, T ⊢ ψ) (hS : S ⊢ φ) : T ⊢ φ :=
begin
  induction hS with ψ hψS ψ hψax α β hαS hαβS hαT hαβT,
  { exact h ψ hψS },
  { exact is_axiom _ ‹_› },
  { exact is_modus_ponens _ _ ‹_› ‹_› }
end

lemma consequence_trans (h : S ⊆ T) (hS : S ⊢ φ) : T ⊢ φ :=
consequence_cut (λ ψ _, consequence_mem (h ‹_›)) hS

def is_true (φ : Formula) : Prop := ∅ ⊢ φ

prefix ` ⊢ₜ `:40 := is_true

lemma is_true_def : ⊢ₜ φ ↔ ∅ ⊢ φ := iff.rfl

lemma consequence_of_is_true : ⊢ₜ φ → T ⊢ φ :=
consequence_trans (set.empty_subset _)

end basics

section deduction_theorem

variables {T S : Theory} {φ ψ ξ : Formula}

lemma is_true_self_to_self : ⊢ₜ φ →ᶠ φ  :=
begin
  apply is_modus_ponens (φ →ᶠ (φ →ᶠ φ)) _ is_P1,
  exact is_modus_ponens (φ →ᶠ ((φ →ᶠ φ) →ᶠ φ)) _ is_P1 is_P2,
end

lemma consequence_self_to_self : T ⊢ φ →ᶠ φ :=
consequence_of_is_true is_true_self_to_self

lemma consequence_to_of_consequence (h : T ⊢ φ) : T ⊢ ψ →ᶠ φ :=
is_modus_ponens φ _ ‹_› is_P1

lemma consequence_union_singleton_of_consequence_to (h : T ⊢ φ →ᶠ ψ) : T ∪ {φ} ⊢ ψ :=
begin
  apply is_modus_ponens φ _,
  { apply is_theory, simp },
  { refine consequence_trans _ h,
    simp }
end

lemma consequence_to_of_consequence_union_singleton (h : T ∪ {φ} ⊢ ψ) : (T ⊢ φ →ᶠ ψ) :=
begin
  induction h with ξ hξTφ ξ hξax α β hαTφ hαβTφ hαT hαβT,
  { rw set.mem_union at hξTφ,
    cases hξTφ,
    { exact consequence_to_of_consequence (is_theory _ ‹_›) },
    { rw set.mem_singleton_iff at hξTφ,
      rw hξTφ,
      exact consequence_self_to_self } },
  { exact consequence_to_of_consequence (is_axiom _ ‹_›) },
  { apply is_modus_ponens _ _ hαT,
    apply is_modus_ponens _ _ hαβT,
    exact is_P2 }
end

theorem deduction : (T ⊢ φ →ᶠ ψ) ↔ T ∪ {φ} ⊢ ψ :=
⟨consequence_union_singleton_of_consequence_to, consequence_to_of_consequence_union_singleton⟩

lemma is_true_deduction : ⊢ₜ φ →ᶠ ψ ↔ {φ} ⊢ ψ :=
by rw [is_true_def, deduction, set.empty_union]

end deduction_theorem

section compactness

variables {T : Theory} {φ ψ : Formula}

theorem exists_finset_consequence_of_consequence (h : T ⊢ φ) :
  ∃ (S : finset Formula), ((S : set Formula) ⊆ T) ∧ (S : set Formula) ⊢ φ :=
begin
  induction h with ψ hψT ψ hψax α β hαT hαβT hαT hαβT,
  { refine ⟨{ψ}, finset.singleton_subset_set_iff.mpr hψT, _⟩,
    simp [consequence_self] },
  { use ∅,
    simp [is_axiom _ ‹_›] },
  { rcases hαT with ⟨A, hAT, hAα⟩,
    rcases hαβT with ⟨B, hBT, hBαβ⟩,
    use A ∪ B,
    split,
    { simp [hAT, hBT] },
    { refine is_modus_ponens α _ (consequence_trans (by simp) hAα)
    (consequence_trans (by simp) hBαβ) } }
end

end compactness

section negation

variables {T S : Theory} {φ ψ : Formula}

def false : Formula := ¬ᶠ (Formula.Var 0 →ᶠ Formula.Var 0)

lemma consequence_of_consequence_consequence_not (h : T ⊢ φ) (hn : T ⊢ ¬ᶠ φ) : T ⊢ ψ :=
begin
  apply is_modus_ponens φ _ ‹_›,
  exact is_modus_ponens (¬ᶠ ψ →ᶠ ¬ᶠ φ) _ (consequence_to_of_consequence ‹_›) is_P3,
end

lemma consequence_of_consequence_false (h : T ⊢ false) : T ⊢ φ :=
begin
  apply is_modus_ponens (Formula.Var 0 →ᶠ Formula.Var 0) _ consequence_self_to_self,
  refine is_modus_ponens (¬ᶠ φ →ᶠ ¬ᶠ (Formula.Var 0 →ᶠ Formula.Var 0)) _ _ is_P3,
  exact consequence_to_of_consequence h
end

lemma is_true_not_to_self_to_self : ⊢ₜ (¬ᶠ φ →ᶠ φ) →ᶠ φ :=
begin
  rw is_true_deduction,
  apply is_modus_ponens (¬ᶠ φ →ᶠ φ) _ consequence_self,
  refine is_modus_ponens (¬ᶠ φ →ᶠ ¬ᶠ (¬ᶠ φ →ᶠ φ)) _ _ is_P3,
  rw deduction,
  have h : ¬ᶠ φ ∈ {¬ᶠ φ →ᶠ φ} ∪ {¬ᶠ φ} := (set.mem_union_right _ (set.mem_singleton _)),
  refine consequence_of_consequence_consequence_not _ (consequence_mem ‹_›),
  rw ← deduction,
  exact consequence_self
end

lemma consequence_not_to_self_to_self : T ⊢ (¬ᶠ φ →ᶠ φ) →ᶠ φ :=
consequence_of_is_true is_true_not_to_self_to_self

lemma is_true_not_not_to : ⊢ₜ ¬ᶠ ¬ᶠ φ →ᶠ φ :=
begin
  rw is_true_deduction,
  refine is_modus_ponens (¬ᶠ φ →ᶠ φ) _ _ consequence_not_to_self_to_self,
  rw deduction,
  exact consequence_of_consequence_consequence_not
  (consequence_mem (set.mem_union_right _ (set.mem_singleton _)))
  (consequence_mem (set.mem_union_left _ (set.mem_singleton _)))
end

lemma consequence_not_not_to : T ⊢ ¬ᶠ ¬ᶠ φ →ᶠ φ  :=
consequence_of_is_true is_true_not_not_to

lemma is_true_to_not_not : ⊢ₜ φ →ᶠ ¬ᶠ ¬ᶠ φ :=
is_modus_ponens _ _ consequence_not_not_to is_P3

lemma consequence_to_not_not : T ⊢ φ →ᶠ ¬ᶠ ¬ᶠ φ  :=
consequence_of_is_true is_true_to_not_not

lemma is_true_modus_tollens : ⊢ₜ (φ →ᶠ ψ) →ᶠ (¬ᶠ ψ →ᶠ ¬ᶠ φ) :=
begin
  rw is_true_deduction,
  apply is_modus_ponens _ _ _ is_P3,
  rw deduction,
  refine is_modus_ponens _ _ _ consequence_to_not_not,
  refine is_modus_ponens _ _ _ (consequence_mem (set.mem_union_left _ (set.mem_singleton _))),
  rw ← deduction,
  exact consequence_not_not_to
end

lemma consequence_modus_tollens : T ⊢ (φ →ᶠ ψ) →ᶠ (¬ᶠ ψ →ᶠ ¬ᶠ φ) :=
consequence_of_is_true is_true_modus_tollens

lemma consequence_of_to_not_to (h : T ⊢ φ →ᶠ ψ) (hn : T ⊢ (¬ᶠ φ) →ᶠ ψ) : T ⊢ ψ :=
begin
  refine is_modus_ponens (¬ᶠ ψ →ᶠ ψ) _ _ (consequence_not_to_self_to_self),
  rw deduction,
  have H := is_modus_ponens _ _ h consequence_modus_tollens,
  refine is_modus_ponens _ _ _ (consequence_trans (set.subset_union_left _ _) hn),
  refine is_modus_ponens _ _ _ (consequence_trans (set.subset_union_left _ _) H),
  exact consequence_mem (set.mem_union_right _ (set.mem_singleton _))
end

lemma consequence_not_to_to_to_not : T ⊢ ¬ᶠ (φ →ᶠ ψ) →ᶠ (φ →ᶠ ¬ᶠ ψ) :=
begin
  rw [deduction, deduction],
  refine consequence_of_to_not_to _ consequence_self_to_self,
  rw deduction,
  refine consequence_of_consequence_consequence_not (_ : _ ⊢ φ →ᶠ ψ) _,
  { exact is_modus_ponens _ _ (consequence_mem (by simp)) is_P1 },
  { exact consequence_mem (by simp) }
end

lemma consequence_not_to_to : T ⊢ ¬ᶠ φ →ᶠ (φ →ᶠ ψ) :=
begin
  rw [deduction, deduction],
  refine consequence_of_consequence_consequence_not (_ : _ ⊢ φ) _;
  exact consequence_mem (by simp)
end

end negation

def consistent (T : Theory) : Prop :=
∀ φ : Formula, ¬ (T ⊢ φ) ∨ ¬ (T ⊢ ¬ᶠ φ)

lemma consistent_iff (T : Theory) : consistent T ↔ ∀ (φ : Formula), ¬ (T ⊢ φ) ∨ ¬ (T ⊢ ¬ᶠ φ) :=
iff.rfl

def complete (T : Theory) : Prop :=
∀ φ : Formula, T ⊢ φ ∨ T ⊢ ¬ᶠ φ

section consistency

variables {T S : Theory} {φ ψ : Formula}

lemma consistent.trans (hT : consistent T) (h : S ⊆ T) : consistent S :=
begin
  intro φ,
  cases hT φ with hφ hnφ,
  exact or.inl (λ h', hφ $ consequence_trans ‹_› h'),
  exact or.inr (λ h', hnφ $ consequence_trans ‹_› h'),
end

lemma consistent_of_not_consequence : ¬ (T ⊢ φ) → consistent T :=
begin
  rw consistent_iff,
  contrapose!,
  rintros ⟨ψ, h⟩,
  exact consequence_of_consequence_consequence_not h.1 h.2,
end

lemma consistent.exists_not_consequence (h : consistent T) : ∃ φ : Formula, ¬ (T ⊢ φ) :=
begin
  cases (h (Formula.Var 0)) with hφ hnφ,
  { exact ⟨(Formula.Var 0), ‹_›⟩ },
  { exact ⟨¬ᶠ (Formula.Var 0), ‹_›⟩ }
end

lemma consistent_iff_exists_not_consequence : consistent T ↔ ∃ φ : Formula, ¬ (T ⊢ φ) :=
⟨consistent.exists_not_consequence,
λ h, begin
  rcases h with ⟨φ, h⟩,
  exact consistent_of_not_consequence h
end⟩

lemma inconsistent_iff_all_consequence : ¬ consistent T ↔ ∀ φ : Formula, T ⊢ φ :=
by simp only [iff_self, syntactics.consistent_iff_exists_not_consequence, not_exists_not]

lemma inconsistent_of_consequence_false (h : T ⊢ false) : ¬ consistent T :=
begin
  rw inconsistent_iff_all_consequence,
  exact λ _, consequence_of_consequence_false h
end

lemma inconsistent_iff_consequence_false : ¬ consistent T ↔ T ⊢ false :=
⟨λ h, inconsistent_iff_all_consequence.1 h false, inconsistent_of_consequence_false⟩

lemma finset_inconsistent_of_inconsistent (h : ¬ consistent T) :
  ∃ (S : finset Formula), ((S : set Formula) ⊆ T) ∧ ¬ (consistent (S : set Formula)) :=
begin
  rw inconsistent_iff_consequence_false at h,
  rcases exists_finset_consequence_of_consequence h with ⟨S, hST, hSfalse⟩,
  use [S, hST],
  rwa inconsistent_iff_consequence_false,
end

lemma consistent_of_all_finset_consistent
  (h : ∀ (S : finset Formula), ((S : set Formula) ⊆ T) → (consistent (S : set Formula))) :
  consistent T :=
by { revert h, contrapose!, exact finset_inconsistent_of_inconsistent }

lemma consistent_iff_all_finset_consistent :
  consistent T ↔ ∀ (S : finset Formula), ((S : set Formula) ⊆ T) → (consistent (S : set Formula)) :=
⟨λ _ _ _, consistent.trans ‹_› ‹_›, consistent_of_all_finset_consistent⟩

lemma consistent_union_of_consistent_not_consequence (hφ : ¬ T ⊢ φ) : consistent (T ∪ {¬ᶠ φ}) :=
begin
    rw consistent_iff_exists_not_consequence,
    use φ,
    revert hφ,
    contrapose!,
    rw ← deduction,
    intro h,
    exact is_modus_ponens _ _ h consequence_not_to_self_to_self,
end

lemma inconsistent_union_not_of_consequence (hφ : T ⊢ φ) : ¬ consistent (T ∪ {¬ᶠ φ}) :=
begin
  rw inconsistent_iff_consequence_false,
  rw ← deduction,
  apply is_modus_ponens _ _ _ is_P3,
  have h : T ⊢ ¬ᶠ ¬ᶠ φ := is_modus_ponens _ _ hφ consequence_to_not_not,
  exact is_modus_ponens _ _ h is_P1,
end

end consistency

section consistent_complete

variables {T : Theory} {φ ψ : Formula}

lemma consistent_complete.consequence_not_iff_not_consequence (hcons : consistent T) (hcom : complete T) :
  T ⊢ ¬ᶠ φ ↔ ¬ T ⊢ φ :=
⟨by { have := hcons φ, cc }, by { have := hcom φ, cc }⟩

lemma consistent_complete.consequence_to_of_consequence_of (hcons : consistent T) (hcom : complete T) (h : (T ⊢ φ) → (T ⊢ ψ)) : T ⊢ φ →ᶠ ψ  :=
begin
  by_contra hn,
  have Hn := (consistent_complete.consequence_not_iff_not_consequence ‹_› ‹_›).2 hn,
  have hn' := λ H, is_modus_ponens _ _ H (is_modus_ponens _ _ Hn consequence_not_to_to_to_not),
  rw consistent_complete.consequence_not_iff_not_consequence ‹_› ‹_› at hn',
  by_cases hφ : T ⊢ φ,
  { cc },
  { rw ← consistent_complete.consequence_not_iff_not_consequence ‹_› ‹_› at hφ,
    have H : T ⊢ φ →ᶠ ψ := is_modus_ponens _ _ hφ consequence_not_to_to,
    cc }
end

lemma consistent_complete.consequence_to_iff_consequence_of (hcons : consistent T) (hcom : complete T) :
  T ⊢ φ →ᶠ ψ ↔ (T ⊢ φ → T ⊢ ψ) :=
⟨λ x y, is_modus_ponens _ _ y x, consistent_complete.consequence_to_of_consequence_of ‹_› ‹_›⟩

end consistent_complete

section consistent_extension

variables {T : Theory}

open zorn

private lemma chain_union_consistent_consistent (c : set Theory) (hcons : c ⊆ consistent) (hc : chain (⊆) c) (hcne : c.nonempty) :
  consistent (⋃ (s ∈ c), s) :=
begin
  rw consistent_iff_all_finset_consistent,
  intros S hS,
  cases hcne with a ha,
  rcases finset.exists_mem_subset_of_subset_bUnion_of_directed_on ha (chain.directed_on hc) hS
    with ⟨R, hRc, hSR⟩,
  refine consistent.trans _ hSR,
  exact set.mem_of_subset_of_mem hcons hRc,
end

lemma consistent.exists_maximal_consistent_extension (h : consistent T):
  ∃ (T' : Theory) (hT' : consistent T'), T ⊆ T' ∧ ∀ (S : Theory) (hS : consistent S), T' ⊆ S → S = T' :=
zorn_subset_nonempty consistent (λ c hcons hc hcne,
  ⟨⋃ (s ∈ c), s, chain_union_consistent_consistent c ‹_› ‹_› ‹_›,
    λ s, set.subset_bUnion_of_mem⟩) _ ‹_›

theorem consistent.exists_consistent_complete_extension (h : consistent T):
  ∃ (T' : Theory), T ⊆ T' ∧ consistent T' ∧ complete T' :=
begin
  rcases h.exists_maximal_consistent_extension with ⟨T', hT', hTT', h⟩,
  refine ⟨T', hTT', hT', λ φ, _⟩,
  rw or_iff_not_imp_left,
  intro hφ,
  rw ← h _ (consistent_union_of_consistent_not_consequence hφ) (set.subset_union_left _ _),
  exact consequence_mem (set.mem_union_right _ (set.mem_singleton _))
end

end consistent_extension

end syntactics


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

! This file was ported from Lean 3 source module algebra.category.Mon.basic
! leanprover-community/mathlib commit 0caf3701139ef2e69c215717665361cda205a90b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.ConcreteCategory.BundledHom
import Mathlib.Algebra.PUnitInstances
import Mathlib.CategoryTheory.Functor.ReflectsIso

/-!
# Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid.

We introduce the bundled categories:
* `MonCat`
* `AddMonCat`
* `CommMonCat`
* `AddCommMonCat`
along with the relevant forgetful functors between them.
-/

universe u v

open CategoryTheory

/-- The category of monoids and monoid morphisms. -/
@[to_additive AddMonCat]
def MonCat : Type (u + 1) :=
  Bundled Monoid
set_option linter.uppercaseLean3 false in
#align Mon MonCat
set_option linter.uppercaseLean3 false in
#align AddMon AddMonCat

/-- The category of additive monoids and monoid morphisms. -/
add_decl_doc AddMonCat

namespace MonCat

/-- `MonoidHom` doesn't actually assume associativity. This alias is needed to make the category
theory machinery work. -/
@[to_additive]
abbrev AssocMonoidHom (M N : Type _) [Monoid M] [Monoid N] :=
  MonoidHom M N
set_option linter.uppercaseLean3 false in
#align Mon.assoc_monoid_hom MonCat.AssocMonoidHom
set_option linter.uppercaseLean3 false in
#align AddMon.assoc_add_monoid_hom AddMonCat.AssocAddMonoidHom

/-- `AddMonoidHom` doesn't actually assume associativity. This alias is needed to make
the category theory machinery work. -/
add_decl_doc AddMonCat.AssocAddMonoidHom

@[to_additive]
instance bundledHom : BundledHom AssocMonoidHom where
  toFun  {X Y} _ _ f := ⇑f
  id _ := MonoidHom.id _
  comp _ _ _ := MonoidHom.comp
set_option linter.uppercaseLean3 false in
#align Mon.bundled_hom MonCat.bundledHom
set_option linter.uppercaseLean3 false in
#align AddMon.bundled_hom AddMonCat.bundledHom

instance largeCategory : LargeCategory MonCat := by
  dsimp only [MonCat]
  infer_instance

instance concreteCategory : ConcreteCategory MonCat :=
  BundledHom.concreteCategory _

attribute [to_additive] MonCat.largeCategory MonCat.concreteCategory

@[to_additive]
instance : CoeSort MonCat (Type _) := by
  dsimp only [MonCat]
  infer_instance

/-- Construct a bundled `MonCat` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [Monoid M] : MonCat :=
  Bundled.of M
set_option linter.uppercaseLean3 false in
#align Mon.of MonCat.of
set_option linter.uppercaseLean3 false in
#align AddMon.of AddMonCat.of

/-- Construct a bundled `MonCat` from the underlying type and typeclass. -/
add_decl_doc AddMonCat.of

/-- Typecheck a `MonoidHom` as a morphism in `MonCat`. -/
@[to_additive]
def ofHom {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : of X ⟶ of Y :=
  f
set_option linter.uppercaseLean3 false in
#align Mon.of_hom MonCat.ofHom
set_option linter.uppercaseLean3 false in
#align AddMon.of_hom AddMonCat.ofHom

/-- Typecheck a `AddMonoidHom` as a morphism in `AddMonCat`. -/
add_decl_doc AddMonCat.ofHom

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance {X Y : MonCat} : CoeFun (X ⟶ Y) fun _ => X → Y :=
  ConcreteCategory.hasCoeToFun

-- porting note: in mathlib the LHS was `(⇑ofHom f) x`; the coercion was unfolded
-- to make the simp lemma work
@[to_additive (attr := simp) _root_.AddMonCat.ofHom_apply]
lemma ofHom_apply {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) (x : X) :
  ((forget MonCat).map (MonCat.ofHom f)) x = f x := rfl
set_option linter.uppercaseLean3 false in
#align Mon.of_hom_apply MonCat.ofHom_apply

@[to_additive]
instance : Inhabited MonCat :=
  -- The default instance for `Monoid PUnit` is derived via `CommRing` which breaks to_additive
  ⟨@of PUnit (@DivInvMonoid.toMonoid _ (@Group.toDivInvMonoid _
    (@CommGroup.toGroup _ PUnit.commGroup)))⟩

@[to_additive]
instance (M : MonCat) : Monoid M :=
  M.str

@[to_additive (attr := simp)]
theorem coe_of (R : Type u) [Monoid R] : (MonCat.of R : Type u) = R :=
  rfl
set_option linter.uppercaseLean3 false in
#align Mon.coe_of MonCat.coe_of
set_option linter.uppercaseLean3 false in
#align AddMon.coe_of AddMonCat.coe_of

@[to_additive]
instance {G : Type _} [Group G] : Group (MonCat.of G) := by assumption

-- porting note: this was added to ease the port
/-- the morphism in `MonCat` associated to a `MonoidHom` -/
@[to_additive (attr := simp)]
def Hom.mk {X Y : MonCat} (f : X →* Y) : X ⟶ Y := f

/-- the morphism in `AddMonCat` associated to a `AddMonoidHom` -/
add_decl_doc AddMonCat.Hom.mk

-- porting note: this lemma was added to make automation work in `MonCat.forget_reflects_isos`
@[to_additive (attr := simp)]
lemma Hom.map_mul {X Y : MonCat} (f : X ⟶ Y) (x y : X) :
  ((forget MonCat).map f) (x * y) =
    f x * f y := by
  apply MonoidHom.map_mul (show MonoidHom X Y from f)

-- porting note: added as a complement to `Hom.map_mul`
@[to_additive (attr := simp)]
lemma Hom.map_one {X Y : MonCat} (f : X ⟶ Y) :
  ((forget MonCat).map f) (1 : X) = (1 : Y) := by
  apply MonoidHom.map_one (show MonoidHom X Y from f)

end MonCat

/-- The category of commutative monoids and monoid morphisms. -/
@[to_additive AddCommMonCat]
def CommMonCat : Type (u + 1) :=
  Bundled CommMonoid
set_option linter.uppercaseLean3 false in
#align CommMon CommMonCat
set_option linter.uppercaseLean3 false in
#align AddCommMon AddCommMonCat

/-- The category of additive commutative monoids and monoid morphisms. -/
add_decl_doc AddCommMonCat

namespace CommMonCat

@[to_additive]
instance : BundledHom.ParentProjection @CommMonoid.toMonoid := ⟨⟩

instance largeCategory : LargeCategory CommMonCat := by
  dsimp only [CommMonCat]
  infer_instance

instance concreteCategory : ConcreteCategory CommMonCat := by
  dsimp only [CommMonCat]
  infer_instance

attribute [to_additive] CommMonCat.largeCategory CommMonCat.concreteCategory

@[to_additive]
instance : CoeSort CommMonCat (Type _) := by
  dsimp only [CommMonCat]
  infer_instance

/-- Construct a bundled `CommMonCat` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [CommMonoid M] : CommMonCat :=
  Bundled.of M
set_option linter.uppercaseLean3 false in
#align CommMon.of CommMonCat.of
set_option linter.uppercaseLean3 false in
#align AddCommMon.of AddCommMonCat.of

/-- Construct a bundled `AddCommMon` from the underlying type and typeclass. -/
add_decl_doc AddCommMonCat.of

@[to_additive]
instance : Inhabited CommMonCat :=
  -- The default instance for `CommMonoid PUnit` is derived via `CommRing` which breaks to_additive
  ⟨@of PUnit (@CommGroup.toCommMonoid _ PUnit.commGroup)⟩

@[to_additive]
instance (M : CommMonCat) : CommMonoid M :=
  M.str

@[to_additive (attr := simp)]
theorem coe_of (R : Type u) [CommMonoid R] : (CommMonCat.of R : Type u) = R :=
  rfl
set_option linter.uppercaseLean3 false in
#align CommMon.coe_of CommMonCat.coe_of
set_option linter.uppercaseLean3 false in
#align AddCommMon.coe_of AddCommMonCat.coe_of

@[to_additive hasForgetToAddMonCat]
instance hasForgetToMonCat : HasForget₂ CommMonCat MonCat :=
  BundledHom.forget₂ _ _
set_option linter.uppercaseLean3 false in
#align CommMon.has_forget_to_Mon CommMonCat.hasForgetToMonCat
set_option linter.uppercaseLean3 false in
#align AddCommMon.has_forget_to_AddMon AddCommMonCat.hasForgetToAddMonCat

@[to_additive]
instance : Coe CommMonCat.{u} MonCat.{u} where coe := (forget₂ CommMonCat MonCat).obj

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance {X Y : CommMonCat} : CoeFun (X ⟶ Y) fun _ => X → Y :=
  ConcreteCategory.hasCoeToFun

-- porting note: this was added to make automation work
/-- Typecheck a `MonoidHom` as a morphism in `CommMonCat`. -/
@[to_additive]
def ofHom {X Y : Type u} [CommMonoid X] [CommMonoid Y] (f : X →* Y) : of X ⟶ of Y :=
  f

/-- Typecheck a `AddMonoidHom` as a morphism in `AddCommMonCat`. -/
add_decl_doc AddCommMonCat.ofHom

-- porting note: this was added to make automation work in `MulEquiv.toCommMonCatIso`
@[to_additive (attr := simp) _root_.AddCommMonCat.ofHom_apply]
lemma ofHom_apply {X Y : Type u} [CommMonoid X] [CommMonoid Y] (f : X →* Y) (x : X) :
  ((forget CommMonCat).map (CommMonCat.ofHom f)) x = f x := rfl

-- porting note: this was added to make the following examples work
/-- the morphism in `CommMonCat` associated to a `MonoidHom` -/
@[to_additive (attr := simp)]
def Hom.mk {X Y : CommMonCat} (f : X →* Y) : X ⟶ Y := f

/-- the morphism in `AddCommMonCat` associated to a `AddMonoidHom` -/
add_decl_doc AddCommMonCat.Hom.mk

-- porting note: this lemma was added to make automation work in `CommMonCat.forget_reflects_isos`
@[to_additive (attr := simp)]
lemma Hom.map_mul {X Y : CommMonCat} (f : X ⟶ Y) (x y : X) :
  ((forget CommMonCat).map f) (x * y) = f x * f y := by
  apply MonoidHom.map_mul (show MonoidHom X Y from f)

-- porting note: added as a complement to `Hom.map_mul`
@[to_additive (attr := simp)]
lemma Hom.map_one {X Y : CommMonCat} (f : X ⟶ Y) :
  ((forget CommMonCat).map f) (1 : X) = (1 : Y) := by
  apply MonoidHom.map_one (show MonoidHom X Y from f)

end CommMonCat

-- We verify that the coercions of morphisms to functions work correctly:
example {R S : MonCat} (f : R ⟶ S) : ↑R → ↑S := f

example {R S : CommMonCat} (f : R ⟶ S) : ↑R → ↑S := f

-- We verify that when constructing a morphism in `CommMonCat`,
-- when we construct the `toFun` field, the types are presented as `↥R`,
-- rather than `R.α` or (as we used to have) `↥(bundled.map comm_monoid.to_monoid R)`.
example (R : CommMonCat.{u}) : R ⟶ R :=
  -- porting note: the constructor `CommMonCat.Hom.mk` was added to make this example work
  CommMonCat.Hom.mk
    { toFun := fun x => by
        match_target (R : Type u)
        -- porting note: is there an equivalent of `match_hyp` in Lean4?
        --match_hyp x : (R : Type u)
        exact x * x
      map_one' := by simp
      map_mul' := fun x y => by
        dsimp
        rw [mul_assoc x y (x * y), ← mul_assoc y x y, mul_comm y x, mul_assoc, mul_assoc] }

variable {X Y : Type u}

attribute [local ext] ConcreteCategory.hom_ext

section

variable [Monoid X] [Monoid Y]

/-- Build an isomorphism in the category `MonCat` from a `MulEquiv` between `Monoid`s. -/
@[to_additive (attr := simps) AddEquiv.toAddMonCatIso
      "Build an isomorphism in the category `AddMonCat` from\nan `AddEquiv` between `AddMonoid`s."]
def MulEquiv.toMonCatIso (e : X ≃* Y) : MonCat.of X ≅ MonCat.of Y where
  hom := MonCat.ofHom e.toMonoidHom
  inv := MonCat.ofHom e.symm.toMonoidHom
set_option linter.uppercaseLean3 false in
#align mul_equiv.to_Mon_iso MulEquiv.toMonCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv.to_AddMon_iso AddEquiv.toAddMonCatIso

end

section

variable [CommMonoid X] [CommMonoid Y]

/-- Build an isomorphism in the category `CommMonCat` from a `MulEquiv` between `CommMonoid`s. -/
@[to_additive (attr := simps) AddEquiv.toAddCommMonCatIso]
def MulEquiv.toCommMonCatIso (e : X ≃* Y) : CommMonCat.of X ≅ CommMonCat.of Y where
  hom := CommMonCat.ofHom e.toMonoidHom
  inv := CommMonCat.ofHom e.symm.toMonoidHom
set_option linter.uppercaseLean3 false in
#align mul_equiv.to_CommMon_iso MulEquiv.toCommMonCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv.to_AddCommMon_iso AddEquiv.toAddCommMonCatIso

/-- Build an isomorphism in the category `AddCommMonCat`
from an `AddEquiv` between `AddCommMonoid`s. -/
add_decl_doc AddEquiv.toAddCommMonCatIso

end

namespace CategoryTheory.Iso

/-- Build a `MulEquiv` from an isomorphism in the category `MonCat`. -/
@[to_additive addMonCatIsoToAddEquiv
      "Build an `AddEquiv` from an isomorphism in the category\n`AddMonCat`."]
def monCatIsoToMulEquiv {X Y : MonCat} (i : X ≅ Y) : X ≃* Y :=
  MonoidHom.toMulEquiv i.hom i.inv i.hom_inv_id i.inv_hom_id
set_option linter.uppercaseLean3 false in
#align category_theory.iso.Mon_iso_to_mul_equiv CategoryTheory.Iso.monCatIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align category_theory.iso.AddMon_iso_to_add_equiv CategoryTheory.Iso.addMonCatIsoToAddEquiv

/-- Build a `MulEquiv` from an isomorphism in the category `CommMonCat`. -/
@[to_additive "Build an `AddEquiv` from an isomorphism in the category\n`AddCommMonCat`."]
def commMonCatIsoToMulEquiv {X Y : CommMonCat} (i : X ≅ Y) : X ≃* Y :=
  MonoidHom.toMulEquiv i.hom i.inv i.hom_inv_id i.inv_hom_id
set_option linter.uppercaseLean3 false in
#align category_theory.iso.CommMon_iso_to_mul_equiv CategoryTheory.Iso.commMonCatIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align category_theory.iso.CommMon_iso_to_add_equiv CategoryTheory.Iso.commMonCatIsoToAddEquiv

end CategoryTheory.Iso

/-- multiplicative equivalences between `Monoid`s are the same as (isomorphic to) isomorphisms
in `MonCat` -/
@[to_additive addEquivIsoAddMonCatIso]
def mulEquivIsoMonCatIso {X Y : Type u} [Monoid X] [Monoid Y] :
  X ≃* Y ≅ MonCat.of X ≅ MonCat.of Y where
  hom e := e.toMonCatIso
  inv i := i.monCatIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align mul_equiv_iso_Mon_iso mulEquivIsoMonCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv_iso_AddMon_iso addEquivIsoAddMonCatIso

/-- additive equivalences between `AddMonoid`s are the same
as (isomorphic to) isomorphisms in `AddMonCat` -/
add_decl_doc addEquivIsoAddMonCatIso

/-- multiplicative equivalences between `CommMonoid`s are the same as (isomorphic to) isomorphisms
in `CommMonCat` -/
@[to_additive addEquivIsoAddCommMonCatIso]
def mulEquivIsoCommMonCatIso {X Y : Type u} [CommMonoid X] [CommMonoid Y] :
    X ≃* Y ≅ CommMonCat.of X ≅ CommMonCat.of Y
    where
  hom e := e.toCommMonCatIso
  inv i := i.commMonCatIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align mul_equiv_iso_CommMon_iso mulEquivIsoCommMonCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv_iso_AddCommMon_iso addEquivIsoAddCommMonCatIso

/-- additive equivalences between `AddCommMonoid`s are
the same as (isomorphic to) isomorphisms in `AddCommMonCat` -/
add_decl_doc addEquivIsoAddCommMonCatIso

@[to_additive]
instance MonCat.forget_reflects_isos : ReflectsIsomorphisms (forget MonCat.{u}) where
  reflects {X Y} f _ := by
    let i := asIso ((forget MonCat).map f)
    let e : X ≃* Y := MulEquiv.mk i.toEquiv (by aesop)
    exact IsIso.of_iso e.toMonCatIso
set_option linter.uppercaseLean3 false in
#align Mon.forget_reflects_isos MonCat.forget_reflects_isos
set_option linter.uppercaseLean3 false in
#align AddMon.forget_reflects_isos AddMonCat.forget_reflects_isos

@[to_additive]
instance CommMonCat.forget_reflects_isos : ReflectsIsomorphisms (forget CommMonCat.{u}) where
  reflects {X Y} f _ := by
    let i := asIso ((forget CommMonCat).map f)
    let e : X ≃* Y := MulEquiv.mk i.toEquiv
    -- porting note: same remark as for `MonCat.forget_reflects_iso`
      (MonoidHom.map_mul (show MonoidHom X Y from f))
    exact IsIso.of_iso e.toCommMonCatIso
set_option linter.uppercaseLean3 false in
#align CommMon.forget_reflects_isos CommMonCat.forget_reflects_isos
set_option linter.uppercaseLean3 false in
#align AddCommMon.forget_reflects_isos AddCommMonCat.forget_reflects_isos

-- porting note: this was added in order to ensure that `forget₂ CommMonCat MonCat`
-- automatically reflects isomorphisms
-- we could have used `CategoryTheory.ConcreteCategory.ReflectsIso` alternatively
instance : Full (forget₂ CommMonCat MonCat) where preimage f := f

example : ReflectsIsomorphisms (forget₂ CommMonCat MonCat) := inferInstance