/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Eric Wieser
-/
import analysis.specific_limits.basic
import analysis.analytic.basic
import analysis.complex.basic
import data.nat.choose.cast
import data.finset.noncomm_prod

/-!
# Exponential in a Banach algebra

In this file, we define `exp 𝕂 : 𝔸 → 𝔸`, the exponential map in a topological algebra `𝔸` over a
field `𝕂`.

While for most interesting results we need `𝔸` to be normed algebra, we do not require this in the
definition in order to make `exp` independent of a particular choice of norm. The definition also
does not require that `𝔸` be complete, but we need to assume it for most results.

We then prove some basic results, but we avoid importing derivatives here to minimize dependencies.
Results involving derivatives and comparisons with `real.exp` and `complex.exp` can be found in
`analysis/special_functions/exponential`.

## Main results

We prove most result for an arbitrary field `𝕂`, and then specialize to `𝕂 = ℝ` or `𝕂 = ℂ`.

### General case

- `exp_add_of_commute_of_mem_ball` : if `𝕂` has characteristic zero, then given two commuting
  elements `x` and `y` in the disk of convergence, we have
  `exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`
- `exp_add_of_mem_ball` : if `𝕂` has characteristic zero and `𝔸` is commutative, then given two
  elements `x` and `y` in the disk of convergence, we have
  `exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`
- `exp_neg_of_mem_ball` : if `𝕂` has characteristic zero and `𝔸` is a division ring, then given an
  element `x` in the disk of convergence, we have `exp 𝕂 (-x) = (exp 𝕂 x)⁻¹`.

### `𝕂 = ℝ` or `𝕂 = ℂ`

- `exp_series_radius_eq_top` : the `formal_multilinear_series` defining `exp 𝕂` has infinite
  radius of convergence
- `exp_add_of_commute` : given two commuting elements `x` and `y`, we have
  `exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`
- `exp_add` : if `𝔸` is commutative, then we have `exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`
  for any `x` and `y`
- `exp_neg` : if `𝔸` is a division ring, then we have `exp 𝕂 (-x) = (exp 𝕂 x)⁻¹`.
- `exp_sum_of_commute` : the analogous result to `exp_add_of_commute` for `finset.sum`.
- `exp_sum` : the analogous result to `exp_add` for `finset.sum`.
- `exp_nsmul` : repeated addition in the domain corresponds to repeated multiplication in the
  codomain.
- `exp_zsmul` : repeated addition in the domain corresponds to repeated multiplication in the
  codomain.

### Other useful compatibility results

- `exp_eq_exp` : if `𝔸` is a normed algebra over two fields `𝕂` and `𝕂'`, then `exp 𝕂 = exp 𝕂' 𝔸`

-/

open filter is_R_or_C continuous_multilinear_map normed_field asymptotics
open_locale nat topological_space big_operators ennreal

section topological_algebra

variables (𝕂 𝔸 : Type*) [field 𝕂] [ring 𝔸] [algebra 𝕂 𝔸] [topological_space 𝔸]
  [topological_ring 𝔸]

/-- `exp_series 𝕂 𝔸` is the `formal_multilinear_series` whose `n`-th term is the map
`(xᵢ) : 𝔸ⁿ ↦ (1/n! : 𝕂) • ∏ xᵢ`. Its sum is the exponential map `exp 𝕂 : 𝔸 → 𝔸`. -/
def exp_series : formal_multilinear_series 𝕂 𝔸 𝔸 :=
λ n, (n!⁻¹ : 𝕂) • continuous_multilinear_map.mk_pi_algebra_fin 𝕂 n 𝔸

variables {𝔸}

/-- `exp 𝕂 : 𝔸 → 𝔸` is the exponential map determined by the action of `𝕂` on `𝔸`.
It is defined as the sum of the `formal_multilinear_series` `exp_series 𝕂 𝔸`.

Note that when `𝔸 = matrix n n 𝕂`, this is the **Matrix Exponential**; see
[`analysis.normed_space.matrix_exponential`](../matrix_exponential) for lemmas specific to that
case. -/
noncomputable def exp (x : 𝔸) : 𝔸 := (exp_series 𝕂 𝔸).sum x

variables {𝕂}

lemma exp_series_apply_eq (x : 𝔸) (n : ℕ) : exp_series 𝕂 𝔸 n (λ _, x) = (n!⁻¹ : 𝕂) • x^n :=
by simp [exp_series]

lemma exp_series_apply_eq' (x : 𝔸) :
  (λ n, exp_series 𝕂 𝔸 n (λ _, x)) = (λ n, (n!⁻¹ : 𝕂) • x^n) :=
funext (exp_series_apply_eq x)

lemma exp_series_sum_eq (x : 𝔸) : (exp_series 𝕂 𝔸).sum x = ∑' (n : ℕ), (n!⁻¹ : 𝕂) • x^n :=
tsum_congr (λ n, exp_series_apply_eq x n)

