/-
Copyright (c) 2022 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

import topology.algebra.module.weak_dual
import algebra.algebra.spectrum

/-!
# Character space of a topological algebra

The character space of a topological algebra is the subset of elements of the weak dual that
are also algebra homomorphisms. This space is used in the Gelfand transform, which gives an
isomorphism between a commutative C⋆-algebra and continuous functions on the character space
of the algebra. This, in turn, is used to construct the continuous functional calculus on
C⋆-algebras.

## Implementation notes

We define `character_space 𝕜 A` as a subset of the weak dual, which automatically puts the
correct topology on the space. We then define `to_alg_hom` which provides the algebra homomorphism
corresponding to any element. We also provide `to_clm` which provides the element as a
continuous linear map. (Even though `weak_dual 𝕜 A` is a type copy of `A →L[𝕜] 𝕜`, this is
often more convenient.)

## Tags

character space, Gelfand transform, functional calculus

-/

namespace weak_dual

/-- The character space of a topological algebra is the subset of elements of the weak dual that
are also algebra homomorphisms. -/
def character_space (𝕜 : Type*) (A : Type*) [comm_semiring 𝕜] [topological_space 𝕜]
  [has_continuous_add 𝕜] [has_continuous_const_smul 𝕜 𝕜]
  [non_unital_non_assoc_semiring A] [topological_space A] [module 𝕜 A] :=
  {φ : weak_dual 𝕜 A | (φ ≠ 0) ∧ (∀ (x y : A), φ (x * y) = (φ x) * (φ y))}

variables {𝕜 : Type*} {A : Type*}

namespace character_space

section non_unital_non_assoc_semiring

