/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux, Jon Bannon

! This file was ported from Lean 3 source module analysis.normed_space.star.multiplier
! leanprover-community/mathlib commit d3af0609f6db8691dffdc3e1fb7feb7da72698f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Star.StarAlgHom
import Mathbin.Analysis.NormedSpace.Star.Basic
import Mathbin.Analysis.NormedSpace.OperatorNorm
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.Analysis.NormedSpace.Star.Mul

/-!
# Multiplier Algebra of a C⋆-algebra

Define the multiplier algebra of a C⋆-algebra as the algebra (over `𝕜`) of double centralizers,
for which we provide the localized notation `𝓜(𝕜, A)`.  A double centralizer is a pair of
continuous linear maps `L R : A →L[𝕜] A` satisfying the intertwining condition `R x * y = x * L y`.

There is a natural embedding `A → 𝓜(𝕜, A)` which sends `a : A` to the continuous linear maps
`L R : A →L[𝕜] A` given by left and right multiplication by `a`, and we provide this map as a
coercion.

The multiplier algebra corresponds to a non-commutative Stone–Čech compactification in the sense
that when the algebra `A` is commutative, it can be identified with `C₀(X, ℂ)` for some locally
compact Hausdorff space `X`, and in that case `𝓜(𝕜, A)` can be identified with `C(β X, ℂ)`.

## Implementation notes

We make the hypotheses on `𝕜` as weak as possible so that, in particular, this construction works
for both `𝕜 = ℝ` and `𝕜 = ℂ`.

The reader familiar with C⋆-algebra theory may recognize that one
only needs `L` and `R` to be functions instead of continuous linear maps, at least when `A` is a
C⋆-algebra. Our intention is simply to eventually provide a constructor for this situation.

We pull back the `normed_algebra` structure (and everything contained therein) through the
ring (even algebra) homomorphism
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` which
sends `a : 𝓜(𝕜, A)` to `(a.fst, mul_opposite.op a.snd)`. The star structure is provided
separately.

## References

* https://en.wikipedia.org/wiki/Multiplier_algebra

## TODO

+ Define a type synonym for `𝓜(𝕜, A)` which is equipped with the strict uniform space structure
  and show it is complete
+ Show that the image of `A` in `𝓜(𝕜, A)` is an essential ideal
+ Prove the universal property of `𝓜(𝕜, A)`
+ Construct a double centralizer from a pair of maps (not necessarily linear or continuous)
  `L : A → A`, `R : A → A` satisfying the centrality condition `∀ x y, R x * y = x * L y`.
+ Show that if `A` is unital, then `A ≃⋆ₐ[𝕜] 𝓜(𝕜, A)`.
-/

open NNReal ENNReal

open NNReal ContinuousLinearMap MulOpposite

universe u v

/-- The type of *double centralizers*, also known as the *multiplier algebra* and denoted by
`𝓜(𝕜, A)`, of a non-unital normed algebra.

If `x : 𝓜(𝕜, A)`, then `x.fst` and `x.snd` are what is usually referred to as $L$ and $R$. -/
@[ext]
structure DoubleCentralizer (𝕜 : Type u) (A : Type v) [NontriviallyNormedField 𝕜]
  [NonUnitalNormedRing A] [NormedSpace 𝕜 A] [SMulCommClass 𝕜 A A] [IsScalarTower 𝕜 A A] extends
  (A →L[𝕜] A) × (A →L[𝕜] A) where
  central : ∀ x y : A, snd x * y = x * fst y
#align double_centralizer DoubleCentralizer

-- mathport name: «expr𝓜( , )»
scoped[MultiplierAlgebra] notation "𝓜(" 𝕜 ", " A ")" => DoubleCentralizer 𝕜 A

namespace DoubleCentralizer

section NontriviallyNormed

variable (𝕜 A : Type _) [NontriviallyNormedField 𝕜] [NonUnitalNormedRing A]

variable [NormedSpace 𝕜 A] [SMulCommClass 𝕜 A A] [IsScalarTower 𝕜 A A]

/-!
### Algebraic structure

Because the multiplier algebra is defined as the algebra of double centralizers, there is a natural
injection `double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`
defined by `λ a, (a.fst, mul_opposite.op a.snd)`. We use this map to pull back the ring, module and
algebra structure from `(A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` to `𝓜(𝕜, A)`. -/

variable {𝕜 A}

theorem range_toProd :
    Set.range toProd = { lr : (A →L[𝕜] A) × _ | ∀ x y, lr.2 x * y = x * lr.1 y } :=
  Set.ext fun x =>
    ⟨by
      rintro ⟨a, rfl⟩
      exact a.central, fun hx => ⟨⟨x, hx⟩, rfl⟩⟩
#align double_centralizer.range_to_prod DoubleCentralizer.range_toProd

instance : Add 𝓜(𝕜, A)
    where add a b :=
    { toProd := a.toProd + b.toProd
      central := fun x y =>
        show (a.snd + b.snd) x * y = x * (a.fst + b.fst) y by
          simp only [ContinuousLinearMap.add_apply, mul_add, add_mul, central] }

instance : Zero 𝓜(𝕜, A)
    where zero :=
    { toProd := 0
      central := fun x y => (MulZeroClass.zero_mul y).trans (MulZeroClass.mul_zero x).symm }

instance : Neg 𝓜(𝕜, A)
    where neg a :=
    { toProd := -a.toProd
      central := fun x y =>
        show -a.snd x * y = x * -a.fst y by
          simp only [ContinuousLinearMap.neg_apply, neg_mul, mul_neg, central] }

instance : Sub 𝓜(𝕜, A)
    where sub a b :=
    { toProd := a.toProd - b.toProd
      central := fun x y =>
        show (a.snd - b.snd) x * y = x * (a.fst - b.fst) y by
          simp only [ContinuousLinearMap.sub_apply, sub_mul, mul_sub, central] }

section Scalars

variable {S : Type _} [Monoid S] [DistribMulAction S A] [SMulCommClass 𝕜 S A]
  [ContinuousConstSMul S A] [IsScalarTower S A A] [SMulCommClass S A A]

instance : SMul S 𝓜(𝕜, A)
    where smul s a :=
    { toProd := s • a.toProd
      central := fun x y =>
        show (s • a.snd) x * y = x * (s • a.fst) y by
          simp only [ContinuousLinearMap.smul_apply, mul_smul_comm, smul_mul_assoc, central] }

@[simp]
theorem smul_toProd (s : S) (a : 𝓜(𝕜, A)) : (s • a).toProd = s • a.toProd :=
  rfl
#align double_centralizer.smul_to_prod DoubleCentralizer.smul_toProd

theorem smul_fst (s : S) (a : 𝓜(𝕜, A)) : (s • a).fst = s • a.fst :=
  rfl
#align double_centralizer.smul_fst DoubleCentralizer.smul_fst

theorem smul_snd (s : S) (a : 𝓜(𝕜, A)) : (s • a).snd = s • a.snd :=
  rfl
#align double_centralizer.smul_snd DoubleCentralizer.smul_snd

variable {T : Type _} [Monoid T] [DistribMulAction T A] [SMulCommClass 𝕜 T A]
  [ContinuousConstSMul T A] [IsScalarTower T A A] [SMulCommClass T A A]

instance [SMul S T] [IsScalarTower S T A] : IsScalarTower S T 𝓜(𝕜, A)
    where smul_assoc _ _ a := ext _ _ <| smul_assoc _ _ a.toProd

instance [SMulCommClass S T A] : SMulCommClass S T 𝓜(𝕜, A)
    where smul_comm _ _ a := ext _ _ <| smul_comm _ _ a.toProd

instance {R : Type _} [Semiring R] [Module R A] [SMulCommClass 𝕜 R A] [ContinuousConstSMul R A]
    [IsScalarTower R A A] [SMulCommClass R A A] [Module Rᵐᵒᵖ A] [IsCentralScalar R A] :
    IsCentralScalar R 𝓜(𝕜, A) where op_smul_eq_smul _ a := ext _ _ <| op_smul_eq_smul _ a.toProd

end Scalars

instance : One 𝓜(𝕜, A) :=
  ⟨⟨1, fun x y => rfl⟩⟩

instance : Mul 𝓜(𝕜, A)
    where mul a b :=
    { toProd := (a.fst.comp b.fst, b.snd.comp a.snd)
      central := fun x y => show b.snd (a.snd x) * y = x * a.fst (b.fst y) by simp only [central] }

instance : NatCast 𝓜(𝕜, A)
    where natCast n :=
    ⟨n, fun x y => by
      rw [Prod.snd_natCast, Prod.fst_natCast]
      simp only [← Nat.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc]⟩

instance : IntCast 𝓜(𝕜, A)
    where intCast n :=
    ⟨n, fun x y => by
      rw [Prod.snd_intCast, Prod.fst_intCast]
      simp only [← Int.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc]⟩

instance : Pow 𝓜(𝕜, A) ℕ
    where pow a n :=
    ⟨a.toProd ^ n, fun x y => by
      induction' n with k hk generalizing x y
      · rfl
      · rw [Prod.pow_snd, Prod.pow_fst] at hk⊢
        rw [pow_succ a.snd, mul_apply, a.central, hk, pow_succ' a.fst, mul_apply]⟩

instance : Inhabited 𝓜(𝕜, A) :=
  ⟨0⟩

@[simp]
theorem add_toProd (a b : 𝓜(𝕜, A)) : (a + b).toProd = a.toProd + b.toProd :=
  rfl
#align double_centralizer.add_to_prod DoubleCentralizer.add_toProd

@[simp]
theorem zero_toProd : (0 : 𝓜(𝕜, A)).toProd = 0 :=
  rfl
#align double_centralizer.zero_to_prod DoubleCentralizer.zero_toProd

@[simp]
theorem neg_toProd (a : 𝓜(𝕜, A)) : (-a).toProd = -a.toProd :=
  rfl
#align double_centralizer.neg_to_prod DoubleCentralizer.neg_toProd

@[simp]
theorem sub_toProd (a b : 𝓜(𝕜, A)) : (a - b).toProd = a.toProd - b.toProd :=
  rfl
#align double_centralizer.sub_to_prod DoubleCentralizer.sub_toProd

@[simp]
theorem one_toProd : (1 : 𝓜(𝕜, A)).toProd = 1 :=
  rfl
#align double_centralizer.one_to_prod DoubleCentralizer.one_toProd

@[simp]
theorem nat_cast_toProd (n : ℕ) : (n : 𝓜(𝕜, A)).toProd = n :=
  rfl
#align double_centralizer.nat_cast_to_prod DoubleCentralizer.nat_cast_toProd

@[simp]
theorem int_cast_toProd (n : ℤ) : (n : 𝓜(𝕜, A)).toProd = n :=
  rfl
#align double_centralizer.int_cast_to_prod DoubleCentralizer.int_cast_toProd

@[simp]
theorem pow_toProd (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).toProd = a.toProd ^ n :=
  rfl
#align double_centralizer.pow_to_prod DoubleCentralizer.pow_toProd

theorem add_fst (a b : 𝓜(𝕜, A)) : (a + b).fst = a.fst + b.fst :=
  rfl
#align double_centralizer.add_fst DoubleCentralizer.add_fst

theorem add_snd (a b : 𝓜(𝕜, A)) : (a + b).snd = a.snd + b.snd :=
  rfl
#align double_centralizer.add_snd DoubleCentralizer.add_snd

theorem zero_fst : (0 : 𝓜(𝕜, A)).fst = 0 :=
  rfl
#align double_centralizer.zero_fst DoubleCentralizer.zero_fst

theorem zero_snd : (0 : 𝓜(𝕜, A)).snd = 0 :=
  rfl
#align double_centralizer.zero_snd DoubleCentralizer.zero_snd

theorem neg_fst (a : 𝓜(𝕜, A)) : (-a).fst = -a.fst :=
  rfl
#align double_centralizer.neg_fst DoubleCentralizer.neg_fst

theorem neg_snd (a : 𝓜(𝕜, A)) : (-a).snd = -a.snd :=
  rfl
#align double_centralizer.neg_snd DoubleCentralizer.neg_snd

theorem sub_fst (a b : 𝓜(𝕜, A)) : (a - b).fst = a.fst - b.fst :=
  rfl
#align double_centralizer.sub_fst DoubleCentralizer.sub_fst

theorem sub_snd (a b : 𝓜(𝕜, A)) : (a - b).snd = a.snd - b.snd :=
  rfl
#align double_centralizer.sub_snd DoubleCentralizer.sub_snd

theorem one_fst : (1 : 𝓜(𝕜, A)).fst = 1 :=
  rfl
#align double_centralizer.one_fst DoubleCentralizer.one_fst

theorem one_snd : (1 : 𝓜(𝕜, A)).snd = 1 :=
  rfl
#align double_centralizer.one_snd DoubleCentralizer.one_snd

@[simp]
theorem mul_fst (a b : 𝓜(𝕜, A)) : (a * b).fst = a.fst * b.fst :=
  rfl
#align double_centralizer.mul_fst DoubleCentralizer.mul_fst

@[simp]
theorem mul_snd (a b : 𝓜(𝕜, A)) : (a * b).snd = b.snd * a.snd :=
  rfl
#align double_centralizer.mul_snd DoubleCentralizer.mul_snd

theorem nat_cast_fst (n : ℕ) : (n : 𝓜(𝕜, A)).fst = n :=
  rfl
#align double_centralizer.nat_cast_fst DoubleCentralizer.nat_cast_fst

theorem nat_cast_snd (n : ℕ) : (n : 𝓜(𝕜, A)).snd = n :=
  rfl
#align double_centralizer.nat_cast_snd DoubleCentralizer.nat_cast_snd

theorem int_cast_fst (n : ℤ) : (n : 𝓜(𝕜, A)).fst = n :=
  rfl
#align double_centralizer.int_cast_fst DoubleCentralizer.int_cast_fst

theorem int_cast_snd (n : ℤ) : (n : 𝓜(𝕜, A)).snd = n :=
  rfl
#align double_centralizer.int_cast_snd DoubleCentralizer.int_cast_snd

theorem pow_fst (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).fst = a.fst ^ n :=
  rfl
#align double_centralizer.pow_fst DoubleCentralizer.pow_fst

theorem pow_snd (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).snd = a.snd ^ n :=
  rfl
#align double_centralizer.pow_snd DoubleCentralizer.pow_snd

/-- The natural injection from `double_centralizer.to_prod` except the second coordinate inherits
`mul_opposite.op`. The ring structure on `𝓜(𝕜, A)` is the pullback under this map. -/
def toProdMulOpposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ := fun a =>
  (a.fst, MulOpposite.op a.snd)
#align double_centralizer.to_prod_mul_opposite DoubleCentralizer.toProdMulOpposite

theorem toProdMulOpposite_injective :
    Function.Injective (toProdMulOpposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ) := fun a b h =>
  let h' := Prod.ext_iff.mp h
  ext _ _ <| Prod.ext h'.1 <| MulOpposite.op_injective h'.2
#align double_centralizer.to_prod_mul_opposite_injective DoubleCentralizer.toProdMulOpposite_injective

theorem range_toProdMulOpposite :
    Set.range toProdMulOpposite = { lr : (A →L[𝕜] A) × _ | ∀ x y, unop lr.2 x * y = x * lr.1 y } :=
  Set.ext fun x =>
    ⟨by
      rintro ⟨a, rfl⟩
      exact a.central, fun hx => ⟨⟨(x.1, unop x.2), hx⟩, Prod.ext rfl rfl⟩⟩
#align double_centralizer.range_to_prod_mul_opposite DoubleCentralizer.range_toProdMulOpposite

/-- The ring structure is inherited as the pullback under the injective map
`double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` -/
instance : Ring 𝓜(𝕜, A) :=
  toProdMulOpposite_injective.Ring _ rfl rfl (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl)
    (fun _ _ => rfl) (fun x n => Prod.ext rfl <| MulOpposite.op_smul _ _)
    (fun x n => Prod.ext rfl <| MulOpposite.op_smul _ _)
    (fun x n => Prod.ext rfl <| MulOpposite.op_pow _ _) (fun _ => rfl) fun _ => rfl

/-- The canonical map `double_centralizer.to_prod` as an additive group homomorphism. -/
@[simps]
def toProdHom : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A)
    where
  toFun := toProd
  map_zero' := rfl
  map_add' x y := rfl
#align double_centralizer.to_prod_hom DoubleCentralizer.toProdHom

/-- The canonical map `double_centralizer.to_prod_mul_opposite` as a ring homomorphism. -/
@[simps]
def toProdMulOppositeHom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ
    where
  toFun := toProdMulOpposite
  map_zero' := rfl
  map_one' := rfl
  map_add' x y := rfl
  map_mul' x y := rfl
#align double_centralizer.to_prod_mul_opposite_hom DoubleCentralizer.toProdMulOppositeHom

/-- The module structure is inherited as the pullback under the additive group monomorphism
`double_centralizer.to_prod : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A)` -/
instance {S : Type _} [Semiring S] [Module S A] [SMulCommClass 𝕜 S A] [ContinuousConstSMul S A]
    [IsScalarTower S A A] [SMulCommClass S A A] : Module S 𝓜(𝕜, A) :=
  Function.Injective.module S toProdHom ext fun x y => rfl

-- TODO: generalize to `algebra S 𝓜(𝕜, A)` once `continuous_linear_map.algebra` is generalized.
instance : Algebra 𝕜 𝓜(𝕜, A)
    where
  toFun k :=
    { toProd := algebraMap 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)) k
      central := fun x y => by
        simp_rw [Prod.algebraMap_apply, Algebra.algebraMap_eq_smul_one, smul_apply, one_apply,
          mul_smul_comm, smul_mul_assoc] }
  map_one' := ext _ _ <| map_one <| algebraMap 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A))
  map_mul' k₁ k₂ :=
    ext _ _ <|
      Prod.ext (map_mul (algebraMap 𝕜 (A →L[𝕜] A)) _ _)
        ((map_mul (algebraMap 𝕜 (A →L[𝕜] A)) _ _).trans (Algebra.commutes _ _))
  map_zero' := ext _ _ <| map_zero <| algebraMap 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A))
  map_add' _ _ := ext _ _ <| map_add (algebraMap 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A))) _ _
  commutes' _ _ := ext _ _ <| Prod.ext (Algebra.commutes _ _) (Algebra.commutes _ _).symm
  smul_def' _ _ :=
    ext _ _ <|
      Prod.ext (Algebra.smul_def _ _) ((Algebra.smul_def _ _).trans <| Algebra.commutes _ _)

@[simp]
theorem algebraMap_toProd (k : 𝕜) : (algebraMap 𝕜 𝓜(𝕜, A) k).toProd = algebraMap 𝕜 _ k :=
  rfl
#align double_centralizer.algebra_map_to_prod DoubleCentralizer.algebraMap_toProd

theorem algebraMap_fst (k : 𝕜) : (algebraMap 𝕜 𝓜(𝕜, A) k).fst = algebraMap 𝕜 _ k :=
  rfl
#align double_centralizer.algebra_map_fst DoubleCentralizer.algebraMap_fst

theorem algebraMap_snd (k : 𝕜) : (algebraMap 𝕜 𝓜(𝕜, A) k).snd = algebraMap 𝕜 _ k :=
  rfl
#align double_centralizer.algebra_map_snd DoubleCentralizer.algebraMap_snd

/-!
### Star structure
-/

section Star

variable [StarRing 𝕜] [StarRing A] [StarModule 𝕜 A] [NormedStarGroup A]

/-- The star operation on `a : 𝓜(𝕜, A)` is given by
`(star a).to_prod = (star ∘ a.snd ∘ star, star ∘ a.fst ∘ star)`. -/
instance : Star 𝓜(𝕜, A)
    where unit a :=
    { fst :=
        (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.snd).comp
          ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A)
      snd :=
        (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.fst).comp
          ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A)
      central := fun x y => by
        simpa only [star_mul, star_star] using (congr_arg star (a.central (star y) (star x))).symm }

@[simp]
theorem star_fst (a : 𝓜(𝕜, A)) (b : A) : (star a).fst b = star (a.snd (star b)) :=
  rfl
#align double_centralizer.star_fst DoubleCentralizer.star_fst

@[simp]
theorem star_snd (a : 𝓜(𝕜, A)) (b : A) : (star a).snd b = star (a.fst (star b)) :=
  rfl
#align double_centralizer.star_snd DoubleCentralizer.star_snd

instance : StarAddMonoid 𝓜(𝕜, A) :=
  {
    DoubleCentralizer.hasStar with
    star_involutive := fun x => by ext <;> simp only [star_fst, star_snd, star_star]
    star_add := fun x y => by
      ext <;>
        simp only [star_fst, star_snd, add_fst, add_snd, ContinuousLinearMap.add_apply, star_add] }

instance : StarRing 𝓜(𝕜, A) :=
  { DoubleCentralizer.starAddMonoid with
    star_mul := fun a b => by
      ext <;>
        simp only [star_fst, star_snd, mul_fst, mul_snd, star_star, ContinuousLinearMap.coe_mul,
          Function.comp_apply] }

instance : StarModule 𝕜 𝓜(𝕜, A) :=
  { DoubleCentralizer.starAddMonoid with star_smul := fun k a => by ext <;> exact star_smul _ _ }

end Star

/-!
### Coercion from an algebra into its multiplier algebra
-/

/-- The natural coercion of `A` into `𝓜(𝕜, A)` given by sending `a : A` to the pair of linear
maps `Lₐ Rₐ : A →L[𝕜] A` given by left- and right-multiplication by `a`, respectively.

Warning: if `A = 𝕜`, then this is a coercion which is not definitionally equal to the
`algebra_map 𝕜 𝓜(𝕜, 𝕜)` coercion, but these are propositionally equal. See
`double_centralizer.coe_eq_algebra_map` below. -/
noncomputable instance : CoeTC A 𝓜(𝕜, A)
    where coe a :=
    { fst := ContinuousLinearMap.mul 𝕜 A a
      snd := (ContinuousLinearMap.mul 𝕜 A).flip a
      central := fun x y => mul_assoc _ _ _ }

@[simp, norm_cast]
theorem coe_fst (a : A) : (a : 𝓜(𝕜, A)).fst = ContinuousLinearMap.mul 𝕜 A a :=
  rfl
#align double_centralizer.coe_fst DoubleCentralizer.coe_fst

@[simp, norm_cast]
theorem coe_snd (a : A) : (a : 𝓜(𝕜, A)).snd = (ContinuousLinearMap.mul 𝕜 A).flip a :=
  rfl
#align double_centralizer.coe_snd DoubleCentralizer.coe_snd

theorem coe_eq_algebraMap : (coe : 𝕜 → 𝓜(𝕜, 𝕜)) = algebraMap 𝕜 𝓜(𝕜, 𝕜) := by
  ext <;>
      simp only [coe_fst, mul_apply', mul_one, algebra_map_to_prod, Prod.algebraMap_apply, coe_snd,
        flip_apply, one_mul] <;>
    simp only [Algebra.algebraMap_eq_smul_one, smul_apply, one_apply, smul_eq_mul, mul_one]
#align double_centralizer.coe_eq_algebra_map DoubleCentralizer.coe_eq_algebraMap

/-- The coercion of an algebra into its multiplier algebra as a non-unital star algebra
homomorphism. -/
@[simps]
noncomputable def coeHom [StarRing 𝕜] [StarRing A] [StarModule 𝕜 A] [NormedStarGroup A] :
    A →⋆ₙₐ[𝕜] 𝓜(𝕜, A) where
  toFun a := a
  map_smul' k a := by
    ext <;> simp only [coe_fst, coe_snd, ContinuousLinearMap.map_smul, smul_fst, smul_snd]
  map_zero' := by ext <;> simp only [coe_fst, coe_snd, map_zero, zero_fst, zero_snd]
  map_add' a b := by ext <;> simp only [coe_fst, coe_snd, map_add, add_fst, add_snd]
  map_mul' a b := by
    ext <;>
      simp only [coe_fst, coe_snd, mul_apply', flip_apply, mul_fst, mul_snd,
        ContinuousLinearMap.coe_mul, Function.comp_apply, mul_assoc]
  map_star' a := by
    ext <;>
      simp only [coe_fst, coe_snd, mul_apply', star_fst, star_snd, flip_apply, star_mul, star_star]
#align double_centralizer.coe_hom DoubleCentralizer.coeHom

/-!
### Norm structures
We define the norm structure on `𝓜(𝕜, A)` as the pullback under
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`, which
provides a definitional isometric embedding. Consequently, completeness of `𝓜(𝕜, A)` is obtained
by proving that the range of this map is closed.