lemma exp_eq_tsum : exp 𝕂 = (λ x : 𝔸, ∑' (n : ℕ), (n!⁻¹ : 𝕂) • x^n) :=
funext exp_series_sum_eq

@[simp] lemma exp_zero [t2_space 𝔸] : exp 𝕂 (0 : 𝔸) = 1 :=
begin
  suffices : (λ x : 𝔸, ∑' (n : ℕ), (n!⁻¹ : 𝕂) • x^n) 0 = ∑' (n : ℕ), if n = 0 then 1 else 0,
  { have key : ∀ n ∉ ({0} : finset ℕ), (if n = 0 then (1 : 𝔸) else 0) = 0,
      from λ n hn, if_neg (finset.not_mem_singleton.mp hn),
    rw [exp_eq_tsum, this, tsum_eq_sum key, finset.sum_singleton],
    simp },
  refine tsum_congr (λ n, _),
  split_ifs with h h;
  simp [h]
end

@[simp] lemma exp_op [t2_space 𝔸] (x : 𝔸) :
  exp 𝕂 (mul_opposite.op x) = mul_opposite.op (exp 𝕂 x) :=
by simp_rw [exp, exp_series_sum_eq, ←mul_opposite.op_pow, ←mul_opposite.op_smul, tsum_op]

@[simp] lemma exp_unop [t2_space 𝔸] (x : 𝔸ᵐᵒᵖ) :
  exp 𝕂 (mul_opposite.unop x) = mul_opposite.unop (exp 𝕂 x) :=
by simp_rw [exp, exp_series_sum_eq, ←mul_opposite.unop_pow, ←mul_opposite.unop_smul, tsum_unop]

lemma star_exp [t2_space 𝔸] [star_ring 𝔸] [has_continuous_star 𝔸] (x : 𝔸) :
  star (exp 𝕂 x) = exp 𝕂 (star x) :=
by simp_rw [exp_eq_tsum, ←star_pow, ←star_inv_nat_cast_smul, ←tsum_star]

variables (𝕂)

lemma commute.exp_right [t2_space 𝔸] {x y : 𝔸} (h : commute x y) : commute x (exp 𝕂 y) :=
begin
  rw exp_eq_tsum,
  exact commute.tsum_right x (λ n, (h.pow_right n).smul_right _),
end

lemma commute.exp_left [t2_space 𝔸] {x y : 𝔸} (h : commute x y) : commute (exp 𝕂 x) y :=
(h.symm.exp_right 𝕂).symm

lemma commute.exp [t2_space 𝔸] {x y : 𝔸} (h : commute x y) : commute (exp 𝕂 x) (exp 𝕂 y) :=
(h.exp_left _).exp_right _

end topological_algebra

section topological_division_algebra
variables {𝕂 𝔸 : Type*} [field 𝕂] [division_ring 𝔸] [algebra 𝕂 𝔸] [topological_space 𝔸]
  [topological_ring 𝔸]

lemma exp_series_apply_eq_div (x : 𝔸) (n : ℕ) : exp_series 𝕂 𝔸 n (λ _, x) = x^n / n! :=
by rw [div_eq_mul_inv, ←(nat.cast_commute n! (x ^ n)).inv_left₀.eq, ←smul_eq_mul,
    exp_series_apply_eq, inv_nat_cast_smul_eq _ _ _ _]

lemma exp_series_apply_eq_div' (x : 𝔸) : (λ n, exp_series 𝕂 𝔸 n (λ _, x)) = (λ n, x^n / n!) :=
funext (exp_series_apply_eq_div x)

lemma exp_series_sum_eq_div (x : 𝔸) : (exp_series 𝕂 𝔸).sum x = ∑' (n : ℕ), x^n / n! :=
tsum_congr (exp_series_apply_eq_div x)

lemma exp_eq_tsum_div : exp 𝕂 = (λ x : 𝔸, ∑' (n : ℕ), x^n / n!) :=
funext exp_series_sum_eq_div

end topological_division_algebra

section normed

section any_field_any_algebra

variables {𝕂 𝔸 𝔹 : Type*} [nondiscrete_normed_field 𝕂]
variables [normed_ring 𝔸] [normed_ring 𝔹] [normed_algebra 𝕂 𝔸] [normed_algebra 𝕂 𝔹]

lemma norm_exp_series_summable_of_mem_ball (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  summable (λ n, ∥exp_series 𝕂 𝔸 n (λ _, x)∥) :=
(exp_series 𝕂 𝔸).summable_norm_apply hx

lemma norm_exp_series_summable_of_mem_ball' (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  summable (λ n, ∥(n!⁻¹ : 𝕂) • x^n∥) :=
begin
  change summable (norm ∘ _),
  rw ← exp_series_apply_eq',
  exact norm_exp_series_summable_of_mem_ball x hx
end

section complete_algebra

variables [complete_space 𝔸]

lemma exp_series_summable_of_mem_ball (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  summable (λ n, exp_series 𝕂 𝔸 n (λ _, x)) :=
summable_of_summable_norm (norm_exp_series_summable_of_mem_ball x hx)

lemma exp_series_summable_of_mem_ball' (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  summable (λ n, (n!⁻¹ : 𝕂) • x^n) :=
summable_of_summable_norm (norm_exp_series_summable_of_mem_ball' x hx)

lemma exp_series_has_sum_exp_of_mem_ball (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  has_sum (λ n, exp_series 𝕂 𝔸 n (λ _, x)) (exp 𝕂 x) :=
formal_multilinear_series.has_sum (exp_series 𝕂 𝔸) hx

lemma exp_series_has_sum_exp_of_mem_ball' (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  has_sum (λ n, (n!⁻¹ : 𝕂) • x^n) (exp 𝕂 x):=
begin
  rw ← exp_series_apply_eq',
  exact exp_series_has_sum_exp_of_mem_ball x hx
end

lemma has_fpower_series_on_ball_exp_of_radius_pos (h : 0 < (exp_series 𝕂 𝔸).radius) :
  has_fpower_series_on_ball (exp 𝕂) (exp_series 𝕂 𝔸) 0 (exp_series 𝕂 𝔸).radius :=
(exp_series 𝕂 𝔸).has_fpower_series_on_ball h

lemma has_fpower_series_at_exp_zero_of_radius_pos (h : 0 < (exp_series 𝕂 𝔸).radius) :
  has_fpower_series_at (exp 𝕂) (exp_series 𝕂 𝔸) 0 :=
(has_fpower_series_on_ball_exp_of_radius_pos h).has_fpower_series_at

lemma continuous_on_exp :
  continuous_on (exp 𝕂 : 𝔸 → 𝔸) (emetric.ball 0 (exp_series 𝕂 𝔸).radius) :=
formal_multilinear_series.continuous_on

lemma analytic_at_exp_of_mem_ball (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  analytic_at 𝕂 (exp 𝕂) x:=
begin
  by_cases h : (exp_series 𝕂 𝔸).radius = 0,
  { rw h at hx, exact (ennreal.not_lt_zero hx).elim },
  { have h := pos_iff_ne_zero.mpr h,
    exact (has_fpower_series_on_ball_exp_of_radius_pos h).analytic_at_of_mem hx }
end

/-- In a Banach-algebra `𝔸` over a normed field `𝕂` of characteristic zero, if `x` and `y` are
in the disk of convergence and commute, then `exp 𝕂 (x + y) = (exp 𝕂 x) * (exp 𝕂 y)`. -/
lemma exp_add_of_commute_of_mem_ball [char_zero 𝕂]
  {x y : 𝔸} (hxy : commute x y) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius)
  (hy : y ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  exp 𝕂 (x + y) = (exp 𝕂 x) * (exp 𝕂 y) :=
begin
  rw [exp_eq_tsum, tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm
        (norm_exp_series_summable_of_mem_ball' x hx) (norm_exp_series_summable_of_mem_ball' y hy)],
  dsimp only,
  conv_lhs {congr, funext, rw [hxy.add_pow' _, finset.smul_sum]},
  refine tsum_congr (λ n, finset.sum_congr rfl $ λ kl hkl, _),
  rw [nsmul_eq_smul_cast 𝕂, smul_smul, smul_mul_smul, ← (finset.nat.mem_antidiagonal.mp hkl),
      nat.cast_add_choose, (finset.nat.mem_antidiagonal.mp hkl)],
  congr' 1,
  have : (n! : 𝕂) ≠ 0 := nat.cast_ne_zero.mpr n.factorial_ne_zero,
  field_simp [this]
end

/-- `exp 𝕂 x` has explicit two-sided inverse `exp 𝕂 (-x)`. -/
noncomputable def invertible_exp_of_mem_ball [char_zero 𝕂] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : invertible (exp 𝕂 x) :=
{ inv_of := exp 𝕂 (-x),
  inv_of_mul_self := begin
    have hnx : -x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius,
    { rw [emetric.mem_ball, ←neg_zero, edist_neg_neg],
      exact hx },
    rw [←exp_add_of_commute_of_mem_ball (commute.neg_left $ commute.refl x) hnx hx, neg_add_self,
      exp_zero],
  end,
  mul_inv_of_self := begin
    have hnx : -x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius,
    { rw [emetric.mem_ball, ←neg_zero, edist_neg_neg],
      exact hx },
    rw [←exp_add_of_commute_of_mem_ball (commute.neg_right $ commute.refl x) hx hnx, add_neg_self,
      exp_zero],
  end }

lemma is_unit_exp_of_mem_ball [char_zero 𝕂] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : is_unit (exp 𝕂 x) :=
@is_unit_of_invertible _ _ _ (invertible_exp_of_mem_ball hx)

lemma inv_of_exp_of_mem_ball [char_zero 𝕂] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) [invertible (exp 𝕂 x)] :
  ⅟(exp 𝕂 x) = exp 𝕂 (-x) :=
by { letI := invertible_exp_of_mem_ball hx, convert (rfl : ⅟(exp 𝕂 x) = _) }

/-- Any continuous ring homomorphism commutes with `exp`. -/
lemma map_exp_of_mem_ball {F} [ring_hom_class F 𝔸 𝔹] (f : F) (hf : continuous f) (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  f (exp 𝕂 x) = exp 𝕂 (f x) :=
begin
  rw [exp_eq_tsum, exp_eq_tsum],
  refine ((exp_series_summable_of_mem_ball' _ hx).has_sum.map f hf).tsum_eq.symm.trans _,
  dsimp only [function.comp],
  simp_rw [one_div, map_inv_nat_cast_smul f 𝕂 𝕂, map_pow],
end

end complete_algebra

lemma algebra_map_exp_comm_of_mem_ball [complete_space 𝕂] (x : 𝕂)
  (hx : x ∈ emetric.ball (0 : 𝕂) (exp_series 𝕂 𝕂).radius) :
  algebra_map 𝕂 𝔸 (exp 𝕂 x) = exp 𝕂 (algebra_map 𝕂 𝔸 x) :=
map_exp_of_mem_ball _ (algebra_map_clm _ _).continuous _ hx

end any_field_any_algebra

section any_field_division_algebra

variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_division_ring 𝔸] [normed_algebra 𝕂 𝔸]

variables (𝕂)

lemma norm_exp_series_div_summable_of_mem_ball (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  summable (λ n, ∥x^n / n!∥) :=
begin
  change summable (norm ∘ _),
  rw ← exp_series_apply_eq_div' x,
  exact norm_exp_series_summable_of_mem_ball x hx
end

lemma exp_series_div_summable_of_mem_ball [complete_space 𝔸] (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : summable (λ n, x^n / n!) :=
summable_of_summable_norm (norm_exp_series_div_summable_of_mem_ball 𝕂 x hx)

lemma exp_series_div_has_sum_exp_of_mem_ball [complete_space 𝔸] (x : 𝔸)
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : has_sum (λ n, x^n / n!) (exp 𝕂 x) :=
begin
  rw ← exp_series_apply_eq_div' x,
  exact exp_series_has_sum_exp_of_mem_ball x hx
end

variables {𝕂}

lemma exp_neg_of_mem_ball [char_zero 𝕂] [complete_space 𝔸] {x : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  exp 𝕂 (-x) = (exp 𝕂 x)⁻¹ :=
begin
  letI := invertible_exp_of_mem_ball hx,
  exact inv_of_eq_inv (exp 𝕂 x),
end

end any_field_division_algebra

section any_field_comm_algebra

variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸]
  [complete_space 𝔸]

/-- In a commutative Banach-algebra `𝔸` over a normed field `𝕂` of characteristic zero,
`exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)` for all `x`, `y` in the disk of convergence. -/
lemma exp_add_of_mem_ball [char_zero 𝕂] {x y : 𝔸}
  (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius)
  (hy : y ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) :
  exp 𝕂 (x + y) = (exp 𝕂 x) * (exp 𝕂 y) :=
exp_add_of_commute_of_mem_ball (commute.all x y) hx hy

end any_field_comm_algebra

section is_R_or_C

section any_algebra

variables (𝕂 𝔸 𝔹 : Type*) [is_R_or_C 𝕂] [normed_ring 𝔸] [normed_algebra 𝕂 𝔸]
variables [normed_ring 𝔹] [normed_algebra 𝕂 𝔹]

/-- In a normed algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, the series defining the exponential map
has an infinite radius of convergence. -/
lemma exp_series_radius_eq_top : (exp_series 𝕂 𝔸).radius = ∞ :=
begin
  refine (exp_series 𝕂 𝔸).radius_eq_top_of_summable_norm (λ r, _),
  refine summable_of_norm_bounded_eventually _ (real.summable_pow_div_factorial r) _,
  filter_upwards [eventually_cofinite_ne 0] with n hn,
  rw [norm_mul, norm_norm (exp_series 𝕂 𝔸 n), exp_series, norm_smul, norm_inv, norm_pow,
      nnreal.norm_eq, norm_eq_abs, abs_cast_nat, mul_comm, ←mul_assoc, ←div_eq_mul_inv],
  have : ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕂 n 𝔸∥ ≤ 1 :=
    norm_mk_pi_algebra_fin_le_of_pos (nat.pos_of_ne_zero hn),
  exact mul_le_of_le_one_right (div_nonneg (pow_nonneg r.coe_nonneg n) n!.cast_nonneg) this
end

lemma exp_series_radius_pos : 0 < (exp_series 𝕂 𝔸).radius :=
begin
  rw exp_series_radius_eq_top,
  exact with_top.zero_lt_top
end

variables {𝕂 𝔸 𝔹}

lemma norm_exp_series_summable (x : 𝔸) : summable (λ n, ∥exp_series 𝕂 𝔸 n (λ _, x)∥) :=
norm_exp_series_summable_of_mem_ball x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

lemma norm_exp_series_summable' (x : 𝔸) : summable (λ n, ∥(n!⁻¹ : 𝕂) • x^n∥) :=
norm_exp_series_summable_of_mem_ball' x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

section complete_algebra

variables [complete_space 𝔸]

lemma exp_series_summable (x : 𝔸) : summable (λ n, exp_series 𝕂 𝔸 n (λ _, x)) :=
summable_of_summable_norm (norm_exp_series_summable x)

lemma exp_series_summable' (x : 𝔸) : summable (λ n, (n!⁻¹ : 𝕂) • x^n) :=
summable_of_summable_norm (norm_exp_series_summable' x)

lemma exp_series_has_sum_exp (x : 𝔸) : has_sum (λ n, exp_series 𝕂 𝔸 n (λ _, x)) (exp 𝕂 x) :=
exp_series_has_sum_exp_of_mem_ball x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

lemma exp_series_has_sum_exp' (x : 𝔸) : has_sum (λ n, (n!⁻¹ : 𝕂) • x^n) (exp 𝕂 x):=
exp_series_has_sum_exp_of_mem_ball' x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

lemma exp_has_fpower_series_on_ball :
  has_fpower_series_on_ball (exp 𝕂) (exp_series 𝕂 𝔸) 0 ∞ :=
exp_series_radius_eq_top 𝕂 𝔸 ▸
  has_fpower_series_on_ball_exp_of_radius_pos (exp_series_radius_pos _ _)

lemma exp_has_fpower_series_at_zero :
  has_fpower_series_at (exp 𝕂) (exp_series 𝕂 𝔸) 0 :=
exp_has_fpower_series_on_ball.has_fpower_series_at

lemma exp_continuous : continuous (exp 𝕂 : 𝔸 → 𝔸) :=
begin
  rw [continuous_iff_continuous_on_univ, ← metric.eball_top_eq_univ (0 : 𝔸),
      ← exp_series_radius_eq_top 𝕂 𝔸],
  exact continuous_on_exp
end

lemma exp_analytic (x : 𝔸) :
  analytic_at 𝕂 (exp 𝕂) x :=
analytic_at_exp_of_mem_ball x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

/-- In a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, if `x` and `y` commute, then
`exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`. -/
lemma exp_add_of_commute
  {x y : 𝔸} (hxy : commute x y) :
  exp 𝕂 (x + y) = (exp 𝕂 x) * (exp 𝕂 y) :=
exp_add_of_commute_of_mem_ball hxy ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)
  ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

section
variables (𝕂)

/-- `exp 𝕂 x` has explicit two-sided inverse `exp 𝕂 (-x)`. -/
noncomputable def invertible_exp (x : 𝔸) : invertible (exp 𝕂 x) :=
invertible_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _

lemma is_unit_exp (x : 𝔸) : is_unit (exp 𝕂 x) :=
is_unit_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _

lemma inv_of_exp (x : 𝔸) [invertible (exp 𝕂 x)] :
  ⅟(exp 𝕂 x) = exp 𝕂 (-x) :=
inv_of_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _

lemma ring.inverse_exp (x : 𝔸) : ring.inverse (exp 𝕂 x) = exp 𝕂 (-x) :=
begin
  letI := invertible_exp 𝕂 x,
  exact ring.inverse_invertible _,
end

end

/-- In a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, if a family of elements `f i` mutually
commute then `exp 𝕂 (∑ i, f i) = ∏ i, exp 𝕂 (f i)`. -/
lemma exp_sum_of_commute {ι} (s : finset ι) (f : ι → 𝔸)
  (h : ∀ (i ∈ s) (j ∈ s), commute (f i) (f j)) :
  exp 𝕂 (∑ i in s, f i) = s.noncomm_prod (λ i, exp 𝕂 (f i))
    (λ i hi j hj, (h i hi j hj).exp 𝕂) :=
begin
  classical,
  induction s using finset.induction_on with a s ha ih,
  { simp },
  rw [finset.noncomm_prod_insert_of_not_mem _ _ _ _ ha, finset.sum_insert ha,
      exp_add_of_commute, ih],
  refine commute.sum_right _ _ _ _,
  intros i hi,
  exact h _ (finset.mem_insert_self _ _) _ (finset.mem_insert_of_mem hi),
end

lemma exp_nsmul (n : ℕ) (x : 𝔸) :
  exp 𝕂 (n • x) = exp 𝕂 x ^ n :=
begin
  induction n with n ih,
  { rw [zero_smul, pow_zero, exp_zero], },
  { rw [succ_nsmul, pow_succ, exp_add_of_commute ((commute.refl x).smul_right n), ih] }
end

variables (𝕂)

/-- Any continuous ring homomorphism commutes with `exp`. -/
lemma map_exp {F} [ring_hom_class F 𝔸 𝔹] (f : F) (hf : continuous f) (x : 𝔸) :
  f (exp 𝕂 x) = exp 𝕂 (f x) :=
map_exp_of_mem_ball f hf x $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _

lemma exp_smul {G} [monoid G] [mul_semiring_action G 𝔸] [has_continuous_const_smul G 𝔸]
  (g : G) (x : 𝔸) :
  exp 𝕂 (g • x) = g • exp 𝕂 x :=
(map_exp 𝕂 (mul_semiring_action.to_ring_hom G 𝔸 g) (continuous_const_smul _) x).symm

lemma exp_units_conj (y : 𝔸ˣ) (x : 𝔸)  :
  exp 𝕂 (y * x * ↑(y⁻¹) : 𝔸) = y * exp 𝕂 x * ↑(y⁻¹) :=
exp_smul _ (conj_act.to_conj_act y) x

lemma exp_units_conj' (y : 𝔸ˣ) (x : 𝔸)  :
  exp 𝕂 (↑(y⁻¹) * x * y) = ↑(y⁻¹) * exp 𝕂 x * y :=
exp_units_conj _ _ _

@[simp] lemma prod.fst_exp [complete_space 𝔹] (x : 𝔸 × 𝔹) : (exp 𝕂 x).fst = exp 𝕂 x.fst :=
map_exp _ (ring_hom.fst 𝔸 𝔹) continuous_fst x

@[simp] lemma prod.snd_exp [complete_space 𝔹] (x : 𝔸 × 𝔹) : (exp 𝕂 x).snd = exp 𝕂 x.snd :=
map_exp _ (ring_hom.snd 𝔸 𝔹) continuous_snd x

@[simp] lemma pi.exp_apply {ι : Type*} {𝔸 : ι → Type*} [fintype ι]
  [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)]
  (x : Π i, 𝔸 i) (i : ι) :
  exp 𝕂 x i = exp 𝕂 (x i) :=
begin
  -- Lean struggles to infer this instance due to it wanting `[Π i, semi_normed_ring (𝔸 i)]`
  letI : normed_algebra 𝕂 (Π i, 𝔸 i) := pi.normed_algebra _,
  exact map_exp _ (pi.eval_ring_hom 𝔸 i) (continuous_apply _) x
end

lemma pi.exp_def {ι : Type*} {𝔸 : ι → Type*} [fintype ι]
  [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)]
  (x : Π i, 𝔸 i) :
  exp 𝕂 x = λ i, exp 𝕂 (x i) :=
funext $ pi.exp_apply 𝕂 x

lemma function.update_exp {ι : Type*} {𝔸 : ι → Type*} [fintype ι] [decidable_eq ι]
  [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)]
  (x : Π i, 𝔸 i) (j : ι) (xj : 𝔸 j) :
  function.update (exp 𝕂 x) j (exp 𝕂 xj) = exp 𝕂 (function.update x j xj) :=
begin
  ext i,
  simp_rw [pi.exp_def],
  exact (function.apply_update (λ i, exp 𝕂) x j xj i).symm,
end

end complete_algebra

lemma algebra_map_exp_comm (x : 𝕂) :
  algebra_map 𝕂 𝔸 (exp 𝕂 x) = exp 𝕂 (algebra_map 𝕂 𝔸 x) :=
algebra_map_exp_comm_of_mem_ball x $
  (exp_series_radius_eq_top 𝕂 𝕂).symm ▸ edist_lt_top _ _

end any_algebra

section division_algebra

variables {𝕂 𝔸 : Type*} [is_R_or_C 𝕂] [normed_division_ring 𝔸] [normed_algebra 𝕂 𝔸]

variables (𝕂)

lemma norm_exp_series_div_summable (x : 𝔸) : summable (λ n, ∥x^n / n!∥) :=
norm_exp_series_div_summable_of_mem_ball 𝕂 x
  ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

variables [complete_space 𝔸]

lemma exp_series_div_summable (x : 𝔸) : summable (λ n, x^n / n!) :=
summable_of_summable_norm (norm_exp_series_div_summable 𝕂 x)

lemma exp_series_div_has_sum_exp (x : 𝔸) : has_sum (λ n, x^n / n!) (exp 𝕂 x):=
exp_series_div_has_sum_exp_of_mem_ball 𝕂 x
  ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

variables {𝕂}

lemma exp_neg (x : 𝔸) : exp 𝕂 (-x) = (exp 𝕂 x)⁻¹ :=
exp_neg_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _

lemma exp_zsmul (z : ℤ) (x : 𝔸) : exp 𝕂 (z • x) = (exp 𝕂 x) ^ z :=
begin
  obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg,
  { rw [zpow_coe_nat, coe_nat_zsmul, exp_nsmul] },
  { rw [zpow_neg, zpow_coe_nat, neg_smul, exp_neg, coe_nat_zsmul, exp_nsmul] },
end

lemma exp_conj (y : 𝔸) (x : 𝔸) (hy : y ≠ 0) :
  exp 𝕂 (y * x * y⁻¹) = y * exp 𝕂 x * y⁻¹ :=
exp_units_conj _ (units.mk0 y hy) x

lemma exp_conj' (y : 𝔸) (x : 𝔸)  (hy : y ≠ 0) :
  exp 𝕂 (y⁻¹ * x * y) = y⁻¹ * exp 𝕂 x * y :=
exp_units_conj' _ (units.mk0 y hy) x

end division_algebra

section comm_algebra

variables {𝕂 𝔸 : Type*} [is_R_or_C 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸]

/-- In a commutative Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`,
`exp 𝕂 (x+y) = (exp 𝕂 x) * (exp 𝕂 y)`. -/
lemma exp_add {x y : 𝔸} : exp 𝕂 (x + y) = (exp 𝕂 x) * (exp 𝕂 y) :=
exp_add_of_mem_ball ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)
  ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _)

/-- A version of `exp_sum_of_commute` for a commutative Banach-algebra. -/
lemma exp_sum {ι} (s : finset ι) (f : ι → 𝔸) :
  exp 𝕂 (∑ i in s, f i) = ∏ i in s, exp 𝕂 (f i) :=
begin
  rw [exp_sum_of_commute, finset.noncomm_prod_eq_prod],
  exact λ i hi j hj, commute.all _ _,
end

end comm_algebra

end is_R_or_C

end normed

section scalar_tower

variables (𝕂 𝕂' 𝔸 : Type*) [field 𝕂] [field 𝕂'] [ring 𝔸] [algebra 𝕂 𝔸] [algebra 𝕂' 𝔸]
  [topological_space 𝔸] [topological_ring 𝔸]

/-- If a normed ring `𝔸` is a normed algebra over two fields, then they define the same
`exp_series` on `𝔸`. -/
lemma exp_series_eq_exp_series (n : ℕ) (x : 𝔸) :
  (exp_series 𝕂 𝔸 n (λ _, x)) = (exp_series 𝕂' 𝔸 n (λ _, x)) :=
by rw [exp_series_apply_eq, exp_series_apply_eq, inv_nat_cast_smul_eq 𝕂 𝕂']

/-- If a normed ring `𝔸` is a normed algebra over two fields, then they define the same
exponential function on `𝔸`. -/
lemma exp_eq_exp : (exp 𝕂 : 𝔸 → 𝔸) = exp 𝕂' :=
begin
  ext,
  rw [exp, exp],
  refine tsum_congr (λ n, _),
  rw exp_series_eq_exp_series 𝕂 𝕂' 𝔸 n x
end

lemma exp_ℝ_ℂ_eq_exp_ℂ_ℂ : (exp ℝ : ℂ → ℂ) = exp ℂ :=
exp_eq_exp ℝ ℂ ℂ

end scalar_tower


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

Examples to test finish. (The designations "clarify," "safe," "iauto," etc. are
from a previous tableau prover.)
-/
import tactic.finish
open auto

section
variables A B C D : Prop

/- clarify -/

example (H : ¬ A) (H' : A) : C := by finish
example (H₁ : A ∧ A ∧ B) (H₂ : A ∧ C ∧ B) : A := by finish

/- safe -/

example (H : A) (H₁ : ¬ B) : ¬ (A → B) := by finish
example : A ∨ B → B ∨ A := by finish
example : A ∧ B → B ∧ A := by finish
example (H : A) (H₁ : A → B) (H₂ : B → C) : C := by finish
example (H₁ : A ∧ B) (H₂ : C ∧ B) : C := by finish
example (HA : A) (HB : B) (HC : C) (HD : D) : (A ∧ B) ∧ (C ∧ D) := by finish
example (H₁ : A ∧ B) (H₂ : B ∧ ¬ C) : A ∨ C := by finish
example : (A → B) ∧ (B → C) → A → C := by finish
example : (A → B) ∨ (B → A) := by finish
example : ((A → B) → A) → A := by finish

/- iauto -/

example (H : A) (H₁ : ¬ B) : ¬ (A → B) := by finish
example : ¬ (A ↔ ¬ A) := by finish
example (H : A ↔ B) (H₁ : A ∧ B → C) (H₂ : ¬ A ∧ ¬ B → C) : C := by finish
example (H : A ↔ B) (H₁ : (A ∧ ¬ B) ∨ (¬ A ∧ B)) : C := by finish
example (H : A → B) (H₁ : A) : B := by finish
example (H : A → B) (H₁ : B → C) : A → C := by finish
example (H : A → B ∨ C) (H₁ : B → D) (H₂ : C → D) : A → D := by finish
example : A ∨ B → B ∨ A := by finish

/- using injectivity -/

section
open nat

example (x y : ℕ) : succ x = succ y → x = y ∨ x = succ y := by finish
example (x y z : ℕ) : succ (succ x) = succ y ∧ y = succ z →
  y = succ x ∧ succ x = succ z :=
by finish

end

/-
-- Examples with quantifiers
-/

section
variables (X : Type) (P Q R : X → Prop) (T : X → X → Prop) (a b : X)

/- auto -/

example (H : ∀ x, P x → Q x) (H₁ : ∀ x, P x) : Q a := by finish
example (H : ∀ x, P x → Q x) (H₁ : P a) : Q a := by finish

/- iauto -/

example (H₁ : P a) (H₂ : P b) : ∃ x, P x := by finish
example (H₁ : P a) (H₂ : P b) (H₃ : Q b) : ∃ x, P x ∧ Q x := by finish
example (H₁ : P b) (H₂ : Q b) (H₃ : P a) : ∃ x, P x ∧ Q x := by finish
example (H : ∀ x, P x → Q x ∧ R x) (a : X) (H₁ : P a) : R a ∧ Q a := by finish
example (H : ∃ x, P x ∧ Q x) : ∃ x, Q x ∧ P x := by finish

-- not valid in dependent type theory!
-- example : ∃ x, ((∃ y, P y) → P x) :=
-- by auto'

/- Beyond the scope of finish.
example (H : ∃ x : X, x = x) : ∃ x, ((∃ y, P y) → P x) := by finish
example : (∃ x, ∀ y, T x y) → ∀ y, ∃ x, T x y := by finish
-/

end

example (x y z : ℕ) (p : ℕ → Prop) (h₀ : x = y) (h₁ : y = z) (h₂ : ∀ w, w = z → p w) : p x :=
by finish

end

/-
  more examples
-/

constant foo : Prop
axiom not_foo : ¬ foo

section

variables a b c d : Prop

example : a ∧ b → a := by finish
example : a → (a → b) → (b → c) ∧ (d → ¬ c) → ¬ d := by finish

example : a ∨ b → b ∨ a := by finish

example : ¬ (a ↔ ¬ a) :=
begin
  finish
end

/- examples of tactics that leave goals -/

/-
example : a ∨ b ∨ foo → b ∨ a :=
begin
  clarify,
  admit
end

example : a ∨ b ∨ foo ∨ foo → b ∨ a :=
begin
  safe,
  admit
end

example : a ∨ b ∨ c → ¬ a → ¬ b → d :=
begin
  safe,
  admit
end
-/

end

section

variables (a b c : ℕ) (p q : ℕ → Prop) (r : ℕ → ℕ → Prop)
variables (P Q R : Prop)
variable  (g : bool → nat)

example (h₁ : ∀ x, p x → q x) (h₂ : ∀ x, p x) : q a :=
by finish

example (h₁ : p a) : ∃ x, p x :=
by finish

example (h₁ : p a) (h₂ : p b) (h₃ : q b) : ∃ x, p x ∧ q x :=
by finish

example (h : ∃ x, p x ∧ r x x) (h' : ∀ x, r x x → q x) : ∃ x, p x ∧ q x :=
by finish

example (h : ∃ x, q x ∧ p x)  : ∃ x, p x ∧ q x :=
by finish

example (h₁ : ∀ x, q x → p x) (h₃ : q a)  : ∃ x, p x :=
by finish

example (h₁ : ∀ x, p x → q x → false) (h₂ : p a) (h₃ : p b) (h₄ : q b) : false :=
by finish

example (h : ∀ x, p x) (h₁ : ∀ x, p x → q x) : ∀ x, q x :=
by finish

example (h : ∃ x, p x) (h₁ : ∀ x, p x → q x) : ∃ x, q x :=
by finish

example (h : ¬ ∀ x, ¬ p x) (h₁ : ∀ x, p x → q x) (h₂ : ∀ x, ¬ q x) : false :=
by finish

/-
example (h : p a) (h' : p a → false) : false :=
by finish
-/

end

section
  variables a b c d : Prop
  variables (p q : ℕ → Prop) (r : ℕ → ℕ → Prop)

  example (h₁ : ¬ (a → b ∨ c)) (h₂ : ¬ (b ∨ ¬ c)) : true :=
  begin
    normalize_hyps {classical := false},
    trivial
  end

  example (h : ¬ ∀ x, (∃ y, r x y) → p x) : true :=
  begin
    normalize_hyps {},
    trivial
  end

  example (h₁ : a → b ∨ c) (h₂ : ¬ b) : a → c :=
  begin
    simp * at *,
    assumption
  end
end


import tactic.ring
import tactic.tidy
import linear_algebra.matrix.special_linear_group
import linear_algebra.determinant
import data.matrix.notation
import linear_algebra.matrix
import linear_algebra.matrix.general_linear_group
import data.complex.basic

--import .matrix_groups

/-  This is an attempt to update the kbb birthday repo, so most is not orginal to me-/
open finset
open matrix

open_locale matrix

section
universe u

variables (n : Type* )  [decidable_eq n] [fintype n]

def  integral_matrices_with_determinant  (m : ℤ ) :={ A : matrix n n ℤ  // A.det = m }

lemma SLnZ_eq_Mat_1 : (special_linear_group n ℤ) = (integral_matrices_with_determinant n 1):=
begin
refl,
end

variable (m: ℤ)

instance coe_matrix : has_coe (integral_matrices_with_determinant n m) (matrix n n ℤ) :=
⟨λ A, A.val⟩

instance coe_fun : has_coe_to_fun (integral_matrices_with_determinant n m) (λ _, n → n → ℤ) :=
{ coe := λ A, A.val }

def to_lin' (A : integral_matrices_with_determinant n m) := matrix.to_lin' A

namespace integral_matrices_with_determinant

lemma ext_iff (A B :  integral_matrices_with_determinant n m) : A = B ↔ (∀ i j, A i j = B i j) :=
iff.trans subtype.ext_iff_val ⟨(λ h i j, congr_fun (congr_fun h i) j), matrix.ext⟩

@[ext] lemma ext (A B : integral_matrices_with_determinant n m) : (∀ i j, A i j = B i j) → A = B :=
begin
rw ext_iff,
simp,
end

@[simp]lemma mat_m_vals (A : integral_matrices_with_determinant n m): ∀ i j,
A i j = A.1 i j  :=
begin
intros i j, refl,
end

def SLnZ_M (m : ℤ) :
special_linear_group n ℤ → (integral_matrices_with_determinant n  m) → (integral_matrices_with_determinant n m) :=
λ A B, ⟨A.1 ⬝ B.1, by erw [det_mul, A.2, B.2, one_mul]⟩

lemma one_smul'  : ∀ (M: integral_matrices_with_determinant n m ),
  SLnZ_M n m (1:(special_linear_group n ℤ)) M = M :=
begin
rw SLnZ_M,
simp,
end

lemma mul_smul' : ∀ (A B : special_linear_group n ℤ ), ∀ (M: integral_matrices_with_determinant n m ),
 SLnZ_M n  m (A * B ) M= SLnZ_M n m A (SLnZ_M n m B M):=
begin
simp [SLnZ_M],
intros A B M,
simp [matrix.mul_assoc],
end

instance (m: ℤ )  :
mul_action  ( special_linear_group n ℤ) (integral_matrices_with_determinant n  m):=
{ smul := SLnZ_M n (m : ℤ),
  one_smul := one_smul' n (m: ℤ ),
  mul_smul := mul_smul' n (m:ℤ ) }

variables  (A : special_linear_group n ℤ) (M : integral_matrices_with_determinant n m)

@[simp] lemma smul_is_mul (A : special_linear_group n ℤ) (M : integral_matrices_with_determinant n m):
  (A • M).1 =A * M :=
begin
simp [SLnZ_M],
refl,
end

instance : has_coe (integral_matrices_with_determinant n 1) (special_linear_group n ℤ) :=
⟨ λ a, ⟨a.1, a.2⟩⟩

section has_neg

variables  ( B : integral_matrices_with_determinant n m) [fact (even (fintype.card n))]

instance : has_neg (integral_matrices_with_determinant n m) :=
⟨λ g,
  ⟨- g, by {
  have:= det_smul g (-1),
  simp at this,
  rw this,
  simp [even.neg_one_pow (fact.out (even (fintype.card n)))],
  have gdet:=g.property,
  simp at gdet,
  exact gdet,}⟩⟩

@[simp] lemma mat_m_coe_neg (g : integral_matrices_with_determinant n m) : ↑(- g) = - (↑g : matrix n n ℤ) :=
rfl

@[simp]lemma mat_m_neg_elt (g : integral_matrices_with_determinant n m):
  ∀ i j, ( ↑(-g): matrix n n ℤ) i j= - (g i j) :=
begin
simp,
end

end has_neg

end integral_matrices_with_determinant

end


variables (x y z : ℕ) (p : ℕ → Prop)
variable  (h : p (x * y))

example : (x + 0) * (0 + y * 1 + z * 0) = x * y :=
  by simp

include h
example : p ((x + 0) * (0 + y * 1 + z * 0)) :=
  by { simp, assumption }


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

import ring_theory.witt_vector.basic
import ring_theory.witt_vector.is_poly

/-!

# `init` and `tail`

Given a Witt vector `x`, we are sometimes interested
in its components before and after an index `n`.
This file defines those operations, proves that `init` is polynomial,
and shows how that polynomial interacts with `mv_polynomial.bind₁`.

## Main declarations

* `witt_vector.init n x`: the first `n` coefficients of `x`, as a Witt vector. All coefficients at
  indices ≥ `n` are 0.
* `witt_vector.tail n x`: the complementary part to `init`. All coefficients at indices < `n` are 0,
  otherwise they are the same as in `x`.
* `witt_vector.coeff_add_of_disjoint`: if `x` and `y` are Witt vectors such that for every `n`
  the `n`-th coefficient of `x` or of `y` is `0`, then the coefficients of `x + y`
  are just `x.coeff n + y.coeff n`.

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]

-/

variables {p : ℕ} [hp : fact p.prime] (n : ℕ) {R : Type*} [comm_ring R]

local notation `𝕎` := witt_vector p -- type as `\bbW`

namespace tactic
namespace interactive
setup_tactic_parser

/--
`init_ring` is an auxiliary tactic that discharges goals factoring `init` over ring operations.
-/
meta def init_ring (assert : parse (tk "using" >> parser.pexpr)?) : tactic unit := do
`[rw ext_iff,
  intros i,
  simp only [init, select, coeff_mk],
  split_ifs with hi; try {refl}],
match assert with
| none := skip
| some e := do
  `[simp only [add_coeff, mul_coeff, neg_coeff],
    apply eval₂_hom_congr' (ring_hom.ext_int _ _) _ rfl,
    rintro ⟨b, k⟩ h -],
  tactic.replace `h ```(%%e p _ h),
  `[simp only [finset.mem_range, finset.mem_product, true_and, finset.mem_univ] at h,
    have hk : k < n, by linarith,
    fin_cases b;
    simp only [function.uncurry, matrix.cons_val_zero, matrix.head_cons, coeff_mk,
      matrix.cons_val_one, coeff_mk, hk, if_true]]
end

end interactive
end tactic

namespace witt_vector
open mv_polynomial

open_locale classical
noncomputable theory

section

/-- `witt_vector.select P x`, for a predicate `P : ℕ → Prop` is the Witt vector
whose `n`-th coefficient is `x.coeff n` if `P n` is true, and `0` otherwise.
-/
def select (P : ℕ → Prop) (x : 𝕎 R) : 𝕎 R :=
mk p (λ n, if P n then x.coeff n else 0)

section select
variables (P : ℕ → Prop)

/-- The polynomial that witnesses that `witt_vector.select` is a polynomial function.
`select_poly n` is `X n` if `P n` holds, and `0` otherwise. -/
def select_poly (n : ℕ) : mv_polynomial ℕ ℤ := if P n then X n else 0

lemma coeff_select (x : 𝕎 R) (n : ℕ) :
  (select P x).coeff n = aeval x.coeff (select_poly P n) :=
begin
  dsimp [select, select_poly],
  split_ifs with hi,
  { rw aeval_X },
  { rw alg_hom.map_zero }
end

@[is_poly]

include hp

lemma select_add_select_not :
  ∀ (x : 𝕎 R), select P x + select (λ i, ¬ P i) x = x :=
begin
  ghost_calc _,
  intro n,
  simp only [ring_hom.map_add],
  suffices : (bind₁ (select_poly P)) (witt_polynomial p ℤ n) +
             (bind₁ (select_poly (λ i, ¬P i))) (witt_polynomial p ℤ n) = witt_polynomial p ℤ n,
  { apply_fun (aeval x.coeff) at this,
    simpa only [alg_hom.map_add, aeval_bind₁, ← coeff_select] },
  simp only [witt_polynomial_eq_sum_C_mul_X_pow, select_poly, alg_hom.map_sum, alg_hom.map_pow,
    alg_hom.map_mul, bind₁_X_right, bind₁_C_right, ← finset.sum_add_distrib, ← mul_add],
  apply finset.sum_congr rfl,
  refine λ m hm, mul_eq_mul_left_iff.mpr (or.inl _),
  rw [ite_pow, ite_pow, zero_pow (pow_pos hp.out.pos _)],
  by_cases Pm : P m,
  { rw [if_pos Pm, if_neg _, add_zero],
    exact not_not.mpr Pm },
  { rwa [if_neg Pm, if_pos, zero_add] }
end

lemma coeff_add_of_disjoint (x y : 𝕎 R) (h : ∀ n, x.coeff n = 0 ∨ y.coeff n = 0) :
  (x + y).coeff n = x.coeff n + y.coeff n :=
begin
  let P : ℕ → Prop := λ n, y.coeff n = 0,
  haveI : decidable_pred P := classical.dec_pred P,
  set z := mk p (λ n, if P n then x.coeff n else y.coeff n) with hz,
  have hx : select P z = x,
  { ext1 n, rw [select, coeff_mk, coeff_mk],
    split_ifs with hn, { refl }, { rw (h n).resolve_right hn } },
  have hy : select (λ i, ¬ P i) z = y,
  { ext1 n, rw [select, coeff_mk, coeff_mk],
    split_ifs with hn, { exact hn.symm }, { refl } },
  calc (x + y).coeff n = z.coeff n : by rw [← hx, ← hy, select_add_select_not P z]
  ... = x.coeff n + y.coeff n : _,
  dsimp [z],
  split_ifs with hn,
  { dsimp [P] at hn, rw [hn, add_zero] },
  { rw [(h n).resolve_right hn, zero_add] }
end

end select

/-- `witt_vector.init n x` is the Witt vector of which the first `n` coefficients are those from `x`
and all other coefficients are `0`.
See `witt_vector.tail` for the complementary part.
-/
def init (n : ℕ) : 𝕎 R → 𝕎 R := select (λ i, i < n)

/-- `witt_vector.tail n x` is the Witt vector of which the first `n` coefficients are `0`
and all other coefficients are those from `x`.
See `witt_vector.init` for the complementary part. -/
def tail (n : ℕ) : 𝕎 R → 𝕎 R := select (λ i, n ≤ i)

include hp

@[simp] lemma init_add_tail (x : 𝕎 R) (n : ℕ) :
  init n x + tail n x = x :=
by simp only [init, tail, ← not_lt, select_add_select_not]

end

@[simp]
lemma init_init (x : 𝕎 R) (n : ℕ) :
  init n (init n x) = init n x :=
by init_ring

include hp

lemma init_add (x y : 𝕎 R) (n : ℕ) :
  init n (x + y) = init n (init n x + init n y) :=
by init_ring using witt_add_vars

lemma init_mul (x y : 𝕎 R) (n : ℕ) :
  init n (x * y) = init n (init n x * init n y) :=
by init_ring using witt_mul_vars

lemma init_neg (x : 𝕎 R) (n : ℕ) :
  init n (-x) = init n (-init n x) :=
by init_ring using witt_neg_vars

lemma init_sub (x y : 𝕎 R) (n : ℕ) :
  init n (x - y) = init n (init n x - init n y) :=
begin
  simp only [sub_eq_add_neg],
  rw [init_add, init_neg],
  conv_rhs { rw [init_add, init_init] },
end

section

variables (p)

omit hp

/-- `witt_vector.init n x` is polynomial in the coefficients of `x`. -/
lemma init_is_poly (n : ℕ) : is_poly p (λ R _Rcr, by exactI init n) :=
select_is_poly (λ i, i < n)

end

end witt_vector


import tactic.basic data.num.lemmas

namespace ring_tac
open tactic

-- why this line?
@[derive has_reflect]
inductive ring_expr : Type
| add : ring_expr → ring_expr → ring_expr
| mul : ring_expr → ring_expr → ring_expr
| const : znum → ring_expr
| X : ring_expr

meta def reflect_expr (X : expr) : expr → option ring_expr
| `(%%e₁ + %%e₂) := do
  p₁ ← reflect_expr e₁,
  p₂ ← reflect_expr e₂,
  return (ring_expr.add p₁ p₂)
| `(%%e₁ * %%e₂) := do
  p₁ ← reflect_expr e₁,
  p₂ ← reflect_expr e₂,
  return (ring_expr.mul p₁ p₂)
| e := if e = X then return ring_expr.X else
  do n ← expr.to_int e,
     return (ring_expr.const (znum.of_int' n))

-- mathlib/data/num has znum and stuff like znum.of_int' (see above)
def poly := list znum
-- but why use it?

def poly.add : poly → poly → poly
| [] g := g
| f [] := f
| (a :: f') (b :: g') := (a + b) :: poly.add f' g'

@[simp] lemma poly.zero_add (p : poly) : poly.add [] p = p := by induction p;refl

def poly.smul : znum → poly → poly
| _ [] := []
| z (a :: f') := (z * a) :: poly.smul z f'

def poly.mul : poly → poly → poly
| [] _ := []
| (a :: f') g := poly.add (poly.smul a g) (0 :: (poly.mul f' g))

def poly.const : znum → poly := λ z, [z]

def poly.X : poly := [0,1]

def to_poly : ring_expr → poly
| (ring_expr.add e₁ e₂) := (to_poly e₁).add (to_poly e₂)
| (ring_expr.mul e₁ e₂) := (to_poly e₁).mul (to_poly e₂)
| (ring_expr.const z) := poly.const z
| ring_expr.X := poly.X

def poly.eval {α} [comm_ring α] (X : α) : poly → α
| [] := 0
| (n::l) := n + X * poly.eval l

@[simp] lemma poly.eval_zero {α} [comm_ring α] (X : α) : poly.eval X [] = 0 := rfl

@[simp] theorem poly.eval_add {α} [comm_ring α] (X : α) : ∀ p₁ p₂ : poly,
  (p₁.add p₂).eval X = p₁.eval X + p₂.eval X :=
begin
  intro p₁,
  induction p₁ with h₁ t₁ H,
    -- base case
    intros,simp [poly.eval],
  -- inductive step
  intro p₂,
  cases p₂ with h₂ t₂,
    simp [poly.add],
  unfold poly.eval poly.add,
  rw (H t₂),
  simp [mul_add]
end

@[simp] lemma poly.eval_mul_zero {α} [comm_ring α] (f : poly) (X : α) :
  poly.eval X (poly.mul f []) = 0 :=
begin
  induction f with h t H,
    refl,
  unfold poly.mul poly.smul poly.add poly.mul poly.eval,
  rw H,simp
end

@[simp] lemma poly.eval_smul {α} [comm_ring α] (X : α) (z : znum) (f : poly) :
  poly.eval X (poly.smul z f) = z * poly.eval X f :=
begin
  induction f with h t H, simp [poly.smul,poly.eval,mul_zero],
  unfold poly.smul poly.eval,
  rw H,
  simp [mul_add,znum.cast_mul,mul_assoc,mul_comm]
end

@[simp] theorem poly.eval_mul {α} [comm_ring α] (X : α) : ∀ p₁ p₂ : poly,
  (p₁.mul p₂).eval X = p₁.eval X * p₂.eval X :=
begin
  intro p₁,induction p₁ with h₁ t₁ H,
    simp [poly.mul],
  intro p₂,
  unfold poly.mul,
  rw poly.eval_add,
  unfold poly.eval,
  rw [H p₂,znum.cast_zero,zero_add,add_mul,poly.eval_smul,mul_assoc]
end

@[simp] theorem poly.eval_const {α} [comm_ring α] (X : α) : ∀ n : znum,
  (poly.const n).eval X = n :=
begin
  intro n,
  unfold poly.const poly.eval,simp
end

@[simp] theorem poly.eval_X {α} [comm_ring α] (X : α) : poly.X.eval X = X :=
begin
  unfold poly.X poly.eval,simp
end

def ring_expr.eval {α} [comm_ring α] (X : α) : ring_expr → α
| (ring_expr.add e₁ e₂) := e₁.eval + e₂.eval
| (ring_expr.mul e₁ e₂) := e₁.eval * e₂.eval
| (ring_expr.const z) := z
| ring_expr.X := X

theorem to_poly_eval {α} [comm_ring α] (X : α) (e) : (to_poly e).eval X = e.eval X :=
by induction e; simp [to_poly, ring_expr.eval, *]

theorem main_thm {α} [comm_ring α] (X : α) (e₁ e₂) {x₁ x₂}
  (H : to_poly e₁ = to_poly e₂) (R1 : e₁.eval X = x₁) (R2 : e₂.eval X = x₂) : x₁ = x₂ :=
by rw [← R1, ← R2, ← to_poly_eval, H, to_poly_eval]

meta def ring_tac (X : pexpr) : tactic unit := do
  X ← to_expr X,
  `(%%x₁ = %%x₂) ← target,
  r₁ ← reflect_expr X x₁,
  r₂ ← reflect_expr X x₂,
  let e₁ : expr := reflect r₁,
  let e₂ : expr := reflect r₂,
  `[refine main_thm %%X %%e₁ %%e₂ rfl _ _],
  all_goals `[simp only [ring_expr.eval,
    znum.cast_pos, znum.cast_neg, znum.cast_zero',
    pos_num.cast_bit0, pos_num.cast_bit1,
    pos_num.cast_one']]

theorem X (x : ℤ) : (x + 1) * (x + 1) = x*x+2*x+1 :=
by do ring_tac ```(x)

example (x : ℤ) : (x + 1) + ((-1)*x + 1) = 2 := by do ring_tac ```(x)

#print axioms X

end ring_tac


lemma zero_add (n : mynat) : 0 + n = n :=
begin
induction n with d hd,
rw add_zero,
refl,
rw add_succ,
rw hd,
refl,
end


import tactic.norm_fin

example : (5 : fin 7) = fin.succ (fin.succ 8) := by norm_num
example : (12 : fin 7) = 5 := by norm_num
example : (11 : fin 7) = 4 := by norm_num
example : (12 : fin 6) = 0 := by norm_num
example : (11 : fin 6) = 5 := by norm_num
example : (1 : fin 1) = 0 := by norm_num
example : fin.succ (4 : fin 6) = 12 := by norm_num
example : fin.succ (1 : fin (1 + 2)) = 2 := by norm_num
example : fin.succ (1 : fin (nat.succ (1 + 1))) = 2 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) = 1 := by norm_num
example : (1 : fin (nat.succ (1 + 2))) = 1 := by norm_num
example : (3 : fin (nat.succ (1 + 1 + 1))) = 3 := by norm_num
example : (2 : fin (nat.succ (2 + 1 + 1))) = 7 := by norm_num
example : (2 : fin (nat.succ (nat.succ (2 + 1 + 1)))) = 8 := by norm_num
example : fin.cast_succ (1 : fin (nat.succ (1 + 1))) = 1 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) = 1 := by norm_num
example : fin.succ (3 : fin 6) = 11 := by norm_num
example : fin.cast_succ (4 : fin 6) = 4 := by norm_num
example : fin.cast_succ (fin.cast_succ (4 : fin 5)) = 4 := by norm_num
example : fin.cast_succ (4 : fin 6) = 11 := by norm_num
example : fin.cast_succ (3 : fin 6) = 10 := by norm_num
example : fin.cast_succ (fin.cast_succ (3 : fin 5)) = 10 := by norm_num
example : ¬ fin.cast_succ (fin.cast_succ (3 : fin 5)) ≠ 10 := by norm_num

example : equiv.swap (0 : fin 3) 1 (fin.succ 1) = 2 :=
begin
  success_if_fail {guard_target ((equiv.swap (0 : fin 3) 1) 2 = 2)},
  norm_fin,
  guard_target_mod_implicit (equiv.swap (0 : fin 3) 1 2 = 2),
  exact equiv.swap_apply_of_ne_of_ne dec_trivial dec_trivial
end
example : equiv.swap (0 : fin (1 + 2)) (1 : fin (nat.succ (1 + 1))) (fin.succ 1) = 2 :=
begin
  success_if_fail {guard_target ((equiv.swap (0 : fin 3) 1) 2 = 2)},
  norm_fin,
  guard_target' (equiv.swap (0 : fin 3) 1 2 = 2),
  exact equiv.swap_apply_of_ne_of_ne dec_trivial dec_trivial
end
example : equiv.swap (0 : fin 3) 1 (fin.cast_succ 1) = 0 := by norm_fin

example : (5 : fin 7) < fin.succ (fin.succ 9) := by norm_num
example : (12 : fin 7) < 6 := by norm_num
example : (11 : fin 7) > 3 := by norm_num
example : (12 : fin 6) ≤ 0 := by norm_num
example : (11 : fin 6) ≥ 5 := by norm_num
example : fin.succ (4 : fin 6) < 13 := by norm_num
example : fin.succ (1 : fin (1 + 2)) < 3 := by norm_num
example : fin.succ (1 : fin (nat.succ (1 + 1))) < 3 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) < 2 := by norm_num
example : (1 : fin (nat.succ (1 + 2))) < 7 := by norm_num
example : (3 : fin (nat.succ (1 + 1 + 1))) > 4 := by norm_num
example : (2 : fin (nat.succ (2 + 1 + 1))) < 8 := by norm_num
example : (2 : fin (nat.succ (nat.succ (2 + 1 + 1)))) < 9 := by norm_num
example : fin.cast_succ (1 : fin (nat.succ (1 + 1))) < 7 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) < fin.succ 3 := by norm_num
example : fin.succ (3 : fin 6) < fin.cast_succ 11 := by norm_num
example : fin.cast_succ (4 : fin 6) < fin.succ 4 := by norm_num
example : fin.cast_succ (fin.cast_succ (4 : fin 5)) < fin.cast_succ (fin.succ 4) := by norm_num
example : fin.cast_succ (4 : fin 6) < fin.succ 11 := by norm_num
example : fin.cast_succ (3 : fin 6) < fin.cast_succ 10 := by norm_num
example : fin.cast_succ (fin.cast_succ (3 : fin 5)) < fin.succ (fin.cast_succ 9) := by norm_num

example : (5 : fin 7) ≠ fin.succ (fin.succ 9) := by norm_num
example : (12 : fin 7) ≠ 6 := by norm_num
example : (11 : fin 7) ≠ 3 := by norm_num
example : fin.succ (4 : fin 6) ≠ 13 := by norm_num
example : fin.succ (1 : fin (1 + 2)) ≠ 3 := by norm_num
example : fin.succ (1 : fin (nat.succ (1 + 1))) ≠ 3 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) ≠ 2 := by norm_num
example : (1 : fin (nat.succ (1 + 2))) ≠ 7 := by norm_num
example : (3 : fin (nat.succ (1 + 1 + 1))) ≠ 4 := by norm_num
example : (2 : fin (nat.succ (2 + 1 + 1))) ≠ 8 := by norm_num
example : (2 : fin (nat.succ (nat.succ (2 + 1 + 1)))) ≠ 9 := by norm_num
example : fin.cast_succ (1 : fin (nat.succ (1 + 1))) ≠ 7 := by norm_num
example : (1 : fin (nat.succ (1 + 1))) ≠ fin.succ 3 := by norm_num
example : fin.succ (3 : fin 6) ≠ fin.cast_succ 11 := by norm_num
example : fin.cast_succ (4 : fin 6) ≠ fin.succ 4 := by norm_num
example : fin.cast_succ (fin.cast_succ (4 : fin 5)) ≠ fin.cast_succ (fin.succ 4) := by norm_num
example : fin.cast_succ (4 : fin 6) ≠ fin.succ 11 := by norm_num
example : fin.cast_succ (3 : fin 6) ≠ fin.cast_succ 10 := by norm_num
example : fin.cast_succ (fin.cast_succ (3 : fin 5)) ≠ fin.succ (fin.cast_succ 9) := by norm_num

example : (5 : fin 7) ≠ fin.succ (fin.succ 9) :=
begin
  intro H,
  norm_num at H,
end


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

! This file was ported from Lean 3 source module analysis.analytic.linear
! 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.Analytic.Basic

/-!
# Linear functions are analytic

In this file we prove that a `continuous_linear_map` defines an analytic function with
the formal power series `f x = f a + f (x - a)`.
-/

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜] {E : Type _} [NormedAddCommGroup E]
  [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _}
  [NormedAddCommGroup G] [NormedSpace 𝕜 G]

open Topology Classical BigOperators NNReal ENNReal

open Set Filter Asymptotics

noncomputable section

namespace ContinuousLinearMap

/-- Formal power series of a continuous linear map `f : E →L[𝕜] F` at `x : E`:
`f y = f x + f (y - x)`. -/
@[simp]
def fpowerSeries (f : E →L[𝕜] F) (x : E) : FormalMultilinearSeries 𝕜 E F
  | 0 => ContinuousMultilinearMap.curry0 𝕜 _ (f x)
  | 1 => (continuousMultilinearCurryFin1 𝕜 E F).symm f
  | _ => 0
#align continuous_linear_map.fpower_series ContinuousLinearMap.fpowerSeries

@[simp]
theorem fpowerSeries_apply_add_two (f : E →L[𝕜] F) (x : E) (n : ℕ) : f.fpowerSeries x (n + 2) = 0 :=
  rfl
#align continuous_linear_map.fpower_series_apply_add_two ContinuousLinearMap.fpowerSeries_apply_add_two

@[simp]
theorem fpowerSeries_radius (f : E →L[𝕜] F) (x : E) : (f.fpowerSeries x).radius = ∞ :=
  (f.fpowerSeries x).radius_eq_top_of_forall_image_add_eq_zero 2 fun n => rfl
#align continuous_linear_map.fpower_series_radius ContinuousLinearMap.fpowerSeries_radius

protected theorem hasFpowerSeriesOnBall (f : E →L[𝕜] F) (x : E) :
    HasFpowerSeriesOnBall f (f.fpowerSeries x) x ∞ :=
  { r_le := by simp
    r_pos := ENNReal.coe_lt_top
    HasSum := fun y _ =>
      (hasSum_nat_add_iff' 2).1 <| by simp [Finset.sum_range_succ, ← sub_sub, hasSum_zero] }
#align continuous_linear_map.has_fpower_series_on_ball ContinuousLinearMap.hasFpowerSeriesOnBall

protected theorem hasFpowerSeriesAt (f : E →L[𝕜] F) (x : E) :
    HasFpowerSeriesAt f (f.fpowerSeries x) x :=
  ⟨∞, f.HasFpowerSeriesOnBall x⟩
#align continuous_linear_map.has_fpower_series_at ContinuousLinearMap.hasFpowerSeriesAt

protected theorem analyticAt (f : E →L[𝕜] F) (x : E) : AnalyticAt 𝕜 f x :=
  (f.HasFpowerSeriesAt x).AnalyticAt
#align continuous_linear_map.analytic_at ContinuousLinearMap.analyticAt

/-- Reinterpret a bilinear map `f : E →L[𝕜] F →L[𝕜] G` as a multilinear map
`(E × F) [×2]→L[𝕜] G`. This multilinear map is the second term in the formal
multilinear series expansion of `uncurry f`. It is given by
`f.uncurry_bilinear ![(x, y), (x', y')] = f x y'`. -/
def uncurryBilinear (f : E →L[𝕜] F →L[𝕜] G) : E × F[×2]→L[𝕜] G :=
  @ContinuousLinearMap.uncurryLeft 𝕜 1 (fun _ => E × F) G _ _ _ _ _ <|
    (↑(continuousMultilinearCurryFin1 𝕜 (E × F) G).symm : (E × F →L[𝕜] G) →L[𝕜] _).comp <|
      f.bilinearComp (fst _ _ _) (snd _ _ _)
#align continuous_linear_map.uncurry_bilinear ContinuousLinearMap.uncurryBilinear

@[simp]
theorem uncurryBilinear_apply (f : E →L[𝕜] F →L[𝕜] G) (m : Fin 2 → E × F) :
    f.uncurryBilinear m = f (m 0).1 (m 1).2 :=
  rfl
#align continuous_linear_map.uncurry_bilinear_apply ContinuousLinearMap.uncurryBilinear_apply

/-- Formal multilinear series expansion of a bilinear function `f : E →L[𝕜] F →L[𝕜] G`. -/
@[simp]
def fpowerSeriesBilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) : FormalMultilinearSeries 𝕜 (E × F) G
  | 0 => ContinuousMultilinearMap.curry0 𝕜 _ (f x.1 x.2)
  | 1 => (continuousMultilinearCurryFin1 𝕜 (E × F) G).symm (f.deriv₂ x)
  | 2 => f.uncurryBilinear
  | _ => 0
#align continuous_linear_map.fpower_series_bilinear ContinuousLinearMap.fpowerSeriesBilinear

@[simp]
theorem fpowerSeriesBilinear_radius (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
    (f.fpowerSeriesBilinear x).radius = ∞ :=
  (f.fpowerSeriesBilinear x).radius_eq_top_of_forall_image_add_eq_zero 3 fun n => rfl
#align continuous_linear_map.fpower_series_bilinear_radius ContinuousLinearMap.fpowerSeriesBilinear_radius

protected theorem hasFpowerSeriesOnBallBilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
    HasFpowerSeriesOnBall (fun x : E × F => f x.1 x.2) (f.fpowerSeriesBilinear x) x ∞ :=
  { r_le := by simp
    r_pos := ENNReal.coe_lt_top
    HasSum := fun y _ =>
      (hasSum_nat_add_iff' 3).1 <|
        by
        simp only [Finset.sum_range_succ, Finset.sum_range_one, Prod.fst_add, Prod.snd_add,
          f.map_add_add]
        dsimp; simp only [add_comm, sub_self, hasSum_zero] }
#align continuous_linear_map.has_fpower_series_on_ball_bilinear ContinuousLinearMap.hasFpowerSeriesOnBallBilinear

protected theorem hasFpowerSeriesAtBilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
    HasFpowerSeriesAt (fun x : E × F => f x.1 x.2) (f.fpowerSeriesBilinear x) x :=
  ⟨∞, f.hasFpowerSeriesOnBallBilinear x⟩
#align continuous_linear_map.has_fpower_series_at_bilinear ContinuousLinearMap.hasFpowerSeriesAtBilinear

protected theorem analyticAt_bilinear (f : E →L[𝕜] F →L[𝕜] G) (x : E × F) :
    AnalyticAt 𝕜 (fun x : E × F => f x.1 x.2) x :=
  (f.hasFpowerSeriesAtBilinear x).AnalyticAt
#align continuous_linear_map.analytic_at_bilinear ContinuousLinearMap.analyticAt_bilinear

end ContinuousLinearMap


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Group.preadditive
import Mathlib.group_theory.quotient_group
import Mathlib.category_theory.limits.limits
import Mathlib.category_theory.limits.concrete_category
import Mathlib.category_theory.limits.shapes.kernels
import Mathlib.category_theory.limits.shapes.concrete_category
import Mathlib.PostPort

universes v l u_1

namespace Mathlib

/-!
# The category of additive commutative groups has all colimits.

This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`.
It is a very uniform approach, that conceivably could be synthesised directly
by a tactic that analyses the shape of `add_comm_group` and `monoid_hom`.

TODO:
In fact, in `AddCommGroup` there is a much nicer model of colimits as quotients
of finitely supported functions, and we really should implement this as well (or instead).
-/

-- [ROBOT VOICE]:

-- You should pretend for now that this file was automatically generated.

-- It follows the same template as colimits in Mon.

namespace AddCommGroup.colimits

/-!
We build the colimit of a diagram in `AddCommGroup` by constructing the
free group on the disjoint union of all the abelian groups in the diagram,
then taking the quotient by the abelian group laws within each abelian group,
and the identifications given by the morphisms in the diagram.
-/

/--
An inductive type representing all group expressions (without relations)
on a collection of types indexed by the objects of `J`.
-/
-- There's always `of`

inductive prequotient {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup)
where
| of : (j : J) → ↥(category_theory.functor.obj F j) → prequotient F
| zero : prequotient F
| neg : prequotient F → prequotient F
| add : prequotient F → prequotient F → prequotient F

-- Then one generator for each operation

protected instance prequotient.inhabited {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : Inhabited (prequotient F) :=
  { default := prequotient.zero }

/--
The relation on `prequotient` saying when two expressions are equal
because of the abelian group laws, or
because one element is mapped to another by a morphism in the diagram.
-/
-- Make it an equivalence relation:

inductive relation {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : prequotient F → prequotient F → Prop
where
| refl : ∀ (x : prequotient F), relation F x x
| symm : ∀ (x y : prequotient F), relation F x y → relation F y x
| trans : ∀ (x y z : prequotient F), relation F x y → relation F y z → relation F x z
| map : ∀ (j j' : J) (f : j ⟶ j') (x : ↥(category_theory.functor.obj F j)),
  relation F (prequotient.of j' (coe_fn (category_theory.functor.map F f) x)) (prequotient.of j x)
| zero : ∀ (j : J), relation F (prequotient.of j 0) prequotient.zero
| neg : ∀ (j : J) (x : ↥(category_theory.functor.obj F j)),
  relation F (prequotient.of j (-x)) (prequotient.neg (prequotient.of j x))
| add : ∀ (j : J) (x y : ↥(category_theory.functor.obj F j)),
  relation F (prequotient.of j (x + y)) (prequotient.add (prequotient.of j x) (prequotient.of j y))
| neg_1 : ∀ (x x' : prequotient F), relation F x x' → relation F (prequotient.neg x) (prequotient.neg x')
| add_1 : ∀ (x x' y : prequotient F), relation F x x' → relation F (prequotient.add x y) (prequotient.add x' y)
| add_2 : ∀ (x y y' : prequotient F), relation F y y' → relation F (prequotient.add x y) (prequotient.add x y')
| zero_add : ∀ (x : prequotient F), relation F (prequotient.add prequotient.zero x) x
| add_zero : ∀ (x : prequotient F), relation F (prequotient.add x prequotient.zero) x
| add_left_neg : ∀ (x : prequotient F), relation F (prequotient.add (prequotient.neg x) x) prequotient.zero
| add_comm : ∀ (x y : prequotient F), relation F (prequotient.add x y) (prequotient.add y x)
| add_assoc : ∀ (x y z : prequotient F),
  relation F (prequotient.add (prequotient.add x y) z) (prequotient.add x (prequotient.add y z))

-- There's always a `map` relation

-- Then one relation per operation, describing the interaction with `of`

-- Then one relation per argument of each operation

-- And one relation per axiom

/--
The setoid corresponding to group expressions modulo abelian group relations and identifications.
-/
instance colimit_setoid {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : setoid (prequotient F) :=
  setoid.mk (relation F) sorry

/--
The underlying type of the colimit of a diagram in `AddCommGroup`.
-/
def colimit_type {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) :=
  quotient (colimit_setoid F)

protected instance colimit_type.add_comm_group {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : add_comm_group (colimit_type F) :=
  add_comm_group.mk
    (Quot.lift
      (fun (x : prequotient F) => Quot.lift (fun (y : prequotient F) => Quot.mk setoid.r (prequotient.add x y)) sorry)
      sorry)
    sorry (Quot.mk setoid.r prequotient.zero) sorry sorry
    (Quot.lift (fun (x : prequotient F) => Quot.mk setoid.r (prequotient.neg x)) sorry)
    (add_group.sub._default
      (Quot.lift
        (fun (x : prequotient F) => Quot.lift (fun (y : prequotient F) => Quot.mk setoid.r (prequotient.add x y)) sorry)
        sorry)
      sorry (Quot.mk setoid.r prequotient.zero) sorry sorry
      (Quot.lift (fun (x : prequotient F) => Quot.mk setoid.r (prequotient.neg x)) sorry))
    sorry sorry

@[simp] theorem quot_zero {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : Quot.mk setoid.r prequotient.zero = 0 :=
  rfl

@[simp] theorem quot_neg {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (x : prequotient F) : Quot.mk setoid.r (prequotient.neg x) = -Quot.mk setoid.r x :=
  rfl

@[simp] theorem quot_add {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (x : prequotient F) (y : prequotient F) : Quot.mk setoid.r (prequotient.add x y) = Quot.mk setoid.r x + Quot.mk setoid.r y :=
  rfl

/-- The bundled abelian group giving the colimit of a diagram. -/
def colimit {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : AddCommGroup :=
  of (colimit_type F)

/-- The function from a given abelian group in the diagram to the colimit abelian group. -/
def cocone_fun {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (j : J) (x : ↥(category_theory.functor.obj F j)) : colimit_type F :=
  Quot.mk setoid.r (prequotient.of j x)

/-- The group homomorphism from a given abelian group in the diagram to the colimit abelian
group. -/
def cocone_morphism {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (j : J) : category_theory.functor.obj F j ⟶ colimit F :=
  add_monoid_hom.mk (cocone_fun F j) sorry sorry

@[simp] theorem cocone_naturality {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) {j : J} {j' : J} (f : j ⟶ j') : category_theory.functor.map F f ≫ cocone_morphism F j' = cocone_morphism F j :=
  ext (category_theory.functor.obj F j) (colimit F) (category_theory.functor.map F f ≫ cocone_morphism F j')
    (cocone_morphism F j) fun (x : ↥(category_theory.functor.obj F j)) => quot.sound (relation.map j j' f x)

@[simp] theorem cocone_naturality_components {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (j : J) (j' : J) (f : j ⟶ j') (x : ↥(category_theory.functor.obj F j)) : coe_fn (cocone_morphism F j') (coe_fn (category_theory.functor.map F f) x) = coe_fn (cocone_morphism F j) x := sorry

/-- The cocone over the proposed colimit abelian group. -/
def colimit_cocone {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : category_theory.limits.cocone F :=
  category_theory.limits.cocone.mk (colimit F) (category_theory.nat_trans.mk (cocone_morphism F))

/-- The function from the free abelian group on the diagram to the cone point of any other
cocone. -/
@[simp] def desc_fun_lift {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (s : category_theory.limits.cocone F) : prequotient F → ↥(category_theory.limits.cocone.X s) :=
  sorry

/-- The function from the colimit abelian group to the cone point of any other cocone. -/
def desc_fun {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (s : category_theory.limits.cocone F) : colimit_type F → ↥(category_theory.limits.cocone.X s) :=
  Quot.lift (desc_fun_lift F s) sorry

/-- The group homomorphism from the colimit abelian group to the cone point of any other cocone. -/
def desc_morphism {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) (s : category_theory.limits.cocone F) : colimit F ⟶ category_theory.limits.cocone.X s :=
  add_monoid_hom.mk (desc_fun F s) sorry sorry

/-- Evidence that the proposed colimit is the colimit. -/
def colimit_cocone_is_colimit {J : Type v} [category_theory.small_category J] (F : J ⥤ AddCommGroup) : category_theory.limits.is_colimit (colimit_cocone F) :=
  category_theory.limits.is_colimit.mk fun (s : category_theory.limits.cocone F) => desc_morphism F s

protected instance has_colimits_AddCommGroup : category_theory.limits.has_colimits AddCommGroup :=
  category_theory.limits.has_colimits.mk
    fun (J : Type u_1) (𝒥 : category_theory.small_category J) =>
      category_theory.limits.has_colimits_of_shape.mk
        fun (F : J ⥤ AddCommGroup) =>
          category_theory.limits.has_colimit.mk
            (category_theory.limits.colimit_cocone.mk (colimit_cocone F) (colimit_cocone_is_colimit F))

end AddCommGroup.colimits

namespace AddCommGroup

/--
The categorical cokernel of a morphism in `AddCommGroup`
agrees with the usual group-theoretical quotient.
-/
def cokernel_iso_quotient {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : category_theory.limits.cokernel f ≅ of (quotient_add_group.quotient (add_monoid_hom.range f)) :=
  category_theory.iso.mk (category_theory.limits.cokernel.desc f (quotient_add_group.mk' (add_monoid_hom.range f)) sorry)
    (add_monoid_hom.of ⇑(quotient_add_group.lift (add_monoid_hom.range f) (category_theory.limits.cokernel.π f) sorry))


import data.mv_polynomial.basic
import data.polynomial.basic

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u v
variables {R : Type u}

namespace mv_polynomial
variables {σ : Type*} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section comm_semiring

variables [comm_semiring R] {p q : mv_polynomial σ R}

section decidable_eq

variables [decidable_eq σ]

end decidable_eq

lemma coeff_mul_X_pow (m) (n : ℕ) (s : σ) (p : mv_polynomial σ R) :
  coeff (m + single s n) (p * X s ^ n) = coeff m p :=
begin
  have : (m, single s n) ∈ (m + single s n).antidiagonal := mem_antidiagonal.2 rfl,
  rw [coeff_mul, ← finset.insert_erase this, finset.sum_insert (finset.not_mem_erase _ _),
      finset.sum_eq_zero, add_zero, coeff_X_pow, if_pos, mul_one],
      simp only [eq_self_iff_true],
  rintros ⟨i,j⟩ hij,
  rw [finset.mem_erase, mem_antidiagonal] at hij,
  by_cases H : single s n = j,
  { subst j, simpa using hij },
  { rw [coeff_X_pow, if_neg H, mul_zero] },
end

lemma coeff_mul_X_pow' (m) (n : ℕ) (s : σ) (p : mv_polynomial σ R) :
  coeff m (p * X s ^ n ) = if n ≤ m s then coeff (m - finsupp.single s n) p else 0 :=
begin
  nontriviality R,
  split_ifs with h h,
  { conv_rhs {rw ← coeff_mul_X_pow _ n s},
    congr' with  t,
    by_cases hj : s = t,
    { subst t,
      -- simp [h],
    simp only [tsub_apply, add_apply, single_eq_same], exact (nat.sub_eq_iff_eq_add h).mp rfl,
      },
    { simp [single_eq_of_ne hj] } },
  { rw ← not_mem_support_iff, intro hm, apply h,
    have H := support_mul _ _ hm, simp only [finset.mem_bUnion] at H,
    rcases H with ⟨j, hj, i', hi', H⟩,
    rw [support_X_pow, finset.mem_singleton] at hi', subst i',
    rw finset.mem_singleton at H, subst m,
    rw [add_apply, single_apply, if_pos rfl],
    finish, }
end

lemma coeff_X_pow_mul' (m) (n : ℕ) (s : σ) (p : mv_polynomial σ R) :
  coeff m (X s ^ n * p) = if n ≤ m s then coeff (m - finsupp.single s n) p else 0 :=
begin
  rw mul_comm,
  rw coeff_mul_X_pow',
end

lemma sum_X_mul {α : Type u} (r : finset α) (f : α -> mv_polynomial σ R) (s : σ) :
  (∑ x in r, X s * f x) = X s * (∑ x in r, f x)
:=
begin
  rw finset.mul_sum,
end

lemma sum_C_mul {α : Type u} {r : finset α} {f : α -> mv_polynomial σ R} (e : R) :
  (∑ x in r, C e * f x) = C e * (∑ x in r, f x)
:=
begin
  rw finset.mul_sum,
end

-- -- TODO add to mathlib
-- instance (s : σ →₀ ℕ) : is_add_monoid_hom (@monomial R σ _ s) :=
-- {
--   map_add := begin
--     intros x y,
--     exact monomial_add.symm,
--   end,
--   map_zero := monomial_zero,
-- }

-- lemma sum_monomial_hom {α : Type u} {r : finset α} {f : α -> R}  (s : σ →₀ ℕ) :
--   ((∑ x in r, monomial s (f x)) : mv_polynomial σ R) = monomial s (∑ x in r, f x)
-- :=
-- begin
--   exact finset.sum_hom r (monomial s),
-- end

lemma extract_mul_from_sum {α : Type u} {r : finset α} {f : α -> mv_polynomial σ R} (p : mv_polynomial σ R) :
  (∑ x in r, p * f x) = p * (∑ x in r, f x)
:=
begin
  rw finset.mul_sum,
end

lemma C_mul_C (a a' : R) : C a * C a' = (C (a * a') : mv_polynomial σ R)  :=
begin
  simp,
end

lemma C_mul_monomial' (a a' : R) (s : σ →₀ ℕ) : monomial s a' * C a  = monomial s (a' * a) :=
by simp [C_apply, monomial, single_mul_single]

lemma C_to_monomial (a : R) : @C _ σ _ a = monomial 0 (a) :=
begin
  exact C_apply,
end

-- -- FOr some reason, this lemma is actually useless https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Extracting.20constant.20from.20sum
-- -- I expect many other lemmas in theis file may be useless as well
-- -- TODO investigate and clean up
-- lemma finset_sum_C {α : Type u} {r : finset α} {f : α -> R} (e : R) :
--   (∑ x in r, (C (f x) : mv_polynomial σ R)) = C (∑ x in r, f x)
-- :=
-- begin
--   rw finset.sum_hom,
-- end

-- lemma rearrange1 (n : ℕ) (v1 v2 : σ) (p : mv_polynomial σ R) : (mv_polynomial.X v1 ^ n) * (mv_polynomial.X v2 * p) = mv_polynomial.X v2 * ((mv_polynomial.X v1 ^ n) * p) :=
-- begin
--   ring,
-- end

-- lemma rearrange2 (n : ℕ) (f : R) (v1 : σ) (p : mv_polynomial σ R) : (mv_polynomial.X v1 ^ n) * (mv_polynomial.C f * p) = mv_polynomial.C f * ((mv_polynomial.X v1 ^ n) * p) :=
-- begin
--   ring,
-- end

-- move constants right of X
lemma rearrange_constants_right (f : R) (v1 : σ) :
 mv_polynomial.C f * mv_polynomial.X v1 = (mv_polynomial.X v1) * (mv_polynomial.C f)
:=
begin
  ring,
end

lemma rearrange_constants_right_with_extra (f : R) (v1 : σ) (p : mv_polynomial σ R) :
 mv_polynomial.C f * (mv_polynomial.X v1 * p) = (mv_polynomial.X v1) * (mv_polynomial.C f * p)
:=
begin
  ring,
end

lemma rearrange_constants_right_hard (f : R) (p : polynomial R) :
  polynomial.C f * p = (p) * (polynomial.C f)
:=
begin
  ring,
end

lemma rearrange_sums_right_with_extra {α : Type u} {r : finset α} {f : α -> mv_polynomial σ R} (s : σ) (p : mv_polynomial σ R) :
  (∑ x in r, f x) * (X s * p) = X s * (∑ x in r, f x) * p
:=
begin
  ring,
end

lemma rearrange_sums_right {α : Type u} {r : finset α} {f : α -> mv_polynomial σ R} (s : σ) :
  (∑ x in r, f x) * X s = X s * (∑ x in r, f x)
:=
begin
  ring,
end

-- move constants right of X
lemma rearrange_smul_right (n : ℕ) (a : R) (v1 : σ) (p : mv_polynomial σ R) :
 a • (mv_polynomial.X v1 * p) = (mv_polynomial.X v1) * (a • p)
:=
begin
  rw mul_smul_comm,
end

lemma rearrange_001 (f : R) (p1 p2 p3 : polynomial R) :
 polynomial.C f * p1 = p2 + p3 ↔ p2 + p3 = polynomial.C f * p1
:=
begin
  split,
  {
    intro h, rw h,
  },
  {
    intro h, rw h,
  },
end

lemma rearrange_002 (f : R) (p1 p2 p3 : polynomial R) :
 p1 * polynomial.C f  = p2 + p3 ↔ p2 + p3 = p1 * polynomial.C f
:=
begin
  split,
  {
    intro h, rw h,
  },
  {
    intro h, rw h,
  },
end

lemma add_mul_distrib (a b c d : R) : a + b * c + b * d = a + b * (c + d) :=
begin
  ring,
end

lemma add_mul_distrib' (a b c d : R) : a + c * b + d * b = a + b * (c + d) :=
begin
  ring,
end

end comm_semiring

end mv_polynomial


/-
  Copyright 2020 Grayson Burton
  License available in the LICENSE file.
-/
import data.set tactic .between .convex .dimality

open_locale cardinal

section
universe u

/-- For any set `S`, `S₁` and `S₂` form a dependent bipartition of `S` iff
    their union `S₁ ∪ S₂ = S` and there is no point in one that is between two
    points of the other. -/
def dep_bipartition {α : Type u} [has_betweenness α] (s s₁ s₂ : set α) : Prop :=
s₁ ∪ s₂ = s ∧ (∀ p ∈ s₁, ¬ ∃ q r ∈ s₂, between q p r) ∧
  (∀ p ∈ s₂, ¬ ∃ q r ∈ s₁, between q p r)

/-- Ordered geometry, without an axiom of dimension. -/
class ordered_geo_nodim (α : Type u) extends has_betweenness α :=
(pasch {v₁ v₂ v₃ v₄ v₅ : α} : @lin_indep α _ {v₁, v₂, v₃} → between v₂ v₃ v₄ →
  between v₃ v₅ v₂ → ∃ z ∈ line v₄ v₅, between v₁ z v₂)
(dedekind {p q : α} {s₁ s₂ : set α} : nonempty s₁ → nonempty s₂ →
  dep_bipartition (line p q) s₁ s₂ →
    (∃ v₁ ∈ s₁, ∀ (v₂ ∈ s₁ \ {v₁}) (v₃ ∈ s₂), between v₂ v₁ v₃)
    ∨ (∃ v₁ ∈ s₂, ∀ (v₂ ∈ s₂ \ {v₁}) (v₃ ∈ s₁), between v₂ v₁ v₃))

/-- Ordered geometry, indexed by a dimension `d` for which the appropriate
    axioms of dimensionality apply for any set of points up to some
    cardinality. -/
class ordered_geo (α : Type u) (d : cardinal) extends ordered_geo_nodim α :=
(card_lt_basis : ∃ b : @bases.univ α _, d < #b)

/-- Ordered geometry with a dimension `d`. -/
class ordered_geo_limited (α : Type u) (d : cardinal) extends ordered_geo α d :=
(card_eq_basis : ∃ b : @bases.univ α _, d.succ = #b)

section
parameter {α : Type u}

namespace ordered_geo
section
parameters {d : cardinal.{u}} [ordered_geo α d]

theorem ex_univ_basis : (bases.univ α).nonempty :=
let ⟨⟨w, _⟩, _⟩ := @card_lt_basis α d _ in ⟨w, ‹_›⟩

def sub_geo {d' : cardinal} (h : d' ≤ d) : ordered_geo α d' := {
  card_lt_basis := let ⟨w, hw⟩ := card_lt_basis in ⟨w, lt_of_le_of_lt h hw⟩,
  ..to_ordered_geo_nodim d
}

theorem cards_lt_basis {d' : cardinal} (h : d' ≤ d) : ∃ b : bases.univ α, d' < #b :=
(sub_geo h).card_lt_basis

end

instance (d : cardinal.{u}) [ordered_geo α d] : nonempty α :=
begin
  rw ←cardinal.ne_zero_iff_nonempty,
  intro hα,
  rcases @cards_lt_basis α _ _ _ (zero_le d) with ⟨w, h⟩,
  rw ←hα at h,
  exact not_le.mpr h (cardinal.mk_set_le w)
end

section
parameters {d : cardinal.{u}} [ordered_geo α d]

theorem ex_two_points (hd : 0 < d) : ∃ p q : α, p ≠ q :=
begin
  rw ←cardinal.one_le_iff_pos at hd,
  rcases @cards_lt_basis α _ _ _ hd with ⟨⟨⟨w, _⟩, _⟩, h⟩,
  suffices h : (#bool).lift ≤ #w,
  rcases h with ⟨f, hf⟩,
  refine ⟨f (ulift.up tt), f (ulift.up ff), λ h, _⟩,
  rw ←subtype.ext_iff at h, replace h := hf h, rw ulift.ext_iff at h,
  contradiction,
  change 1 < #w at h,
  refine le_trans (le_of_eq _) (cardinal.succ_le.mpr h),
  rw cardinal.mk_bool,
  have : ↑(2 : ℕ) = (2 : cardinal) := by simp,
  rw [(by simp : (2 : cardinal) = ↑(2 : ℕ)), cardinal.lift_nat_cast],
  norm_cast
end

instance (hd : 0 < d) : nontrivial α :=
⟨ex_two_points hd⟩

theorem basis_min_card {d' : cardinal} (hd : d' < d) {s : set α} (hd' : #s = d') :
  affine_hull s ⊂ set.univ :=
begin
  refine ⟨set.subset_univ _, λ hs : _ ⊆ _, _⟩,
  rw set.univ_subset_iff at hs,
  rcases @card_lt_basis α d _ with ⟨⟨⟨w, hwg⟩, hwb⟩, hw : _ < #w⟩,
  specialize hwb s hs, change #w ≤ _ at hwb,
  rw hd' at hwb,
  exact not_lt.mpr (le_of_lt (lt_of_lt_of_le hw hwb)) hd
end

theorem ex_not_in_affine_hull {d' : cardinal} (hd : d' < d) {s : set α} (hd' : #s = d') :
  ∃ p, p ∉ affine_hull s :=
begin
  by_contra h, push_neg at h,
  have h : affine_hull s = set.univ := by rwa set.eq_univ_iff_forall,
  have := basis_min_card hd hd',
  rw h at this,
  exact (irrefl _) this
end

theorem not_generator_of_less {d' : cardinal} (hd : d' < d) {s : set α} (hd' : #s = d') :
  ¬(generates s _ is_affine.univ) :=
ne_of_lt $ basis_min_card hd hd'

end
end ordered_geo

namespace ordered_geo_limited
section
parameters {d : cardinal.{u}} [ordered_geo α d]

--theorem unique_limited

end
end ordered_geo_limited

/-
section
universe u
parameters {α : Type u} [ordered_geo_inf α]
namespace ordered_geo_inf

instance (d : ℕ) : ordered_geo α d := {lin_simp := λ l _, lin_any_simp l}

/-- For any point, there exists another point that's not equal to it. -/
theorem ex_not_eq (p : α) : ∃ q, p ≠ q :=
@ordered_geo.ex_not_eq _ 0 (ordered_geo _) p

instance : nonempty α := @ordered_geo.nonempty _ 0 _
instance : nontrivial α := @ordered_geo.nontrivial _ 0 _

/-- For any line, there exists a point that's not in it. -/
theorem ex_not_on_line (p q : α) : ∃ r, r ∉ line p q :=
@ordered_geo.ex_not_on_line _ 0 (ordered_geo _) p q

/-- For any plane, there exists a point that's not in it. -/
theorem ex_not_on_plane (p q r : α) :
  ∃ x, x ∉ convex_hull {y | y ∈ [p, q, r]} :=
@ordered_geo.ex_not_on_plane _ 0 (ordered_geo _) p q r

/-- For any potentially-degenerate simplex defined by the vertices `l`, there
    is a point that's not in the convex hull of `l`. -/
lemma ex_point_not_mem_simplex_hull (l : list α) :
  ∃ p, p ∉ convex_hull {q | q ∈ l} :=
begin
  classical,
  by_contra h,
  push_neg at h,
  rcases lin_any_simp l with ⟨w, _, hw⟩,
  rcases collinear.ex_collinear_of_mem (h w) with ⟨_, _, hp, hq, hpq⟩,
  replace h : {z : α | z ∈ l} ⊆ {w} ∪ {z : α | z ∈ l} := λ _, or.inr,
  replace h := convex_hull.is_mono h,
  specialize hw w _ _ (convex_hull.of_set $ or.inl rfl) (h hp) (h hq),

end

theorem psig_nondegen_simplex [inhabited α]
  (hlas : Π vs, @lindep_to_simplex_psig α _ vs) (d : ℕ) :
    Σ' vs : vector α d, nondegen_simplex vs.val :=
begin
  induction d with d hd, { exact ⟨vector.nil, nondegen_simplex.of_nil⟩ },
  induction d with d hd,
    { exact ⟨⟨[arbitrary α], rfl⟩, by simp, by finish⟩ },
  rcases hd with ⟨⟨l, h⟩, hvs⟩,
  rcases hlas l with ⟨p, hp⟩,
  suffices : (p ::ᵥ ⟨l, h⟩ : vector α _).val.nodup,
  refine ⟨vector.cons p ⟨l, h⟩, this, λ v₁ v₂ v₃ hv₁ hv₂ hv₃, _⟩,
  rw [lin_indep_sets, lin_indep] at hp,
  have : subtype.val (p ::ᵥ (⟨l, h⟩ : vector _ _)) = p :: l := rfl,
  rw [this, list.mem_cons_iff] at hv₁ hv₂ hv₃,
  rw (rfl : subtype.val (subtype.mk l h) = l) at hvs,
  cases hp with hp₀ hp₁,
  replace hp₀ : p ∉ l := by simp at hp₀; assumption,
  specialize hp₁ v₁ v₂ v₃ (convex_hull.of_set hv₁) (convex_hull.of_set hv₂),
  specialize hp₁ (convex_hull.of_set hv₃),
  by_cases hv₁₂ : v₁ = v₂, { exact or.inl hv₁₂.symm },
  by_cases hv₂₃ : v₂ = v₃, { exact or.inr (or.inl hv₂₃) },
  by_cases hv₁₃ : v₁ = v₃, swap,
    { rw collinear.swap_iff', exact or.inr (or.inr $ hp₁ hv₁₂ hv₁₃ hv₂₃) },
  induction hv₁₃,-- repeat { cases hv₁ }, repeat { cases hv₂ }, { exact or.inl rfl },
    { apply or.inl,
      rw (⟨ne.symm, ne.symm⟩ : v₁ ≠ v₂ ↔ v₂ ≠ v₁) at hp₁,
      revert v₁,
      rw collinear.none_collinear_iff_empty at hp₁, }
  /-
  rw [imp_iff_not_or, imp_iff_not_or, imp_iff_not_or] at hp₁,
  push_neg at hp₁,
  repeat { cases hp₁ },
    { exact or.inl rfl },
  rotate, { exact (or.inr ∘ or.inl) rfl },
    { rw collinear.swap_iff' at hp₁, exact (or.inr ∘ or.inr) hp₁ },
  swap,
    { apply or.inl, repeat { cases hv₁ }, repeat { cases hv₂ },
        { refl }, }
  -/
end

/-- For any length `d`, there is a nondegenerate simplex with `d` vertices. -/
theorem ex_nondegen_simplex (d : ℕ) :
  ∃ vs : vector α d, nondegen_simplex vs.val :=
begin
  induction d with d hd, { exact ⟨vector.nil, nondegen_simplex.of_nil⟩ },
  induction d with d hd,
    { cases ordered_geo_inf.nonempty with w,
      exact ⟨⟨[w], rfl⟩, by simp, by finish⟩ },
  rcases hd with ⟨⟨l, h⟩, hvs⟩,
  rcases lin_any_simp l with ⟨p, hp⟩,
  suffices : (p :: ⟨l, h⟩ : vector α _).val.nodup,
  refine ⟨vector.cons p ⟨l, h⟩, this, λ v₁ v₂ v₃ hv₁ hv₂ hv₃, _⟩,
  rw lin_indep at hp,
  have : subtype.val (p :: (⟨l, h⟩ : vector _ _)) = p :: l := rfl,
  rw [this, list.mem_cons_iff] at hv₁ hv₂ hv₃,
  rw (rfl : subtype.val (subtype.mk l h) = l) at hvs,
  rw collinear.none_collinear_iff_empty_fixed_1'' at hp,
  rw [convex_hull.is_empty_iff, set.eq_empty_iff_forall_not_mem] at hp,
  have : 0 < l.length := by rw h; exact nat.succ_pos',
  cases list.length_pos_iff_exists_mem.mp this with w hw,
  exact (hp _).elim hw,
  apply list.nodup_cons_of_nodup (λ hp₁, _) hvs.left,
  change p ∈ {z : α | z ∈ subtype.val (⟨l, h⟩ : vector α _)} at hp₁,
  exact lin_indep.not_indep_of_mem (convex_hull.of_set hp₁) hp
end

/-- It's false that for any nondegenerate simplex with `d` vertices and point
    `p`, there are two points in the convex hull of the simplex -/
theorem not_all_in_space (d : ℕ) : ¬ ∀ {vs : vector α d.succ},
  nondegen_simplex vs.val → ∀ v₁, ∃ v₂ v₃ ∈ convex_hull {p | p ∈ vs.val},
    collinear v₁ v₂ v₃ :=
begin
  intro hvs,
  rcases ex_nondegen_simplex (d + 1) with ⟨vs, hl⟩,
  cases ordered_geo_inf.lin_any_simp vs.val with w hw,
  rcases hvs hl w with ⟨_, _, hp, hq, hpq⟩,
  apply hw _ _ hp hq,
  rwa ←collinear.rotate_iff
end

/-- For any `d`, there's a nondegenerate simplex with `d` vertices and a point
    `p` that's linearly independent to the convex hull of the simplex. -/
theorem ex_ndsimp_ex_p_lindep (d : ℕ) : ∃ vs : vector α d.succ,
  nondegen_simplex vs.val ∧ ∃ p, lin_indep p (convex_hull {p | p ∈ vs.val}) :=
begin
  have := not_all_in_space d,
  push_neg at this,
  rcases this with ⟨v, hv1, x, hx⟩,
  refine ⟨v, hv1, x, _⟩,
  rw collinear.none_collinear_iff_empty_fixed_1 at hx,
  rwa [lin_indep.indep_def, collinear.none_collinear_iff_empty_fixed_1'']
end

end ordered_geo_inf-/
end
end


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Theory of topological rings with uniform structure.
-/

import topology.algebra.group_completion topology.algebra.ring

open classical set lattice filter topological_space add_comm_group
local attribute [instance] classical.prop_decidable
noncomputable theory

namespace uniform_space.completion
open dense_embedding uniform_space
variables (α : Type*) [ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] [separated α]

instance is_Z_bilin_mul : is_Z_bilin (λp:α×α, p.1 * p.2) :=
⟨assume a a' b, add_mul a a' b, assume a b b', mul_add a b b'⟩

instance : has_one (completion α) := ⟨(1:α)⟩

instance : has_mul (completion α) :=
⟨λa b, extend (dense_embedding_coe.prod dense_embedding_coe)
  ((coe : α → completion α) ∘ (λp:α×α, p.1 * p.2)) (a, b)⟩

lemma coe_one : ((1 : α) : completion α) = 1 := rfl

lemma continuous_mul' : continuous (λp:completion α×completion α, p.1 * p.2) :=
suffices continuous $ extend (dense_embedding_coe.prod dense_embedding_coe) $
  ((coe : α → completion α) ∘ (λp:α×α, p.1 * p.2)),
{ convert this, ext ⟨a, b⟩, refl },
extend_Z_bilin dense_embedding_coe dense_embedding_coe (continuous.comp continuous_mul' (continuous_coe α))

section rules
variables {α}
lemma coe_mul (a b : α) : ((a * b : α) : completion α) = a * b :=
eq.symm (extend_e_eq (dense_embedding_coe.prod dense_embedding_coe) (a, b))

lemma continuous_mul {β : Type*} [topological_space β] {f g : β → completion α}
  (hf : continuous f) (hg : continuous g) : continuous (λb, f b * g b) :=
(continuous.prod_mk hf hg).comp (continuous_mul' α)
end rules

instance : ring (completion α) :=
{ one_mul       := assume a, completion.induction_on a
    (is_closed_eq (continuous_mul continuous_const continuous_id) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, one_mul]),
  mul_one       := assume a, completion.induction_on a
    (is_closed_eq (continuous_mul continuous_id continuous_const) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, mul_one]),
  mul_assoc     := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_mul (continuous_mul continuous_fst (continuous_snd.comp continuous_fst))
        (continuous_snd.comp continuous_snd))
      (continuous_mul continuous_fst
        (continuous_mul (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_mul, ← coe_mul, ← coe_mul, ← coe_mul, mul_assoc]),
  left_distrib  := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_mul continuous_fst (continuous_add
        (continuous_snd.comp continuous_fst)
        (continuous_snd.comp continuous_snd)))
      (continuous_add
        (continuous_mul continuous_fst (continuous_snd.comp continuous_fst))
        (continuous_mul continuous_fst (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, mul_add]),
  right_distrib := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_mul (continuous_add continuous_fst
        (continuous_snd.comp continuous_fst)) (continuous_snd.comp continuous_snd))
      (continuous_add
        (continuous_mul continuous_fst (continuous_snd.comp continuous_snd))
        (continuous_mul (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, add_mul]),
  ..completion.add_comm_group, ..completion.has_mul α, ..completion.has_one α }

instance is_ring_hom_coe : is_ring_hom (coe : α → completion α) :=
⟨coe_one α, assume a b, coe_mul a b, assume a b, coe_add a b⟩
universe u
instance is_ring_hom_extension
  {β : Type u} [uniform_space β] [ring β] [uniform_add_group β] [topological_ring β]
    [complete_space β] [separated β]
  {f : α → β} [is_ring_hom f] (hf : continuous f) :
  is_ring_hom (completion.extension f) :=
have hf : uniform_continuous f, from uniform_continuous_of_continuous hf,
{ map_one := by rw [← coe_one, extension_coe hf, is_ring_hom.map_one f],
  map_add := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      (continuous_add'.comp continuous_extension)
      (continuous_add (continuous_fst.comp continuous_extension) (continuous_snd.comp continuous_extension)))
    (assume a b,
      by rw [← coe_add, extension_coe hf, extension_coe hf, extension_coe hf, is_add_group_hom.add f]),
  map_mul := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      ((continuous_mul' α).comp continuous_extension)
      (_root_.continuous_mul (continuous_fst.comp continuous_extension) (continuous_snd.comp continuous_extension)))
    (assume a b,
      by rw [← coe_mul, extension_coe hf, extension_coe hf, extension_coe hf, is_ring_hom.map_mul f]) }

end uniform_space.completion

namespace uniform_space
variables {α : Type*}
lemma ring_sep_rel (α) [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  separation_setoid α = submodule.quotient_rel (ideal.closure ⊥) :=
setoid.ext $ assume x y, group_separation_rel x y

lemma ring_sep_quot (α) [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) = (⊥ : ideal α).closure.quotient :=
by rw [@ring_sep_rel α r]; refl

def sep_quot_equiv_ring_quot (α)
  [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) ≃ (⊥ : ideal α).closure.quotient :=
quotient.congr $ assume x y, group_separation_rel x y

/- TODO: use a form of transport a.k.a. lift definition a.k.a. transfer -/
instance [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  comm_ring (quotient (separation_setoid α)) :=
by rw ring_sep_quot α; apply_instance

instance [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  topological_ring (quotient (separation_setoid α)) :=
begin
  convert topological_ring_quotient (⊥ : ideal α).closure,
  { apply ring_sep_rel },
  { dsimp [topological_ring_quotient_topology, quotient.topological_space, to_topological_space],
    congr,
    apply ring_sep_rel,
    apply ring_sep_rel },
  { apply ring_sep_rel },
  { simp [uniform_space.comm_ring] },
end

end uniform_space


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

import .prod_manifold
import .diffeomorph

noncomputable theory

/-!
# Lie groups

We define Lie groups.

## 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`.

## Implementation notes
Note that this definition is temporary, as manifolds are not yet true manifolds, but really charted spaces.
Moreover a priori, a Lie group here is a manifold with corner.
The fact that it is infact corerless should be a theorem.
-/

class smooth_manifold {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  (I : model_with_corners 𝕜 E E) (G : Type*) [topological_space G] [charted_space E G]
  extends smooth_manifold_with_corners I G, model_with_corners.boundaryless I, t2_space G,
  topological_space.second_countable_topology G : Prop

section Lie_group

universes u v

/-- 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 Lie_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  (I : model_with_corners 𝕜 E E) (G : Type*) [topological_space G] [charted_space E G]
  [smooth_manifold_with_corners I G] [add_group G] extends topological_add_group G : Prop :=
  (smooth_add : smooth_in_charts (I.prod I) I (λ p : G×G, p.1 + p.2))
  (smooth_neg : smooth_in_charts I I (λ a:G, -a))

/-- 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 Lie_add_group]
class Lie_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  (I : model_with_corners 𝕜 E E) (G : Type*) [topological_space G] [charted_space E G]
  [smooth_manifold_with_corners I G] [group G] extends topological_group G : Prop :=
  (smooth_mul : smooth_in_charts (I.prod I) I (λ p : G×G, p.1 * p.2))
  (smooth_inv : smooth_in_charts I I (λ a:G, a⁻¹))

 /- Why cannot I be made implicit? -/

section

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E E}
{F : Type*} [normed_group F] [normed_space 𝕜 F] {J : model_with_corners 𝕜 F F}
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G] [Lie_group I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M] [smooth_manifold_with_corners I' M]
{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{M' : Type*} [topological_space M'] [charted_space H'' M'] [smooth_manifold_with_corners I'' M']

@[to_additive]
lemma smooth_in_charts_mul : smooth_in_charts (I.prod I) I (λ p : G×G, p.1 * p.2) :=
Lie_group.smooth_mul

@[to_additive]
lemma smooth_in_charts.mul {f : M → G} {g : M → G} (hf : smooth_in_charts I' I f) (hg : smooth_in_charts I' I g) :
  smooth_in_charts I' I (f * g) :=
smooth_in_charts_mul.comp (hf.prod_mk hg)

@[to_additive]
lemma smooth_mul_left (a : G) : smooth I I (λ b : G, a * b) :=
smooth_mul.comp (smooth_const.prod_mk smooth_id)

def L : G → G → G := λ g : G, λ x : G, g * x

@[to_additive]
lemma smooth_mul_right (a : G) : smooth I I (λ b : G, b * a) :=
smooth_mul.comp (smooth_id.prod_mk smooth_const)

def R : G → G → G := λ g : G, λ x : G, x * g

/- @[to_additive]
lemma smooth_on.mul {f : M → G} {g : M → G} {s : set M}
  (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
  smooth_on I' I (f * g) s := by sorry -/

lemma smooth_pow : ∀ n : ℕ, smooth I I (λ a : G, a ^ n)
| 0 := by simpa using smooth_const
| (k+1) := show smooth I I (λ (a : G), a * a ^ k), from smooth_id.mul (smooth_pow _)

@[to_additive]
lemma smooth_inv : smooth I I (λ x : G, x⁻¹) :=
Lie_group.smooth_inv

@[to_additive]
lemma smooth.inv {f : M → G}
  (hf : smooth I' I f) : smooth I' I (λx, (f x)⁻¹) :=
smooth_inv.comp hf

/- @[to_additive]
lemma smooth_on.inv {f : M → G} {s : set M}
  (hf : smooth_on I' I f s) : smooth_on I' I (λx, (f x)⁻¹) s :=
smooth_inv.comp_smooth_on hf -/

/- Coercion to topological group
instance to_topological_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {I : model_with_corners 𝕜 E E} (G : Type*) [topological_space G] [charted_space E G]
  [smooth_manifold_with_corners I G] [add_group G] [h : Lie_add_group I G] : topological_add_group G :=
{ continuous_add := h.smooth_add.1,
  continuous_neg := h.smooth_neg.1, }

@[to_additive to_topological_add_group]
instance to_topological_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {I : model_with_corners 𝕜 E E} (G : Type*) [topological_space G] [charted_space E G]
  [smooth_manifold_with_corners I G] [group G] [h : Lie_group I G] : topological_group G :=
{ continuous_mul := h.smooth_mul.1,
  continuous_inv := h.smooth_inv.1, }-/

/- Instance of product group -/
/-@[to_additive]-/
instance prod_Lie_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]  {I : model_with_corners 𝕜 E E}
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G] [h : Lie_group I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E'] [finite_dimensional 𝕜 E']  {I' : model_with_corners 𝕜 E' E'}
{G' : Type*} [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G'] [group G'] [h' : Lie_group I' G'] :
Lie_group (I.prod I') (G×G') :=
{ smooth_mul := ((smooth_fst.comp smooth_fst).mul (smooth_fst.comp smooth_snd)).prod_mk
    ((smooth_snd.comp smooth_fst).mul (smooth_snd.comp smooth_snd)),
  smooth_inv := smooth_fst.inv.prod_mk smooth_snd.inv, }

structure Lie_add_group_morphism (I : model_with_corners 𝕜 E E) (I' : model_with_corners 𝕜 E' E')
(G : Type*) [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [add_group G] [Lie_add_group I G]
(G' : Type*) [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G'] [add_group G'] [Lie_add_group I' G'] extends add_monoid_hom G G' :=
  (smooth_to_fun : smooth I I' to_fun)

@[to_additive Lie_add_group_morphism]
structure Lie_group_morphism (I : model_with_corners 𝕜 E E) (I' : model_with_corners 𝕜 E' E')
(G : Type*) [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G] [Lie_group I G]
(G' : Type*) [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G'] [group G'] [Lie_group I' G'] extends monoid_hom G G' :=
  (smooth_to_fun : smooth I I' to_fun)

@[to_additive]
instance {I : model_with_corners 𝕜 E E} {I' : model_with_corners 𝕜 E' E'}
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G] [h: Lie_group I G]
{G' : Type*} [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G'] [group G'] [h' : Lie_group I' G'] :
has_coe_to_fun (Lie_group_morphism I I' G G') := ⟨_, λ a, a.to_fun⟩

@[to_additive]
protected def diffeomorph.mul_left (g : G) :
  diffeomorph I I G G :=
{ smooth_to_fun  := smooth_in_charts_const.mul smooth_in_charts_id,
  smooth_inv_fun := smooth_in_charts_const.mul smooth_in_charts_id,
  .. homeomorph.mul_left g }

@[to_additive]
protected def diffeomorph.mul_right (g : G) :
  diffeomorph I I G G :=
{ smooth_to_fun  := smooth_in_charts_id.mul smooth_in_charts_const,
  smooth_inv_fun := smooth_in_charts_id.mul smooth_in_charts_const,
  .. homeomorph.mul_right g }

end

end Lie_group