variables [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [non_unital_non_assoc_semiring A] [topological_space A]
  [module 𝕜 A]

lemma coe_apply (φ : character_space 𝕜 A) (x : A) : (φ : weak_dual 𝕜 A) x = φ x := rfl

/-- An element of the character space, as a continuous linear map. -/
def to_clm (φ : character_space 𝕜 A) : A →L[𝕜] 𝕜 := (φ : weak_dual 𝕜 A)

lemma to_clm_apply (φ : character_space 𝕜 A) (x : A) : φ x = to_clm φ x := rfl

/-- An element of the character space, as an non-unital algebra homomorphism. -/
@[simps] def to_non_unital_alg_hom (φ : character_space 𝕜 A) : A →ₙₐ[𝕜] 𝕜 :=
{ to_fun := (φ : A → 𝕜),
  map_mul' := φ.prop.2,
  map_smul' := (to_clm φ).map_smul,
  map_zero' := continuous_linear_map.map_zero _,
  map_add' := continuous_linear_map.map_add _ }

lemma map_zero (φ : character_space 𝕜 A) : φ 0 = 0 := (to_non_unital_alg_hom φ).map_zero
lemma map_add (φ : character_space 𝕜 A) (x y : A) : φ (x + y) = φ x + φ y :=
  (to_non_unital_alg_hom φ).map_add _ _
lemma map_smul (φ : character_space 𝕜 A) (r : 𝕜) (x : A) : φ (r • x) = r • (φ x) :=
  (to_clm φ).map_smul _ _
lemma map_mul (φ : character_space 𝕜 A) (x y : A) : φ (x * y) = φ x * φ y :=
  (to_non_unital_alg_hom φ).map_mul _ _
lemma continuous (φ : character_space 𝕜 A) : continuous φ := (to_clm φ).continuous

end non_unital_non_assoc_semiring

section unital

variables [comm_ring 𝕜] [no_zero_divisors 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [topological_space A] [semiring A] [algebra 𝕜 A]

lemma map_one (φ : character_space 𝕜 A) : φ 1 = 1 :=
begin
  have h₁ : (φ 1) * (1 - φ 1) = 0 := by rw [mul_sub, sub_eq_zero, mul_one, ←map_mul φ, one_mul],
  rcases mul_eq_zero.mp h₁ with h₂|h₂,
  { exfalso,
    apply φ.prop.1,
    ext,
    rw [continuous_linear_map.zero_apply, ←one_mul x, coe_apply, map_mul φ, h₂, zero_mul] },
  { rw [sub_eq_zero] at h₂,
    exact h₂.symm },
end

/-- An element of the character space, as an algebra homomorphism. -/
@[simps] def to_alg_hom (φ : character_space 𝕜 A) : A →ₐ[𝕜] 𝕜 :=
{ map_one' := map_one φ,
  commutes' := λ r, by
  { rw [algebra.algebra_map_eq_smul_one, algebra.id.map_eq_id, ring_hom.id_apply],
    change ((φ : weak_dual 𝕜 A) : A →L[𝕜] 𝕜) (r • 1) = r,
    rw [continuous_linear_map.map_smul, algebra.id.smul_eq_mul, coe_apply, map_one φ, mul_one] },
  ..to_non_unital_alg_hom φ }

lemma eq_set_map_one_map_mul [nontrivial 𝕜] : character_space 𝕜 A =
  {φ : weak_dual 𝕜 A | (φ 1 = 1) ∧ (∀ (x y : A), φ (x * y) = (φ x) * (φ y))} :=
begin
  ext x,
  refine ⟨λ h, ⟨map_one ⟨x, h⟩, h.2⟩, λ h, ⟨_, h.2⟩⟩,
  rintro rfl,
  simpa using h.1,
end

lemma is_closed [nontrivial 𝕜] [t2_space 𝕜] [has_continuous_mul 𝕜] :
  is_closed (character_space 𝕜 A) :=
begin
  rw [eq_set_map_one_map_mul],
  refine is_closed.inter (is_closed_eq (eval_continuous _) continuous_const) _,
  change is_closed {φ : weak_dual 𝕜 A | ∀ x y : A, φ (x * y) = φ x * φ y},
  rw [set.set_of_forall],
  refine is_closed_Inter (λ a, _),
  rw [set.set_of_forall],
  exact is_closed_Inter (λ _, is_closed_eq (eval_continuous _)
    ((eval_continuous _).mul (eval_continuous _)))
end

end unital

section ring

variables [comm_ring 𝕜] [no_zero_divisors 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [topological_space A] [ring A] [algebra 𝕜 A]

lemma apply_mem_spectrum [nontrivial 𝕜] (φ : character_space 𝕜 A) (a : A) : φ a ∈ spectrum 𝕜 a :=
(to_alg_hom φ).apply_mem_spectrum a

end ring

end character_space

end weak_dual


import algebra_lemmas
import divided_powers.basic

namespace divided_powers

namespace of_invertible_factorial

variables {A : Type*} [comm_ring A] {I : ideal A}

open_locale classical

noncomputable def dpow (I : ideal A) : ℕ → A → A :=
λ m x, if h : x ∈ I then ring.inverse (m.factorial : A) * x^m else 0

lemma dpow_dif_pos {I : ideal A} (m : ℕ) {x : A} (hx : x ∈ I) :
  dpow I m x = ring.inverse (m.factorial : A) * x^m :=
by simp only [dpow]; rw dif_pos hx

lemma dpow_dif_neg {I : ideal A} {m : ℕ} {x : A} (hx : x ∉ I) : dpow I m x = 0 :=
by simp only [dpow]; rw dif_neg hx

lemma dpow_null {m : ℕ} {x : A} (hx : x ∉ I) : dpow I m x = 0 :=
by simp only [dpow]; rw dif_neg hx

lemma dpow_zero {x : A} (hx : x ∈ I) : dpow I 0 x = 1 :=
begin
  simp only [dpow],
  rw [dif_pos hx, pow_zero, mul_one, nat.factorial_zero, nat.cast_one, ring.inverse_one],
end

lemma dpow_one {x : A} (hx : x ∈ I) :
  dpow I 1 x = x :=
by rw [dpow_dif_pos 1 hx, pow_one, nat.factorial_one, nat.cast_one, ring.inverse_one, one_mul]

lemma dpow_mem {m : ℕ} (hm : m ≠ 0) {x : A} (hx : x ∈ I) : dpow I m x ∈ I :=
begin
  rw dpow_dif_pos m hx,
  exact ideal.mul_mem_left I _ (ideal.pow_mem_of_mem I hx _ (nat.pos_of_ne_zero hm))
end

lemma dpow_add_dif_pos {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) {m : ℕ} (hmn : m < n)
  {x y : A} (hx : x ∈ I) (hy : y ∈ I) : dpow I m (x + y) =
  (finset.range (m + 1)).sum (λ (k : ℕ), dpow I k x * dpow I (m - k) y) :=
begin
  rw dpow_dif_pos m (ideal.add_mem I hx hy),
  simp only [dpow],
  rw [ring.inverse_mul_eq_iff_eq_mul _ _ _ (factorial_is_unit hn_fac hmn), finset.mul_sum, add_pow],
  apply finset.sum_congr rfl,
  intros k hk,
  rw [finset.mem_range, nat.lt_succ_iff] at hk,
  have h_ch : (m.choose k : A) =
    (m.factorial : A) * (ring.inverse (k.factorial)) * (ring.inverse ((m - k).factorial)),
  { have hadd : m = (m - k) + k := (tsub_add_cancel_iff_le.mpr hk).symm,
    rw [ring.eq_mul_inverse_iff_mul_eq _ _ _
      (factorial_is_unit hn_fac (lt_of_le_of_lt (nat.sub_le m k) hmn)),
      ring.eq_mul_inverse_iff_mul_eq  _ _ _ (factorial_is_unit hn_fac  (lt_of_le_of_lt hk hmn))],
    nth_rewrite 0 hadd,
    nth_rewrite 2 hadd,
    rw [← nat.cast_mul, ← nat.cast_mul, nat.add_choose_mul_factorial_mul_factorial],},
    rw [dif_pos hx, dif_pos hy, h_ch, ← mul_assoc, ← mul_assoc, mul_comm
      (ring.inverse ↑((m - k).factorial))  (y ^ (m - k)), mul_assoc _ (x^k), ← mul_assoc (x^k),
      mul_comm (x ^ k * y ^ (m - k)) (ring.inverse ↑((m - k).factorial))],
    ring_nf,
end

lemma dpow_add {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) (hnI : I^n = 0) (m : ℕ) {x : A}
  (hx : x ∈ I) {y : A} (hy : y ∈ I) : dpow I m (x + y) =
    (finset.range (m + 1)).sum (λ (k : ℕ), dpow I k x * dpow I (m - k) y) :=
begin
  by_cases hmn : m < n,
  { exact dpow_add_dif_pos hn_fac hmn hx hy },
  { have h_sub : I^m ≤ I^n := ideal.pow_le_pow (not_lt.mp hmn),
    rw dpow_dif_pos m (ideal.add_mem I hx hy),
    simp only [dpow],
    have hxy : (x + y) ^ m = 0,
    { rw [← ideal.mem_bot, ← ideal.zero_eq_bot, ← hnI],
      apply set.mem_of_subset_of_mem h_sub
        (ideal.pow_mem_pow (ideal.add_mem I hx hy) m) },
    rw [hxy, mul_zero, eq_comm],
    apply finset.sum_eq_zero,
    intros k hk,
    rw [dif_pos hx, dif_pos hy, mul_assoc, mul_comm (x^k), mul_assoc, ← mul_assoc],
    apply mul_eq_zero_of_right,
    rw [← ideal.mem_bot, ← ideal.zero_eq_bot, ← hnI],
    have hIm : y ^ (m - k) * x ^ k ∈ I ^ m,
    { have hadd : m = (m - k) + k,
      { rw [eq_comm, tsub_add_cancel_iff_le],
        exact nat.le_of_lt_succ (finset.mem_range.mp hk) },
      nth_rewrite 1 hadd,
      rw pow_add,
      exact ideal.mul_mem_mul (ideal.pow_mem_pow hy _) (ideal.pow_mem_pow hx _) },
    apply set.mem_of_subset_of_mem h_sub hIm }
end

lemma dpow_smul (m : ℕ) {a x : A} (hx : x ∈ I) :
  dpow I m (a * x) = a ^ m * dpow I m x :=
by rw [dpow_dif_pos m (ideal.mul_mem_left I _ hx), dpow_dif_pos m hx, mul_pow,
    ← mul_assoc, mul_comm _ (a^m), mul_assoc]

lemma dpow_mul_dif_pos {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) {m k : ℕ} (hkm : m + k < n)
  {x : A} (hx : x ∈ I) :
  dpow I m x * dpow I k x = ↑((m + k).choose m) * dpow I (m + k) x :=
begin
  have hm : m < n := lt_of_le_of_lt le_self_add hkm,
  have hk : k < n := lt_of_le_of_lt le_add_self hkm,
  have h_fac : (ring.inverse (m.factorial : A)) * (ring.inverse k.factorial) =
    ↑((m + k).choose m) * (ring.inverse (m + k).factorial),
  { rw [ring.eq_mul_inverse_iff_mul_eq _ _ _ (factorial_is_unit hn_fac hkm), mul_assoc,
    ring.inverse_mul_eq_iff_eq_mul _ _ _ (factorial_is_unit hn_fac hm),
      ring.inverse_mul_eq_iff_eq_mul _ _ _ (factorial_is_unit hn_fac hk)],
    norm_cast, apply congr_arg,
    rw [← nat.add_choose_mul_factorial_mul_factorial, mul_comm, mul_comm _ m.factorial,
      nat.choose_symm_add] },
    rw [dpow_dif_pos _ hx, dpow_dif_pos _ hx, dpow_dif_pos _ hx, mul_assoc,
       ← mul_assoc (x^m), mul_comm (x^m), mul_assoc _ (x^m), ← pow_add, ← mul_assoc,
       ← mul_assoc, h_fac],
end

lemma dpow_mul {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) (hnI : I^n = 0) (m k : ℕ) {x : A}
  (hx : x ∈ I) :
  dpow I m x * dpow I k x = ↑((m + k).choose m) * dpow I (m + k) x :=
begin
  by_cases hkm : m + k < n,
  { exact dpow_mul_dif_pos hn_fac hkm hx, },
  { have hxmk : x ^ (m + k) = 0,
    { exact ideal.mem_pow_eq_zero n (m + k) hnI (not_lt.mp hkm) hx },
    rw [dpow_dif_pos m hx, dpow_dif_pos k hx, dpow_dif_pos (m + k) hx, mul_assoc, ← mul_assoc (x^m),
      mul_comm (x^m), mul_assoc _ (x^m), ← pow_add, hxmk, mul_zero, mul_zero, mul_zero, mul_zero] }
end

lemma dpow_comp_dif_pos {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A))
  {m k : ℕ} (hk : k ≠ 0) (hkm : m * k < n) {x : A} (hx : x ∈ I) :
  dpow I m (dpow I k x) = ↑(mchoose m k) * dpow I (m * k) x :=
begin
  have hmn : m < n,
  { exact lt_of_le_of_lt (nat.le_mul_of_pos_right (nat.pos_of_ne_zero hk)) hkm },
  rw [dpow_dif_pos  (m *k) hx, dpow_dif_pos _ (dpow_mem hk hx)],
  by_cases hm0 : m = 0,
  { simp only [hm0, zero_mul, pow_zero, mul_one, mchoose_zero, nat.cast_one, one_mul] },
  { have hkn : k < n,
    { exact lt_of_le_of_lt (nat.le_mul_of_pos_left (nat.pos_of_ne_zero hm0)) hkm },
    rw dpow_dif_pos _ hx,
    have h_fac : (ring.inverse (m.factorial : A)) * (ring.inverse k.factorial) ^ m =
      ↑(mchoose m k) * (ring.inverse (m*k).factorial),
    { rw [ring.eq_mul_inverse_iff_mul_eq _ _ _ (factorial_is_unit hn_fac hkm), mul_assoc,
        ring.inverse_mul_eq_iff_eq_mul  _ _ _ (factorial_is_unit hn_fac hmn)],
      rw ring.inverse_pow_mul_eq_iff_eq_mul _ _ (factorial_is_unit hn_fac hkn),
      rw [← mchoose_lemma _ hk,
        nat.cast_mul, nat.cast_mul, nat.cast_pow, mul_comm ↑m.factorial, mul_assoc] },
    rw [ mul_pow, ← pow_mul, mul_comm k, ← mul_assoc, ← mul_assoc, h_fac] },
end

lemma dpow_comp {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) (hnI : I^n = 0)
  (m : ℕ) {k : ℕ} (hk : k ≠ 0) {x : A} (hx : x ∈ I) :
  dpow I m (dpow I k x) = ↑(mchoose m k) * dpow I (m * k) x :=
begin
  by_cases hmk : m * k < n,
  { exact dpow_comp_dif_pos hn_fac hk hmk hx },
  { have hxmk : x ^ (m * k) = 0,
    { exact ideal.mem_pow_eq_zero n (m * k) hnI (not_lt.mp hmk) hx },
    rw [dpow_dif_pos _ (dpow_mem hk hx), dpow_dif_pos _ hx, dpow_dif_pos _ hx, mul_pow, ← pow_mul,
      ← mul_assoc, mul_comm k, hxmk, mul_zero, mul_zero, mul_zero] }
end

/-- Proposition 1.2.7 of [B74], part (ii). -/
noncomputable def divided_powers {n : ℕ} (hn_fac : is_unit ((n-1).factorial : A)) (hnI : I^n = 0) :
  divided_powers I :=
{ dpow      := dpow I,
  dpow_null := λ n x hx, dpow_null hx,
  dpow_zero := λ x hx, dpow_zero hx,
  dpow_one  := λ x hx, dpow_one hx,
  dpow_mem  := λ n hn x hx, dpow_mem hn hx,
  dpow_add  := λ m x y hx hy, dpow_add hn_fac hnI m hx hy,
  dpow_smul := λ m a x hx, dpow_smul m hx,
  dpow_mul  := λ m k x hx, dpow_mul hn_fac hnI m k hx,
  dpow_comp := λ m k hk x hx, dpow_comp hn_fac hnI m hk hx }

end of_invertible_factorial

-- Instead of 1.2.1, I formalize example 2 from [BO], Section 3.
namespace rat_algebra

variables {R : Type*} [comm_ring R] (I : ideal R)

noncomputable def dpow : ℕ → R → R :=
λ n, of_invertible_factorial.dpow I n

variable {I}
-- We may not need this, but I'll leave it here for now
lemma dpow_def (n : ℕ) {x : R} (hx : x ∈ I) :
  dpow I n x = (ring.inverse n.factorial) * x^n :=
by simp only [dpow]; rw of_invertible_factorial.dpow_dif_pos _ hx

variable [algebra ℚ R]

variable (I)

noncomputable def divided_powers : divided_powers I :=
{ dpow      := dpow I,
  dpow_null := λ n x hx, of_invertible_factorial.dpow_null hx,
  dpow_zero := λ x hx, of_invertible_factorial.dpow_zero hx,
  dpow_one  := λ x hx, of_invertible_factorial.dpow_one hx,
  dpow_mem  := λ n hn x hx, of_invertible_factorial.dpow_mem hn hx,
  dpow_add  := λ n x y hx hy, of_invertible_factorial.dpow_add_dif_pos
                 (factorial.is_unit (n + 1 - 1)) (n.lt_succ_self) hx hy,
  dpow_smul := λ n a x hx, of_invertible_factorial.dpow_smul n hx,
  dpow_mul  := λ m k x hx, of_invertible_factorial.dpow_mul_dif_pos
                 (factorial.is_unit (m + k + 1 - 1)) (m + k).lt_succ_self hx,
  dpow_comp := λ m k hk x hx, of_invertible_factorial.dpow_comp_dif_pos
                 (factorial.is_unit (m * k + 1 - 1)) hk (lt_add_one _) hx }

lemma divided_powers_dpow_apply (n : ℕ) (x : R) :
  (divided_powers I).dpow n x = dpow I n x :=
rfl

variable {I}

-- There are no other divided power structures on a ℚ-algebra.
lemma divided_powers_unique (hI : _root_.divided_powers I) :
  hI = (divided_powers I) :=
begin
  apply eq_of_eq_on_ideal,
  intros n x hx,
  have hn : is_unit (n.factorial : R) := factorial.is_unit n,
    rw [divided_powers_dpow_apply, dpow_def n hx, eq_comm,
      ring.inverse_mul_eq_iff_eq_mul _ _ _ hn, factorial_mul_dpow_eq_pow _ _ _ hx]
end

end rat_algebra

end divided_powers


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri

! This file was ported from Lean 3 source module geometry.manifold.algebra.lie_group
! leanprover-community/mathlib commit d1bd9c5df2867c1cb463bc6364446d57bdd9f7f1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Geometry.Manifold.Algebra.Monoid

/-!
# Lie groups

A Lie group is a group that is also a smooth manifold, in which the group operations of
multiplication and inversion are smooth maps. Smoothness of the group multiplication means that
multiplication is a smooth mapping of the product manifold `G` × `G` into `G`.

Note that, since a manifold here is not second-countable and Hausdorff a Lie group here is not
guaranteed to be second-countable (even though it can be proved it is Hausdorff). Note also that Lie
groups here are not necessarily finite dimensional.

## Main definitions and statements

* `lie_add_group I G` : a Lie additive group where `G` is a manifold on the model with corners `I`.
* `lie_group I G`     : a Lie multiplicative group where `G` is a manifold on the model with
                        corners `I`.
* `normed_space_lie_add_group` : a normed vector space over a nontrivially normed field
                                 is an additive Lie group.

## Implementation notes

A priori, a Lie group here is a manifold with corners.

The definition of Lie group cannot require `I : model_with_corners 𝕜 E E` with the same space as the
model space and as the model vector space, as one might hope, beause in the product situation,
the model space is `model_prod E E'` and the model vector space is `E × E'`, which are not the same,
so the definition does not apply. Hence the definition should be more general, allowing
`I : model_with_corners 𝕜 E H`.
-/

noncomputable section

open Manifold

-- See note [Design choices about smooth algebraic structures]
/-- A Lie (additive) group is a group and a smooth manifold at the same time in which
the addition and negation operations are smooth. -/
class LieAddGroup {𝕜 : Type _} [NontriviallyNormedField 𝕜] {H : Type _} [TopologicalSpace H]
  {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E] (I : ModelWithCorners 𝕜 E H) (G : Type _)
  [AddGroup G] [TopologicalSpace G] [ChartedSpace H G] extends HasSmoothAdd I G : Prop where
  smooth_neg : Smooth I I fun a : G => -a
#align lie_add_group LieAddGroup

-- See note [Design choices about smooth algebraic structures]
/-- A Lie group is a group and a smooth manifold at the same time in which
the multiplication and inverse operations are smooth. -/
@[to_additive]
class LieGroup {𝕜 : Type _} [NontriviallyNormedField 𝕜] {H : Type _} [TopologicalSpace H]
  {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E] (I : ModelWithCorners 𝕜 E H) (G : Type _)
  [Group G] [TopologicalSpace G] [ChartedSpace H G] extends HasSmoothMul I G : Prop where
  smooth_inv : Smooth I I fun a : G => a⁻¹
#align lie_group LieGroup
#align lie_add_group LieAddGroup

section LieGroup

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜] {H : Type _} [TopologicalSpace H] {E : Type _}
  [NormedAddCommGroup E] [NormedSpace 𝕜 E] {I : ModelWithCorners 𝕜 E H} {F : Type _}
  [NormedAddCommGroup F] [NormedSpace 𝕜 F] {J : ModelWithCorners 𝕜 F F} {G : Type _}
  [TopologicalSpace G] [ChartedSpace H G] [Group G] [LieGroup I G] {E' : Type _}
  [NormedAddCommGroup E'] [NormedSpace 𝕜 E'] {H' : Type _} [TopologicalSpace H']
  {I' : ModelWithCorners 𝕜 E' H'} {M : Type _} [TopologicalSpace M] [ChartedSpace H' M]
  {E'' : Type _} [NormedAddCommGroup E''] [NormedSpace 𝕜 E''] {H'' : Type _} [TopologicalSpace H'']
  {I'' : ModelWithCorners 𝕜 E'' H''} {M' : Type _} [TopologicalSpace M'] [ChartedSpace H'' M']

section

variable (I)

@[to_additive]
theorem smooth_inv : Smooth I I fun x : G => x⁻¹ :=
  LieGroup.smooth_inv
#align smooth_inv smooth_inv
#align smooth_neg smooth_neg

/-- A Lie group is a topological group. This is not an instance for technical reasons,
see note [Design choices about smooth algebraic structures]. -/
@[to_additive
      "An additive Lie group is an additive topological group. This is not an instance for technical\nreasons, see note [Design choices about smooth algebraic structures]."]
theorem topologicalGroup_of_lieGroup : TopologicalGroup G :=
  { continuousMul_of_smooth I with continuous_inv := (smooth_inv I).Continuous }
#align topological_group_of_lie_group topologicalGroup_of_lieGroup
#align topological_add_group_of_lie_add_group topological_add_group_of_lie_add_group

end

@[to_additive]
theorem Smooth.inv {f : M → G} (hf : Smooth I' I f) : Smooth I' I fun x => (f x)⁻¹ :=
  (smooth_inv I).comp hf
#align smooth.inv Smooth.inv
#align smooth.neg Smooth.neg

@[to_additive]
theorem SmoothOn.inv {f : M → G} {s : Set M} (hf : SmoothOn I' I f s) :
    SmoothOn I' I (fun x => (f x)⁻¹) s :=
  (smooth_inv I).comp_smoothOn hf
#align smooth_on.inv SmoothOn.inv
#align smooth_on.neg SmoothOn.neg

@[to_additive]
theorem Smooth.div {f g : M → G} (hf : Smooth I' I f) (hg : Smooth I' I g) : Smooth I' I (f / g) :=
  by
  rw [div_eq_mul_inv]
  exact ((smooth_mul I).comp (hf.prod_mk hg.inv) : _)
#align smooth.div Smooth.div
#align smooth.sub Smooth.sub

@[to_additive]
theorem SmoothOn.div {f g : M → G} {s : Set M} (hf : SmoothOn I' I f s) (hg : SmoothOn I' I g s) :
    SmoothOn I' I (f / g) s := by
  rw [div_eq_mul_inv]
  exact ((smooth_mul I).comp_smoothOn (hf.prod_mk hg.inv) : _)
#align smooth_on.div SmoothOn.div
#align smooth_on.sub SmoothOn.sub

end LieGroup

section ProdLieGroup

-- Instance of product group
@[to_additive]
instance {𝕜 : Type _} [NontriviallyNormedField 𝕜] {H : Type _} [TopologicalSpace H] {E : Type _}
    [NormedAddCommGroup E] [NormedSpace 𝕜 E] {I : ModelWithCorners 𝕜 E H} {G : Type _}
    [TopologicalSpace G] [ChartedSpace H G] [Group G] [LieGroup I G] {E' : Type _}
    [NormedAddCommGroup E'] [NormedSpace 𝕜 E'] {H' : Type _} [TopologicalSpace H']
    {I' : ModelWithCorners 𝕜 E' H'} {G' : Type _} [TopologicalSpace G'] [ChartedSpace H' G']
    [Group G'] [LieGroup I' G'] : LieGroup (I.Prod I') (G × G') :=
  { HasSmoothMul.prod _ _ _ _ with smooth_inv := smooth_fst.inv.prod_mk smooth_snd.inv }

end ProdLieGroup

/-! ### Normed spaces are Lie groups -/

instance normedSpace_lieAddGroup {𝕜 : Type _} [NontriviallyNormedField 𝕜] {E : Type _}
    [NormedAddCommGroup E] [NormedSpace 𝕜 E] : LieAddGroup 𝓘(𝕜, E) E :=
  {
    model_space_smooth with
    smooth_add := smooth_iff.2 ⟨continuous_add, fun x y => contDiff_add.ContDiffOn⟩
    smooth_neg := smooth_iff.2 ⟨continuous_neg, fun x y => contDiff_neg.ContDiffOn⟩ }
#align normed_space_lie_add_group normedSpace_lieAddGroup


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

! This file was ported from Lean 3 source module algebra.lie.quotient
! leanprover-community/mathlib commit 3d7987cda72abc473c7cdbbb075170e9ac620042
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Submodule
import Mathbin.Algebra.Lie.OfAssociative
import Mathbin.LinearAlgebra.Isomorphisms

/-!
# Quotients of Lie algebras and Lie modules

Given a Lie submodule of a Lie module, the quotient carries a natural Lie module structure. In the
special case that the Lie module is the Lie algebra itself via the adjoint action, the submodule
is a Lie ideal and the quotient carries a natural Lie algebra structure.

We define these quotient structures here. A notable omission at the time of writing (February 2021)
is a statement and proof of the universal property of these quotients.

## Main definitions

  * `lie_submodule.quotient.lie_quotient_lie_module`
  * `lie_submodule.quotient.lie_quotient_lie_algebra`

## Tags

lie algebra, quotient
-/

universe u v w w₁ w₂

namespace LieSubmodule

variable {R : Type u} {L : Type v} {M : Type w}

variable [CommRing R] [LieRing L] [LieAlgebra R L] [AddCommGroup M] [Module R M]

variable [LieRingModule L M] [LieModule R L M]

variable (N N' : LieSubmodule R L M) (I J : LieIdeal R L)

/-- The quotient of a Lie module by a Lie submodule. It is a Lie module. -/
instance : HasQuotient M (LieSubmodule R L M) :=
  ⟨fun N => M ⧸ N.toSubmodule⟩

namespace Quotient

variable {N I}

instance addCommGroup : AddCommGroup (M ⧸ N) :=
  Submodule.Quotient.addCommGroup _
#align lie_submodule.quotient.add_comm_group LieSubmodule.Quotient.addCommGroup

instance module' {S : Type _} [Semiring S] [SMul S R] [Module S M] [IsScalarTower S R M] :
    Module S (M ⧸ N) :=
  Submodule.Quotient.module' _
#align lie_submodule.quotient.module' LieSubmodule.Quotient.module'

instance module : Module R (M ⧸ N) :=
  Submodule.Quotient.module _
#align lie_submodule.quotient.module LieSubmodule.Quotient.module

instance isCentralScalar {S : Type _} [Semiring S] [SMul S R] [Module S M] [IsScalarTower S R M]
    [SMul Sᵐᵒᵖ R] [Module Sᵐᵒᵖ M] [IsScalarTower Sᵐᵒᵖ R M] [IsCentralScalar S M] :
    IsCentralScalar S (M ⧸ N) :=
  Submodule.Quotient.isCentralScalar _
#align lie_submodule.quotient.is_central_scalar LieSubmodule.Quotient.isCentralScalar

instance inhabited : Inhabited (M ⧸ N) :=
  ⟨0⟩
#align lie_submodule.quotient.inhabited LieSubmodule.Quotient.inhabited

/-- Map sending an element of `M` to the corresponding element of `M/N`, when `N` is a
lie_submodule of the lie_module `N`. -/
abbrev mk : M → M ⧸ N :=
  Submodule.Quotient.mk
#align lie_submodule.quotient.mk LieSubmodule.Quotient.mk

theorem is_quotient_mk (m : M) : Quotient.mk'' m = (mk m : M ⧸ N) :=
  rfl
#align lie_submodule.quotient.is_quotient_mk LieSubmodule.Quotient.is_quotient_mk

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there
is a natural linear map from `L` to the endomorphisms of `M` leaving `N` invariant. -/
def lieSubmoduleInvariant : L →ₗ[R] Submodule.compatibleMaps N.toSubmodule N.toSubmodule :=
  LinearMap.codRestrict _ (LieModule.toEndomorphism R L M) fun _ _ => N.lie_mem
#align lie_submodule.quotient.lie_submodule_invariant LieSubmodule.Quotient.lieSubmoduleInvariant

variable (N)

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there
is a natural Lie algebra morphism from `L` to the linear endomorphism of the quotient `M/N`. -/
def actionAsEndoMap : L →ₗ⁅R⁆ Module.End R (M ⧸ N) :=
  { LinearMap.comp (Submodule.mapQLinear (N : Submodule R M) ↑N) lieSubmoduleInvariant with
    map_lie' := fun x y =>
      Submodule.linearMap_qext _ <| LinearMap.ext fun m => congr_arg mk <| lie_lie _ _ _ }
#align lie_submodule.quotient.action_as_endo_map LieSubmodule.Quotient.actionAsEndoMap

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there is
a natural bracket action of `L` on the quotient `M/N`. -/
instance actionAsEndoMapBracket : Bracket L (M ⧸ N) :=
  ⟨fun x n => actionAsEndoMap N x n⟩
#align lie_submodule.quotient.action_as_endo_map_bracket LieSubmodule.Quotient.actionAsEndoMapBracket

instance lieQuotientLieRingModule : LieRingModule L (M ⧸ N) :=
  { LieRingModule.compLieHom _ (actionAsEndoMap N) with bracket := Bracket.bracket }
#align lie_submodule.quotient.lie_quotient_lie_ring_module LieSubmodule.Quotient.lieQuotientLieRingModule

/-- The quotient of a Lie module by a Lie submodule, is a Lie module. -/
instance lieQuotientLieModule : LieModule R L (M ⧸ N) :=
  LieModule.compLieHom _ (actionAsEndoMap N)
#align lie_submodule.quotient.lie_quotient_lie_module LieSubmodule.Quotient.lieQuotientLieModule

instance lieQuotientHasBracket : Bracket (L ⧸ I) (L ⧸ I) :=
  ⟨by
    intro x y
    apply Quotient.liftOn₂' x y fun x' y' => mk ⁅x', y'⁆
    intro x₁ x₂ y₁ y₂ h₁ h₂
    apply (Submodule.Quotient.eq I.to_submodule).2
    rw [Submodule.quotientRel_r_def] at h₁ h₂
    have h : ⁅x₁, x₂⁆ - ⁅y₁, y₂⁆ = ⁅x₁, x₂ - y₂⁆ + ⁅x₁ - y₁, y₂⁆ := by
      simp [-lie_skew, sub_eq_add_neg, add_assoc]
    rw [h]
    apply Submodule.add_mem
    · apply lie_mem_right R L I x₁ (x₂ - y₂) h₂
    · apply lie_mem_left R L I (x₁ - y₁) y₂ h₁⟩
#align lie_submodule.quotient.lie_quotient_has_bracket LieSubmodule.Quotient.lieQuotientHasBracket

@[simp]
theorem mk_bracket (x y : L) : mk ⁅x, y⁆ = ⁅(mk x : L ⧸ I), (mk y : L ⧸ I)⁆ :=
  rfl
#align lie_submodule.quotient.mk_bracket LieSubmodule.Quotient.mk_bracket

instance lieQuotientLieRing : LieRing (L ⧸ I)
    where
  add_lie := by
    intro x' y' z'
    apply Quotient.inductionOn₃' x' y' z'
    intro x y z
    repeat' first |rw [is_quotient_mk]|rw [← mk_bracket]|rw [← Submodule.Quotient.mk_add]
    apply congr_arg
    apply add_lie
  lie_add := by
    intro x' y' z'
    apply Quotient.inductionOn₃' x' y' z'
    intro x y z
    repeat' first |rw [is_quotient_mk]|rw [← mk_bracket]|rw [← Submodule.Quotient.mk_add]
    apply congr_arg
    apply lie_add
  lie_self := by
    intro x'
    apply Quotient.inductionOn' x'
    intro x
    rw [is_quotient_mk, ← mk_bracket]
    apply congr_arg
    apply lie_self
  leibniz_lie := by
    intro x' y' z'
    apply Quotient.inductionOn₃' x' y' z'
    intro x y z
    repeat' first |rw [is_quotient_mk]|rw [← mk_bracket]|rw [← Submodule.Quotient.mk_add]
    apply congr_arg
    apply leibniz_lie
#align lie_submodule.quotient.lie_quotient_lie_ring LieSubmodule.Quotient.lieQuotientLieRing

instance lieQuotientLieAlgebra : LieAlgebra R (L ⧸ I)
    where lie_smul := by
    intro t x' y'
    apply Quotient.inductionOn₂' x' y'
    intro x y
    repeat' first |rw [is_quotient_mk]|rw [← mk_bracket]|rw [← Submodule.Quotient.mk_smul]
    apply congr_arg
    apply lie_smul
#align lie_submodule.quotient.lie_quotient_lie_algebra LieSubmodule.Quotient.lieQuotientLieAlgebra

/-- `lie_submodule.quotient.mk` as a `lie_module_hom`. -/
@[simps]
def mk' : M →ₗ⁅R,L⁆ M ⧸ N :=
  { N.toSubmodule.mkQ with
    toFun := mk
    map_lie' := fun r m => rfl }
#align lie_submodule.quotient.mk' LieSubmodule.Quotient.mk'

@[simp]
theorem mk_eq_zero {m : M} : mk' N m = 0 ↔ m ∈ N :=
  Submodule.Quotient.mk_eq_zero N.toSubmodule
#align lie_submodule.quotient.mk_eq_zero LieSubmodule.Quotient.mk_eq_zero

@[simp]
theorem mk'_ker : (mk' N).ker = N := by
  ext
  simp
#align lie_submodule.quotient.mk'_ker LieSubmodule.Quotient.mk'_ker

@[simp]
theorem map_mk'_eq_bot_le : map (mk' N) N' = ⊥ ↔ N' ≤ N := by
  rw [← LieModuleHom.le_ker_iff_map, mk'_ker]
#align lie_submodule.quotient.map_mk'_eq_bot_le LieSubmodule.Quotient.map_mk'_eq_bot_le

/-- Two `lie_module_hom`s from a quotient lie module are equal if their compositions with
`lie_submodule.quotient.mk'` are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem lieModuleHom_ext ⦃f g : M ⧸ N →ₗ⁅R,L⁆ M⦄ (h : f.comp (mk' N) = g.comp (mk' N)) : f = g :=
  LieModuleHom.ext fun x => Quotient.inductionOn' x <| LieModuleHom.congr_fun h
#align lie_submodule.quotient.lie_module_hom_ext LieSubmodule.Quotient.lieModuleHom_ext

end Quotient

end LieSubmodule

namespace LieHom

variable {R L L' : Type _}

variable [CommRing R] [LieRing L] [LieAlgebra R L] [LieRing L'] [LieAlgebra R L']

variable (f : L →ₗ⁅R⁆ L')

/-- The first isomorphism theorem for morphisms of Lie algebras. -/
@[simps]
noncomputable def quotKerEquivRange : (L ⧸ f.ker) ≃ₗ⁅R⁆ f.range :=
  {
    (f : L →ₗ[R]
          L').quotKerEquivRange with
    toFun := (f : L →ₗ[R] L').quotKerEquivRange
    map_lie' := by
      rintro ⟨x⟩ ⟨y⟩
      rw [← SetLike.coe_eq_coe, LieSubalgebra.coe_bracket]
      simp only [Submodule.Quotient.quot_mk_eq_mk, LinearMap.quotKerEquivRange_apply_mk, ←
        LieSubmodule.Quotient.mk_bracket, coe_to_linear_map, map_lie] }
#align lie_hom.quot_ker_equiv_range LieHom.quotKerEquivRange

end LieHom


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

! This file was ported from Lean 3 source module analysis.box_integral.partition.subbox_induction
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.BoxIntegral.Box.SubboxInduction
import Mathbin.Analysis.BoxIntegral.Partition.Tagged

/-!
# Induction on subboxes

In this file we prove (see
`box_integral.tagged_partition.exists_is_Henstock_is_subordinate_homothetic`) that for every box `I`
in `ℝⁿ` and a function `r : ℝⁿ → ℝ` positive on `I` there exists a tagged partition `π` of `I` such
that

* `π` is a Henstock partition;
* `π` is subordinate to `r`;
* each box in `π` is homothetic to `I` with coefficient of the form `1 / 2 ^ n`.

Later we will use this lemma to prove that the Henstock filter is nontrivial, hence the Henstock
integral is well-defined.

## Tags

partition, tagged partition, Henstock integral
-/

namespace BoxIntegral

open Set Metric

open Classical Topology

noncomputable section

variable {ι : Type _} [Fintype ι] {I J : Box ι}

namespace Prepartition

/-- Split a box in `ℝⁿ` into `2 ^ n` boxes by hyperplanes passing through its center. -/
def splitCenter (I : Box ι) : Prepartition I
    where
  boxes := Finset.univ.map (Box.splitCenterBoxEmb I)
  le_of_mem' := by simp [I.split_center_box_le]
  PairwiseDisjoint := by
    rw [Finset.coe_map, Finset.coe_univ, image_univ]
    rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩ Hne
    exact I.disjoint_split_center_box (mt (congr_arg _) Hne)
#align box_integral.prepartition.split_center BoxIntegral.Prepartition.splitCenter

@[simp]
theorem mem_splitCenter : J ∈ splitCenter I ↔ ∃ s, I.splitCenterBox s = J := by simp [split_center]
#align box_integral.prepartition.mem_split_center BoxIntegral.Prepartition.mem_splitCenter

theorem isPartitionSplitCenter (I : Box ι) : IsPartition (splitCenter I) := fun x hx => by simp [hx]
#align box_integral.prepartition.is_partition_split_center BoxIntegral.Prepartition.isPartitionSplitCenter

theorem upper_sub_lower_of_mem_splitCenter (h : J ∈ splitCenter I) (i : ι) :
    J.upper i - J.lower i = (I.upper i - I.lower i) / 2 :=
  let ⟨s, hs⟩ := mem_splitCenter.1 h
  hs ▸ I.upper_sub_lower_splitCenterBox s i
#align box_integral.prepartition.upper_sub_lower_of_mem_split_center BoxIntegral.Prepartition.upper_sub_lower_of_mem_splitCenter

end Prepartition

namespace Box

open Prepartition TaggedPrepartition

/-- Let `p` be a predicate on `box ι`, let `I` be a box. Suppose that the following two properties
hold true.

* Consider a smaller box `J ≤ I`. The hyperplanes passing through the center of `J` split it into
  `2 ^ n` boxes. If `p` holds true on each of these boxes, then it true on `J`.
* For each `z` in the closed box `I.Icc` there exists a neighborhood `U` of `z` within `I.Icc` such
  that for every box `J ≤ I` such that `z ∈ J.Icc ⊆ U`, if `J` is homothetic to `I` with a
  coefficient of the form `1 / 2 ^ m`, then `p` is true on `J`.

Then `p I` is true. See also `box_integral.box.subbox_induction_on'` for a version using
`box_integral.box.split_center_box` instead of `box_integral.prepartition.split_center`. -/
@[elab_as_elim]
theorem subbox_induction_on {p : Box ι → Prop} (I : Box ι)
    (H_ind : ∀ J ≤ I, (∀ J' ∈ splitCenter J, p J') → p J)
    (H_nhds :
      ∀ z ∈ I.Icc,
        ∃ U ∈ 𝓝[I.Icc] z,
          ∀ J ≤ I,
            ∀ (m : ℕ),
              z ∈ J.Icc →
                J.Icc ⊆ U → (∀ i, J.upper i - J.lower i = (I.upper i - I.lower i) / 2 ^ m) → p J) :
    p I :=
  by
  refine' subbox_induction_on' I (fun J hle hs => H_ind J hle fun J' h' => _) H_nhds
  rcases mem_split_center.1 h' with ⟨s, rfl⟩
  exact hs s
#align box_integral.box.subbox_induction_on BoxIntegral.Box.subbox_induction_on

/-- Given a box `I` in `ℝⁿ` and a function `r : ℝⁿ → (0, ∞)`, there exists a tagged partition `π` of
`I` such that

* `π` is a Henstock partition;
* `π` is subordinate to `r`;
* each box in `π` is homothetic to `I` with coefficient of the form `1 / 2 ^ m`.

This lemma implies that the Henstock filter is nontrivial, hence the Henstock integral is
well-defined. -/
theorem exists_tagged_partition_isHenstock_isSubordinate_homothetic (I : Box ι)
    (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    ∃ π : TaggedPrepartition I,
      π.IsPartition ∧
        π.IsHenstock ∧
          π.IsSubordinate r ∧
            (∀ J ∈ π, ∃ m : ℕ, ∀ i, (J : _).upper i - J.lower i = (I.upper i - I.lower i) / 2 ^ m) ∧
              π.distortion = I.distortion :=
  by
  refine' subbox_induction_on I (fun J hle hJ => _) fun z hz => _
  · choose! πi hP hHen hr Hn Hd using hJ
    choose! n hn using Hn
    have hP : ((split_center J).bUnionTagged πi).IsPartition :=
      (is_partition_split_center _).bUnionTagged hP
    have hsub :
      ∀ J' ∈ (split_center J).bUnionTagged πi,
        ∃ n : ℕ, ∀ i, (J' : _).upper i - J'.lower i = (J.upper i - J.lower i) / 2 ^ n :=
      by
      intro J' hJ'
      rcases(split_center J).mem_bUnionTagged.1 hJ' with ⟨J₁, h₁, h₂⟩
      refine' ⟨n J₁ J' + 1, fun i => _⟩
      simp only [hn J₁ h₁ J' h₂, upper_sub_lower_of_mem_split_center h₁, pow_succ, div_div]
    refine' ⟨_, hP, is_Henstock_bUnion_tagged.2 hHen, is_subordinate_bUnion_tagged.2 hr, hsub, _⟩
    refine' tagged_prepartition.distortion_of_const _ hP.nonempty_boxes fun J' h' => _
    rcases hsub J' h' with ⟨n, hn⟩
    exact box.distortion_eq_of_sub_eq_div hn
  · refine'
      ⟨I.Icc ∩ closed_ball z (r z), inter_mem_nhdsWithin _ (closed_ball_mem_nhds _ (r z).coe_prop),
        _⟩
    intro J Hle n Hmem HIcc Hsub
    rw [Set.subset_inter_iff] at HIcc
    refine'
      ⟨single _ _ le_rfl _ Hmem, is_partition_single _, is_Henstock_single _,
        (is_subordinate_single _ _).2 HIcc.2, _, distortion_single _ _⟩
    simp only [tagged_prepartition.mem_single, forall_eq]
    refine' ⟨0, fun i => _⟩
    simp
#align box_integral.box.exists_tagged_partition_is_Henstock_is_subordinate_homothetic BoxIntegral.Box.exists_tagged_partition_isHenstock_isSubordinate_homothetic

end Box

namespace Prepartition

open TaggedPrepartition Finset Function

/-- Given a box `I` in `ℝⁿ`, a function `r : ℝⁿ → (0, ∞)`, and a prepartition `π` of `I`, there
exists a tagged prepartition `π'` of `I` such that

* each box of `π'` is included in some box of `π`;
* `π'` is a Henstock partition;
* `π'` is subordinate to `r`;
* `π'` covers exactly the same part of `I` as `π`;
* the distortion of `π'` is equal to the distortion of `π`.
-/
theorem exists_tagged_le_isHenstock_isSubordinate_union_eq {I : Box ι} (r : (ι → ℝ) → Ioi (0 : ℝ))
    (π : Prepartition I) :
    ∃ π' : TaggedPrepartition I,
      π'.toPrepartition ≤ π ∧
        π'.IsHenstock ∧ π'.IsSubordinate r ∧ π'.distortion = π.distortion ∧ π'.unionᵢ = π.unionᵢ :=
  by
  have := fun J => box.exists_tagged_partition_is_Henstock_is_subordinate_homothetic J r
  choose! πi πip πiH πir hsub πid; clear hsub
  refine'
    ⟨π.bUnion_tagged πi, bUnion_le _ _, is_Henstock_bUnion_tagged.2 fun J _ => πiH J,
      is_subordinate_bUnion_tagged.2 fun J _ => πir J, _, π.Union_bUnion_partition fun J _ => πip J⟩
  rw [distortion_bUnion_tagged]
  exact sup_congr rfl fun J _ => πid J
#align box_integral.prepartition.exists_tagged_le_is_Henstock_is_subordinate_Union_eq BoxIntegral.Prepartition.exists_tagged_le_isHenstock_isSubordinate_union_eq

/-- Given a prepartition `π` of a box `I` and a function `r : ℝⁿ → (0, ∞)`, `π.to_subordinate r`
is a tagged partition `π'` such that

* each box of `π'` is included in some box of `π`;
* `π'` is a Henstock partition;
* `π'` is subordinate to `r`;
* `π'` covers exactly the same part of `I` as `π`;
* the distortion of `π'` is equal to the distortion of `π`.
-/
def toSubordinate (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) : TaggedPrepartition I :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).some
#align box_integral.prepartition.to_subordinate BoxIntegral.Prepartition.toSubordinate

theorem toSubordinate_toPrepartition_le (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π.toSubordinate r).toPrepartition ≤ π :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).choose_spec.1
#align box_integral.prepartition.to_subordinate_to_prepartition_le BoxIntegral.Prepartition.toSubordinate_toPrepartition_le

theorem isHenstockToSubordinate (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π.toSubordinate r).IsHenstock :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).choose_spec.2.1
#align box_integral.prepartition.is_Henstock_to_subordinate BoxIntegral.Prepartition.isHenstockToSubordinate

theorem isSubordinateToSubordinate (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π.toSubordinate r).IsSubordinate r :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).choose_spec.2.2.1
#align box_integral.prepartition.is_subordinate_to_subordinate BoxIntegral.Prepartition.isSubordinateToSubordinate

@[simp]
theorem distortion_toSubordinate (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π.toSubordinate r).distortion = π.distortion :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).choose_spec.2.2.2.1
#align box_integral.prepartition.distortion_to_subordinate BoxIntegral.Prepartition.distortion_toSubordinate

@[simp]
theorem union_toSubordinate (π : Prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π.toSubordinate r).unionᵢ = π.unionᵢ :=
  (π.exists_tagged_le_isHenstock_isSubordinate_union_eq r).choose_spec.2.2.2.2
#align box_integral.prepartition.Union_to_subordinate BoxIntegral.Prepartition.union_toSubordinate

end Prepartition

namespace TaggedPrepartition

/-- Given a tagged prepartition `π₁`, a prepartition `π₂` that covers exactly `I \ π₁.Union`, and
a function `r : ℝⁿ → (0, ∞)`, returns the union of `π₁` and `π₂.to_subordinate r`. This partition
`π` has the following properties:

* `π` is a partition, i.e. it covers the whole `I`;
* `π₁.boxes ⊆ π.boxes`;
* `π.tag J = π₁.tag J` whenever `J ∈ π₁`;
* `π` is Henstock outside of `π₁`: `π.tag J ∈ J.Icc` whenever `J ∈ π`, `J ∉ π₁`;
* `π` is subordinate to `r` outside of `π₁`;
* the distortion of `π` is equal to the maximum of the distortions of `π₁` and `π₂`.
-/
def unionComplToSubordinate (π₁ : TaggedPrepartition I) (π₂ : Prepartition I)
    (hU : π₂.unionᵢ = I \ π₁.unionᵢ) (r : (ι → ℝ) → Ioi (0 : ℝ)) : TaggedPrepartition I :=
  π₁.disjUnion (π₂.toSubordinate r)
    (((π₂.union_toSubordinate r).trans hU).symm ▸ disjoint_sdiff_self_right)
#align box_integral.tagged_prepartition.union_compl_to_subordinate BoxIntegral.TaggedPrepartition.unionComplToSubordinate

theorem isPartitionUnionComplToSubordinate (π₁ : TaggedPrepartition I) (π₂ : Prepartition I)
    (hU : π₂.unionᵢ = I \ π₁.unionᵢ) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    IsPartition (π₁.unionComplToSubordinate π₂ hU r) :=
  Prepartition.isPartitionDisjUnionOfEqDiff ((π₂.union_toSubordinate r).trans hU)
#align box_integral.tagged_prepartition.is_partition_union_compl_to_subordinate BoxIntegral.TaggedPrepartition.isPartitionUnionComplToSubordinate

@[simp]
theorem unionComplToSubordinate_boxes (π₁ : TaggedPrepartition I) (π₂ : Prepartition I)
    (hU : π₂.unionᵢ = I \ π₁.unionᵢ) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π₁.unionComplToSubordinate π₂ hU r).boxes = π₁.boxes ∪ (π₂.toSubordinate r).boxes :=
  rfl
#align box_integral.tagged_prepartition.union_compl_to_subordinate_boxes BoxIntegral.TaggedPrepartition.unionComplToSubordinate_boxes

@[simp]
theorem union_unionComplToSubordinate_boxes (π₁ : TaggedPrepartition I) (π₂ : Prepartition I)
    (hU : π₂.unionᵢ = I \ π₁.unionᵢ) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π₁.unionComplToSubordinate π₂ hU r).unionᵢ = I :=
  (isPartitionUnionComplToSubordinate _ _ _ _).unionᵢ_eq
#align box_integral.tagged_prepartition.Union_union_compl_to_subordinate_boxes BoxIntegral.TaggedPrepartition.union_unionComplToSubordinate_boxes

@[simp]
theorem distortion_unionComplToSubordinate (π₁ : TaggedPrepartition I) (π₂ : Prepartition I)
    (hU : π₂.unionᵢ = I \ π₁.unionᵢ) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
    (π₁.unionComplToSubordinate π₂ hU r).distortion = max π₁.distortion π₂.distortion := by
  simp [union_compl_to_subordinate]
#align box_integral.tagged_prepartition.distortion_union_compl_to_subordinate BoxIntegral.TaggedPrepartition.distortion_unionComplToSubordinate

end TaggedPrepartition

end BoxIntegral


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

! This file was ported from Lean 3 source module analysis.complex.conformal
! leanprover-community/mathlib commit 468b141b14016d54b479eb7a0fff1e360b7e3cf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.Isometry
import Mathbin.Analysis.NormedSpace.ConformalLinearMap
import Mathbin.Analysis.NormedSpace.FiniteDimension

/-!
# Conformal maps between complex vector spaces

We prove the sufficient and necessary conditions for a real-linear map between complex vector spaces
to be conformal.

## Main results

* `is_conformal_map_complex_linear`: a nonzero complex linear map into an arbitrary complex
                                     normed space is conformal.
* `is_conformal_map_complex_linear_conj`: the composition of a nonzero complex linear map with
                                          `conj` is complex linear.
* `is_conformal_map_iff_is_complex_or_conj_linear`: a real linear map between the complex
                                                            plane is conformal iff it's complex
                                                            linear or the composition of
                                                            some complex linear map and `conj`.

## Warning

Antiholomorphic functions such as the complex conjugate are considered as conformal functions in
this file.
-/

noncomputable section

open Complex ContinuousLinearMap

open ComplexConjugate

theorem isConformalMap_conj : IsConformalMap (conjLie : ℂ →L[ℝ] ℂ) :=
  conjLie.toLinearIsometry.IsConformalMap
#align is_conformal_map_conj isConformalMap_conj

section ConformalIntoComplexNormed

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedSpace ℂ E] {z : ℂ}
  {g : ℂ →L[ℝ] E} {f : ℂ → E}

theorem isConformalMap_complex_linear {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) :
    IsConformalMap (map.restrictScalars ℝ) :=
  by
  have minor₁ : ‖map 1‖ ≠ 0 := by simpa only [ext_ring_iff, Ne.def, norm_eq_zero] using nonzero
  refine' ⟨‖map 1‖, minor₁, ⟨‖map 1‖⁻¹ • map, _⟩, _⟩
  · intro x
    simp only [LinearMap.smul_apply]
    have : x = x • 1 := by rw [smul_eq_mul, mul_one]
    nth_rw 1 [this]
    rw [_root_.coe_coe map, LinearMap.coe_restrictScalars]
    simp only [map.coe_coe, map.map_smul, norm_smul, norm_inv, norm_norm]
    field_simp only [one_mul]
  · ext1
    simp only [minor₁, LinearMap.smul_apply, _root_.coe_coe, LinearMap.coe_restrictScalars,
      ContinuousLinearMap.coe_coe, coe_restrict_scalars', coe_smul',
      LinearIsometry.coe_toContinuousLinearMap, LinearIsometry.coe_mk, Pi.smul_apply,
      smul_inv_smul₀, Ne.def, not_false_iff]
#align is_conformal_map_complex_linear isConformalMap_complex_linear

theorem isConformalMap_complex_linear_conj {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) :
    IsConformalMap ((map.restrictScalars ℝ).comp (conjCle : ℂ →L[ℝ] ℂ)) :=
  (isConformalMap_complex_linear nonzero).comp isConformalMap_conj
#align is_conformal_map_complex_linear_conj isConformalMap_complex_linear_conj

end ConformalIntoComplexNormed

section ConformalIntoComplexPlane

open ContinuousLinearMap

variable {f : ℂ → ℂ} {z : ℂ} {g : ℂ →L[ℝ] ℂ}

theorem IsConformalMap.is_complex_or_conj_linear (h : IsConformalMap g) :
    (∃ map : ℂ →L[ℂ] ℂ, map.restrictScalars ℝ = g) ∨
      ∃ map : ℂ →L[ℂ] ℂ, map.restrictScalars ℝ = g ∘L ↑conjCle :=
  by
  rcases h with ⟨c, hc, li, rfl⟩
  obtain ⟨li, rfl⟩ : ∃ li' : ℂ ≃ₗᵢ[ℝ] ℂ, li'.toLinearIsometry = li
  exact
    ⟨li.to_linear_isometry_equiv rfl, by
      ext1
      rfl⟩
  rcases linear_isometry_complex li with ⟨a, rfl | rfl⟩
  -- let rot := c • (a : ℂ) • continuous_linear_map.id ℂ ℂ,
  · refine' Or.inl ⟨c • (a : ℂ) • ContinuousLinearMap.id ℂ ℂ, _⟩
    ext1
    simp only [coe_restrict_scalars', smul_apply, LinearIsometry.coe_toContinuousLinearMap,
      LinearIsometryEquiv.coe_toLinearIsometry, rotation_apply, id_apply, smul_eq_mul]
  · refine' Or.inr ⟨c • (a : ℂ) • ContinuousLinearMap.id ℂ ℂ, _⟩
    ext1
    simp only [coe_restrict_scalars', smul_apply, LinearIsometry.coe_toContinuousLinearMap,
      LinearIsometryEquiv.coe_toLinearIsometry, rotation_apply, id_apply, smul_eq_mul, comp_apply,
      LinearIsometryEquiv.trans_apply, ContinuousLinearEquiv.coe_coe, conj_cle_apply,
      conj_lie_apply, conj_conj]
#align is_conformal_map.is_complex_or_conj_linear IsConformalMap.is_complex_or_conj_linear

/-- A real continuous linear map on the complex plane is conformal if and only if the map or its
    conjugate is complex linear, and the map is nonvanishing. -/
theorem isConformalMap_iff_is_complex_or_conj_linear :
    IsConformalMap g ↔
      ((∃ map : ℂ →L[ℂ] ℂ, map.restrictScalars ℝ = g) ∨
          ∃ map : ℂ →L[ℂ] ℂ, map.restrictScalars ℝ = g ∘L ↑conjCle) ∧
        g ≠ 0 :=
  by
  constructor
  · exact fun h => ⟨h.is_complex_or_conj_linear, h.NeZero⟩
  · rintro ⟨⟨map, rfl⟩ | ⟨map, hmap⟩, h₂⟩
    · refine' isConformalMap_complex_linear _
      contrapose! h₂ with w
      simp only [w, restrict_scalars_zero]
    · have minor₁ : g = map.restrict_scalars ℝ ∘L ↑conj_cle :=
        by
        ext1
        simp only [hmap, coe_comp', ContinuousLinearEquiv.coe_coe, Function.comp_apply,
          conj_cle_apply, starRingEnd_self_apply]
      rw [minor₁] at h₂⊢
      refine' isConformalMap_complex_linear_conj _
      contrapose! h₂ with w
      simp only [w, restrict_scalars_zero, zero_comp]
#align is_conformal_map_iff_is_complex_or_conj_linear isConformalMap_iff_is_complex_or_conj_linear

end ConformalIntoComplexPlane