In addition, we prove that `𝓜(𝕜, A)` is a normed algebra, and, when `A` is a C⋆-algebra, we show
that `𝓜(𝕜, A)` is also a C⋆-algebra. Moreover, in this case, for `a : 𝓜(𝕜, A)`,
`‖a‖ = ‖a.fst‖ = ‖a.snd‖`. -/

/-- The normed group structure is inherited as the pullback under the ring monomoprhism
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`. -/
noncomputable instance : NormedRing 𝓜(𝕜, A) :=
  NormedRing.induced _ _ (toProdMulOppositeHom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ)
    toProdMulOpposite_injective

-- even though the definition is actually in terms of `double_centralizer.to_prod_mul_opposite`, we
-- choose to see through that here to avoid `mul_opposite.op` appearing.
theorem norm_def (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.toProdHom‖ :=
  rfl
#align double_centralizer.norm_def DoubleCentralizer.norm_def

theorem nnnorm_def (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.toProdHom‖₊ :=
  rfl
#align double_centralizer.nnnorm_def DoubleCentralizer.nnnorm_def

theorem norm_def' (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.toProdMulOppositeHom‖ :=
  rfl
#align double_centralizer.norm_def' DoubleCentralizer.norm_def'

theorem nnnorm_def' (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.toProdMulOppositeHom‖₊ :=
  rfl
#align double_centralizer.nnnorm_def' DoubleCentralizer.nnnorm_def'

instance : NormedSpace 𝕜 𝓜(𝕜, A) :=
  { DoubleCentralizer.module with norm_smul_le := fun k a => norm_smul_le k a.toProdMulOpposite }

instance : NormedAlgebra 𝕜 𝓜(𝕜, A) :=
  { DoubleCentralizer.algebra, DoubleCentralizer.normedSpace with }

theorem uniformEmbedding_toProdMulOpposite : UniformEmbedding (@toProdMulOpposite 𝕜 A _ _ _ _ _) :=
  uniformEmbedding_comap toProdMulOpposite_injective
#align double_centralizer.uniform_embedding_to_prod_mul_opposite DoubleCentralizer.uniformEmbedding_toProdMulOpposite

instance [CompleteSpace A] : CompleteSpace 𝓜(𝕜, A) :=
  by
  rw [completeSpace_iff_isComplete_range uniform_embedding_to_prod_mul_opposite.to_uniform_inducing]
  apply IsClosed.isComplete
  simp only [range_to_prod_mul_opposite, Set.setOf_forall]
  refine' isClosed_interᵢ fun x => isClosed_interᵢ fun y => isClosed_eq _ _
  exact
    ((ContinuousLinearMap.apply 𝕜 A _).Continuous.comp <| continuous_unop.comp continuous_snd).mul
      continuous_const
  exact continuous_const.mul ((ContinuousLinearMap.apply 𝕜 A _).Continuous.comp continuous_fst)

variable [StarRing A] [CstarRing A]

/-- For `a : 𝓜(𝕜, A)`, the norms of `a.fst` and `a.snd` coincide, and hence these
also coincide with `‖a‖` which is `max (‖a.fst‖) (‖a.snd‖)`. -/
theorem norm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a.snd‖ :=
  by
  -- a handy lemma for this proof
  have h0 : ∀ f : A →L[𝕜] A, ∀ C : ℝ≥0, (∀ b : A, ‖f b‖₊ ^ 2 ≤ C * ‖f b‖₊ * ‖b‖₊) → ‖f‖₊ ≤ C :=
    by
    intro f C h
    have h1 : ∀ b, C * ‖f b‖₊ * ‖b‖₊ ≤ C * ‖f‖₊ * ‖b‖₊ ^ 2 :=
      by
      intro b
      convert mul_le_mul_right' (mul_le_mul_left' (f.le_op_nnnorm b) C) ‖b‖₊ using 1
      ring
    have :=
      div_le_of_le_mul
        (f.op_nnnorm_le_bound _
          (by
            simpa only [sqrt_sq, sqrt_mul] using fun b =>
              sqrt_le_sqrt_iff.mpr ((h b).trans (h1 b))))
    convert rpow_le_rpow this two_pos.le
    · simp only [rpow_two, div_pow, sq_sqrt]
      simp only [sq, mul_self_div_self]
    · simp only [rpow_two, sq_sqrt]
  have h1 : ∀ b, ‖a.fst b‖₊ ^ 2 ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊ :=
    by
    intro b
    calc
      ‖a.fst b‖₊ ^ 2 = ‖star (a.fst b) * a.fst b‖₊ := by
        simpa only [← sq] using CstarRing.nnnorm_star_mul_self.symm
      _ ≤ ‖a.snd (star (a.fst b))‖₊ * ‖b‖₊ := (a.central (star (a.fst b)) b ▸ nnnorm_mul_le _ _)
      _ ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊ :=
        nnnorm_star (a.fst b) ▸ mul_le_mul_right' (a.snd.le_op_nnnorm _) _

  have h2 : ∀ b, ‖a.snd b‖₊ ^ 2 ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊ :=
    by
    intro b
    calc
      ‖a.snd b‖₊ ^ 2 = ‖a.snd b * star (a.snd b)‖₊ := by
        simpa only [← sq] using CstarRing.nnnorm_self_mul_star.symm
      _ ≤ ‖b‖₊ * ‖a.fst (star (a.snd b))‖₊ :=
        ((a.central b (star (a.snd b))).symm ▸ nnnorm_mul_le _ _)
      _ = ‖a.fst (star (a.snd b))‖₊ * ‖b‖₊ := (mul_comm _ _)
      _ ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊ :=
        nnnorm_star (a.snd b) ▸ mul_le_mul_right' (a.fst.le_op_nnnorm _) _

  exact le_antisymm (h0 _ _ h1) (h0 _ _ h2)
#align double_centralizer.norm_fst_eq_snd DoubleCentralizer.norm_fst_eq_snd

theorem nnnorm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a.snd‖₊ :=
  Subtype.ext <| norm_fst_eq_snd a
#align double_centralizer.nnnorm_fst_eq_snd DoubleCentralizer.nnnorm_fst_eq_snd

@[simp]
theorem norm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a‖ := by
  simp only [norm_def, to_prod_hom_apply, Prod.norm_def, norm_fst_eq_snd, max_eq_right,
    eq_self_iff_true]
#align double_centralizer.norm_fst DoubleCentralizer.norm_fst

@[simp]
theorem norm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖ = ‖a‖ := by rw [← norm_fst, norm_fst_eq_snd]
#align double_centralizer.norm_snd DoubleCentralizer.norm_snd

@[simp]
theorem nnnorm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a‖₊ :=
  Subtype.ext (norm_fst a)
#align double_centralizer.nnnorm_fst DoubleCentralizer.nnnorm_fst

@[simp]
theorem nnnorm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖₊ = ‖a‖₊ :=
  Subtype.ext (norm_snd a)
#align double_centralizer.nnnorm_snd DoubleCentralizer.nnnorm_snd

end NontriviallyNormed

section DenselyNormed

variable {𝕜 A : Type _} [DenselyNormedField 𝕜] [StarRing 𝕜]

variable [NonUnitalNormedRing A] [StarRing A] [CstarRing A]

variable [NormedSpace 𝕜 A] [SMulCommClass 𝕜 A A] [IsScalarTower 𝕜 A A] [StarModule 𝕜 A]

instance : CstarRing 𝓜(𝕜, A)
    where norm_star_mul_self a :=
    congr_arg (coe : ℝ≥0 → ℝ) <|
      show ‖star a * a‖₊ = ‖a‖₊ * ‖a‖₊
        by
        /- The essence of the argument is this: let `a = (L,R)` and recall `‖a‖ = ‖L‖`.
            `star a = (star ∘ R ∘ star, star ∘ L ∘ star)`. Then for any `x y : A`, we have
            `‖star a * a‖ = ‖(star a * a).snd‖ = ‖R (star (L (star x))) * y‖ = ‖star (L (star x)) * L y‖`
            Now, on the one hand,
            `‖star (L (star x)) * L y‖ ≤ ‖star (L (star x))‖ * ‖L y‖ = ‖L (star x)‖ * ‖L y‖ ≤ ‖L‖ ^ 2`
            whenever `‖x‖, ‖y‖ ≤ 1`, so the supremum over all such `x, y` is at most `‖L‖ ^ 2`.
            On the other hand, for any `‖z‖ ≤ 1`, we may choose `x := star z` and `y := z` to get:
            `‖star (L (star x)) * L y‖ = ‖star (L z) * (L z)‖ = ‖L z‖ ^ 2`, and taking the supremum over
            all such `z` yields that the supremum is at least `‖L‖ ^ 2`. It is the latter part of the
            argument where `densely_normed_field 𝕜` is required (for `Sup_closed_unit_ball_eq_nnnorm`). -/
        have hball : (Metric.closedBall (0 : A) 1).Nonempty :=
          Metric.nonempty_closedBall.2 zero_le_one
        have key :
          ∀ x y, ‖x‖₊ ≤ 1 → ‖y‖₊ ≤ 1 → ‖a.snd (star (a.fst (star x))) * y‖₊ ≤ ‖a‖₊ * ‖a‖₊ :=
          by
          intro x y hx hy
          rw [a.central]
          calc
            ‖star (a.fst (star x)) * a.fst y‖₊ ≤ ‖a.fst (star x)‖₊ * ‖a.fst y‖₊ :=
              nnnorm_star (a.fst (star x)) ▸ nnnorm_mul_le _ _
            _ ≤ ‖a.fst‖₊ * 1 * (‖a.fst‖₊ * 1) :=
              (mul_le_mul' (a.fst.le_op_norm_of_le ((nnnorm_star x).trans_le hx))
                (a.fst.le_op_norm_of_le hy))
            _ ≤ ‖a‖₊ * ‖a‖₊ := by simp only [mul_one, nnnorm_fst]

        rw [← nnnorm_snd]
        simp only [mul_snd, ← Sup_closed_unit_ball_eq_nnnorm, star_snd, mul_apply]
        simp only [← @op_nnnorm_mul 𝕜 A]
        simp only [← Sup_closed_unit_ball_eq_nnnorm, mul_apply']
        refine' csupₛ_eq_of_forall_le_of_forall_lt_exists_gt (hball.image _) _ fun r hr => _
        · rintro - ⟨x, hx, rfl⟩
          refine' csupₛ_le (hball.image _) _
          rintro - ⟨y, hy, rfl⟩
          exact key x y (mem_closedBall_zero_iff.1 hx) (mem_closedBall_zero_iff.1 hy)
        · simp only [Set.mem_image, Set.mem_setOf_eq, exists_prop, exists_exists_and_eq_and]
          have hr' : r.sqrt < ‖a‖₊ := ‖a‖₊.sqrt_mul_self ▸ NNReal.sqrt_lt_sqrt_iff.2 hr
          simp_rw [← nnnorm_fst, ← Sup_closed_unit_ball_eq_nnnorm] at hr'
          obtain ⟨_, ⟨x, hx, rfl⟩, hxr⟩ := exists_lt_of_lt_csupₛ (hball.image _) hr'
          have hx' : ‖x‖₊ ≤ 1 := mem_closedBall_zero_iff.1 hx
          refine' ⟨star x, mem_closedBall_zero_iff.2 ((nnnorm_star x).trans_le hx'), _⟩
          refine' lt_csupₛ_of_lt _ ⟨x, hx, rfl⟩ _
          · refine' ⟨‖a‖₊ * ‖a‖₊, _⟩
            rintro - ⟨y, hy, rfl⟩
            exact key (star x) y ((nnnorm_star x).trans_le hx') (mem_closedBall_zero_iff.1 hy)
          ·
            simpa only [a.central, star_star, CstarRing.nnnorm_star_mul_self, NNReal.sq_sqrt, ←
              sq] using pow_lt_pow_of_lt_left hxr zero_le' two_pos

end DenselyNormed

end DoubleCentralizer


#eval 2+2
#check Sigma
#check Σ'x, x > 3
#check [1, 2, 3]
#check (_ ∘ _)
#check Function.comp

#check HasEquiv
#check Fin

-- Карта и территория

#check propext
#check funext

-- Натуральные числа

#check Add
#check Mul

#check congr
#check Eq.subst

#check {x // x > 3}
#check Subtype.eta

#check Exists
#check Fin

-- Фактор-типы и целые числа

-- Рациональные и вещественные числа

-- Множества и зависимые пары

-- Функции

namespace Function

def retraction   (f: α → ω)(g: ω → α): Prop :=  ∀x, g (f x) = x
def coretraction (f: ω → α)(g: α → ω): Prop :=  retraction g f

def inverse (f: α → ω)(g: ω → α) : Prop :=  retraction f g ∧ retraction g f

def injective  (f: α → ω) : Prop :=  ∀x y, f x = f y → x = y
def surjective (f: α → ω) : Prop :=  ∀y, ∃x, f x = y
def bijective  (f: α → ω) : Prop :=  injective f ∧ surjective f

theorem has_retr_injective (f: α → ω)(er: ∃g, retraction f g) : injective f :=
by
  let ⟨g, r⟩ := er;
  intro x y (e: f x = f y);  show x = y
  have e2: g (f x) = g (f y) := congrArg g e
  exact r x ▸ r y ▸ e2

theorem has_coretr_surjective (f: ω → α)(ec: ∃g, coretraction f g) : surjective f :=
  let ⟨g,c⟩ := ec;  λy:α => ⟨g y, (by rw[c y] : f (g y) = y)⟩

-- theorem inj_has_retraction (f: α → ω)(ij: injective f) : ∃g, retraction f g :=
-- by sorry

-- theorem surj_has_coretraction (f: α → ω)(sj: surjective f) : ∃g, coretraction f g :=
-- by sorry

theorem lwfix (f: α → α → ω)(sj: surjective f)(u: ω → ω): ∃x, u x = x := by
  let d := λx => u (f x x);  let ⟨c,fp⟩ := (sj d : ∃c, f c = d);
  refine ⟨d c, Eq.symm ?_⟩
  calc
    d c = u (f c c) := rfl
      _ = u (d c)   := by rw[fp]

end Function

-- Отношения

---------------

#check WellFounded

#check Acc

example (n:Nat): Acc Nat.lt n := by
  apply Nat.rec
  · show Acc _ 0
    exact Acc.intro _ $ λk (h: k < 0) => absurd h (Nat.not_lt_zero k)
  · refine λn h => (?_: Acc _ n.succ)
    refine Acc.intro _ $ λk (lt: k < n.succ) => (?_: Acc _ k)
    apply (Nat.eq_or_lt_of_le (Nat.le_of_succ_le_succ lt)).elim
    · intro (l: k = n); exact l ▸ h
    · intro (r: k < n); exact Acc.inv h r

#check Eq.subst

-- example {C: α → Sort v}(F: ∀ x, (∀ y, r y x → C y) → C x)(x:α)(a: Acc r x): C x :=
--   a.rec (λx _ ih => F x ih)

#print Acc.rec

inductive WTree {α:Type}: α → Type where
| leaf (r:α): WTree r
| branch (x:α)(b: ∀y:α, WTree y): WTree x


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Mario Carneiro
-/
import Mathlib.Tactic.NormNum
import Mathlib.Tactic.FinCases
import Mathlib.Data.Set.Intervals.Basic

/-!
# Case bash on variables in finite intervals

This file provides the tactic `interval_cases`. `interval_cases n` will:
1. inspect hypotheses looking for lower and upper bounds of the form `a ≤ n` and `n < b`
   (in `ℕ`, `ℤ`, `ℕ+`, bounds of the form `a < n` and `n ≤ b` are also allowed),
   and also makes use of lower and upper bounds found via `le_top` and `bot_le`
   (so for example if `n : ℕ`, then the bound `0 ≤ n` is automatically found).
2. call `fin_cases` on the synthesised hypothesis `n ∈ set.Ico a b`,
   assuming an appropriate `fintype` instance can be found for the type of `n`.

The variable `n` can belong to any type `α`, with the following restrictions:
* only bounds on which `expr.to_rat` succeeds will be considered "explicit" (TODO: generalise this?)
* an instance of `decidable_eq α` is available,
* an explicit lower bound can be found among the hypotheses, or from `bot_le n`,
* an explicit upper bound can be found among the hypotheses, or from `le_top n`,
* if multiple bounds are located, an instance of `linear_order α` is available, and
* an instance of `fintype set.Ico l u` is available for the relevant bounds.

You can also explicitly specify a lower and upper bound to use, as `interval_cases using hl hu`,
where the hypotheses should be of the form `hl : a ≤ n` and `hu : n < b`. In that case,
`interval_cases` calls `fin_cases` on the resulting hypothesis `h : n ∈ set.Ico a b`.
-/

set_option linter.unusedVariables false

namespace Mathlib.Tactic

open Lean Meta Elab Tactic Term Qq Int

namespace IntervalCases

/-- The result of `interval_cases` is a list of goals,
one for each integer value between the bounds. -/
structure IntervalCasesSubgoal where
  /-- The target expression, a numeral in the input type -/
  rhs : Expr
  /-- The numeric value of the target expression -/
  value : Int
  /-- The new subgoal, of the form `⊢ x = rhs → tgt` -/
  goal : MVarId

/--
A `Bound` represents the result of analyzing a lower or upper bound expression.
If `e` is the scrutinee expression, then a lower bound expression like `3 < e`
is normalized to `¬e ≤ 3` and represented as `.lt 3`, and an upper bound expression
like `e ≤ 5` is represented as `.le 5`.
-/
inductive Bound
  /-- A strictly less-than lower bound `n ≱ e` or upper bound `e ≱ n`. (`interval_cases` uses
  less-equal exclusively, so less-than bounds are actually written as not-less-equal
  with flipped arguments.) -/
  | lt (n : ℤ)
  /-- A less-than-or-equal lower bound `n ≤ e` or upper bound `e ≤ n`. -/
  | le (n : ℤ)

/--
Assuming `Bound` represents a lower bound, this returns the (inclusive)
least integer value which is allowed. So `3 ≤ e` means the lower bound is 3 and
`3 < e` means the lower bound is `4`.
-/
def Bound.asLower : Bound → ℤ
  | .lt n => n + 1
  | .le n => n

/--
Assuming `Bound` represents an upper bound, this returns the (inclusive)
greatest integer value which is allowed. So `e ≤ 3` means the lower bound is 3 and
`e < 3` means the upper bound is `2`. Note that in the case of `e < 0` on `Nat`
the upper bound is `-1`, which is not representable as a `Nat`;
this is why we have to treat the `.lt` and `.le` cases separately instead of normalizing
everything to `.le` bounds.
-/
def Bound.asUpper : Bound → ℤ
  | .lt n => n - 1
  | .le n => n

/--
Given a type `ty` (the type of a hypothesis in the context or a provided expression),
attempt to parse it as an inequality, and return `(a, b, strict, positive)`, where
`positive` means it is a negated inequality and `strict` means it is a strict inequality
(`a < b` or `a ≱ b`). `a` is always the lesser argument and `b` the greater one.
-/
def parseBound (ty : Expr) : MetaM (Expr × Expr × Bool × Bool) := do
  let ty ← whnfR ty
  if ty.isAppOfArity ``Not 1 then
    let ty ← whnfR ty.appArg!
    if ty.isAppOfArity ``LT.lt 4 then
      pure (ty.appArg!, ty.appFn!.appArg!, false, false)
    else if ty.isAppOfArity ``LE.le 4 then
      pure (ty.appArg!, ty.appFn!.appArg!, true, false)
    else failure
  else if ty.isAppOfArity ``LT.lt 4 then
    pure (ty.appFn!.appArg!, ty.appArg!, true, true)
  else if ty.isAppOfArity ``LE.le 4 then
    pure (ty.appFn!.appArg!, ty.appArg!, false, true)
  else failure

/-- A "typeclass" (not actually a class) of methods for the type-specific handling of
`interval_cases`. To add support for a new type, you have to implement this interface and add
a dispatch case for it in `intervalCases`. -/
structure Methods where
  /-- Given `e`, construct `(bound, n, p)` where `p` is a proof of `n ≤ e` or `n < e`
  (characterized by `bound`), or `failure` if the type is not lower-bounded. -/
  initLB (e : Expr) : MetaM (Bound × Expr × Expr) := failure
  /-- Given `e`, construct `(bound, n, p)` where `p` is a proof of `e ≤ n` or `e < n`
  (characterized by `bound`), or `failure` if the type is not upper-bounded. -/
  initUB (e : Expr) : MetaM (Bound × Expr × Expr) := failure
  /-- Given `a, b`, prove `a ≤ b` or fail. -/
  proveLE : Expr → Expr → MetaM Expr
  /-- Given `a, b`, prove `a ≱ b` or fail. -/
  proveLT : Expr → Expr → MetaM Expr
  /-- Given `a, b, a', p` where `p` proves `a ≱ b` and `a' := a+1`, prove `a' ≤ b`. -/
  roundUp : Expr → Expr → Expr → Expr → MetaM Expr
  /-- Given `a, b, b', p` where `p` proves `a ≱ b` and `b' := b-1`, prove `a ≤ b'`. -/
  roundDown : Expr → Expr → Expr → Expr → MetaM Expr
  /-- Given `e`, return `(z, n, p)` where `p : e = n` and `n` is a numeral
  appropriate for the type denoting the integer `z`. -/
  eval : Expr → MetaM (Int × Expr × Expr)
  /-- Construct the canonical numeral for integer `z`, or fail if `z` is out of range. -/
  mkNumeral : Int → MetaM Expr

theorem of_not_lt_left [LinearOrder α] (h : ¬(a:α) < b) (eq : a = a') : b ≤ a' := eq ▸ not_lt.1 h

/--
Given a proof `pf`, attempts to parse it as an upper (`lb = false`) or lower (`lb = true`)
bound on `n`. If successful, it returns `(bound, n, pf')` where `n` is a numeral and
`pf'` proves `n ≤ e` or `n ≱ e` (as described by `bound`).
-/
def Methods.getBound (m : Methods) (e : Expr) (pf : Expr) (lb : Bool) :
    MetaM (Bound × Expr × Expr) := do
  let (e', c) ← match ← parseBound (← inferType pf), lb with
    | (b, a, false, false), false =>
      let (z, a', eq) ← m.eval a; pure (b, .le z, a', ← mkAppM ``of_not_lt_left #[pf, eq])
    | (b, a, false, false), true =>
      let (z, b', eq) ← m.eval b; pure (a, .le z, b', ← mkAppM ``of_not_lt_right #[pf, eq])
    | (a, b, false, true), false =>
      let (z, b', eq) ← m.eval b; pure (a, .le z, b', ← mkAppM ``of_le_right #[pf, eq])
    | (a, b, false, true), true =>
      let (z, a', eq) ← m.eval a; pure (b, .le z, a', ← mkAppM ``of_le_left #[pf, eq])
    | (b, a, true, false), false =>
      let (z, a', eq) ← m.eval a; pure (b, .lt z, a', ← mkAppM ``of_not_le_left #[pf, eq])
    | (b, a, true, false), true =>
      let (z, b', eq) ← m.eval b; pure (a, .lt z, b', ← mkAppM ``of_not_le_right #[pf, eq])
    | (a, b, true, true), false =>
      let (z, b', eq) ← m.eval b; pure (a, .lt z, b', ← mkAppM ``of_lt_right #[pf, eq])
    | (a, b, true, true), true =>
      let (z, a', eq) ← m.eval a; pure (b, .lt z, a', ← mkAppM ``of_lt_left #[pf, eq])
  let .true ← withNewMCtxDepth <| withReducible <| isDefEq e e' | failure
  pure c

theorem le_of_not_le_of_le [LinearOrder α] (h1 : ¬hi ≤ n) (h2 : hi ≤ lo) : (n:α) ≤ lo :=
  le_trans (le_of_not_le h1) h2

/--
Given `(z1, e1, p1)` a lower bound on `e` and `(z2, e2, p2)` an upper bound on `e`,
such that the distance between the bounds is negative, returns a proof of `False`.
-/
def Methods.inconsistentBounds (m : Methods)
    (z1 z2 : Bound) (e1 e2 p1 p2 e : Expr) : MetaM Expr := do
  match z1, z2 with
  | .le lo, .lt hi =>
    if lo == hi then return p2.app p1
    return p2.app (← mkAppM ``le_trans #[← m.proveLE e2 e1, p1])
  | .lt lo, .le hi =>
    if lo == hi then return p1.app p2
    return p1.app (← mkAppM ``le_trans #[p2, ← m.proveLE e2 e1])
  | .le _, .le _ => return (← m.proveLT e2 e1).app (← mkAppM ``le_trans #[p1, p2])
  | .lt lo, .lt hi =>
    if hi ≤ lo then return p1.app (← mkAppM ``le_of_not_le_of_le #[p2, ← m.proveLE e2 e1])
    let e3 ← m.mkNumeral (hi - 1)
    let p3 ← m.roundDown e e2 e3 p2
    return p1.app (← mkAppM ``le_trans #[p3, ← m.proveLE e3 e1])

/--
Given `(z1, e1, p1)` a lower bound on `e` and `(z2, e2, p2)` an upper bound on `e`, such that the
distance between the bounds matches the number of `cases` in the subarray (which must be positive),
proves the goal `g` using the metavariables in the array by recursive bisection.
This is the core of the tactic, producing a case tree of if statements which bottoms out
at the `cases`.
-/
partial def Methods.bisect (m : Methods) (g : MVarId) (cases : Subarray IntervalCasesSubgoal)
    (z1 z2 : Bound) (e1 e2 p1 p2 e : Expr) : MetaM Unit := g.withContext do
  if 1 < cases.size then
    let tgt ← g.getType
    let mid := cases.size / 2
    let z3 := z1.asLower + mid
    let e3 ← m.mkNumeral z3
    let le ← mkAppM ``LE.le #[e3, e]
    let g₁ ← mkFreshExprMVar (← mkArrow (mkNot le) tgt) .syntheticOpaque
    let g₂ ← mkFreshExprMVar (← mkArrow le tgt) .syntheticOpaque
    g.assign <| ← mkAppM ``dite #[le, g₂, g₁]
    let (x₁, g₁) ← g₁.mvarId!.intro1
    m.bisect g₁ cases[:mid] z1 (.lt z3) e1 e3 p1 (.fvar x₁) e
    let (x₂, g₂) ← g₂.mvarId!.intro1
    m.bisect g₂ cases[mid:] (.le z3) z2 e3 e2 (.fvar x₂) p2 e
  else if _x : 0 < cases.size then
    let { goal, rhs, .. } := cases[0]
    let pf₁ ← match z1 with | .le _ => pure p1 | .lt _ => m.roundUp e1 e rhs p1
    let pf₂ ← match z2 with | .le _ => pure p2 | .lt _ => m.roundDown e e2 rhs p2
    g.assign (.app (.mvar goal) (← mkAppM ``le_antisymm #[pf₂, pf₁]))
  else panic! "no goals"

/-- A `Methods` implementation for `ℕ`.
This tells `interval_cases` how to work on natural numbers. -/
def natMethods : Methods where
  initLB (e : Q(ℕ)) :=
    pure (.le 0, q(0), q(Nat.zero_le $e))
  eval e := do
    let ⟨z, e, p⟩ := (← NormNum.derive (α := (q(ℕ) : Q(Type))) e).toRawIntEq.get!
    pure (z, e, p)
  proveLE (lhs rhs : Q(ℕ)) := mkDecideProof q($lhs ≤ $rhs)
  proveLT (lhs rhs : Q(ℕ)) := mkDecideProof q(¬$rhs ≤ $lhs)
  roundUp (lhs rhs _ : Q(ℕ)) (p : Q(¬$rhs ≤ $lhs)) := pure q(Nat.gt_of_not_le $p)
  roundDown (lhs _ rhs' : Q(ℕ)) (p : Q(¬Nat.succ $rhs' ≤ $lhs)) := pure q(Nat.ge_of_not_lt $p)
  mkNumeral
    | (i : ℕ) => pure q($i)
    | _ => failure

theorem _root_.Int.add_one_le_of_not_le {a b : ℤ} (h : ¬b ≤ a) : a + 1 ≤ b :=
  Int.add_one_le_iff.2 (Int.not_le.1 h)
theorem _root_.Int.le_sub_one_of_not_le {a b : ℤ} (h : ¬b ≤ a) : a ≤ b - 1 :=
  Int.le_sub_one_iff.2 (Int.not_le.1 h)

/-- A `Methods` implementation for `ℤ`.
This tells `interval_cases` how to work on integers. -/
def intMethods : Methods where
  eval e := do
    let ⟨z, e, p⟩ := (← NormNum.derive (α := (q(ℤ) : Q(Type))) e).toRawIntEq.get!
    pure (z, e, p)
  proveLE (lhs rhs : Q(ℤ)) := mkDecideProof q($lhs ≤ $rhs)
  proveLT (lhs rhs : Q(ℤ)) := mkDecideProof q(¬$rhs ≤ $lhs)
  roundUp (lhs rhs _ : Q(ℤ)) (p : Q(¬$rhs ≤ $lhs)) := pure q(Int.add_one_le_of_not_le $p)
  roundDown (lhs rhs _ : Q(ℤ)) (p : Q(¬$rhs ≤ $lhs)) := pure q(Int.le_sub_one_of_not_le $p)
  mkNumeral
    | (i : Nat) => let n : Q(ℕ) := mkRawNatLit i; pure q(OfNat.ofNat $n : ℤ)
    | .negSucc i => let n : Q(ℕ) := mkRawNatLit (i+1); pure q(-OfNat.ofNat $n : ℤ)

/--
`intervalCases` proves goal `g` by splitting into cases for each integer between the given bounds.

Parameters:
* `g`: the goal, which can have any type `⊢ tgt` (it works in both proofs and programs)
* `e`: the scrutinee, the expression we are proving is bounded between integers
* `e'`: a version of `e` used for error messages. (This is used by the `interval_cases` frontend
  tactic because it uses a fresh variable for `e`, so it is more helpful to show the
  pre-generalized expression in error messages.)
* `lbs`: A list of candidate lower bound expressions.
  The tactic will automatically pick the best lower bound it can find from the list.
* `ubs`: A list of candidate upper bound expressions.
  The tactic will automatically pick the best upper bound it can find from the list.
* `mustUseBounds`: If true, the tactic will fail if it is unable to parse any of the
  given `ubs` or `lbs` into bounds. If false (the default), these will be silently skipped
  and an error message is only produced if we could not find any bounds (including those supplied
  by the type itself, e.g. if we are working over `Nat` or `Fin n`).

Returns an array of `IntervalCasesSubgoal`, one per subgoal. A subgoal has the following fields:
* `rhs`: the numeral expression for this case
* `value`: the integral value of `rhs`
* `goal`: the subgoal of type `⊢ e = rhs → tgt`

Note that this tactic does not perform any substitution or introduction steps -
all subgoals are in the same context as `goal` itself.
 -/
def intervalCases (g : MVarId) (e e' : Expr) (lbs ubs : Array Expr) (mustUseBounds := false) :
    MetaM (Array IntervalCasesSubgoal) := g.withContext do
  let α ← whnfR (← inferType e)
  let m ←
    if α.isConstOf ``Nat then pure natMethods else
    if α.isConstOf ``Int then pure intMethods else
    -- if α.isConstOf ``PNat then pure pnatMethods else
    throwError "interval_cases failed: unsupported type {α}"
  let mut lb ← try? (m.initLB e)
  for pf in lbs do
    if let some lb1 ← try? (m.getBound e pf true) then
      if lb.all (·.1.asLower < lb1.1.asLower) then
        lb := some lb1
    else if mustUseBounds then
      throwError "interval_cases failed: provided bound '{← inferType pf}' cannot be evaluated"
  let mut ub ← try? (m.initUB e)
  for pf in ubs do
    if let some ub1 ← try? (m.getBound e pf false) then
      if ub.all (·.1.asUpper > ub1.1.asUpper) then
        ub := some ub1
    else if mustUseBounds then
      throwError "interval_cases failed: provided bound '{← inferType pf}' cannot be evaluated"
  match lb, ub with
  | some (z1, e1, p1), some (z2, e2, p2) =>
    if z1.asLower > z2.asUpper then
      (← g.exfalso).assign (← m.inconsistentBounds z1 z2 e1 e2 p1 p2 e)
      pure #[]
    else
      let mut goals := #[]
      let lo := z1.asLower
      let tgt ← g.getType
      let tag ← g.getTag
      for i in [:(z2.asUpper-lo+1).toNat] do
        let z := lo+i
        let rhs ← m.mkNumeral z
        let ty ← mkArrow (← mkEq e rhs) tgt
        let goal ← mkFreshExprMVar ty .syntheticOpaque (appendTag tag (toString z))
        goals := goals.push { rhs, value := z, goal := goal.mvarId! }
      m.bisect g goals.toSubarray z1 z2 e1 e2 p1 p2 e
      pure goals
  | none, some _ => throwError "interval_cases failed: could not find lower bound on {e'}"
  | some _, none => throwError "interval_cases failed: could not find upper bound on {e'}"
  | none, none => throwError "interval_cases failed: could not find bounds on {e'}"

end IntervalCases

open IntervalCases

/--
`interval_cases n` searches for upper and lower bounds on a variable `n`,
and if bounds are found,
splits into separate cases for each possible value of `n`.

As an example, in
```
example (n : ℕ) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 := by
  interval_cases n
  all_goals simp
```
after `interval_cases n`, the goals are `3 = 3 ∨ 3 = 4` and `4 = 3 ∨ 4 = 4`.

You can also explicitly specify a lower and upper bound to use,
as `interval_cases using hl, hu`.
The hypotheses should be in the form `hl : a ≤ n` and `hu : n < b`,
in which case `interval_cases` calls `fin_cases` on the resulting fact `n ∈ set.Ico a b`.

You can specify a name `h` for the new hypothesis,
as `interval_cases h : n` or `interval_cases h : n using hl, hu`.
-/
syntax (name := intervalCases) "interval_cases" (ppSpace colGt atomic(binderIdent " : ")? term)?
  (" using " term ", " term)? : tactic

elab_rules : tactic
  | `(tactic| interval_cases $[$[$h :]? $e]? $[using $lb, $ub]?) => do
    let g ← getMainGoal
    let cont x h? subst g e lbs ubs mustUseBounds : TacticM Unit := do
      let goals ← IntervalCases.intervalCases g (.fvar x) e lbs ubs mustUseBounds
      let gs ← goals.mapM fun { goal, .. } => do
        let (fv, g) ← goal.intro1
        let (subst, g) ← substCore g fv (fvarSubst := subst)
        if let some hStx := h.getD none then
          if let some fv := h? then
            g.withContext <| (subst.get fv).addLocalVarInfoForBinderIdent hStx
        pure g
      replaceMainGoal gs.toList
    g.withContext do
    let hName? := (h.getD none).map fun
      | `(binderIdent| $n:ident) => n.getId
      | _ => `_
    match e, lb, ub with
    | e, some lb, some ub =>
      let e ← if let some e := e then Tactic.elabTerm e none else mkFreshExprMVar none
      let lb' ← Tactic.elabTerm lb none
      let ub' ← Tactic.elabTerm ub none
      let lbTy ← inferType lb'
      let ubTy ← inferType ub'
      try
        let (_, hi, _) ← parseBound lbTy
        let .true ← isDefEq e hi | failure
      catch _ => throwErrorAt lb "expected a term of the form _ < {e} or _ ≤ {e}, got {lbTy}"
      try
        let (lo, _) ← parseBound ubTy
        let .true ← isDefEq e lo | failure
      catch _ => throwErrorAt ub "expected a term of the form {e} < _ or {e} ≤ _, got {ubTy}"
      let (subst, xs, g) ← g.generalizeHyp #[{ expr := e, hName? }] (← getLCtx).getFVarIds
      g.withContext do
      cont xs[0]! xs[1]? subst g e #[subst.apply lb'] #[subst.apply ub'] (mustUseBounds := true)
    | some e, none, none =>
      let e ← Tactic.elabTerm e none
      let (subst, xs, g) ← g.generalizeHyp #[{ expr := e, hName? }] (← getLCtx).getFVarIds
      let x := xs[0]!
      g.withContext do
      let e := subst.apply e
      let mut lbs := #[]
      let mut ubs := #[]
      for ldecl in ← getLCtx do
        try
          let (lo, hi, _) ← parseBound ldecl.type
          if ← withNewMCtxDepth <| withReducible <| isDefEq (.fvar x) lo then
            ubs := ubs.push (.fvar ldecl.fvarId)
          else if ← withNewMCtxDepth <| withReducible <| isDefEq (.fvar x) hi then
            lbs := lbs.push (.fvar ldecl.fvarId)
          else failure
        catch _ => pure ()
      cont x xs[1]? subst g e lbs ubs (mustUseBounds := false)
    | _, _, _ => throwUnsupportedSyntax


import algebra

def finmap (α β : Type*) := α → option β

namespace finmap
variables (α β : Type*) [decidable_eq α]
def empty {α β} [decidable_eq α] : finmap α β := λ _, none
def extend {α β} [decidable_eq α] (m : finmap α β) (k : α) (v : β) := λ k', if k = k' then some v else m k'
notation `•` := empty
notation m `⟦` k `:` v `⟧` := extend m k v
#eval •⟦1:3⟧ 1
#check ([] : list ℕ)
#check []

def m1 : finmap ℕ ℕ := •⟦1:3⟧⟦2:4⟧
#eval m1 2

lemma sound {α β} [decidable_eq α] (m : finmap α β) (k : α) (v : β) : m⟦k:v⟧ k = some v :=
begin
simp only [extend], split_ifs, all_goals {refl},
end
lemma frame {α β} [decidable_eq α] (m : finmap α β) (k k' : α) (v : β) : k ≠ k' → m⟦k':v⟧ k = m k := λ h,
begin
simp only [extend], split_ifs with h2, exact false.rec _ (h h2.symm), refl,
end
end finmap

universes u v
inductive hlist : list (Type u) → Type (u+1)
| nil : hlist []
| cons {i} {is} : i → hlist is → hlist (i :: is)
infixr ` :: `:67 := hlist.cons --notation `[` `]` := HList.nil
inductive hmem : Type u → list (Type u) → Type (u+1)
| head {a} {as}   : hmem a (a :: as)
| tail {a b} {bs} : hmem a bs → hmem a (b::bs)

namespace hmem
variables {α : Type u} {γ : list (Type u)}
def lift_r : Π {γ γ' : list (Type u)}, hmem α γ' → hmem α (γ ++ γ')
| [] _ m := m
| (_ :: _) _ m := tail m.lift_r
def lift_l : Π {γ γ' : list (Type u)}, hmem α γ → hmem α (γ ++ γ')
| _ _ head := head
| _ _ (tail r) := tail r.lift_l
end hmem

namespace hlist
def get {i} : Π {is}, hlist is → hmem i is → i
| _ (cons a _) (hmem.head) := a
| _ (cons _ as) (hmem.tail h) := as.get h
def update {i} (v : i) : Π {is}, hlist is → hmem i is → hlist is
| _ (cons _ as) (hmem.head) := v :: as
| _ (cons a as) (hmem.tail h) := a :: (as.update h)

theorem get_update {i} (v : i) : Π {is} (s : hlist is) (m : hmem i is), (s.update v m).get m = v
| _ (cons _ _) (hmem.head) := rfl
| _ (cons _ as) (hmem.tail h) := get_update as h
-- todo: the frame rule (het eq?)
--theorem frame {i j} (v : i) : Π {is} (s : hlist is) (m : hmem i is) (n : hmem j is), m ≠ n → (s.update v m).get n = s.get n := sorry

def append : Π {γ γ' : list (Type u)}, hlist γ → hlist γ' → hlist (γ ++ γ')
| _ _ (hlist.nil) y := y
| _ _ (hlist.cons a as) y := hlist.cons a (as.append y)
local infixr ` ++ `:67 := hlist.append
theorem get_update_append_l {i} (v : i) : Π {γ γ' : list (Type u)} (s : hlist γ) (t : hlist γ') (m : hmem i γ),
((s ++ t).update v m.lift_l) = s.update v m ++ t
:= λ γ γ' s t m,
begin
  induction m,
  { cases s,
    refl, },
  { cases s,
    simp only [append, hmem.lift_l, update],
    split,
    refl,
    apply m_ih,
  }
end
theorem get_update_append_r {i} (v : i) : Π {γ γ' : list (Type u)} (s : hlist γ) (t : hlist γ') (m : hmem i γ'),
((s ++ t).update v m.lift_r) = s ++ t.update v m
:= λ γ γ' s t m,
begin
  induction s,
  { refl },
  { simp only [append, hmem.lift_r, update],
    split,
    refl,
    assumption, }
end
end hlist


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.algebra.hom

/-!
# Morphisms of non-unital algebras

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

This file defines morphisms between two types, each of which carries:
 * an addition,
 * an additive zero,
 * a multiplication,
 * a scalar action.

The multiplications are not assumed to be associative or unital, or even to be compatible with the
scalar actions. In a typical application, the operations will satisfy compatibility conditions
making them into algebras (albeit possibly non-associative and/or non-unital) but such conditions
are not required to make this definition.

This notion of morphism should be useful for any category of non-unital algebras. The motivating
application at the time it was introduced was to be able to state the adjunction property for
magma algebras. These are non-unital, non-associative algebras obtained by applying the
group-algebra construction except where we take a type carrying just `has_mul` instead of `group`.

For a plausible future application, one could take the non-unital algebra of compactly-supported
functions on a non-compact topological space. A proper map between a pair of such spaces
(contravariantly) induces a morphism between their algebras of compactly-supported functions which
will be a `non_unital_alg_hom`.

TODO: add `non_unital_alg_equiv` when needed.

## Main definitions

  * `non_unital_alg_hom`
  * `alg_hom.to_non_unital_alg_hom`

## Tags

non-unital, algebra, morphism
-/

universes u v w w₁ w₂ w₃

variables (R : Type u) (A : Type v) (B : Type w) (C : Type w₁)

set_option old_structure_cmd true

/-- A morphism respecting addition, multiplication, and scalar multiplication. When these arise from
algebra structures, this is the same as a not-necessarily-unital morphism of algebras. -/
structure non_unital_alg_hom [monoid R]
  [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
  [non_unital_non_assoc_semiring B] [distrib_mul_action R B]
  extends A →+[R] B, A →ₙ* B

infixr ` →ₙₐ `:25 := non_unital_alg_hom _
notation A ` →ₙₐ[`:25 R `] ` B := non_unital_alg_hom R A B

attribute [nolint doc_blame] non_unital_alg_hom.to_distrib_mul_action_hom
attribute [nolint doc_blame] non_unital_alg_hom.to_mul_hom

/-- `non_unital_alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms
from `A` to `B`.  -/
class non_unital_alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*)
  (B : out_param Type*) [monoid R]
  [non_unital_non_assoc_semiring A] [non_unital_non_assoc_semiring B]
  [distrib_mul_action R A] [distrib_mul_action R B]
  extends distrib_mul_action_hom_class F R A B, mul_hom_class F A B

-- `R` becomes a metavariable but that's fine because it's an `out_param`
attribute [nolint dangerous_instance] non_unital_alg_hom_class.to_mul_hom_class

namespace non_unital_alg_hom_class

-- `R` becomes a metavariable but that's fine because it's an `out_param`
@[priority 100, nolint dangerous_instance] -- See note [lower instance priority]
instance non_unital_alg_hom_class.to_non_unital_ring_hom_class {F R A B : Type*} [monoid R]
  [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
  [non_unital_non_assoc_semiring B] [distrib_mul_action R B]
  [non_unital_alg_hom_class F R A B] : non_unital_ring_hom_class F A B :=
{ coe := coe_fn, ..‹non_unital_alg_hom_class F R A B› }

variables [semiring R]
  [non_unital_non_assoc_semiring A] [module R A]
  [non_unital_non_assoc_semiring B] [module R B]

@[priority 100] -- see Note [lower instance priority]
instance {F : Type*} [non_unital_alg_hom_class F R A B] : linear_map_class F R A B :=
{ map_smulₛₗ := distrib_mul_action_hom_class.map_smul,
  ..‹non_unital_alg_hom_class F R A B› }

instance {F R A B : Type*} [monoid R]
  [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
  [non_unital_non_assoc_semiring B] [distrib_mul_action R B]
  [non_unital_alg_hom_class F R A B] : has_coe_t F (A →ₙₐ[R] B) :=
{ coe := λ f,
  { to_fun := f,
    map_smul' := map_smul f,
    .. (f : A →ₙ+* B) } }

end non_unital_alg_hom_class

namespace non_unital_alg_hom

variables {R A B C} [monoid R]
variables [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
variables [non_unital_non_assoc_semiring B] [distrib_mul_action R B]
variables [non_unital_non_assoc_semiring C] [distrib_mul_action R C]

/-- see Note [function coercion] -/
instance : has_coe_to_fun (A →ₙₐ[R] B) (λ _, A → B) := ⟨to_fun⟩

@[simp] lemma to_fun_eq_coe (f : A →ₙₐ[R] B) : f.to_fun = ⇑f := rfl

initialize_simps_projections non_unital_alg_hom (to_fun → apply)

@[simp, protected] lemma coe_coe {F : Type*} [non_unital_alg_hom_class F R A B] (f : F) :
  ⇑(f : A →ₙₐ[R] B) = f := rfl

lemma coe_injective :
  @function.injective (A →ₙₐ[R] B) (A → B) coe_fn :=
by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr

instance : non_unital_alg_hom_class (A →ₙₐ[R] B) R A B :=
{ coe := to_fun,
  coe_injective' := coe_injective,
  map_smul := λ f, f.map_smul',
  map_add := λ f, f.map_add',
  map_zero := λ f, f.map_zero',
  map_mul := λ f, f.map_mul' }

@[ext] lemma ext {f g : A →ₙₐ[R] B} (h : ∀ x, f x = g x) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : A →ₙₐ[R] B} : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

lemma congr_fun {f g : A →ₙₐ[R] B} (h : f = g) (x : A) : f x = g x := h ▸ rfl

@[simp] lemma coe_mk (f : A → B) (h₁ h₂ h₃ h₄) :
  ((⟨f, h₁, h₂, h₃, h₄⟩ : A →ₙₐ[R] B) : A → B) = f :=
rfl

@[simp] lemma mk_coe (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) :
  (⟨f, h₁, h₂, h₃, h₄⟩ : A →ₙₐ[R] B) = f :=
by { ext, refl, }

instance : has_coe (A →ₙₐ[R] B) (A →+[R] B) :=
⟨to_distrib_mul_action_hom⟩

instance : has_coe (A →ₙₐ[R] B) (A →ₙ* B) := ⟨to_mul_hom⟩

@[simp]

@[simp] lemma to_mul_hom_eq_coe (f : A →ₙₐ[R] B) : f.to_mul_hom = ↑f :=
rfl

@[simp, norm_cast] lemma coe_to_distrib_mul_action_hom (f : A →ₙₐ[R] B) :
  ((f : A →+[R] B) : A → B) = f :=
rfl

@[simp, norm_cast] lemma coe_to_mul_hom (f : A →ₙₐ[R] B) :
  ((f : A →ₙ* B) : A → B) = f :=
rfl

lemma to_distrib_mul_action_hom_injective {f g : A →ₙₐ[R] B}
  (h : (f : A →+[R] B) = (g : A →+[R] B)) : f = g :=
by { ext a, exact distrib_mul_action_hom.congr_fun h a, }

lemma to_mul_hom_injective {f g : A →ₙₐ[R] B}
  (h : (f : A →ₙ* B) = (g : A →ₙ* B)) : f = g :=
by { ext a, exact mul_hom.congr_fun h a, }

@[norm_cast] lemma coe_distrib_mul_action_hom_mk (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) :
  ((⟨f, h₁, h₂, h₃, h₄⟩ : A →ₙₐ[R] B) : A →+[R] B) =
  ⟨f, h₁, h₂, h₃⟩ :=
by { ext, refl, }

@[norm_cast] lemma coe_mul_hom_mk (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) :
  ((⟨f, h₁, h₂, h₃, h₄⟩ : A →ₙₐ[R] B) : A →ₙ* B) = ⟨f, h₄⟩ :=
by { ext, refl, }

@[simp] protected lemma map_smul (f : A →ₙₐ[R] B) (c : R) (x : A) :
  f (c • x) = c • f x := map_smul _ _ _

@[simp] protected lemma map_add (f : A →ₙₐ[R] B) (x y : A) :
  f (x + y) = (f x) + (f y) := map_add _ _ _

@[simp] protected lemma map_mul (f : A →ₙₐ[R] B) (x y : A) :
  f (x * y) = (f x) * (f y) := map_mul _ _ _

@[simp] protected lemma map_zero (f : A →ₙₐ[R] B) : f 0 = 0 := map_zero _

instance : has_zero (A →ₙₐ[R] B) :=
⟨{ map_mul' := by simp,
   .. (0 : A →+[R] B) }⟩

instance : has_one (A →ₙₐ[R] A) :=
⟨{ map_mul' := by simp,
   .. (1 : A →+[R] A) }⟩

@[simp] lemma coe_zero : ((0 : A →ₙₐ[R] B) : A → B) = 0 := rfl

@[simp] lemma coe_one : ((1 : A →ₙₐ[R] A) : A → A) = id := rfl

lemma zero_apply (a : A) : (0 : A →ₙₐ[R] B) a = 0 := rfl

lemma one_apply (a : A) : (1 : A →ₙₐ[R] A) a = a := rfl

instance : inhabited (A →ₙₐ[R] B) := ⟨0⟩

/-- The composition of morphisms is a morphism. -/
def comp (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) : A →ₙₐ[R] C :=
{ .. (f : B →ₙ* C).comp (g : A →ₙ* B),
  .. (f : B →+[R] C).comp (g : A →+[R] B) }

@[simp, norm_cast] lemma coe_comp (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) :
  (f.comp g : A → C) = (f : B → C) ∘ (g : A → B) :=
rfl

lemma comp_apply (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) (x : A) :
  f.comp g x = f (g x) :=
rfl

/-- The inverse of a bijective morphism is a morphism. -/
def inverse (f : A →ₙₐ[R] B) (g : B → A)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) :
  B →ₙₐ[R] A :=
{ .. (f : A →ₙ* B).inverse g h₁ h₂,
  .. (f : A →+[R] B).inverse g h₁ h₂ }

@[simp] lemma coe_inverse (f : A →ₙₐ[R] B) (g : B → A)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) :
  (inverse f g h₁ h₂ : B → A) = g :=
rfl

/-! ### Operations on the product type

Note that much of this is copied from [`linear_algebra/prod`](../../linear_algebra/prod). -/

section prod

variables (R A B)
/-- The first projection of a product is a non-unital alg_hom. -/
@[simps]
def fst : A × B →ₙₐ[R] A :=
{ to_fun := prod.fst,
  map_zero' := rfl, map_add' := λ x y, rfl, map_smul' := λ x y, rfl, map_mul' := λ x y, rfl }

/-- The second projection of a product is a non-unital alg_hom. -/
@[simps]
def snd : A × B →ₙₐ[R] B :=
{ to_fun := prod.snd,
  map_zero' := rfl, map_add' := λ x y, rfl, map_smul' := λ x y, rfl, map_mul' := λ x y, rfl }

variables {R A B}

/-- The prod of two morphisms is a morphism. -/
@[simps] def prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : (A →ₙₐ[R] B × C) :=
{ to_fun    := pi.prod f g,
  map_zero' := by simp only [pi.prod, prod.zero_eq_mk, map_zero],
  map_add'  := λ x y, by simp only [pi.prod, prod.mk_add_mk, map_add],
  map_mul'  := λ x y, by simp only [pi.prod, prod.mk_mul_mk, map_mul],
  map_smul' := λ c x, by simp only [pi.prod, prod.smul_mk, map_smul, ring_hom.id_apply] }

lemma coe_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl

@[simp] theorem fst_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) :
  (fst R B C).comp (prod f g) = f := by ext; refl

@[simp] theorem snd_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) :
  (snd R B C).comp (prod f g) = g := by ext; refl

@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
coe_injective pi.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains. -/
@[simps] def prod_equiv : ((A →ₙₐ[R] B) × (A →ₙₐ[R] C)) ≃ (A →ₙₐ[R] B × C) :=
{ to_fun := λ f, f.1.prod f.2,
  inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f),
  left_inv := λ f, by ext; refl,
  right_inv := λ f, by ext; refl }

variables (R A B)

/-- The left injection into a product is a non-unital algebra homomorphism. -/
def inl : A →ₙₐ[R] A × B := prod 1 0

/-- The right injection into a product is a non-unital algebra homomorphism. -/
def inr : B →ₙₐ[R] A × B := prod 0 1

variables {R A B}

@[simp] theorem coe_inl : (inl R A B : A → A × B) = λ x, (x, 0) := rfl
theorem inl_apply (x : A) : inl R A B x = (x, 0) := rfl

@[simp] theorem coe_inr : (inr R A B : B → A × B) = prod.mk 0 := rfl
theorem inr_apply (x : B) : inr R A B x = (0, x) := rfl

end prod

end non_unital_alg_hom

/-! ### Interaction with `alg_hom` -/

namespace alg_hom

variables {R A B} [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]

@[priority 100] -- see Note [lower instance priority]
instance {F : Type*} [alg_hom_class F R A B] : non_unital_alg_hom_class F R A B :=
{ map_smul := map_smul,
  ..‹alg_hom_class F R A B› }

/-- A unital morphism of algebras is a `non_unital_alg_hom`. -/
def to_non_unital_alg_hom (f : A →ₐ[R] B) : A →ₙₐ[R] B :=
{ map_smul' := map_smul f, .. f, }

instance non_unital_alg_hom.has_coe : has_coe (A →ₐ[R] B) (A →ₙₐ[R] B) :=
⟨to_non_unital_alg_hom⟩

@[simp] lemma to_non_unital_alg_hom_eq_coe (f : A →ₐ[R] B) : f.to_non_unital_alg_hom = f :=
rfl

@[simp, norm_cast] lemma coe_to_non_unital_alg_hom (f : A →ₐ[R] B) :
  ((f : A →ₙₐ[R] B) : A → B) = f :=
rfl

end alg_hom


import tactic

import data.setoid.partition

--#check setoid.partition.rel_iso

open setoid

variable (α : Type)

-- mathlib has this function already.
/-
def classes (r : setoid α) : set (set α) :=
{s | ∃ y, s = {x | r.rel x y}}
-/
--  set_option pp.notation false

example : {p : set (set α) // is_partition p} ≃
  setoid α :=
{ to_fun := λ pa, { r := λ (a b : α), ∀ X ∈ pa.1, a ∈ X → b ∈ X,
  iseqv :=
  begin
    cases pa with p hp,
    dsimp only at *,
    -- Need to check that the binary relation on α coming from
    -- a partition p is reflexive, symmetric and transitive
    -- note that p is just the set of sets; hp is the proof
    -- that it's a partition.
    split,
    { -- reflexive
      unfold reflexive,
      cc,
    },
    split,
    { -- symmetric
      -- this needs thought
      -- rintros a b hab X (hX : X ∈ p) hbX,
      -- obtain ⟨Y, ⟨hYp, haY, -⟩, hY2⟩ := hp.2 a, simp at hY2,
      -- have hY3 : ∀ (Z : set α), Z ∈ p → a ∈ Z → Z = Y,
      rintros b c hbc X (hX : X ∈ p) hcX,
      obtain ⟨Y, ⟨hYp, hcY, -⟩, hY2⟩ := hp.2 c, simp at hY2,
      have hpcY : ∀ (Z : set α), Z ∈ p → c ∈ Z → Z = Y,
        simpa using hY2, clear hY2,
      --specialize hab {x | r.rel x y}
      have hXY := hpcY X hX hcX,
      obtain ⟨Z, ⟨hZp, hbZ, -⟩, hZ2⟩ := hp.2 b, simp at hZ2,
      have hcZ := hbc Z hZp hbZ,
      have hZY := hpcY Z hZp hcZ,
      rw [hXY, ← hZY], exact hbZ },
    { -- transitive
      intros b c d hbc hcd X hXp hbX,
      apply hcd, exact hXp,
      apply hbc;
      assumption,
    }
  end },
  inv_fun := λ r, ⟨classes r,
  begin
    haveI : has_equiv α := ⟨r.rel⟩,
    split,
    { -- empty set isn't an equiv class
      -- proof by contradiction
      intro h,
      cases h with a ha,
      suffices : a ∈ (∅ : set α),
        cases this,
      rw ha,
      simp only [set.mem_set_of_eq],
    },
    { intro a,
      use {x : α | r.rel x a},
      dsimp only,
      split,
      { suffices : {x : α | r.rel x a} ∈ r.classes ∧ r.rel a a,
          simpa,
        split,
          use a,
          refl },
      { intro X,
        rintro ⟨⟨c, rfl⟩, haX, -⟩,
        ext b,
        resetI,
        -- TODO must fix this notation
        change setoid.r b c ↔ r.rel b a,
        change r.rel a c at haX,
        split,
          intro hbc,
          apply r.iseqv.2.2, -- these suck
            exact hbc,
            apply r.iseqv.2.1,
            exact haX,
          -- need a ~ b <-> b ~ a
          intro hba,
          apply r.iseqv.2.2,exact hba, exact haX,
      }
    }
  end⟩,
  left_inv := begin
    rintro ⟨p, hp⟩,
    simp only,
    ext X,
    split,
    { rintro ⟨b, rfl⟩,
      obtain ⟨Y, ⟨hYp, hbY, -⟩, hY2⟩ := hp.2 b,
      have hpb : ∀ (y : set α), y ∈ p → b ∈ y → y = Y,
        simpa using hY2, clear hY2,
      convert hYp,
      ext c,
      obtain ⟨Z, ⟨hZp, hcZ, -⟩, hY2⟩ := hp.2 c,
      have hpc : ∀ (y : set α), y ∈ p → c ∈ y → y = Z,
        simpa using hY2, clear hY2,
      show (∀ X : set α, X ∈ p → c ∈ X → b ∈ X) ↔ _,
      split,
      { intro hpcb,
        specialize hpcb Z hZp hcZ,
        specialize hpb Z hZp hpcb,
        rw ← hpb,
        exact hcZ,
      },
      { intro hcY,
        intros X hXp hcX,
        have hXZ := hpc X hXp hcX,
        have hYZ := hpc Y hYp hcY,
        convert hbY,
        cc } },
    { intro hXp,
      have hX : X.nonempty,
        have h := hp.1,
        rw ← set.ne_empty_iff_nonempty,
        rintro rfl, contradiction,
      cases hX with b hbX,
      use b,
      ext c,
      simp,
      show c ∈ X ↔ (∀ X : set α, X ∈ p → c ∈ X → b ∈ X),
      split,
      { intros hcX Y hYp hcY,
        convert hbX,
        obtain ⟨Z, ⟨hZp, hcZ, -⟩, hY2⟩ := hp.2 c,
        have hpc : ∀ (y : set α), y ∈ p → c ∈ y → y = Z,
          simpa using hY2, clear hY2,
        have hYZ := hpc Y hYp hcY,
        have hXZ := hpc X hXp hcX,
        cc },
      { intros hcb,
        obtain ⟨Z, ⟨hZp, hcZ, -⟩, hY2⟩ := hp.2 c,
        have hpc : ∀ (y : set α), y ∈ p → c ∈ y → y = Z,
          simpa using hY2, clear hY2,
        obtain ⟨Y, ⟨hYp, hbY, -⟩, hY2⟩ := hp.2 b,
        have hpb : ∀ (y : set α), y ∈ p → b ∈ y → y = Y,
          simpa using hY2, clear hY2,
        have hZY := hpb Z hZp (hcb Z hZp hcZ),
        have hXY := hpb X hXp hbX,
        cc } }
  end,
  right_inv := begin
    rintro ⟨r, hrr, hrs, hrt⟩,
    ext s,
    simp only [setoid.rel],
    split,
    { intro h,
      specialize h {x : α | r x s} (by use s; refl) (by apply hrr),
      apply hrs,
      exact h },
    { intros hrsb X,
      rintros ⟨c, rfl⟩ h,
      simp [setoid.rel] at h ⊢,
      apply hrt, apply hrs, exact hrsb,
      exact h,
    }
  end }


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import tactic -- importa todas las tácticas de Lean

/-!

# Tácticas
En este fichero describimos el funcionamiento de las siguientes tácticas de Lean y proporcionamos
ejemplos de uso de las mismas.
* `sorry`
* `intro`
* `exact`
* `apply`
* `triv`
* `exfalso`
* `change`
* `by_contra`
* `cases`
* `split`
* `refl`
* `rw`
* `have`
* `left`
* `right`
* `by_cases`

CONSEJO: Aprovecha la interactividad de Lean. Dentro de una demostración delimitada por `begin` y
`end`, pulsando al final de cada línea podemos ver en la ventana derecha el estado actual de la
demostración.
-/

/- # Tácticas -/

--  `P`, `Q` y `R` denotan proposiciones.
variables (P Q R : Prop)

/- ## sorry
  `sorry` se puede utilizar para cerrar cualquier meta. Genera un aviso de que dicha meta no ha
  sido cerrada, que aparece en la sección "All Messages" del "Lean infoview". El número total de
  warnings aparece en la parte inferior de la pantalla.
-/

example (P NP : Prop) : P = NP :=
begin
  sorry
end

/- ## exact

Si queremos demostrar una meta `P` y tenemos disponible la hipótesis `hP : P`, podemos cerrar la
meta utilizando la táctica `exact hP`

NOTA: `exact P` no funciona en esta situación (no debemos confundir la proposición `P` con su
demostración `hP`).  -/

example (hP : P) (hQ : Q) : P :=
begin
  exact hP,
end

/-  ## intro

Dada la meta `P → Q`, la táctica `intro hP` introduce una hipótesis local `hP : P` y cambia la meta
a `Q`.

VARIANTE: `intros` puede utilizarse para introducir varias hipótesis en una misma línea. -/

example (hQ : Q) : P → Q :=
begin
  intro hP,
  exact hQ,
end

example : Q → P → Q :=
begin
  intros hQ hP,
  exact hQ,
end

/- ## apply

La táctica `apply` se utiliza para razonar hacia atrás. Por ejemplo, si el estado táctico es

hPQ : P → Q
⊢ Q,

tras utilizar `apply hPQ` el estado cambiará a

hPQ : P → Q
⊢ P.

Es decir, la demostración de `Q` se reduce a demostrar `P` y las hipótesis activas no se modifican.

En general, `apply h` intenta unificar la meta actual con la conclusión del término `h`. Si tiene
éxito, la meta es reemplazada por una o varias metas (tantas como premisas tenga `h`).
 -/

example (h : P → Q) (hP : P) : Q :=
begin
  apply h,
  exact hP,
end

-- En este ejemplo, `apply` genera dos submetas
example (hP : P) (hQ : Q) (h : P → Q → Q)  : Q :=
begin
  apply h,
  /- RECOMENDACIÓN DE ESTILO: cuando la aplicación de una táctica introduce nuevas submetas, es
    recomendable englobar la demostración de cada una entre llaves `{ }`. -/
  { exact hP },
  { exact hQ }
end

/- ## triv
La táctica `triv` demuestra `⊢ true`.
-/

example : true :=
begin
  triv,
end

/- ## exfalso
La táctica `exfalso` cambia cualquier meta a `false`.
-/

example (hP : P) (h : P → false) : Q :=
begin
  exfalso,
  apply h,
  exact hP
end

/- ## change
La táctica `change` permite reemplazar una meta `⊢ P` por otra `⊢ Q`, siempre que `P` y `Q` sean
definicionalmente iguales. También puede utilizarse en hipótesis: `change Q at h` reemplaza `h : P`
por `h : Q`.
-/

example (hPQ : ¬ P ↔ Q) (hQ : Q) : P → false :=
begin
  change ¬ P,  -- ¬ P está definido como P → false.
  rw hPQ,
  exact hQ,
end

example (hP : P) (hnP : ¬ P) : false :=
begin
  change P → false at hnP, -- ¬ P está definido como P → false.
  exact hnP hP,
end

/- ## by_contra
La táctica `by_contra` permite realizar demostraciones por reducción al absurdo. Si la meta es
```
⊢ P
```

entonces la instrucción `by_contra h,`cambiará el "Tactic state" a

```
h : ¬P
⊢ false
```

-/

/- ## cases

`cases` es una táctica de propósito general para deconstruir hipótesis. Aquí presentamos dos de los
casos de uso más básicos; veremos otros a medida que avance el curso.

### Ejemplos

1) Si tenemos como hipótesis una conjunción `hPaQ : P ∧ Q`, la instrucción `cases hPaQ with hP hQ,`
eliminará `hPaQ` y la reemplazará por las dos hipótesis
```
hP : P
hQ : Q
```

2) Dada la hipótesis `hPiQ : P ↔ Q`, `cases hPiQ with hPQ hQP,`
reemplazará `hPiQ` por las dos hipótesis.
```
hPQ : P → Q
hQP : Q → P
```

Por otro lado, como veremos más abajo también podemos utilizar la táctica `rw h` con hipótesis
de la forma `h : P ↔ Q`, y habrá que valorar cuál de las dos tácticas es más útil en cada
situación.

-/

/- ## split

Si la meta actual es una conjunción `⊢ P ∧ Q`, podemos utilizar la táctica `split` para dividirla
en las dos metas `⊢ P` y `⊢ Q`.

Tras usar `split`, la recomendación de estilo es utilizar llaves `{ }` para delimitar la
demostración de cada una de las nuevas metas.

```
split,
{ demostración de P },
{ demostración de Q },
```

Similarmente, `split,` transforma la meta `⊢ P ↔ Q` en dos metas `⊢ P → Q` y `⊢ Q → P`.

-/

/- ## refl
La táctica `refl` cierra metas de la forma `⊢ P = Q` donde `P` y `Q` son iguales por definición.
También demuestra metas de la forma `R x y`, donde `x` e `y` son definicionalmente iguales y `R` es
una relación binaria reflexiva . -/

example : ¬ P ↔ P → false :=
begin
  refl,
end

/- ## rw

Dada una hipótesis `h : P = Q`, podemos utilizar `rw h` para sustituir todas las apariciones de `P`
por `Q` en la meta. La táctica también puede utilizarse cuando `h` es una equivalencia lógica en
lugar de una igualdad. El argumento `h` puede ser tanto una hipótesis local como un teorema.

NOTAS:

1) Si queremos utilizar `h : P = Q` para sustituir `Q` por `P`, la sintáxis es `rw ← h`. Esta flecha
a la izquierda se puede obtener escribiendo `\l`.

2) `rw` sólo funciona con hipótesis de la forma `a = b` o `P ↔ Q`, pero no con implicaciones `P → Q`.
(en dicho caso, utilizaríamos la táctica `apply`).

3) `rw` se puede utilizar en hipótesis, utilizando la palabra clave `at`.

AVISO: Antes de terminar, `rw` invoca la táctica `refl`.
-/

example (a b : ℕ) (hab : a = b) (hb : b + 1 = 3) : a + 1 = 3 :=
begin
  rw hab,
  exact hb
end

example (h1 : P ↔ Q) (h2 : Q → R) : P → R :=
begin
  rw h1,
  exact h2,
end

example (hQ : ¬ Q) : ¬(P ∧ Q)  :=
begin
  -- `not_and` es una demostración de la equivalencia `¬(P ∧ Q) ↔ (P → ¬Q)`.
  rw not_and,
  intro hP,
  exact hQ,
end

example (hP : ¬P) (hPQ : P = Q) : ¬ Q :=
begin
  rw ← hPQ,
  exact hP,
end

example (h1 : P ↔ Q) (h2 : P → R) : Q → R :=
begin
  rw h1 at h2,
  exact h2,
end

/- ## have

La táctica `have` se utiliza para introducir una nueva hipótesis dentro del estado táctico (que
tendremos que demostrar a partir de las hipótesis existentes).

Para utilizarla, escribimos:
  have h : t,
  { p },
donde `h` es el nombre que queremos dar a la hipótesis, `t` es la hipótesis a demostrar y `p`
una demostración de la misma. -/

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  intros hPQ hnQ hP,
  have hQ : Q,     -- introducimos la hipótesis, que aparece como meta en el estado táctico
  {exact hPQ hP }, -- demostramos la hipótesis
  exact hnQ hQ,    -- la utilizamos para cerrar la meta principal
end

/- ## left

La táctica `left` convierte la meta `⊢ P ∨ Q` en `⊢ P`. -/

example (hP : P) : P ∨ Q :=
begin
  left,
  exact hP,
end

/- ## right

La táctica `right` convierte la meta `⊢ P ∨ Q` en `⊢ Q`. -/

example (hQ : Q) : P ∨ Q :=
begin
  right,
  exact hQ,
end

/-

## by_cases

Dada una proposición `P`, la táctica `by_cases h : P` divide la demostración de la meta en dos
casos: uno asumiento `h : P` y otro asumiendo `h : ¬P`.
-/

example : P ∨ ¬ P :=
begin
by_cases hP : P,
{ left, exact hP },
{ right, exact hP },
end


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

! This file was ported from Lean 3 source module topology.instances.nnreal
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.InfiniteSum.Order
import Mathlib.Topology.Algebra.InfiniteSum.Ring
import Mathlib.Topology.Instances.Real

/-!
# Topology on `ℝ≥0`

The natural topology on `ℝ≥0` (the one induced from `ℝ`), and a basic API.

## Main definitions

Instances for the following typeclasses are defined:

* `TopologicalSpace ℝ≥0`
* `TopologicalSemiring ℝ≥0`
* `TopologicalSpace.SecondCountableTopology ℝ≥0`
* `OrderTopology ℝ≥0`
* `ContinuousSub ℝ≥0`
* `HasContinuousInv₀ ℝ≥0` (continuity of `x⁻¹` away from `0`)
* `ContinuousSMul ℝ≥0 α` (whenever `α` has a continuous `MulAction ℝ α`)

Everything is inherited from the corresponding structures on the reals.

## Main statements

Various mathematically trivial lemmas are proved about the compatibility
of limits and sums in `ℝ≥0` and `ℝ`. For example

* `tendsto_coe {f : Filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
  Filter.Tendsto (fun a, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ Filter.Tendsto m f (𝓝 x)`

says that the limit of a filter along a map to `ℝ≥0` is the same in `ℝ` and `ℝ≥0`, and

* `coe_tsum {f : α → ℝ≥0} : ((∑'a, f a) : ℝ) = (∑'a, (f a : ℝ))`

says that says that a sum of elements in `ℝ≥0` is the same in `ℝ` and `ℝ≥0`.

Similarly, some mathematically trivial lemmas about infinite sums are proved,
a few of which rely on the fact that subtraction is continuous.

-/

noncomputable section

open Set TopologicalSpace Metric Filter

open Topology

namespace NNReal

open NNReal BigOperators Filter

instance : TopologicalSpace ℝ≥0 := inferInstance

-- short-circuit type class inference
instance : TopologicalSemiring ℝ≥0 where
  toContinuousAdd := continuousAdd_induced toRealHom
  toContinuousMul := continuousMul_induced toRealHom

instance : SecondCountableTopology ℝ≥0 :=
  inferInstanceAs (SecondCountableTopology { x : ℝ | 0 ≤ x })

instance : OrderTopology ℝ≥0 :=
  orderTopology_of_ordConnected (t := Ici 0)

section coe

variable {α : Type _}

open Filter Finset

theorem _root_.continuous_real_toNNReal : Continuous Real.toNNReal :=
  (continuous_id.max continuous_const).subtype_mk _
#align continuous_real_to_nnreal continuous_real_toNNReal

theorem continuous_coe : Continuous ((↑) : ℝ≥0 → ℝ) :=
  continuous_subtype_val
#align nnreal.continuous_coe NNReal.continuous_coe

/-- Embedding of `ℝ≥0` to `ℝ` as a bundled continuous map. -/
@[simps (config := { fullyApplied := false })]
def _root_.ContinuousMap.coeNNRealReal : C(ℝ≥0, ℝ) :=
  ⟨(↑), continuous_coe⟩
#align continuous_map.coe_nnreal_real ContinuousMap.coeNNRealReal
#align continuous_map.coe_nnreal_real_apply ContinuousMap.coeNNRealReal_apply

instance ContinuousMap.canLift {X : Type _} [TopologicalSpace X] :
    CanLift C(X, ℝ) C(X, ℝ≥0) ContinuousMap.coeNNRealReal.comp fun f => ∀ x, 0 ≤ f x where
  prf f hf := ⟨⟨fun x => ⟨f x, hf x⟩, f.2.subtype_mk _⟩, FunLike.ext' rfl⟩
#align nnreal.continuous_map.can_lift NNReal.ContinuousMap.canLift

@[simp, norm_cast]
theorem tendsto_coe {f : Filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
    Tendsto (fun a => (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ Tendsto m f (𝓝 x) :=
  tendsto_subtype_rng.symm
#align nnreal.tendsto_coe NNReal.tendsto_coe

theorem tendsto_coe' {f : Filter α} [NeBot f] {m : α → ℝ≥0} {x : ℝ} :
    Tendsto (fun a => m a : α → ℝ) f (𝓝 x) ↔ ∃ hx : 0 ≤ x, Tendsto m f (𝓝 ⟨x, hx⟩) :=
  ⟨fun h => ⟨ge_of_tendsto' h fun c => (m c).2, tendsto_coe.1 h⟩, fun ⟨_, hm⟩ => tendsto_coe.2 hm⟩
#align nnreal.tendsto_coe' NNReal.tendsto_coe'

@[simp] theorem map_coe_atTop : map toReal atTop = atTop := map_val_Ici_atTop 0
#align nnreal.map_coe_at_top NNReal.map_coe_atTop

theorem comap_coe_atTop : comap toReal atTop = atTop := (atTop_Ici_eq 0).symm
#align nnreal.comap_coe_at_top NNReal.comap_coe_atTop

@[simp, norm_cast]
theorem tendsto_coe_atTop {f : Filter α} {m : α → ℝ≥0} :
    Tendsto (fun a => (m a : ℝ)) f atTop ↔ Tendsto m f atTop :=
  tendsto_Ici_atTop.symm
#align nnreal.tendsto_coe_at_top NNReal.tendsto_coe_atTop

theorem _root_.tendsto_real_toNNReal {f : Filter α} {m : α → ℝ} {x : ℝ} (h : Tendsto m f (𝓝 x)) :
    Tendsto (fun a => Real.toNNReal (m a)) f (𝓝 (Real.toNNReal x)) :=
  (continuous_real_toNNReal.tendsto _).comp h
#align tendsto_real_to_nnreal tendsto_real_toNNReal

theorem _root_.tendsto_real_toNNReal_atTop : Tendsto Real.toNNReal atTop atTop := by
  rw [← tendsto_coe_atTop]
  exact tendsto_atTop_mono Real.le_coe_toNNReal tendsto_id
#align tendsto_real_to_nnreal_at_top tendsto_real_toNNReal_atTop

theorem nhds_zero : 𝓝 (0 : ℝ≥0) = ⨅ (a : ℝ≥0) (_h : a ≠ 0), 𝓟 (Iio a) :=
  nhds_bot_order.trans <| by simp only [bot_lt_iff_ne_bot]; rfl
#align nnreal.nhds_zero NNReal.nhds_zero

theorem nhds_zero_basis : (𝓝 (0 : ℝ≥0)).HasBasis (fun a : ℝ≥0 => 0 < a) fun a => Iio a :=
  nhds_bot_basis
#align nnreal.nhds_zero_basis NNReal.nhds_zero_basis

instance : ContinuousSub ℝ≥0 :=
  ⟨((continuous_coe.fst'.sub continuous_coe.snd').max continuous_const).subtype_mk _⟩

instance : HasContinuousInv₀ ℝ≥0 := inferInstance

instance [TopologicalSpace α] [MulAction ℝ α] [ContinuousSMul ℝ α] :
    ContinuousSMul ℝ≥0 α where
  continuous_smul := continuous_induced_dom.fst'.smul continuous_snd

@[norm_cast]
theorem hasSum_coe {f : α → ℝ≥0} {r : ℝ≥0} : HasSum (fun a => (f a : ℝ)) (r : ℝ) ↔ HasSum f r := by
  simp only [HasSum, ← coe_sum, tendsto_coe]
#align nnreal.has_sum_coe NNReal.hasSum_coe

protected theorem _root_.HasSum.toNNReal {f : α → ℝ} {y : ℝ} (hf₀ : ∀ n, 0 ≤ f n)
    (hy : HasSum f y) : HasSum (fun x => Real.toNNReal (f x)) y.toNNReal := by
  lift y to ℝ≥0 using hy.nonneg hf₀
  lift f to α → ℝ≥0 using hf₀
  simpa [hasSum_coe] using hy

theorem hasSum_real_toNNReal_of_nonneg {f : α → ℝ} (hf_nonneg : ∀ n, 0 ≤ f n) (hf : Summable f) :
    HasSum (fun n => Real.toNNReal (f n)) (Real.toNNReal (∑' n, f n)) :=
  hf.hasSum.toNNReal hf_nonneg
#align nnreal.has_sum_real_to_nnreal_of_nonneg NNReal.hasSum_real_toNNReal_of_nonneg

@[norm_cast]
theorem summable_coe {f : α → ℝ≥0} : (Summable fun a => (f a : ℝ)) ↔ Summable f := by
  constructor
  exact fun ⟨a, ha⟩ => ⟨⟨a, ha.nonneg fun x => (f x).2⟩, hasSum_coe.1 ha⟩
  exact fun ⟨a, ha⟩ => ⟨a.1, hasSum_coe.2 ha⟩
#align nnreal.summable_coe NNReal.summable_coe

theorem summable_mk {f : α → ℝ} (hf : ∀ n, 0 ≤ f n) :
    (@Summable ℝ≥0 _ _ _ fun n => ⟨f n, hf n⟩) ↔ Summable f :=
  Iff.symm <| summable_coe (f := fun x => ⟨f x, hf x⟩)
#align nnreal.summable_coe_of_nonneg NNReal.summable_mk

open Classical

@[norm_cast]
theorem coe_tsum {f : α → ℝ≥0} : ↑(∑' a, f a) = ∑' a, (f a : ℝ) :=
  if hf : Summable f then Eq.symm <| (hasSum_coe.2 <| hf.hasSum).tsum_eq
  else by simp [tsum_def, hf, mt summable_coe.1 hf]
#align nnreal.coe_tsum NNReal.coe_tsum

theorem coe_tsum_of_nonneg {f : α → ℝ} (hf₁ : ∀ n, 0 ≤ f n) :
    (⟨∑' n, f n, tsum_nonneg hf₁⟩ : ℝ≥0) = (∑' n, ⟨f n, hf₁ n⟩ : ℝ≥0) :=
  NNReal.eq <| Eq.symm <| coe_tsum (f := fun x => ⟨f x, hf₁ x⟩)
#align nnreal.coe_tsum_of_nonneg NNReal.coe_tsum_of_nonneg

nonrec theorem tsum_mul_left (a : ℝ≥0) (f : α → ℝ≥0) : (∑' x, a * f x) = a * ∑' x, f x :=
  NNReal.eq <| by simp only [coe_tsum, NNReal.coe_mul, tsum_mul_left]
#align nnreal.tsum_mul_left NNReal.tsum_mul_left

nonrec theorem tsum_mul_right (f : α → ℝ≥0) (a : ℝ≥0) : (∑' x, f x * a) = (∑' x, f x) * a :=
  NNReal.eq <| by simp only [coe_tsum, NNReal.coe_mul, tsum_mul_right]
#align nnreal.tsum_mul_right NNReal.tsum_mul_right

theorem summable_comp_injective {β : Type _} {f : α → ℝ≥0} (hf : Summable f) {i : β → α}
    (hi : Function.Injective i) : Summable (f ∘ i) := by
  rw [← summable_coe] at hf ⊢
  exact hf.comp_injective hi
#align nnreal.summable_comp_injective NNReal.summable_comp_injective

theorem summable_nat_add (f : ℕ → ℝ≥0) (hf : Summable f) (k : ℕ) : Summable fun i => f (i + k) :=
  summable_comp_injective hf <| add_left_injective k
#align nnreal.summable_nat_add NNReal.summable_nat_add

nonrec theorem summable_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) :
    (Summable fun i => f (i + k)) ↔ Summable f := by
  rw [← summable_coe, ← summable_coe]
  exact @summable_nat_add_iff ℝ _ _ _ (fun i => (f i : ℝ)) k
#align nnreal.summable_nat_add_iff NNReal.summable_nat_add_iff

nonrec theorem hasSum_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) {a : ℝ≥0} :
    HasSum (fun n => f (n + k)) a ↔ HasSum f (a + ∑ i in range k, f i) := by
  rw [← hasSum_coe, hasSum_nat_add_iff (f := fun n => toReal (f n)) k]; norm_cast
#align nnreal.has_sum_nat_add_iff NNReal.hasSum_nat_add_iff

theorem sum_add_tsum_nat_add {f : ℕ → ℝ≥0} (k : ℕ) (hf : Summable f) :
    (∑' i, f i) = (∑ i in range k, f i) + ∑' i, f (i + k) :=
  (sum_add_tsum_nat_add' <| (summable_nat_add_iff k).2 hf).symm
#align nnreal.sum_add_tsum_nat_add NNReal.sum_add_tsum_nat_add

theorem infᵢ_real_pos_eq_infᵢ_nnreal_pos [CompleteLattice α] {f : ℝ → α} :
    (⨅ (n : ℝ) (_h : 0 < n), f n) = ⨅ (n : ℝ≥0) (_h : 0 < n), f n :=
  le_antisymm (infᵢ_mono' fun r => ⟨r, le_rfl⟩) (infᵢ₂_mono' fun r hr => ⟨⟨r, hr.le⟩, hr, le_rfl⟩)
#align nnreal.infi_real_pos_eq_infi_nnreal_pos NNReal.infᵢ_real_pos_eq_infᵢ_nnreal_pos

end coe

theorem tendsto_cofinite_zero_of_summable {α} {f : α → ℝ≥0} (hf : Summable f) :
    Tendsto f cofinite (𝓝 0) := by
  simp only [← summable_coe, ← tendsto_coe] at hf ⊢
  exact hf.tendsto_cofinite_zero
#align nnreal.tendsto_cofinite_zero_of_summable NNReal.tendsto_cofinite_zero_of_summable

theorem tendsto_atTop_zero_of_summable {f : ℕ → ℝ≥0} (hf : Summable f) : Tendsto f atTop (𝓝 0) := by
  rw [← Nat.cofinite_eq_atTop]
  exact tendsto_cofinite_zero_of_summable hf
#align nnreal.tendsto_at_top_zero_of_summable NNReal.tendsto_atTop_zero_of_summable

/-- The sum over the complement of a finset tends to `0` when the finset grows to cover the whole
space. This does not need a summability assumption, as otherwise all sums are zero. -/
nonrec theorem tendsto_tsum_compl_atTop_zero {α : Type _} (f : α → ℝ≥0) :
    Tendsto (fun s : Finset α => ∑' b : { x // x ∉ s }, f b) atTop (𝓝 0) := by
  simp_rw [← tendsto_coe, coe_tsum, NNReal.coe_zero]
  exact tendsto_tsum_compl_atTop_zero fun a : α => (f a : ℝ)
#align nnreal.tendsto_tsum_compl_at_top_zero NNReal.tendsto_tsum_compl_atTop_zero

/-- `x ↦ x ^ n` as an order isomorphism of `ℝ≥0`. -/
def powOrderIso (n : ℕ) (hn : n ≠ 0) : ℝ≥0 ≃o ℝ≥0 :=
  StrictMono.orderIsoOfSurjective (fun x ↦ x ^ n) (fun x y h =>
      strictMonoOn_pow hn.bot_lt (zero_le x) (zero_le y) h) <|
    (continuous_id.pow _).surjective (tendsto_pow_atTop hn) <| by
      simpa [OrderBot.atBot_eq, pos_iff_ne_zero]
#align nnreal.pow_order_iso NNReal.powOrderIso

end NNReal


/-= Chapter 9: Structures and records =-/

/- Declaring structures -/
namespace declaring_structures

structure Point (α : Type u) where
  mk :: (x : α) (y : α)

#check Point
#check @Point.rec
#check @Point.mk
#check @Point.x
#check @Point.y

namespace alternate_form

structure Point (α : Type u) where
  rect ::
  x : α
  y : α

example : Point Nat := Point.rect 3 4

end alternate_form

namespace default_constructor

structure Point (α : Type u) where
  x : α
  y : α

example : Point Nat := Point.mk 3 4

end default_constructor

#eval Point.x (Point.mk 10 20)
#eval Point.y (Point.mk 10 20)

open Point

example (a b : α) : x (mk a b) = a := rfl
example (a b : α) : y (mk a b) = b := rfl

def p := Point.mk 10 20

#check p.x
#eval p.x
#eval p.y

namespace dot_notation

structure Point (α : Type u) where
  rect ::
  x : α
  y : α
deriving Repr

def Point.add (p q : Point Nat) :=
  Point.rect (p.x + q.x) (p.y + q.y)

def p : Point Nat := Point.rect 1 2
def q : Point Nat := Point.rect 3 4

#eval p.add q

def Point.smul (n : Nat) (p : Point Nat) :=
  Point.rect (n * p.x) (n * p.y)

#eval p.smul 3

#check @List.map

def xs : List Nat := [1, 2, 3]
def f : Nat → Nat := λ x => x * x

#eval xs.map f

end dot_notation

end declaring_structures

/- Objects -/
namespace objects

namespace basic_point

structure Point (α : Type u) where
  x : α
  y : α

#check { x := 10, y := 20 : Point Nat }
#check { y := 20, x := 10 : Point _ }
#check ({ x := 10, y := 20 } : Point Nat )

example : Point Nat := { y := 20, x := 10 }

end basic_point

namespace field_inference

structure MyStruct where
  {α : Type u}
  {β : Type v}
  a : α
  b : β

#check { a := 10, b := true : MyStruct }

end field_inference

namespace record_update

structure Point (α : Type u) where
  x : α
  y : α
deriving Repr

def p : Point Nat := { x := 1, y := 2 }

#eval { p with y := 3 }
#eval { p with x := 4 }

structure Point3 (α : Type u) where
  x : α
  y : α
  z : α

def q : Point3 Nat := { x := 5, y := 5, z := 5 }
def r : Point3 Nat := { p, q with x := 6 }

example : r.x = 6 := rfl
example : r.y = 2 := rfl
example : r.z = 5 := rfl

end record_update

end objects

/- Inheritance -/
namespace inheritance

namespace simple

structure Point (α : Type u) where
  x : α
  y : α

inductive Color where
| red | green | blue

structure ColorPoint (α : Type u) extends Point α where
  c : Color

end simple

namespace multiple

structure Point (α : Type u) where
  x : α
  y : α
  z : α

structure RgbValue where
  red : Nat
  green : Nat
  blue : Nat

structure RedGreenPoint (α : Type u) extends Point α, RgbValue where
  no_blue : blue = 0

def p : Point Nat := { x := 10, y := 10, z := 20 }

def rgp : RedGreenPoint Nat :=
  { p with red := 200, green := 40, blue := 0,  no_blue := rfl }

example : rgp.x = 10 := rfl
example : rgp.red = 200 := rfl

end multiple

end inheritance