/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.analytic.composition
import tactic.congrm
/-!

# Inverse of analytic functions

We construct the left and right inverse of a formal multilinear series with invertible linear term,
we prove that they coincide and study their properties (notably convergence).

## Main statements

* `p.left_inv i`: the formal left inverse of the formal multilinear series `p`,
  for `i : E ≃L[𝕜] F` which coincides with `p₁`.
* `p.right_inv i`: the formal right inverse of the formal multilinear series `p`,
  for `i : E ≃L[𝕜] F` which coincides with `p₁`.
* `p.left_inv_comp` says that `p.left_inv i` is indeed a left inverse to `p` when `p₁ = i`.
* `p.right_inv_comp` says that `p.right_inv i` is indeed a right inverse to `p` when `p₁ = i`.
* `p.left_inv_eq_right_inv`: the two inverses coincide.
* `p.radius_right_inv_pos_of_radius_pos`: if a power series has a positive radius of convergence,
  then so does its inverse.

-/

open_locale big_operators classical topology
open finset filter

namespace formal_multilinear_series

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]

/-! ### The left inverse of a formal multilinear series -/

/-- The left inverse of a formal multilinear series, where the `n`-th term is defined inductively
in terms of the previous ones to make sure that `(left_inv p i) ∘ p = id`. For this, the linear term
`p₁` in `p` should be invertible. In the definition, `i` is a linear isomorphism that should
coincide with `p₁`, so that one can use its inverse in the construction. The definition does not
use that `i = p₁`, but proofs that the definition is well-behaved do.

The `n`-th term in `q ∘ p` is `∑ qₖ (p_{j₁}, ..., p_{jₖ})` over `j₁ + ... + jₖ = n`. In this
expression, `qₙ` appears only once, in `qₙ (p₁, ..., p₁)`. We adjust the definition so that this
term compensates the rest of the sum, using `i⁻¹` as an inverse to `p₁`.

These formulas only make sense when the constant term `p₀` vanishes. The definition we give is
general, but it ignores the value of `p₀`.
-/
noncomputable def left_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  formal_multilinear_series 𝕜 F E
| 0     := 0
| 1     := (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm
| (n+2) := - ∑ c : {c : composition (n+2) // c.length < n + 2},
      have (c : composition (n+2)).length < n+2 := c.2,
      (left_inv (c : composition (n+2)).length).comp_along_composition
        (p.comp_continuous_linear_map i.symm) c

@[simp] lemma left_inv_coeff_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.left_inv i 0 = 0 := by rw left_inv

@[simp] lemma left_inv_coeff_one (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.left_inv i 1 = (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm := by rw left_inv

/-- The left inverse does not depend on the zeroth coefficient of a formal multilinear
series. -/
lemma left_inv_remove_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.remove_zero.left_inv i = p.left_inv i :=
begin
  ext1 n,
  induction n using nat.strong_rec' with n IH,
  cases n, { simp }, -- if one replaces `simp` with `refl`, the proof times out in the kernel.
  cases n, { simp }, -- TODO: why?
  simp only [left_inv, neg_inj],
  refine finset.sum_congr rfl (λ c cuniv, _),
  rcases c with ⟨c, hc⟩,
  ext v,
  dsimp,
  simp [IH _ hc],
end

/-- The left inverse to a formal multilinear series is indeed a left inverse, provided its linear
term is invertible. -/
lemma left_inv_comp (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) :
  (left_inv p i).comp p = id 𝕜 E :=
begin
  ext n v,
  cases n,
  { simp only [left_inv, continuous_multilinear_map.zero_apply, id_apply_ne_one, ne.def,
      not_false_iff, zero_ne_one, comp_coeff_zero']},
  cases n,
  { simp only [left_inv, comp_coeff_one, h, id_apply_one, continuous_linear_equiv.coe_apply,
      continuous_linear_equiv.symm_apply_apply, continuous_multilinear_curry_fin1_symm_apply] },
  have A : (finset.univ : finset (composition (n+2)))
    = {c | composition.length c < n + 2}.to_finset ∪ {composition.ones (n+2)},
  { refine subset.antisymm (λ c hc, _) (subset_univ _),
    by_cases h : c.length < n + 2,
    { simp [h] },
    { simp [composition.eq_ones_iff_le_length.2 (not_lt.1 h)] } },
  have B : disjoint ({c | composition.length c < n + 2} : set (composition (n + 2))).to_finset
    {composition.ones (n+2)}, by simp,
  have C : (p.left_inv i (composition.ones (n + 2)).length)
    (λ (j : fin (composition.ones n.succ.succ).length), p 1 (λ k,
      v ((fin.cast_le (composition.length_le _)) j)))
    = p.left_inv i (n+2) (λ (j : fin (n+2)), p 1 (λ k, v j)),
  { apply formal_multilinear_series.congr _ (composition.ones_length _) (λ j hj1 hj2, _),
    exact formal_multilinear_series.congr _ rfl (λ k hk1 hk2, by congr) },
  have D : p.left_inv i (n+2) (λ (j : fin (n+2)), p 1 (λ k, v j)) =
    - ∑ (c : composition (n + 2)) in {c : composition (n + 2) | c.length < n + 2}.to_finset,
        (p.left_inv i c.length) (p.apply_composition c v),
  { simp only [left_inv, continuous_multilinear_map.neg_apply, neg_inj,
      continuous_multilinear_map.sum_apply],
    convert (sum_to_finset_eq_subtype (λ (c : composition (n+2)), c.length < n+2)
      (λ (c : composition (n+2)), (continuous_multilinear_map.comp_along_composition
        (p.comp_continuous_linear_map ↑(i.symm)) c (p.left_inv i c.length))
          (λ (j : fin (n + 2)), p 1 (λ (k : fin 1), v j)))).symm.trans _,
    simp only [comp_continuous_linear_map_apply_composition,
      continuous_multilinear_map.comp_along_composition_apply],
    congr,
    ext c,
    congr,
    ext k,
    simp [h] },
  simp [formal_multilinear_series.comp, show n + 2 ≠ 1, by dec_trivial, A, finset.sum_union B,
    apply_composition_ones, C, D, -set.to_finset_set_of],
end

/-! ### The right inverse of a formal multilinear series -/

/-- The right inverse of a formal multilinear series, where the `n`-th term is defined inductively
in terms of the previous ones to make sure that `p ∘ (right_inv p i) = id`. For this, the linear
term `p₁` in `p` should be invertible. In the definition, `i` is a linear isomorphism that should
coincide with `p₁`, so that one can use its inverse in the construction. The definition does not
use that `i = p₁`, but proofs that the definition is well-behaved do.

The `n`-th term in `p ∘ q` is `∑ pₖ (q_{j₁}, ..., q_{jₖ})` over `j₁ + ... + jₖ = n`. In this
expression, `qₙ` appears only once, in `p₁ (qₙ)`. We adjust the definition of `qₙ` so that this
term compensates the rest of the sum, using `i⁻¹` as an inverse to `p₁`.

These formulas only make sense when the constant term `p₀` vanishes. The definition we give is
general, but it ignores the value of `p₀`.
-/
noncomputable def right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  formal_multilinear_series 𝕜 F E
| 0     := 0
| 1     := (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm
| (n+2) :=
    let q : formal_multilinear_series 𝕜 F E := λ k, if h : k < n + 2 then right_inv k else 0 in
    - (i.symm : F →L[𝕜] E).comp_continuous_multilinear_map ((p.comp q) (n+2))

@[simp] lemma right_inv_coeff_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.right_inv i 0 = 0 := by rw right_inv

@[simp] lemma right_inv_coeff_one (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.right_inv i 1 = (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm := by rw right_inv

/-- The right inverse does not depend on the zeroth coefficient of a formal multilinear
series. -/
lemma right_inv_remove_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.remove_zero.right_inv i = p.right_inv i :=
begin
  ext1 n,
  induction n using nat.strong_rec' with n IH,
  rcases n with _|_|n,
  { simp only [right_inv_coeff_zero] },
  { simp only [right_inv_coeff_one] },
  simp only [right_inv, neg_inj],
  rw remove_zero_comp_of_pos _ _ (add_pos_of_nonneg_of_pos (n.zero_le) zero_lt_two),
  congrm i.symm.to_continuous_linear_map.comp_continuous_multilinear_map (p.comp (λ k, _) _),
  by_cases hk : k < n+2; simp [hk, IH]
end

lemma comp_right_inv_aux1 {n : ℕ} (hn : 0 < n)
  (p : formal_multilinear_series 𝕜 E F) (q : formal_multilinear_series 𝕜 F E) (v : fin n → F) :
  p.comp q n v =
    (∑ (c : composition n) in {c : composition n | 1 < c.length}.to_finset,
      p c.length (q.apply_composition c v)) + p 1 (λ i, q n v) :=
begin
  have A : (finset.univ : finset (composition n))
    = {c | 1 < composition.length c}.to_finset ∪ {composition.single n hn},
  { refine subset.antisymm (λ c hc, _) (subset_univ _),
    by_cases h : 1 < c.length,
    { simp [h] },
    { have : c.length = 1,
        by { refine (eq_iff_le_not_lt.2 ⟨ _, h⟩).symm, exact c.length_pos_of_pos hn },
      rw ← composition.eq_single_iff_length hn at this,
      simp [this] } },
  have B : disjoint ({c | 1 < composition.length c} : set (composition n)).to_finset
    {composition.single n hn}, by simp,
  have C : p (composition.single n hn).length
              (q.apply_composition (composition.single n hn) v)
            = p 1 (λ (i : fin 1), q n v),
  { apply p.congr (composition.single_length hn) (λ j hj1 hj2, _),
    simp [apply_composition_single] },
  simp [formal_multilinear_series.comp, A, finset.sum_union B, C, -set.to_finset_set_of],
end

lemma comp_right_inv_aux2
  (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (n : ℕ) (v : fin (n + 2) → F) :
  ∑ (c : composition (n + 2)) in {c : composition (n + 2) | 1 < c.length}.to_finset,
    p c.length (apply_composition (λ (k : ℕ), ite (k < n + 2) (p.right_inv i k) 0) c v) =
  ∑ (c : composition (n + 2)) in {c : composition (n + 2) | 1 < c.length}.to_finset,
    p c.length ((p.right_inv i).apply_composition c v) :=
begin
  have N : 0 < n + 2, by dec_trivial,
  refine sum_congr rfl (λ c hc, p.congr rfl (λ j hj1 hj2, _)),
  have : ∀ k, c.blocks_fun k < n + 2,
  { simp only [set.mem_to_finset, set.mem_set_of_eq] at hc,
    simp [← composition.ne_single_iff N, composition.eq_single_iff_length, ne_of_gt hc] },
  simp [apply_composition, this],
end

/-- The right inverse to a formal multilinear series is indeed a right inverse, provided its linear
term is invertible and its constant term vanishes. -/
lemma comp_right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) (h0 : p 0 = 0) :
  p.comp (right_inv p i) = id 𝕜 F :=
begin
  ext n v,
  cases n,
  { simp only [h0, continuous_multilinear_map.zero_apply, id_apply_ne_one, ne.def, not_false_iff,
      zero_ne_one, comp_coeff_zero']},
  cases n,
  { simp only [comp_coeff_one, h, right_inv, continuous_linear_equiv.apply_symm_apply, id_apply_one,
      continuous_linear_equiv.coe_apply, continuous_multilinear_curry_fin1_symm_apply] },
  have N : 0 < n+2, by dec_trivial,
  simp [comp_right_inv_aux1 N, h, right_inv, lt_irrefl n, show n + 2 ≠ 1, by dec_trivial,
        ← sub_eq_add_neg, sub_eq_zero, comp_right_inv_aux2, -set.to_finset_set_of],
end

lemma right_inv_coeff (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (n : ℕ) (hn : 2 ≤ n) :
  p.right_inv i n = - (i.symm : F →L[𝕜] E).comp_continuous_multilinear_map
    (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition n)),
      p.comp_along_composition (p.right_inv i) c) :=
begin
  cases n, { exact false.elim (zero_lt_two.not_le hn) },
  cases n, { exact false.elim (one_lt_two.not_le hn) },
  simp only [right_inv, neg_inj],
  congr' 1,
  ext v,
  have N : 0 < n + 2, by dec_trivial,
  have : (p 1) (λ (i : fin 1), 0) = 0 := continuous_multilinear_map.map_zero _,
  simp [comp_right_inv_aux1 N, lt_irrefl n, this, comp_right_inv_aux2, -set.to_finset_set_of],
end

/-! ### Coincidence of the left and the right inverse -/

private lemma left_inv_eq_right_inv_aux (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) (h0 : p 0 = 0) :
  left_inv p i = right_inv p i := calc
left_inv p i = (left_inv p i).comp (id 𝕜 F) : by simp
... = (left_inv p i).comp (p.comp (right_inv p i)) : by rw comp_right_inv p i h h0
... = ((left_inv p i).comp p).comp (right_inv p i) : by rw comp_assoc
... = (id 𝕜 E).comp (right_inv p i) : by rw left_inv_comp p i h
... = right_inv p i : by simp

/-- The left inverse and the right inverse of a formal multilinear series coincide. This is not at
all obvious from their definition, but it follows from uniqueness of inverses (which comes from the
fact that composition is associative on formal multilinear series). -/
theorem left_inv_eq_right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) :
  left_inv p i = right_inv p i := calc
left_inv p i = left_inv p.remove_zero i : by rw left_inv_remove_zero
... = right_inv p.remove_zero i : by { apply left_inv_eq_right_inv_aux; simp [h] }
... = right_inv p i : by rw right_inv_remove_zero

/-!
### Convergence of the inverse of a power series

Assume that `p` is a convergent multilinear series, and let `q` be its (left or right) inverse.
Using the left-inverse formula gives
$$
q_n = - (p_1)^{-n} \sum_{k=0}^{n-1} \sum_{i_1 + \dotsc + i_k = n} q_k (p_{i_1}, \dotsc, p_{i_k}).
$$
Assume for simplicity that we are in dimension `1` and `p₁ = 1`. In the formula for `qₙ`, the term
`q_{n-1}` appears with a multiplicity of `n-1` (choosing the index `i_j` for which `i_j = 2` while
all the other indices are equal to `1`), which indicates that `qₙ` might grow like `n!`. This is
bad for summability properties.

It turns out that the right-inverse formula is better behaved, and should instead be used for this
kind of estimate. It reads
$$
q_n = - (p_1)^{-1} \sum_{k=2}^n \sum_{i_1 + \dotsc + i_k = n} p_k (q_{i_1}, \dotsc, q_{i_k}).
$$
Here, `q_{n-1}` can only appear in the term with `k = 2`, and it only appears twice, so there is
hope this formula can lead to an at most geometric behavior.

Let `Qₙ = ‖qₙ‖`. Bounding `‖pₖ‖` with `C r^k` gives an inequality
$$
Q_n ≤ C' \sum_{k=2}^n r^k \sum_{i_1 + \dotsc + i_k = n} Q_{i_1} \dotsm Q_{i_k}.
$$

This formula is not enough to prove by naive induction on `n` a bound of the form `Qₙ ≤ D R^n`.
However, assuming that the inequality above were an equality, one could get a formula for the
generating series of the `Qₙ`:

$$
\begin{align}
Q(z) & := \sum Q_n z^n = Q_1 z + C' \sum_{2 \leq k \leq n} \sum_{i_1 + \dotsc + i_k = n}
  (r z^{i_1} Q_{i_1}) \dotsm (r z^{i_k} Q_{i_k})
\\ & = Q_1 z + C' \sum_{k = 2}^\infty (\sum_{i_1 \geq 1} r z^{i_1} Q_{i_1})
  \dotsm (\sum_{i_k \geq 1} r z^{i_k} Q_{i_k})
\\ & = Q_1 z + C' \sum_{k = 2}^\infty (r Q(z))^k
= Q_1 z + C' (r Q(z))^2 / (1 - r Q(z)).
\end{align}
$$

One can solve this formula explicitly. The solution is analytic in a neighborhood of `0` in `ℂ`,
hence its coefficients grow at most geometrically (by a contour integral argument), and therefore
the original `Qₙ`, which are bounded by these ones, are also at most geometric.

This classical argument is not really satisfactory, as it requires an a priori bound on a complex
analytic function. Another option would be to compute explicitly its terms (with binomial
coefficients) to obtain an explicit geometric bound, but this would be very painful.

Instead, we will use the above intuition, but in a slightly different form, with finite sums and an
induction. I learnt this trick in [pöschel2017siegelsternberg]. Let
$S_n = \sum_{k=1}^n Q_k a^k$ (where `a` is a positive real parameter to be chosen suitably small).
The above computation but with finite sums shows that

$$
S_n \leq Q_1 a + C' \sum_{k=2}^n (r S_{n-1})^k.
$$

In particular, $S_n \leq Q_1 a + C' (r S_{n-1})^2 / (1- r S_{n-1})$.
Assume that $S_{n-1} \leq K a$, where `K > Q₁` is fixed and `a` is small enough so that
`r K a ≤ 1/2` (to control the denominator). Then this equation gives a bound
$S_n \leq Q_1 a + 2 C' r^2 K^2 a^2$.
If `a` is small enough, this is bounded by `K a` as the second term is quadratic in `a`, and
therefore negligible.

By induction, we deduce `Sₙ ≤ K a` for all `n`, which gives in particular the fact that `aⁿ Qₙ`
remains bounded.
-/

/-- First technical lemma to control the growth of coefficients of the inverse. Bound the explicit
expression for `∑_{k<n+1} aᵏ Qₖ` in terms of a sum of powers of the same sum one step before,
in a general abstract setup. -/
lemma radius_right_inv_pos_of_radius_pos_aux1
  (n : ℕ) (p : ℕ → ℝ) (hp : ∀ k, 0 ≤ p k) {r a : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) :
  ∑ k in Ico 2 (n + 1), a ^ k *
      (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
          r ^ c.length * ∏ j, p (c.blocks_fun j))
  ≤ ∑ j in Ico 2 (n + 1), r ^ j * (∑ k in Ico 1 n, a ^ k * p k) ^ j :=
calc
∑ k in Ico 2 (n + 1), a ^ k *
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      r ^ c.length * ∏ j, p (c.blocks_fun j))
= ∑ k in Ico 2 (n + 1),
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      ∏ j, r * (a ^ (c.blocks_fun j) * p (c.blocks_fun j))) :
begin
  simp_rw [mul_sum],
  apply sum_congr rfl (λ k hk, _),
  apply sum_congr rfl (λ c hc, _),
  rw [prod_mul_distrib, prod_mul_distrib, prod_pow_eq_pow_sum, composition.sum_blocks_fun,
      prod_const, card_fin],
  ring,
end
... ≤ ∑ d in comp_partial_sum_target 2 (n + 1) n,
        ∏ (j : fin d.2.length), r * (a ^ d.2.blocks_fun j * p (d.2.blocks_fun j)) :
begin
  rw sum_sigma',
  refine sum_le_sum_of_subset_of_nonneg _ (λ x hx1 hx2,
    prod_nonneg (λ j hj, mul_nonneg hr (mul_nonneg (pow_nonneg ha _) (hp _)))),
  rintros ⟨k, c⟩ hd,
  simp only [set.mem_to_finset, mem_Ico, mem_sigma, set.mem_set_of_eq] at hd,
  simp only [mem_comp_partial_sum_target_iff],
  refine ⟨hd.2, c.length_le.trans_lt hd.1.2, λ j, _⟩,
  have : c ≠ composition.single k (zero_lt_two.trans_le hd.1.1),
    by simp [composition.eq_single_iff_length, ne_of_gt hd.2],
  rw composition.ne_single_iff at this,
  exact (this j).trans_le (nat.lt_succ_iff.mp hd.1.2)
end
... = ∑ e in comp_partial_sum_source 2 (n+1) n, ∏ (j : fin e.1), r * (a ^ e.2 j * p (e.2 j)) :
begin
  symmetry,
  apply comp_change_of_variables_sum,
  rintros ⟨k, blocks_fun⟩ H,
  have K : (comp_change_of_variables 2 (n + 1) n ⟨k, blocks_fun⟩ H).snd.length = k, by simp,
  congr' 2; try { rw K },
  rw fin.heq_fun_iff K.symm,
  assume j,
  rw comp_change_of_variables_blocks_fun,
end
... = ∑ j in Ico 2 (n+1), r ^ j * (∑ k in Ico 1 n, a ^ k * p k) ^ j :
begin
  rw [comp_partial_sum_source, ← sum_sigma' (Ico 2 (n + 1))
    (λ (k : ℕ), (fintype.pi_finset (λ (i : fin k), Ico 1 n) : finset (fin k → ℕ)))
    (λ n e, ∏ (j : fin n), r * (a ^ e j * p (e j)))],
  apply sum_congr rfl (λ j hj, _),
  simp only [← @multilinear_map.mk_pi_algebra_apply ℝ (fin j) _ ℝ],
  simp only [← multilinear_map.map_sum_finset (multilinear_map.mk_pi_algebra ℝ (fin j) ℝ)
    (λ k (m : ℕ), r * (a ^ m * p m))],
  simp only [multilinear_map.mk_pi_algebra_apply],
  dsimp,
  simp [prod_const, ← mul_sum, mul_pow],
end

/-- Second technical lemma to control the growth of coefficients of the inverse. Bound the explicit
expression for `∑_{k<n+1} aᵏ Qₖ` in terms of a sum of powers of the same sum one step before,
in the specific setup we are interesting in, by reducing to the general bound in
`radius_right_inv_pos_of_radius_pos_aux1`. -/
lemma radius_right_inv_pos_of_radius_pos_aux2
  {n : ℕ} (hn : 2 ≤ n + 1) (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  {r a C : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) (hC : 0 ≤ C) (hp : ∀ n, ‖p n‖ ≤ C * r ^ n) :
   (∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖) ≤
     ‖(i.symm : F →L[𝕜] E)‖ * a + ‖(i.symm : F →L[𝕜] E)‖ * C * ∑ k in Ico 2 (n + 1),
      (r * ((∑ j in Ico 1 n, a ^ j * ‖p.right_inv i j‖))) ^ k :=
let I := ‖(i.symm : F →L[𝕜] E)‖ in calc
∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖
    = a * I + ∑ k in Ico 2 (n + 1), a ^ k * ‖p.right_inv i k‖ :
by simp only [linear_isometry_equiv.norm_map, pow_one, right_inv_coeff_one,
              nat.Ico_succ_singleton, sum_singleton, ← sum_Ico_consecutive _ one_le_two hn]
... = a * I + ∑ k in Ico 2 (n + 1), a ^ k *
        ‖(i.symm : F →L[𝕜] E).comp_continuous_multilinear_map
          (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
            p.comp_along_composition (p.right_inv i) c)‖ :
begin
  congr' 1,
  apply sum_congr rfl (λ j hj, _),
  rw [right_inv_coeff _ _ _ (mem_Ico.1 hj).1, norm_neg],
end
... ≤ a * ‖(i.symm : F →L[𝕜] E)‖ + ∑ k in Ico 2 (n + 1), a ^ k * (I *
      (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
        C * r ^ c.length * ∏ j, ‖p.right_inv i (c.blocks_fun j)‖)) :
begin
  apply_rules [add_le_add, le_refl, sum_le_sum (λ j hj, _), mul_le_mul_of_nonneg_left,
    pow_nonneg, ha],
  apply (continuous_linear_map.norm_comp_continuous_multilinear_map_le _ _).trans,
  apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
  apply (norm_sum_le _ _).trans,
  apply sum_le_sum (λ c hc, _),
  apply (comp_along_composition_norm _ _ _).trans,
  apply mul_le_mul_of_nonneg_right (hp _),
  exact prod_nonneg (λ j hj, norm_nonneg _),
end
... = I * a + I * C * ∑ k in Ico 2 (n + 1), a ^ k *
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      r ^ c.length * ∏ j, ‖p.right_inv i (c.blocks_fun j)‖) :
begin
  simp_rw [mul_assoc C, ← mul_sum, ← mul_assoc, mul_comm _ (‖↑i.symm‖), mul_assoc, ← mul_sum,
    ← mul_assoc, mul_comm _ C, mul_assoc, ← mul_sum],
  ring,
end
... ≤ I * a + I * C * ∑ k in Ico 2 (n+1), (r * ((∑ j in Ico 1 n, a ^ j * ‖p.right_inv i j‖))) ^ k :
begin
  apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, norm_nonneg, hC, mul_nonneg],
  simp_rw [mul_pow],
  apply radius_right_inv_pos_of_radius_pos_aux1 n (λ k, ‖p.right_inv i k‖)
    (λ k, norm_nonneg _) hr ha,
end

/-- If a a formal multilinear series has a positive radius of convergence, then its right inverse
also has a positive radius of convergence. -/
theorem radius_right_inv_pos_of_radius_pos (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (hp : 0 < p.radius) : 0 < (p.right_inv i).radius :=
begin
  obtain ⟨C, r, Cpos, rpos, ple⟩ : ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ (n : ℕ), ‖p n‖ ≤ C * r ^ n :=
    le_mul_pow_of_radius_pos p hp,
  let I := ‖(i.symm : F →L[𝕜] E)‖,
  -- choose `a` small enough to make sure that `∑_{k ≤ n} aᵏ Qₖ` will be controllable by
  -- induction
  obtain ⟨a, apos, ha1, ha2⟩ : ∃ a (apos : 0 < a),
    (2 * I * C * r^2 * (I + 1) ^ 2 * a ≤ 1) ∧ (r * (I + 1) * a ≤ 1/2),
  { have : tendsto (λ a, 2 * I * C * r^2 * (I + 1) ^ 2 * a) (𝓝 0)
      (𝓝 (2 * I * C * r^2 * (I + 1) ^ 2 * 0)) := tendsto_const_nhds.mul tendsto_id,
    have A : ∀ᶠ a in 𝓝 0, 2 * I * C * r^2 * (I + 1) ^ 2 * a < 1,
      by { apply (tendsto_order.1 this).2, simp [zero_lt_one] },
    have : tendsto (λ a, r * (I + 1) * a) (𝓝 0)
      (𝓝 (r * (I + 1) * 0)) := tendsto_const_nhds.mul tendsto_id,
    have B : ∀ᶠ a in 𝓝 0, r * (I + 1) * a < 1/2,
      by { apply (tendsto_order.1 this).2, simp [zero_lt_one] },
    have C : ∀ᶠ a in 𝓝[>] (0 : ℝ), (0 : ℝ) < a,
      by { filter_upwards [self_mem_nhds_within] with _ ha using ha },
    rcases (C.and ((A.and B).filter_mono inf_le_left)).exists with ⟨a, ha⟩,
    exact ⟨a, ha.1, ha.2.1.le, ha.2.2.le⟩ },
  -- check by induction that the partial sums are suitably bounded, using the choice of `a` and the
  -- inductive control from Lemma `radius_right_inv_pos_of_radius_pos_aux2`.
  let S := λ n, ∑ k in Ico 1 n, a ^ k * ‖p.right_inv i k‖,
  have IRec : ∀ n, 1 ≤ n → S n ≤ (I + 1) * a,
  { apply nat.le_induction,
    { simp only [S],
      rw [Ico_eq_empty_of_le (le_refl 1), sum_empty],
      exact mul_nonneg (add_nonneg (norm_nonneg _) zero_le_one) apos.le },
    { assume n one_le_n hn,
      have In : 2 ≤ n + 1, by linarith,
      have Snonneg : 0 ≤ S n :=
        sum_nonneg (λ x hx, mul_nonneg (pow_nonneg apos.le _) (norm_nonneg _)),
      have rSn : r * S n ≤ 1/2 := calc
        r * S n ≤ r * ((I+1) * a) : mul_le_mul_of_nonneg_left hn rpos.le
        ... ≤ 1/2 : by rwa [← mul_assoc],
      calc S (n + 1) ≤ I * a + I * C * ∑ k in Ico 2 (n + 1), (r * S n)^k :
         radius_right_inv_pos_of_radius_pos_aux2 In p i rpos.le apos.le Cpos.le ple
      ... = I * a + I * C * (((r * S n) ^ 2 - (r * S n) ^ (n + 1)) / (1 - r * S n)) :
        by { rw geom_sum_Ico' _ In, exact ne_of_lt (rSn.trans_lt (by norm_num)) }
      ... ≤ I * a + I * C * ((r * S n) ^ 2 / (1/2)) :
        begin
          apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, mul_nonneg, norm_nonneg,
            Cpos.le],
          refine div_le_div (sq_nonneg _) _ (by norm_num) (by linarith),
          simp only [sub_le_self_iff],
          apply pow_nonneg (mul_nonneg rpos.le Snonneg),
        end
      ... = I * a + 2 * I * C * (r * S n) ^ 2 : by ring
      ... ≤ I * a + 2 * I * C * (r * ((I + 1) * a)) ^ 2 :
        by apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, mul_nonneg, norm_nonneg,
            Cpos.le, zero_le_two, pow_le_pow_of_le_left, rpos.le]
      ... = (I + 2 * I * C * r^2 * (I + 1) ^ 2 * a) * a : by ring
      ... ≤ (I + 1) * a :
        by apply_rules [mul_le_mul_of_nonneg_right, apos.le, add_le_add, le_refl] } },
  -- conclude that all coefficients satisfy `aⁿ Qₙ ≤ (I + 1) a`.
  let a' : nnreal := ⟨a, apos.le⟩,
  suffices H : (a' : ennreal) ≤ (p.right_inv i).radius,
    by { apply lt_of_lt_of_le _ H, exact_mod_cast apos },
  apply le_radius_of_bound _ ((I + 1) * a) (λ n, _),
  by_cases hn : n = 0,
  { have : ‖p.right_inv i n‖ = ‖p.right_inv i 0‖, by congr; try { rw hn },
    simp only [this, norm_zero, zero_mul, right_inv_coeff_zero],
    apply_rules [mul_nonneg, add_nonneg, norm_nonneg, zero_le_one, apos.le] },
  { have one_le_n : 1 ≤ n := bot_lt_iff_ne_bot.2 hn,
    calc ‖p.right_inv i n‖ * ↑a' ^ n = a ^ n * ‖p.right_inv i n‖ : mul_comm _ _
    ... ≤ ∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖ :
      begin
        have : ∀ k ∈ Ico 1 (n + 1), 0 ≤ a ^ k * ‖p.right_inv i k‖ :=
          λ k hk, mul_nonneg (pow_nonneg apos.le _) (norm_nonneg _),
        exact single_le_sum this (by simp [one_le_n]),
      end
    ... ≤ (I + 1) * a : IRec (n + 1) (by dec_trivial) }
end

end formal_multilinear_series


/-
This file sets out definitions of what it means for a CNF formula to encode
a Boolean function. Encodings of non-Boolean functions may require different
definitions.

Authors: Cayden Codel, Marijn Heule, Jeremy Avigad
Carnegie Mellon University
-/

import cnf.literal
import cnf.assignment
import cnf.clause
import cnf.cnf
import basic

universe u

variables {V : Type*} [decidable_eq V] [inhabited V]

namespace encoding

open assignment

/- A CNF formula encodes a Boolean function -/
def encodes (f : list bool → bool) (F : cnf V) (l : list (literal V)) :=
  ∀ τ, (f (l.map (literal.eval τ)) = tt ↔ ∃ σ, F.eval σ = tt ∧ (eqod τ σ (clause.vars l)))

/- Definition of S-equivalence -/
def sequiv (F₁ F₂ : cnf V) (s : finset V) := ∀ τ,
  ((∃ σ₁, F₁.eval σ₁ = tt ∧ (eqod τ σ₁ s)) ↔ (∃ σ₂, F₂.eval σ₂ = tt ∧ (eqod τ σ₂ s)))

@[refl] theorem sequiv.refl (F : cnf V) (s : finset V) : sequiv F F s :=
assume _, iff.rfl

@[symm] theorem sequiv.symm {F₁ F₂ : cnf V} {s : finset V} :
  sequiv F₁ F₂ s → sequiv F₂ F₁ s :=
assume h τ, (h τ).symm

@[trans] theorem sequiv.trans {F₁ F₂ F₃ : cnf V} {s : finset V} :
  sequiv F₁ F₂ s → sequiv F₂ F₃ s → sequiv F₁ F₃ s :=
assume h₁ h₂ τ, ⟨λ h, (h₂ τ).mp ((h₁ τ).mp h), λ h, (h₁ τ).mpr ((h₂ τ).mpr h)⟩

theorem encodes_of_encodes_of_sequiv {f : list bool → bool} {F₁ F₂ : cnf V} {l : list (literal V)} :
  encodes f F₁ l → sequiv F₁ F₂ (clause.vars l) → encodes f F₂ l :=
assume h₁ h₂ τ, ⟨λ h, (h₂ τ).mp ((h₁ τ).mp h), λ h, (h₁ τ).mpr ((h₂ τ).mpr h)⟩

end encoding


/- LoVe Homework 7: Metaprogramming -/

import .lovelib

namespace LoVe

open expr
open tactic
open declaration

/- Question 1: A `safe` Tactic -/

/- We develop a tactic that applies all safe introduction and elimination rules
for the connectives and quantifiers exhaustively. A rule is said to be _safe_ if
it always gives rise to provable subgoals. In addition, we will require that
safe rules do not introduce metavariables (which can easily be instantiated
accidentally with the wrong terms.)

We proceed in three steps. -/

/- 1.1. Develop a `safe_intros` tactic that applies the introduction rules for
`true`, `¬`, `∧`, `↔`, and `→`/`∀`. The tactic generalizes `intro_ands` from the
exercise.

**Hint**: You can use `tactic.intro` or `tactic.intro1` for some of these.

**Hint**: You can use the `<|>` operator between the rules/tactics for different
symbols. -/

meta def safe_intros : tactic unit :=
sorry

example {a b c d : Prop} :
  a → ¬ b ∧ (c ↔ d) :=
begin
  safe_intros,
  /- The proof state should be roughly as follows:

  a b c d : Prop,
  a_1 : a,
  a_2 : b
  ⊢ false

  a b c d : Prop,
  a_1 : a,
  a_2 : c
  ⊢ d

  a b c d : Prop,
  a_1 : a,
  a_2 : d
  ⊢ c -/
  repeat { sorry }
end

/- 1.2. Develop a `safe_destructs` tactic that eliminates `false`, `∧`, `∨`,
`↔`, and `∃`. The tactic generalizes `destruct_ands` from the exercise. -/

meta def safe_destructs : tactic unit :=
sorry

example {a b c d e f : Prop} {p : ℕ → Prop}
    (hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f)
    (hex : ∃x, p x) :
  false :=
begin
  safe_destructs,
  /- The proof state should be roughly as follows:

  2 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false -/
  repeat { sorry }
end

/- 1.3. Implement a `safe` tactic that first performs introduction, then
elimination, and finally proves all the subgoals that can be discharged directly
by `assumption`. The tactic generalizes `destro_and` from the exercise.

**Hint**: The `try` tactic combinator might be useful. -/

meta def safe : tactic unit :=
sorry

example {a b c d e f : Prop} {p : ℕ → Prop}
    (hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f)
    (hex : ∃x, p x) :
  a → ¬ b ∧ (c ↔ d) :=
begin
  safe,
  /- The proof state should be roughly as follows:

  3 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : c,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ d -/
  repeat { sorry }
end

/- Question 2 **optional**: An `auto` Tactic -/

/- 2.1 **optional**. Develop an Isabelle-style `auto` tactic.

This tactic would apply all safe introduction and elimination rules. In
addition, it would try unsafe rules (such as `or.intro_left` and `false.elim`)
but backtrack at some point (or try several possibilities in parallel).
Iterative deepening may be a valid approach, or best-first search, or
breadth-first search. The tactic should also attempt to apply assumptions whose
conclusion matches the goal, but backtrack if necessary.

See also "Automatic Proof and Disproof in Isabelle/HOL"
(https://www.cs.vu.nl/~jbe248/frocos2011-dis-proof.pdf) by Blanchette, Bulwahn,
and Nipkow, and the references they give. -/

/- 2.2 **optional**. Test your tactic on some benchmarks.

You can try your tactic on logic puzzles of the kinds we proved in exercise 2
and homework 2. Please include these below. -/

end LoVe


--
@[simp] theorem andTrue (p : Prop) : (p ∧ True) = p :=
  propext <| Iff.intro (fun ⟨h, _⟩ => h) (fun h => ⟨h, trivial⟩)
attribute [simp] Nat.add_comm

theorem ex1 (x : Nat) : (if x > 3 ∧ True then 1 else 2) = (if x > 3 then 1 else 2) :=
 by simp

theorem ex2 (x : Nat) : (if x = 0 ∧ True then x + 1 else 2 + x) = (if x = 0 then 1 else x + 2) :=
  by simp (config := {contextual := true})

#print ex2

theorem ex3 (x : Nat) : (if h : x = 0 ∧ True then x + 1 else 2 + x) = (if h : x = 0 then 1 + x else x + 2) :=
  by simp

#print ex3


import basic_definitions.morphism
universe variables u v w w'

open linear_map

namespace equiv_morphism
variables {G : Type u} [group G]
          {R : Type v} [ring R]
          {M : Type w}   [add_comm_group M]  [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']

/--
  an equiv`f : ρ ≃ᵣ π` between representation is a linear equiv `f.ℓ : M(ρ) ≃ₗ[R] M(π)` satisfying
    `f.ℓ ∘   ρ g  = π g  ∘   f.ℓ` has function on `linear_map` !
-/
structure G_equiv (ρ : group_representation G R M) (π : group_representation G R M') : Type (max w w') :=
(ℓ : M ≃ₗ[R] M')
(commute : ∀(g : G),  ↑ℓ   ⊚    ρ g  = π g  ⊚    ℓ) --- en terme d'élément !

infixr ` ≃ᵣ `:25 := G_equiv

@[ext]lemma ext {ρ  : group_representation G R M}   {ρ'  : group_representation G R M'} ( f g : ρ ≃ᵣ ρ') :
(f.ℓ)  = g.ℓ  → f = g := begin intros, cases f,cases g , congr'; try {assumption} end

def not_isomorphic (ρ : group_representation G R M) (ρ' : group_representation G R  M') :=   -- more general
                      (ρ ≃ᵣ ρ') → false
/--
  `is_isomorphic ρ ρ'` when nonempty(ρ ≃ᵣ ρ')
-/
def is_isomorphic (ρ : group_representation G R M) (ρ' : group_representation G R  M') := nonempty (ρ ≃ᵣ ρ')

lemma non_is_isomorphic_eq_not_isomorphic (ρ : group_representation G R M) (ρ' : group_representation G R  M') :
¬ (is_isomorphic ρ ρ') → (not_isomorphic ρ ρ') := begin
  intros, intro,unfold is_isomorphic at  *,
  have : nonempty (ρ ≃ᵣ ρ'),
    use a_1, trivial,
end
/-!
  an equiv`f : ρ ≃ᵣ π` induce a morphism of representation.
-/variables  {ρ  : group_representation G R M}   {ρ'  : group_representation G R M'}
instance : has_coe (ρ ≃ᵣ ρ')(ρ ⟶ᵣ ρ') := ⟨λ f, { ℓ := f.ℓ , commute :=  f.commute, }  ⟩

open_locale classical

/-!
    Let `f : M ≃ₗ[R] M'` a `linear_equiv` and `ρ : G → GL R M` a representation,
    we can construct a representation `image` and a `representation equiv`
-/

open linear_equiv
lemma ker_and_range_trivial_to_bijective (f : M →ₗ[R]M')  (hyp : ker f = ⊥  ∧ range f = ⊤) : function.bijective f :=  begin
  split,refine ker_eq_bot.mp  hyp.1,
        refine range_eq_top.mp  hyp.2,
end

noncomputable def gker (f : M →ₗ[R]M') (certif  : ker f = ⊥  ∧ range f = ⊤)  :  M ≃ M' :=  {
  to_fun    := f,
  inv_fun   := function.surj_inv (ker_and_range_trivial_to_bijective f certif).2,
  left_inv  := function.left_inverse_surj_inv (ker_and_range_trivial_to_bijective f certif),
  right_inv := function.right_inverse_surj_inv (ker_and_range_trivial_to_bijective f certif).right,
}
#where
lemma gker_ext (f : M →ₗ[R]M') (hyp : ker f = ⊥  ∧ range f = ⊤) : (gker f hyp).to_fun = f := rfl

noncomputable lemma ker_im_equiv'' (f : M →ₗ[R]M') (hyp : ker f  = ⊥  ∧ range f  = ⊤) : M ≃ₗ[R] M'  :=  {
  to_fun    := f  ,
  add       := f.map_add ,
  smul      := f.map_smul,
  inv_fun   := (gker f  hyp).inv_fun  ,
  left_inv  := begin let g := (gker f hyp).left_inv, erw ← (gker_ext f  hyp), exact g end,
  right_inv := begin let g := (gker f hyp).right_inv, erw ← (gker_ext f  hyp), exact g end,
}
lemma ker_im_equiv_ext''  (f : M →ₗ[R]M') (hyp : ker f  = ⊥  ∧ range f  = ⊤) :
linear_equiv.to_linear_map(ker_im_equiv'' f hyp) = f := begin
  ext, dunfold ker_im_equiv'', exact rfl,
end
variables (f : M ≃ₗ[R] M')
lemma linear_equiv_compo_id (f : M ≃ₗ[R] M') : (linear_equiv.to_linear_map f) ⊚ (linear_equiv.to_linear_map f.symm) = linear_map.id := begin
  ext, change (f.to_fun ∘  f.symm.to_fun) x = x,
  let t := f.6,exact  t x,
end
noncomputable lemma ker_im_equiv' (f : ρ ⟶ᵣ ρ') (hyp : ker f.ℓ  = ⊥  ∧ range f.ℓ  = ⊤) : M ≃ₗ[R] M'  :=  {
  to_fun    := f.ℓ  ,
  add       := f.ℓ.map_add ,
  smul      := f.ℓ.map_smul,
  inv_fun   := (gker f.ℓ  hyp).inv_fun  ,
  left_inv  := begin let g := (gker f.ℓ hyp).left_inv, erw ← (gker_ext f.ℓ  hyp), exact g end,
  right_inv := begin let g := (gker f.ℓ hyp).right_inv, erw ← (gker_ext f.ℓ  hyp), exact g end,
}
noncomputable lemma ker_im_equiv (f : ρ ⟶ᵣ ρ') (hyp : ker f.ℓ  = ⊥  ∧ range f.ℓ  = ⊤) : ρ ≃ᵣ ρ' := {
  ℓ        := (ker_im_equiv' f hyp),
  commute  := begin intros, dunfold ker_im_equiv',erw f.commute, exact rfl end
}

local notation  f ` leq ` g := linear_equiv.trans g f

@[simp]lemma eq_mul (ρ : group_representation G R M) ( g g' : G) : ρ (g * g') = (ρ g ⊚ ρ g') := begin
    erw ρ.map_mul, exact rfl,
end
variables (f : M ≃ₗ[R] M')
@[simp] lemma mul_inv (f : M ≃ₗ[R] M') : (f leq f.symm) = linear_equiv.refl R M' := begin
    ext, rw refl_apply,rw trans_apply, simp,
end
lemma mul_eq_mul (f g : M ≃ₗ[R] M ) : (f leq g) = f * g := begin
    ext, exact rfl,
end

def image (ρ : group_representation G R M) (f : M ≃ₗ[R] M') : group_representation G R M' := {
  to_fun := λ g,  f leq   (gr.to_equiv' ρ g) leq f.symm  ,
  map_one' := begin
        ext, dsimp, unfold gr.to_equiv', change (⇑f  ∘  (ρ 1) ∘  ⇑(f.symm)) x = x,
        erw ρ.map_one, simp,
     end,
  map_mul' := begin
        intros g g',ext, dsimp, unfold gr.to_equiv', change (⇑f  ∘  (ρ (g * g')) ∘  ⇑(f.symm)) x = _, simp,exact rfl,
  end }
def image_equiv (ρ : group_representation G R M) (f : M ≃ₗ[R] M') :  ρ ≃ᵣ (image ρ f) := { ℓ := f,
  commute := begin
        intros g, ext, unfold image, simp,exact rfl,
  end }
end equiv_morphism
#lint


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.calculus.mean_value
import tactic.monotonicity

/-!
# Extending differentiability to the boundary

We investigate how differentiable functions inside a set extend to differentiable functions
on the boundary. For this, it suffices that the function and its derivative admit limits there.
A general version of this statement is given in `has_fderiv_at_boundary_of_tendsto_fderiv`.

One-dimensional versions, in which one wants to obtain differentiability at the left endpoint or
the right endpoint of an interval, are given in
`has_deriv_at_interval_left_endpoint_of_tendsto_deriv` and
`has_deriv_at_interval_right_endpoint_of_tendsto_deriv`. These versions are formulated in terms
of the one-dimensional derivative `deriv ℝ f`.
-/

variables {E : Type*} [normed_group E] [normed_space ℝ E]
          {F : Type*} [normed_group F] [normed_space ℝ F]

open filter set metric continuous_linear_map
open_locale topological_space
local attribute [mono] prod_mono

/-- If a function `f` is differentiable in a convex open set and continuous on its closure, and its
derivative converges to a limit `f'` at a point on the boundary, then `f` is differentiable there
with derivative `f'`. -/
theorem has_fderiv_at_boundary_of_tendsto_fderiv {f : E → F} {s : set E} {x : E} {f' : E →L[ℝ] F}
  (f_diff : differentiable_on ℝ f s) (s_conv : convex s) (s_open : is_open s)
  (f_cont : ∀y ∈ closure s, continuous_within_at f s y)
  (h : tendsto (λy, fderiv ℝ f y) (𝓝[s] x) (𝓝 f')) :
  has_fderiv_within_at f f' (closure s) x :=
begin
  classical,
  -- one can assume without loss of generality that `x` belongs to the closure of `s`, as the
  -- statement is empty otherwise
  by_cases hx : x ∉ closure s,
  { rw ← closure_closure at hx, exact has_fderiv_within_at_of_not_mem_closure hx },
  push_neg at hx,
  rw [has_fderiv_within_at, has_fderiv_at_filter, asymptotics.is_o_iff],
  /- One needs to show that `∥f y - f x - f' (y - x)∥ ≤ ε ∥y - x∥` for `y` close to `x` in `closure
  s`, where `ε` is an arbitrary positive constant. By continuity of the functions, it suffices to
  prove this for nearby points inside `s`. In a neighborhood of `x`, the derivative of `f` is
  arbitrarily close to `f'` by assumption. The mean value inequality completes the proof. -/
  assume ε ε_pos,
  obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ∥fderiv ℝ f y - f'∥ < ε,
    by simpa [dist_zero_right] using tendsto_nhds_within_nhds.1 h ε ε_pos,
  set B := ball x δ,
  suffices : ∀ y ∈ B ∩ (closure s), ∥f y - f x - (f' y - f' x)∥ ≤ ε * ∥y - x∥,
    from mem_nhds_within_iff.2 ⟨δ, δ_pos, λy hy, by simpa using this y hy⟩,
  suffices : ∀ p : E × E, p ∈ closure ((B ∩ s).prod (B ∩ s)) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥
    ≤ ε * ∥p.2 - p.1∥,
  { rw closure_prod_eq at this,
    intros y y_in,
    apply this ⟨x, y⟩,
    have : B ∩ closure s ⊆ closure (B ∩ s), from closure_inter_open is_open_ball,
    exact ⟨this ⟨mem_ball_self δ_pos, hx⟩, this y_in⟩ },
  have key : ∀ p : E × E, p ∈ (B ∩ s).prod (B ∩ s) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥
    ≤ ε * ∥p.2 - p.1∥,
  { rintros ⟨u, v⟩ ⟨u_in, v_in⟩,
    have conv : convex (B ∩ s) := (convex_ball _ _).inter s_conv,
    have diff : differentiable_on ℝ f (B ∩ s) := f_diff.mono (inter_subset_right _ _),
    have bound : ∀ z ∈ (B ∩ s), ∥fderiv_within ℝ f (B ∩ s) z - f'∥ ≤ ε,
    { intros z z_in,
      convert le_of_lt (hδ _ z_in.2 z_in.1),
      have op : is_open (B ∩ s) := is_open_inter is_open_ball s_open,
      rw differentiable_at.fderiv_within _ (op.unique_diff_on z z_in),
      exact (diff z z_in).differentiable_at (mem_nhds_sets op z_in) },
    simpa using conv.norm_image_sub_le_of_norm_fderiv_within_le' diff bound u_in v_in },
  rintros ⟨u, v⟩ uv_in,
  refine continuous_within_at.closure_le uv_in _ _ key,
  have f_cont' : ∀y ∈ closure s, continuous_within_at (f - f') s y,
  { intros y y_in,
    exact tendsto.sub (f_cont y y_in) (f'.cont.continuous_within_at) },
  all_goals { -- common start for both continuity proofs
    have : (B ∩ s).prod (B ∩ s) ⊆ s.prod s, by mono ; exact inter_subset_right _ _,
    obtain ⟨u_in, v_in⟩ : u ∈ closure s ∧ v ∈ closure s,
      by simpa [closure_prod_eq] using closure_mono this uv_in,
    apply continuous_within_at.mono _ this,
    simp only [continuous_within_at] },
  rw nhds_within_prod_eq,
  { have : f v - f u - (f' v - f' u) = f v - f' v - (f u - f' u) := by abel,
    rw this,
    convert tendsto.comp continuous_norm.continuous_at
      ((tendsto.comp (f_cont' v v_in) tendsto_snd).sub $ tendsto.comp (f_cont' u u_in) tendsto_fst),
    intros, simp, abel },
  { apply tendsto_nhds_within_of_tendsto_nhds,
    rw nhds_prod_eq,
    exact tendsto_const_nhds.mul
      (tendsto.comp continuous_norm.continuous_at $ tendsto_snd.sub tendsto_fst) },
end

/-- If a function is differentiable on the right of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the right at `a`. -/
lemma has_deriv_at_interval_left_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[Ioi a] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[Ioi a] a) (𝓝 e)) :
  has_deriv_within_at f e (Ici a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_tendsto_fderiv`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (a, b)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ab, sab⟩ : ∃ b ∈ Ioi a, Ioc a b ⊆ s :=
    mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 hs,
  let t := Ioo a b,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ioc_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex t := convex_Ioo a b,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc a b := closure_Ioo ab,
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨lt_of_le_of_ne hy.1 (ne.symm h), hy.2⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp [deriv_fderiv.symm],
    refine tendsto.comp is_bounded_bilinear_map_smul_right.continuous_right.continuous_at _,
    exact tendsto_nhds_within_mono_left Ioo_subset_Ioi_self f_lim' },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc a b) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (mem_nhds_within_Ici_iff_exists_Icc_subset.2 ⟨b, ab, subset.refl _⟩)
end

/-- If a function is differentiable on the left of a point `a : ℝ`, continuous at `a`, and
its derivative also converges at `a`, then `f` is differentiable on the left at `a`. -/
lemma has_deriv_at_interval_right_endpoint_of_tendsto_deriv {s : set ℝ} {e : E} {a : ℝ} {f : ℝ → E}
  (f_diff : differentiable_on ℝ f s) (f_lim : continuous_within_at f s a)
  (hs : s ∈ 𝓝[Iio a] a)
  (f_lim' : tendsto (λx, deriv f x) (𝓝[Iio a] a) (𝓝 e)) :
  has_deriv_within_at f e (Iic a) a :=
begin
  /- This is a specialization of `has_fderiv_at_boundary_of_differentiable`. To be in the setting of
  this theorem, we need to work on an open interval with closure contained in `s ∪ {a}`, that we
  call `t = (b, a)`. Then, we check all the assumptions of this theorem and we apply it. -/
  obtain ⟨b, ba, sab⟩ : ∃ b ∈ Iio a, Ico b a ⊆ s :=
    mem_nhds_within_Iio_iff_exists_Ico_subset.1 hs,
  let t := Ioo b a,
  have ts : t ⊆ s := subset.trans Ioo_subset_Ico_self sab,
  have t_diff : differentiable_on ℝ f t := f_diff.mono ts,
  have t_conv : convex t := convex_Ioo b a,
  have t_open : is_open t := is_open_Ioo,
  have t_closure : closure t = Icc b a := closure_Ioo ba,
  have t_cont : ∀y ∈ closure t, continuous_within_at f t y,
  { rw t_closure,
    assume y hy,
    by_cases h : y = a,
    { rw h, exact f_lim.mono ts },
    { have : y ∈ s := sab ⟨hy.1, lt_of_le_of_ne hy.2 h⟩,
      exact (f_diff.continuous_on y this).mono ts } },
  have t_diff' : tendsto (λx, fderiv ℝ f x) (𝓝[t] a) (𝓝 (smul_right 1 e)),
  { simp [deriv_fderiv.symm],
    refine tendsto.comp is_bounded_bilinear_map_smul_right.continuous_right.continuous_at _,
    exact tendsto_nhds_within_mono_left Ioo_subset_Iio_self f_lim' },
  -- now we can apply `has_fderiv_at_boundary_of_differentiable`
  have : has_deriv_within_at f e (Icc b a) a,
  { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure],
    exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' },
  exact this.nhds_within (mem_nhds_within_Iic_iff_exists_Icc_subset.2 ⟨b, ba, subset.refl _⟩)
end

/-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are
continuous at this point, then `g` is also the derivative of `f` at this point. -/
lemma has_deriv_at_of_has_deriv_at_of_ne {f g : ℝ → E} {x : ℝ}
  (f_diff : ∀ y ≠ x, has_deriv_at f (g y) y)
  (hf : continuous_at f x) (hg : continuous_at g x) :
  has_deriv_at f (g x) x :=
begin
  have A : has_deriv_within_at f (g x) (Ici x) x,
  { have diff : differentiable_on ℝ f (Ioi x) :=
      λy hy, (f_diff y (ne_of_gt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[Ioi x] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_sets_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_gt hy)).deriv.symm },
  have B : has_deriv_within_at f (g x) (Iic x) x,
  { have diff : differentiable_on ℝ f (Iio x) :=
      λy hy, (f_diff y (ne_of_lt hy)).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_right_endpoint_of_tendsto_deriv diff hf.continuous_within_at
      self_mem_nhds_within,
    have : tendsto g (𝓝[Iio x] x) (𝓝 (g x)) := tendsto_inf_left hg,
    apply this.congr' _,
    apply mem_sets_of_superset self_mem_nhds_within (λy hy, _),
    exact (f_diff y (ne_of_lt hy)).deriv.symm },
  simpa using B.union A
end


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

Defines bounded lattice type class hierarchy.

Includes the Prop and fun instances.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.lattice
import Mathlib.data.option.basic
import Mathlib.tactic.pi_instances
import Mathlib.logic.nontrivial
import Mathlib.PostPort

universes u l v u_1 u_2

namespace Mathlib

/-- Typeclass for the `⊤` (`\top`) notation -/
/-- Typeclass for the `⊥` (`\bot`) notation -/
class has_top (α : Type u) where
  top : α

class has_bot (α : Type u) where
  bot : α

notation:1024 "⊤" => Mathlib.has_top.top

notation:1024 "⊥" => Mathlib.has_bot.bot

/-- An `order_top` is a partial order with a maximal element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_top (α : Type u) extends has_top α, partial_order α where
  le_top : ∀ (a : α), a ≤ ⊤

@[simp] theorem le_top {α : Type u} [order_top α] {a : α} : a ≤ ⊤ := order_top.le_top a

theorem top_unique {α : Type u} [order_top α] {a : α} (h : ⊤ ≤ a) : a = ⊤ := le_antisymm le_top h

-- TODO: delete in favor of the next?

theorem eq_top_iff {α : Type u} [order_top α] {a : α} : a = ⊤ ↔ ⊤ ≤ a :=
  { mp := fun (eq : a = ⊤) => Eq.symm eq ▸ le_refl ⊤, mpr := top_unique }

@[simp] theorem top_le_iff {α : Type u} [order_top α] {a : α} : ⊤ ≤ a ↔ a = ⊤ :=
  { mp := top_unique, mpr := fun (h : a = ⊤) => Eq.symm h ▸ le_refl ⊤ }

@[simp] theorem not_top_lt {α : Type u} [order_top α] {a : α} : ¬⊤ < a :=
  fun (h : ⊤ < a) => lt_irrefl a (lt_of_le_of_lt le_top h)

theorem eq_top_mono {α : Type u} [order_top α] {a : α} {b : α} (h : a ≤ b) (h₂ : a = ⊤) : b = ⊤ :=
  iff.mp top_le_iff (h₂ ▸ h)

theorem lt_top_iff_ne_top {α : Type u} [order_top α] {a : α} : a < ⊤ ↔ a ≠ ⊤ := sorry

theorem ne_top_of_lt {α : Type u} [order_top α] {a : α} {b : α} (h : a < b) : a ≠ ⊤ :=
  iff.mp lt_top_iff_ne_top (lt_of_lt_of_le h le_top)

theorem ne_top_of_le_ne_top {α : Type u} [order_top α] {a : α} {b : α} (hb : b ≠ ⊤) (hab : a ≤ b) :
    a ≠ ⊤ :=
  fun (ha : a = ⊤) => hb (top_unique (ha ▸ hab))

theorem strict_mono.top_preimage_top' {α : Type u} {β : Type v} [linear_order α] [order_top β]
    {f : α → β} (H : strict_mono f) {a : α} (h_top : f a = ⊤) (x : α) : x ≤ a :=
  strict_mono.top_preimage_top H
    (fun (p : β) => eq.mpr (id (Eq._oldrec (Eq.refl (p ≤ f a)) h_top)) le_top) x

theorem order_top.ext_top {α : Type u_1} {A : order_top α} {B : order_top α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : ⊤ = ⊤ :=
  top_unique (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ ≤ ⊤)) (Eq.symm (propext (H ⊤ ⊤))))) le_top)

theorem order_top.ext {α : Type u_1} {A : order_top α} {B : order_top α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

/-- An `order_bot` is a partial order with a minimal element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_bot (α : Type u) extends has_bot α, partial_order α where
  bot_le : ∀ (a : α), ⊥ ≤ a

@[simp] theorem bot_le {α : Type u} [order_bot α] {a : α} : ⊥ ≤ a := order_bot.bot_le a

theorem bot_unique {α : Type u} [order_bot α] {a : α} (h : a ≤ ⊥) : a = ⊥ := le_antisymm h bot_le

-- TODO: delete?

theorem eq_bot_iff {α : Type u} [order_bot α] {a : α} : a = ⊥ ↔ a ≤ ⊥ :=
  { mp := fun (eq : a = ⊥) => Eq.symm eq ▸ le_refl ⊥, mpr := bot_unique }

@[simp] theorem le_bot_iff {α : Type u} [order_bot α] {a : α} : a ≤ ⊥ ↔ a = ⊥ :=
  { mp := bot_unique, mpr := fun (h : a = ⊥) => Eq.symm h ▸ le_refl ⊥ }

@[simp] theorem not_lt_bot {α : Type u} [order_bot α] {a : α} : ¬a < ⊥ :=
  fun (h : a < ⊥) => lt_irrefl a (lt_of_lt_of_le h bot_le)

theorem ne_bot_of_le_ne_bot {α : Type u} [order_bot α] {a : α} {b : α} (hb : b ≠ ⊥) (hab : b ≤ a) :
    a ≠ ⊥ :=
  fun (ha : a = ⊥) => hb (bot_unique (ha ▸ hab))

theorem eq_bot_mono {α : Type u} [order_bot α] {a : α} {b : α} (h : a ≤ b) (h₂ : b = ⊥) : a = ⊥ :=
  iff.mp le_bot_iff (h₂ ▸ h)

theorem bot_lt_iff_ne_bot {α : Type u} [order_bot α] {a : α} : ⊥ < a ↔ a ≠ ⊥ := sorry

theorem ne_bot_of_gt {α : Type u} [order_bot α] {a : α} {b : α} (h : a < b) : b ≠ ⊥ :=
  iff.mp bot_lt_iff_ne_bot (lt_of_le_of_lt bot_le h)

theorem strict_mono.bot_preimage_bot' {α : Type u} {β : Type v} [linear_order α] [order_bot β]
    {f : α → β} (H : strict_mono f) {a : α} (h_bot : f a = ⊥) (x : α) : a ≤ x :=
  strict_mono.bot_preimage_bot H
    (fun (p : β) => eq.mpr (id (Eq._oldrec (Eq.refl (f a ≤ p)) h_bot)) bot_le) x

theorem order_bot.ext_bot {α : Type u_1} {A : order_bot α} {B : order_bot α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : ⊥ = ⊥ :=
  bot_unique (eq.mpr (id (Eq._oldrec (Eq.refl (⊥ ≤ ⊥)) (Eq.symm (propext (H ⊥ ⊥))))) bot_le)

theorem order_bot.ext {α : Type u_1} {A : order_bot α} {B : order_bot α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

/-- A `semilattice_sup_top` is a semilattice with top and join. -/
class semilattice_sup_top (α : Type u) extends semilattice_sup α, order_top α where

@[simp] theorem top_sup_eq {α : Type u} [semilattice_sup_top α] {a : α} : ⊤ ⊔ a = ⊤ :=
  sup_of_le_left le_top

@[simp] theorem sup_top_eq {α : Type u} [semilattice_sup_top α] {a : α} : a ⊔ ⊤ = ⊤ :=
  sup_of_le_right le_top

/-- A `semilattice_sup_bot` is a semilattice with bottom and join. -/
class semilattice_sup_bot (α : Type u) extends order_bot α, semilattice_sup α where

@[simp] theorem bot_sup_eq {α : Type u} [semilattice_sup_bot α] {a : α} : ⊥ ⊔ a = a :=
  sup_of_le_right bot_le

@[simp] theorem sup_bot_eq {α : Type u} [semilattice_sup_bot α] {a : α} : a ⊔ ⊥ = a :=
  sup_of_le_left bot_le

@[simp] theorem sup_eq_bot_iff {α : Type u} [semilattice_sup_bot α] {a : α} {b : α} :
    a ⊔ b = ⊥ ↔ a = ⊥ ∧ b = ⊥ :=
  sorry

protected instance nat.semilattice_sup_bot : semilattice_sup_bot ℕ :=
  semilattice_sup_bot.mk 0 distrib_lattice.le distrib_lattice.lt distrib_lattice.le_refl
    distrib_lattice.le_trans distrib_lattice.le_antisymm nat.zero_le distrib_lattice.sup
    distrib_lattice.le_sup_left distrib_lattice.le_sup_right distrib_lattice.sup_le

/-- A `semilattice_inf_top` is a semilattice with top and meet. -/
class semilattice_inf_top (α : Type u) extends semilattice_inf α, order_top α where

@[simp] theorem top_inf_eq {α : Type u} [semilattice_inf_top α] {a : α} : ⊤ ⊓ a = a :=
  inf_of_le_right le_top

@[simp] theorem inf_top_eq {α : Type u} [semilattice_inf_top α] {a : α} : a ⊓ ⊤ = a :=
  inf_of_le_left le_top

@[simp] theorem inf_eq_top_iff {α : Type u} [semilattice_inf_top α] {a : α} {b : α} :
    a ⊓ b = ⊤ ↔ a = ⊤ ∧ b = ⊤ :=
  sorry

/-- A `semilattice_inf_bot` is a semilattice with bottom and meet. -/
class semilattice_inf_bot (α : Type u) extends order_bot α, semilattice_inf α where

@[simp] theorem bot_inf_eq {α : Type u} [semilattice_inf_bot α] {a : α} : ⊥ ⊓ a = ⊥ :=
  inf_of_le_left bot_le

@[simp] theorem inf_bot_eq {α : Type u} [semilattice_inf_bot α] {a : α} : a ⊓ ⊥ = ⊥ :=
  inf_of_le_right bot_le

/- Bounded lattices -/

/-- A bounded lattice is a lattice with a top and bottom element,
  denoted `⊤` and `⊥` respectively. This allows for the interpretation
  of all finite suprema and infima, taking `inf ∅ = ⊤` and `sup ∅ = ⊥`. -/
class bounded_lattice (α : Type u) extends order_bot α, order_top α, lattice α where

protected instance semilattice_inf_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
    semilattice_inf_top α :=
  semilattice_inf_top.mk bounded_lattice.top bounded_lattice.le bounded_lattice.lt
    bounded_lattice.le_refl bounded_lattice.le_trans bounded_lattice.le_antisymm sorry
    bounded_lattice.inf bounded_lattice.inf_le_left bounded_lattice.inf_le_right
    bounded_lattice.le_inf

protected instance semilattice_inf_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
    semilattice_inf_bot α :=
  semilattice_inf_bot.mk bounded_lattice.bot bounded_lattice.le bounded_lattice.lt
    bounded_lattice.le_refl bounded_lattice.le_trans bounded_lattice.le_antisymm sorry
    bounded_lattice.inf bounded_lattice.inf_le_left bounded_lattice.inf_le_right
    bounded_lattice.le_inf

protected instance semilattice_sup_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
    semilattice_sup_top α :=
  semilattice_sup_top.mk bounded_lattice.top bounded_lattice.le bounded_lattice.lt
    bounded_lattice.le_refl bounded_lattice.le_trans bounded_lattice.le_antisymm sorry
    bounded_lattice.sup bounded_lattice.le_sup_left bounded_lattice.le_sup_right
    bounded_lattice.sup_le

protected instance semilattice_sup_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
    semilattice_sup_bot α :=
  semilattice_sup_bot.mk bounded_lattice.bot bounded_lattice.le bounded_lattice.lt
    bounded_lattice.le_refl bounded_lattice.le_trans bounded_lattice.le_antisymm sorry
    bounded_lattice.sup bounded_lattice.le_sup_left bounded_lattice.le_sup_right
    bounded_lattice.sup_le

theorem bounded_lattice.ext {α : Type u_1} {A : bounded_lattice α} {B : bounded_lattice α}
    (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B :=
  sorry

/-- A bounded distributive lattice is exactly what it sounds like. -/
class bounded_distrib_lattice (α : Type u_1) extends distrib_lattice α, bounded_lattice α where

theorem inf_eq_bot_iff_le_compl {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α}
    (h₁ : b ⊔ c = ⊤) (h₂ : b ⊓ c = ⊥) : a ⊓ b = ⊥ ↔ a ≤ c :=
  sorry

/- Prop instance -/

protected instance bounded_distrib_lattice_Prop : bounded_distrib_lattice Prop :=
  bounded_distrib_lattice.mk Or (fun (a b : Prop) => a → b)
    (distrib_lattice.lt._default fun (a b : Prop) => a → b) sorry sorry sorry Or.inl Or.inr sorry
    And and.left and.right sorry sorry True sorry False false.elim

protected instance Prop.linear_order : linear_order Prop :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry
    (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le
    Mathlib.decidable_lt_of_decidable_le

@[simp] theorem le_iff_imp {p : Prop} {q : Prop} : p ≤ q ↔ p → q := iff.rfl

theorem monotone_and {α : Type u} [preorder α] {p : α → Prop} {q : α → Prop} (m_p : monotone p)
    (m_q : monotone q) : monotone fun (x : α) => p x ∧ q x :=
  fun (a b : α) (h : a ≤ b) => and.imp (m_p h) (m_q h)

-- Note: by finish [monotone] doesn't work

theorem monotone_or {α : Type u} [preorder α] {p : α → Prop} {q : α → Prop} (m_p : monotone p)
    (m_q : monotone q) : monotone fun (x : α) => p x ∨ q x :=
  fun (a b : α) (h : a ≤ b) => or.imp (m_p h) (m_q h)

protected instance pi.order_bot {α : Type u_1} {β : α → Type u_2} [(a : α) → order_bot (β a)] :
    order_bot ((a : α) → β a) :=
  order_bot.mk (fun (_x : α) => ⊥) partial_order.le partial_order.lt sorry sorry sorry sorry

/- Function lattices -/

protected instance pi.has_sup {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_sup (α i)] :
    has_sup ((i : ι) → α i) :=
  has_sup.mk fun (f g : (i : ι) → α i) (i : ι) => f i ⊔ g i

@[simp] theorem sup_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_sup (α i)]
    (f : (i : ι) → α i) (g : (i : ι) → α i) (i : ι) : has_sup.sup f g i = f i ⊔ g i :=
  rfl

protected instance pi.has_inf {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_inf (α i)] :
    has_inf ((i : ι) → α i) :=
  has_inf.mk fun (f g : (i : ι) → α i) (i : ι) => f i ⊓ g i

@[simp] theorem inf_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_inf (α i)]
    (f : (i : ι) → α i) (g : (i : ι) → α i) (i : ι) : has_inf.inf f g i = f i ⊓ g i :=
  rfl

protected instance pi.has_bot {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_bot (α i)] :
    has_bot ((i : ι) → α i) :=
  has_bot.mk fun (i : ι) => ⊥

@[simp] theorem bot_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_bot (α i)] (i : ι) :
    ⊥ = ⊥ :=
  rfl

protected instance pi.has_top {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_top (α i)] :
    has_top ((i : ι) → α i) :=
  has_top.mk fun (i : ι) => ⊤

@[simp] theorem top_apply {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → has_top (α i)] (i : ι) :
    ⊤ = ⊤ :=
  rfl

protected instance pi.semilattice_sup {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_sup (α i)] : semilattice_sup ((i : ι) → α i) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

protected instance pi.semilattice_inf {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_inf (α i)] : semilattice_inf ((i : ι) → α i) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

protected instance pi.semilattice_inf_bot {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_inf_bot (α i)] : semilattice_inf_bot ((i : ι) → α i) :=
  semilattice_inf_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry has_inf.inf
    sorry sorry sorry

protected instance pi.semilattice_inf_top {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_inf_top (α i)] : semilattice_inf_top ((i : ι) → α i) :=
  semilattice_inf_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry has_inf.inf
    sorry sorry sorry

protected instance pi.semilattice_sup_bot {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_sup_bot (α i)] : semilattice_sup_bot ((i : ι) → α i) :=
  semilattice_sup_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry has_sup.sup
    sorry sorry sorry

protected instance pi.semilattice_sup_top {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → semilattice_sup_top (α i)] : semilattice_sup_top ((i : ι) → α i) :=
  semilattice_sup_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry has_sup.sup
    sorry sorry sorry

protected instance pi.lattice {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → lattice (α i)] :
    lattice ((i : ι) → α i) :=
  lattice.mk semilattice_sup.sup semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance pi.bounded_lattice {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → bounded_lattice (α i)] : bounded_lattice ((i : ι) → α i) :=
  bounded_lattice.mk semilattice_sup_top.sup semilattice_sup_top.le semilattice_sup_top.lt sorry
    sorry sorry sorry sorry sorry semilattice_inf_bot.inf sorry sorry sorry semilattice_sup_top.top
    sorry semilattice_inf_bot.bot sorry

theorem eq_bot_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) (x : α) : x = ⊥ :=
  eq_bot_mono le_top (Eq.symm hα)

theorem eq_top_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) (x : α) : x = ⊤ :=
  eq_top_mono bot_le hα

theorem subsingleton_of_top_le_bot {α : Type u_1} [bounded_lattice α] (h : ⊤ ≤ ⊥) :
    subsingleton α :=
  subsingleton.intro
    fun (a b : α) =>
      le_antisymm (le_trans le_top (le_trans h bot_le)) (le_trans le_top (le_trans h bot_le))

theorem subsingleton_of_bot_eq_top {α : Type u_1} [bounded_lattice α] (hα : ⊥ = ⊤) :
    subsingleton α :=
  subsingleton_of_top_le_bot (ge_of_eq hα)

theorem subsingleton_iff_bot_eq_top {α : Type u_1} [bounded_lattice α] : ⊥ = ⊤ ↔ subsingleton α :=
  { mp := subsingleton_of_bot_eq_top, mpr := fun (h : subsingleton α) => subsingleton.elim ⊥ ⊤ }

/-- Attach `⊥` to a type. -/
def with_bot (α : Type u_1) := Option α

namespace with_bot

protected instance has_coe_t {α : Type u} : has_coe_t α (with_bot α) := has_coe_t.mk some

protected instance has_bot {α : Type u} : has_bot (with_bot α) := has_bot.mk none

protected instance inhabited {α : Type u} : Inhabited (with_bot α) := { default := ⊥ }

theorem none_eq_bot {α : Type u} : none = ⊥ := rfl

theorem some_eq_coe {α : Type u} (a : α) : some a = ↑a := rfl

/-- Recursor for `with_bot` using the preferred forms `⊥` and `↑a`. -/
def rec_bot_coe {α : Type u} {C : with_bot α → Sort u_1} (h₁ : C ⊥) (h₂ : (a : α) → C ↑a)
    (n : with_bot α) : C n :=
  Option.rec h₁ h₂

theorem coe_eq_coe {α : Type u} {a : α} {b : α} : ↑a = ↑b ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑b ↔ a = b)) (Eq.symm (option.some.inj_eq a b))))
    (iff.refl (↑a = ↑b))

protected instance has_lt {α : Type u} [HasLess α] : HasLess (with_bot α) :=
  { Less := fun (o₁ o₂ : Option α) => ∃ (b : α), ∃ (H : b ∈ o₂), ∀ (a : α), a ∈ o₁ → a < b }

@[simp] theorem some_lt_some {α : Type u} [HasLess α] {a : α} {b : α} : some a < some b ↔ a < b :=
  sorry

theorem bot_lt_some {α : Type u} [HasLess α] (a : α) : ⊥ < some a :=
  Exists.intro a
    (Exists.intro rfl fun (b : α) (hb : b ∈ ⊥) => false.elim (option.not_mem_none b hb))

theorem bot_lt_coe {α : Type u} [HasLess α] (a : α) : ⊥ < ↑a := bot_lt_some a

protected instance preorder {α : Type u} [preorder α] : preorder (with_bot α) :=
  preorder.mk (fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₁), ∃ (b : α), ∃ (H : b ∈ o₂), a ≤ b)
    Less sorry sorry

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_bot α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance order_bot {α : Type u} [partial_order α] : order_bot (with_bot α) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem coe_le_coe {α : Type u} [preorder α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b := sorry

@[simp] theorem some_le_some {α : Type u} [preorder α] {a : α} {b : α} : some a ≤ some b ↔ a ≤ b :=
  coe_le_coe

theorem coe_le {α : Type u} [partial_order α] {a : α} {b : α} {o : Option α} :
    b ∈ o → (↑a ≤ o ↔ a ≤ b) :=
  sorry

theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b := some_lt_some

theorem le_coe_get_or_else {α : Type u} [preorder α] (a : with_bot α) (b : α) :
    a ≤ ↑(option.get_or_else a b) :=
  sorry

@[simp] theorem get_or_else_bot {α : Type u} (a : α) : option.get_or_else ⊥ a = a := rfl

theorem get_or_else_bot_le_iff {α : Type u} [order_bot α] {a : with_bot α} {b : α} :
    option.get_or_else a ⊥ ≤ b ↔ a ≤ ↑b :=
  sorry

protected instance decidable_le {α : Type u} [preorder α] [DecidableRel LessEq] :
    DecidableRel LessEq :=
  sorry

protected instance decidable_lt {α : Type u} [HasLess α] [DecidableRel Less] : DecidableRel Less :=
  sorry

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_bot α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry with_bot.decidable_le
    Mathlib.decidable_eq_of_decidable_le with_bot.decidable_lt

protected instance semilattice_sup {α : Type u} [semilattice_sup α] :
    semilattice_sup_bot (with_bot α) :=
  semilattice_sup_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    (option.lift_or_get has_sup.sup) sorry sorry sorry

protected instance semilattice_inf {α : Type u} [semilattice_inf α] :
    semilattice_inf_bot (with_bot α) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    (fun (o₁ o₂ : with_bot α) => option.bind o₁ fun (a : α) => option.map (fun (b : α) => a ⊓ b) o₂)
    sorry sorry sorry

protected instance lattice {α : Type u} [lattice α] : lattice (with_bot α) :=
  lattice.mk semilattice_sup_bot.sup semilattice_sup_bot.le semilattice_sup_bot.lt sorry sorry sorry
    sorry sorry sorry semilattice_inf_bot.inf sorry sorry sorry

theorem lattice_eq_DLO {α : Type u} [linear_order α] :
    Mathlib.lattice_of_linear_order = with_bot.lattice :=
  lattice.ext fun (x y : with_bot α) => iff.rfl

theorem sup_eq_max {α : Type u} [linear_order α] (x : with_bot α) (y : with_bot α) :
    x ⊔ y = max x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = max x y)) (Eq.symm sup_eq_max)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = x ⊔ y)) lattice_eq_DLO)) (Eq.refl (x ⊔ y)))

theorem inf_eq_min {α : Type u} [linear_order α] (x : with_bot α) (y : with_bot α) :
    x ⊓ y = min x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = min x y)) (Eq.symm inf_eq_min)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = x ⊓ y)) lattice_eq_DLO)) (Eq.refl (x ⊓ y)))

protected instance order_top {α : Type u} [order_top α] : order_top (with_bot α) :=
  order_top.mk (some ⊤) partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance bounded_lattice {α : Type u} [bounded_lattice α] :
    bounded_lattice (with_bot α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

theorem well_founded_lt {α : Type u} [partial_order α] (h : well_founded Less) :
    well_founded Less :=
  sorry

protected instance densely_ordered {α : Type u} [partial_order α] [densely_ordered α]
    [no_bot_order α] : densely_ordered (with_bot α) :=
  densely_ordered.mk fun (a b : with_bot α) => sorry

end with_bot

--TODO(Mario): Construct using order dual on with_bot

/-- Attach `⊤` to a type. -/
def with_top (α : Type u_1) := Option α

namespace with_top

protected instance has_coe_t {α : Type u} : has_coe_t α (with_top α) := has_coe_t.mk some

protected instance has_top {α : Type u} : has_top (with_top α) := has_top.mk none

protected instance inhabited {α : Type u} : Inhabited (with_top α) := { default := ⊤ }

theorem none_eq_top {α : Type u} : none = ⊤ := rfl

theorem some_eq_coe {α : Type u} (a : α) : some a = ↑a := rfl

/-- Recursor for `with_top` using the preferred forms `⊤` and `↑a`. -/
def rec_top_coe {α : Type u} {C : with_top α → Sort u_1} (h₁ : C ⊤) (h₂ : (a : α) → C ↑a)
    (n : with_top α) : C n :=
  Option.rec h₁ h₂

theorem coe_eq_coe {α : Type u} {a : α} {b : α} : ↑a = ↑b ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑b ↔ a = b)) (Eq.symm (option.some.inj_eq a b))))
    (iff.refl (↑a = ↑b))

@[simp] theorem top_ne_coe {α : Type u} {a : α} : ⊤ ≠ ↑a :=
  fun (ᾰ : ⊤ = ↑a) =>
    eq.dcases_on ᾰ (fun (a_1 : some a = none) => option.no_confusion a_1) (Eq.refl ↑a) (HEq.refl ᾰ)

@[simp] theorem coe_ne_top {α : Type u} {a : α} : ↑a ≠ ⊤ :=
  fun (ᾰ : ↑a = ⊤) =>
    eq.dcases_on ᾰ (fun (a_1 : none = some a) => option.no_confusion a_1) (Eq.refl ⊤) (HEq.refl ᾰ)

protected instance has_lt {α : Type u} [HasLess α] : HasLess (with_top α) :=
  { Less := fun (o₁ o₂ : Option α) => ∃ (b : α), ∃ (H : b ∈ o₁), ∀ (a : α), a ∈ o₂ → b < a }

protected instance has_le {α : Type u} [HasLessEq α] : HasLessEq (with_top α) :=
  { LessEq := fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₂), ∃ (b : α), ∃ (H : b ∈ o₁), b ≤ a }

@[simp] theorem some_lt_some {α : Type u} [HasLess α] {a : α} {b : α} : some a < some b ↔ a < b :=
  sorry

@[simp] theorem some_le_some {α : Type u} [HasLessEq α] {a : α} {b : α} : some a ≤ some b ↔ a ≤ b :=
  sorry

@[simp] theorem le_none {α : Type u} [HasLessEq α] {a : with_top α} : a ≤ none := sorry

@[simp] theorem some_lt_none {α : Type u} [HasLess α] {a : α} : some a < none := sorry

protected instance can_lift {α : Type u} : can_lift (with_top α) α :=
  can_lift.mk coe (fun (r : with_top α) => r ≠ ⊤) sorry

protected instance preorder {α : Type u} [preorder α] : preorder (with_top α) :=
  preorder.mk (fun (o₁ o₂ : Option α) => ∀ (a : α) (H : a ∈ o₂), ∃ (b : α), ∃ (H : b ∈ o₁), b ≤ a)
    Less sorry sorry

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_top α) :=
  partial_order.mk preorder.le preorder.lt sorry sorry sorry

protected instance order_top {α : Type u} [partial_order α] : order_top (with_top α) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem coe_le_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b := sorry

theorem le_coe {α : Type u} [partial_order α] {a : α} {b : α} {o : Option α} :
    a ∈ o → (o ≤ ↑b ↔ a ≤ b) :=
  sorry

theorem le_coe_iff {α : Type u} [partial_order α] {b : α} {x : with_top α} :
    x ≤ ↑b ↔ ∃ (a : α), x = ↑a ∧ a ≤ b :=
  sorry

theorem coe_le_iff {α : Type u} [partial_order α] {a : α} {x : with_top α} :
    ↑a ≤ x ↔ ∀ (b : α), x = ↑b → a ≤ b :=
  sorry

theorem lt_iff_exists_coe {α : Type u} [partial_order α] {a : with_top α} {b : with_top α} :
    a < b ↔ ∃ (p : α), a = ↑p ∧ ↑p < b :=
  sorry

theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b := some_lt_some

theorem coe_lt_top {α : Type u} [partial_order α] (a : α) : ↑a < ⊤ := some_lt_none

theorem coe_lt_iff {α : Type u} [partial_order α] {a : α} {x : with_top α} :
    ↑a < x ↔ ∀ (b : α), x = ↑b → a < b :=
  sorry

theorem not_top_le_coe {α : Type u} [partial_order α] (a : α) : ¬⊤ ≤ ↑a :=
  fun (h : ⊤ ≤ ↑a) => false.elim (lt_irrefl ⊤ (lt_of_le_of_lt h (coe_lt_top a)))

protected instance decidable_le {α : Type u} [preorder α] [DecidableRel LessEq] :
    DecidableRel LessEq :=
  fun (x y : with_top α) => with_bot.decidable_le y x

protected instance decidable_lt {α : Type u} [HasLess α] [DecidableRel Less] : DecidableRel Less :=
  fun (x y : with_top α) => with_bot.decidable_lt y x

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_top α) :=
  linear_order.mk partial_order.le partial_order.lt sorry sorry sorry sorry with_top.decidable_le
    Mathlib.decidable_eq_of_decidable_le with_top.decidable_lt

protected instance semilattice_inf {α : Type u} [semilattice_inf α] :
    semilattice_inf_top (with_top α) :=
  semilattice_inf_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry
    (option.lift_or_get has_inf.inf) sorry sorry sorry

theorem coe_inf {α : Type u} [semilattice_inf α] (a : α) (b : α) : ↑(a ⊓ b) = ↑a ⊓ ↑b := rfl

protected instance semilattice_sup {α : Type u} [semilattice_sup α] :
    semilattice_sup_top (with_top α) :=
  semilattice_sup_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry
    (fun (o₁ o₂ : with_top α) => option.bind o₁ fun (a : α) => option.map (fun (b : α) => a ⊔ b) o₂)
    sorry sorry sorry

theorem coe_sup {α : Type u} [semilattice_sup α] (a : α) (b : α) : ↑(a ⊔ b) = ↑a ⊔ ↑b := rfl

protected instance lattice {α : Type u} [lattice α] : lattice (with_top α) :=
  lattice.mk semilattice_sup_top.sup semilattice_sup_top.le semilattice_sup_top.lt sorry sorry sorry
    sorry sorry sorry semilattice_inf_top.inf sorry sorry sorry

theorem lattice_eq_DLO {α : Type u} [linear_order α] :
    Mathlib.lattice_of_linear_order = with_top.lattice :=
  lattice.ext fun (x y : with_top α) => iff.rfl

theorem sup_eq_max {α : Type u} [linear_order α] (x : with_top α) (y : with_top α) :
    x ⊔ y = max x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = max x y)) (Eq.symm sup_eq_max)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊔ y = x ⊔ y)) lattice_eq_DLO)) (Eq.refl (x ⊔ y)))

theorem inf_eq_min {α : Type u} [linear_order α] (x : with_top α) (y : with_top α) :
    x ⊓ y = min x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = min x y)) (Eq.symm inf_eq_min)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ⊓ y = x ⊓ y)) lattice_eq_DLO)) (Eq.refl (x ⊓ y)))

protected instance order_bot {α : Type u} [order_bot α] : order_bot (with_top α) :=
  order_bot.mk (some ⊥) partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance bounded_lattice {α : Type u} [bounded_lattice α] :
    bounded_lattice (with_top α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

theorem well_founded_lt {α : Type u_1} [partial_order α] (h : well_founded Less) :
    well_founded Less :=
  sorry

protected instance densely_ordered {α : Type u} [partial_order α] [densely_ordered α]
    [no_top_order α] : densely_ordered (with_top α) :=
  densely_ordered.mk fun (a b : with_top α) => sorry

theorem lt_iff_exists_coe_btwn {α : Type u} [partial_order α] [densely_ordered α] [no_top_order α]
    {a : with_top α} {b : with_top α} : a < b ↔ ∃ (x : α), a < ↑x ∧ ↑x < b :=
  sorry

end with_top

namespace subtype

/-- A subtype forms a `⊔`-`⊥`-semilattice if `⊥` and `⊔` preserve the property. -/
protected def semilattice_sup_bot {α : Type u} [semilattice_sup_bot α] {P : α → Prop} (Pbot : P ⊥)
    (Psup : ∀ {x y : α}, P x → P y → P (x ⊔ y)) :
    semilattice_sup_bot (Subtype fun (x : α) => P x) :=
  semilattice_sup_bot.mk { val := ⊥, property := Pbot } semilattice_sup.le semilattice_sup.lt sorry
    sorry sorry sorry semilattice_sup.sup sorry sorry sorry

/-- A subtype forms a `⊓`-`⊥`-semilattice if `⊥` and `⊓` preserve the property. -/
protected def semilattice_inf_bot {α : Type u} [semilattice_inf_bot α] {P : α → Prop} (Pbot : P ⊥)
    (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) :
    semilattice_inf_bot (Subtype fun (x : α) => P x) :=
  semilattice_inf_bot.mk { val := ⊥, property := Pbot } semilattice_inf.le semilattice_inf.lt sorry
    sorry sorry sorry semilattice_inf.inf sorry sorry sorry

/-- A subtype forms a `⊓`-`⊤`-semilattice if `⊤` and `⊓` preserve the property. -/
protected def semilattice_inf_top {α : Type u} [semilattice_inf_top α] {P : α → Prop} (Ptop : P ⊤)
    (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) :
    semilattice_inf_top (Subtype fun (x : α) => P x) :=
  semilattice_inf_top.mk { val := ⊤, property := Ptop } semilattice_inf.le semilattice_inf.lt sorry
    sorry sorry sorry semilattice_inf.inf sorry sorry sorry

end subtype

namespace order_dual

protected instance has_top (α : Type u) [has_bot α] : has_top (order_dual α) := has_top.mk ⊥

protected instance has_bot (α : Type u) [has_top α] : has_bot (order_dual α) := has_bot.mk ⊤

protected instance order_top (α : Type u) [order_bot α] : order_top (order_dual α) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry bot_le

protected instance order_bot (α : Type u) [order_top α] : order_bot (order_dual α) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry le_top

protected instance semilattice_sup_top (α : Type u) [semilattice_inf_bot α] :
    semilattice_sup_top (order_dual α) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance semilattice_sup_bot (α : Type u) [semilattice_inf_top α] :
    semilattice_sup_bot (order_dual α) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance semilattice_inf_top (α : Type u) [semilattice_sup_bot α] :
    semilattice_inf_top (order_dual α) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_inf_bot (α : Type u) [semilattice_sup_top α] :
    semilattice_inf_bot (order_dual α) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance bounded_lattice (α : Type u) [bounded_lattice α] :
    bounded_lattice (order_dual α) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

protected instance bounded_distrib_lattice (α : Type u) [bounded_distrib_lattice α] :
    bounded_distrib_lattice (order_dual α) :=
  bounded_distrib_lattice.mk bounded_lattice.sup bounded_lattice.le bounded_lattice.lt sorry sorry
    sorry sorry sorry sorry bounded_lattice.inf sorry sorry sorry sorry bounded_lattice.top sorry
    bounded_lattice.bot sorry

end order_dual

namespace prod

protected instance has_top (α : Type u) (β : Type v) [has_top α] [has_top β] : has_top (α × β) :=
  has_top.mk (⊤, ⊤)

protected instance has_bot (α : Type u) (β : Type v) [has_bot α] [has_bot β] : has_bot (α × β) :=
  has_bot.mk (⊥, ⊥)

protected instance order_top (α : Type u) (β : Type v) [order_top α] [order_top β] :
    order_top (α × β) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance order_bot (α : Type u) (β : Type v) [order_bot α] [order_bot β] :
    order_bot (α × β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_sup_top (α : Type u) (β : Type v) [semilattice_sup_top α]
    [semilattice_sup_top β] : semilattice_sup_top (α × β) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance semilattice_inf_top (α : Type u) (β : Type v) [semilattice_inf_top α]
    [semilattice_inf_top β] : semilattice_inf_top (α × β) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_sup_bot (α : Type u) (β : Type v) [semilattice_sup_bot α]
    [semilattice_sup_bot β] : semilattice_sup_bot (α × β) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance semilattice_inf_bot (α : Type u) (β : Type v) [semilattice_inf_bot α]
    [semilattice_inf_bot β] : semilattice_inf_bot (α × β) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance bounded_lattice (α : Type u) (β : Type v) [bounded_lattice α]
    [bounded_lattice β] : bounded_lattice (α × β) :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

protected instance bounded_distrib_lattice (α : Type u) (β : Type v) [bounded_distrib_lattice α]
    [bounded_distrib_lattice β] : bounded_distrib_lattice (α × β) :=
  bounded_distrib_lattice.mk bounded_lattice.sup bounded_lattice.le bounded_lattice.lt sorry sorry
    sorry sorry sorry sorry bounded_lattice.inf sorry sorry sorry sorry bounded_lattice.top sorry
    bounded_lattice.bot sorry

end prod

/-- Two elements of a lattice are disjoint if their inf is the bottom element.
  (This generalizes disjoint sets, viewed as members of the subset lattice.) -/
def disjoint {α : Type u} [semilattice_inf_bot α] (a : α) (b : α) := a ⊓ b ≤ ⊥

theorem disjoint.eq_bot {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} (h : disjoint a b) :
    a ⊓ b = ⊥ :=
  iff.mpr eq_bot_iff h

theorem disjoint_iff {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} :
    disjoint a b ↔ a ⊓ b = ⊥ :=
  iff.symm eq_bot_iff

theorem disjoint.comm {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} :
    disjoint a b ↔ disjoint b a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (disjoint a b ↔ disjoint b a)) (disjoint.equations._eqn_1 a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊓ b ≤ ⊥ ↔ disjoint b a)) (disjoint.equations._eqn_1 b a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊓ b ≤ ⊥ ↔ b ⊓ a ≤ ⊥)) inf_comm)) (iff.refl (b ⊓ a ≤ ⊥))))

theorem disjoint.symm {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} :
    disjoint a b → disjoint b a :=
  iff.mp disjoint.comm

@[simp] theorem disjoint_bot_left {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint ⊥ a :=
  inf_le_left

@[simp] theorem disjoint_bot_right {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint a ⊥ :=
  inf_le_right

theorem disjoint.mono {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α} {d : α}
    (h₁ : a ≤ b) (h₂ : c ≤ d) : disjoint b d → disjoint a c :=
  le_trans (inf_le_inf h₁ h₂)

theorem disjoint.mono_left {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α}
    (h : a ≤ b) : disjoint b c → disjoint a c :=
  disjoint.mono h (le_refl c)

theorem disjoint.mono_right {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} {c : α}
    (h : b ≤ c) : disjoint a c → disjoint a b :=
  disjoint.mono (le_refl a) h

@[simp] theorem disjoint_self {α : Type u} [semilattice_inf_bot α] {a : α} : disjoint a a ↔ a = ⊥ :=
  sorry

theorem disjoint.ne {α : Type u} [semilattice_inf_bot α] {a : α} {b : α} (ha : a ≠ ⊥)
    (hab : disjoint a b) : a ≠ b :=
  sorry

@[simp] theorem disjoint_top {α : Type u} [bounded_lattice α] {a : α} : disjoint a ⊤ ↔ a = ⊥ :=
  sorry

@[simp] theorem top_disjoint {α : Type u} [bounded_lattice α] {a : α} : disjoint ⊤ a ↔ a = ⊥ :=
  sorry

@[simp] theorem disjoint_sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α} :
    disjoint (a ⊔ b) c ↔ disjoint a c ∧ disjoint b c :=
  sorry

@[simp] theorem disjoint_sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α}
    {c : α} : disjoint a (b ⊔ c) ↔ disjoint a b ∧ disjoint a c :=
  sorry

theorem disjoint.sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α}
    (ha : disjoint a c) (hb : disjoint b c) : disjoint (a ⊔ b) c :=
  iff.mpr disjoint_sup_left { left := ha, right := hb }

theorem disjoint.sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α} {c : α}
    (hb : disjoint a b) (hc : disjoint a c) : disjoint a (b ⊔ c) :=
  iff.mpr disjoint_sup_right { left := hb, right := hc }

theorem disjoint.left_le_of_le_sup_right {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α}
    {c : α} (h : a ≤ b ⊔ c) (hd : disjoint a c) : a ≤ b :=
  (fun (x : a ⊓ c ≤ b ⊓ c) => le_of_inf_le_sup_le x (sup_le h le_sup_right))
    (Eq.symm (iff.mp disjoint_iff hd) ▸ bot_le)

theorem disjoint.left_le_of_le_sup_left {α : Type u} [bounded_distrib_lattice α] {a : α} {b : α}
    {c : α} (h : a ≤ c ⊔ b) (hd : disjoint a c) : a ≤ b :=
  le_of_inf_le_sup_le (Eq.symm (iff.mp disjoint_iff hd) ▸ bot_le) (sup_comm ▸ sup_le h le_sup_left)

/-!
### `is_compl` predicate
-/

/-- Two elements `x` and `y` are complements of each other if
`x ⊔ y = ⊤` and `x ⊓ y = ⊥`. -/
structure is_compl {α : Type u} [bounded_lattice α] (x : α) (y : α) where
  inf_le_bot : x ⊓ y ≤ ⊥
  top_le_sup : ⊤ ≤ x ⊔ y

namespace is_compl

protected theorem disjoint {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) :
    disjoint x y :=
  inf_le_bot h

protected theorem symm {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) :
    is_compl y x :=
  mk (eq.mpr (id (Eq._oldrec (Eq.refl (y ⊓ x ≤ ⊥)) inf_comm)) (inf_le_bot h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ ≤ y ⊔ x)) sup_comm)) (top_le_sup h))

theorem of_eq {α : Type u} [bounded_lattice α] {x : α} {y : α} (h₁ : x ⊓ y = ⊥) (h₂ : x ⊔ y = ⊤) :
    is_compl x y :=
  mk (le_of_eq h₁) (le_of_eq (Eq.symm h₂))

theorem inf_eq_bot {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) :
    x ⊓ y = ⊥ :=
  disjoint.eq_bot (is_compl.disjoint h)

theorem sup_eq_top {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) :
    x ⊔ y = ⊤ :=
  top_unique (top_le_sup h)

theorem to_order_dual {α : Type u} [bounded_lattice α] {x : α} {y : α} (h : is_compl x y) :
    is_compl x y :=
  mk (top_le_sup h) (inf_le_bot h)

theorem le_left_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl x y) : z ≤ x ↔ disjoint z y :=
  { mp := fun (hz : z ≤ x) => disjoint.mono_left hz (is_compl.disjoint h),
    mpr :=
      fun (hz : disjoint z y) =>
        le_of_inf_le_sup_le (le_trans hz bot_le) (le_trans le_top (top_le_sup h)) }

theorem le_right_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl x y) : z ≤ y ↔ disjoint z x :=
  le_left_iff (is_compl.symm h)

theorem left_le_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl x y) : x ≤ z ↔ ⊤ ≤ z ⊔ y :=
  le_left_iff (to_order_dual h)

theorem right_le_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl x y) : y ≤ z ↔ ⊤ ≤ z ⊔ x :=
  left_le_iff (is_compl.symm h)

theorem antimono {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α}
    (h : is_compl x y) (h' : is_compl x' y') (hx : x ≤ x') : y' ≤ y :=
  iff.mpr (right_le_iff h') (le_trans (top_le_sup (is_compl.symm h)) (sup_le_sup_left hx y))

theorem right_unique {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (hxy : is_compl x y) (hxz : is_compl x z) : y = z :=
  le_antisymm (antimono hxz hxy (le_refl x)) (antimono hxy hxz (le_refl x))

theorem left_unique {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (hxz : is_compl x z) (hyz : is_compl y z) : x = y :=
  right_unique (is_compl.symm hxz) (is_compl.symm hyz)

theorem sup_inf {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α}
    (h : is_compl x y) (h' : is_compl x' y') : is_compl (x ⊔ x') (y ⊓ y') :=
  sorry

theorem inf_sup {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {x' : α} {y' : α}
    (h : is_compl x y) (h' : is_compl x' y') : is_compl (x ⊓ x') (y ⊔ y') :=
  is_compl.symm (sup_inf (is_compl.symm h) (is_compl.symm h'))

theorem inf_left_eq_bot_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl y z) : x ⊓ y = ⊥ ↔ x ≤ z :=
  inf_eq_bot_iff_le_compl (sup_eq_top h) (inf_eq_bot h)

theorem inf_right_eq_bot_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl y z) : x ⊓ z = ⊥ ↔ x ≤ y :=
  inf_left_eq_bot_iff (is_compl.symm h)

theorem disjoint_left_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl y z) : disjoint x y ↔ x ≤ z :=
  iff.trans disjoint_iff (inf_left_eq_bot_iff h)

theorem disjoint_right_iff {α : Type u} [bounded_distrib_lattice α] {x : α} {y : α} {z : α}
    (h : is_compl y z) : disjoint x z ↔ x ≤ y :=
  disjoint_left_iff (is_compl.symm h)

end is_compl

theorem is_compl_bot_top {α : Type u} [bounded_lattice α] : is_compl ⊥ ⊤ :=
  is_compl.of_eq bot_inf_eq sup_top_eq

theorem is_compl_top_bot {α : Type u} [bounded_lattice α] : is_compl ⊤ ⊥ :=
  is_compl.of_eq inf_bot_eq top_sup_eq

theorem bot_ne_top {α : Type u} [bounded_lattice α] [nontrivial α] : ⊥ ≠ ⊤ :=
  fun (H : ⊥ = ⊤) => iff.mpr not_nontrivial_iff_subsingleton (subsingleton_of_bot_eq_top H) _inst_2

theorem top_ne_bot {α : Type u} [bounded_lattice α] [nontrivial α] : ⊤ ≠ ⊥ := ne.symm bot_ne_top

namespace bool

protected instance bounded_lattice : bounded_lattice Bool :=
  bounded_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry tt sorry false sorry

end bool

@[simp] theorem top_eq_tt : ⊤ = tt := rfl

@[simp] theorem bot_eq_ff : ⊥ = false := rfl

end Mathlib


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

import analysis.normed_space.exponential
import analysis.matrix
import linear_algebra.matrix.zpow
import linear_algebra.matrix.hermitian
import linear_algebra.matrix.symmetric
import topology.uniform_space.matrix

/-!
# Lemmas about the matrix exponential

In this file, we provide results about `exp` on `matrix`s over a topological or normed algebra.
Note that generic results over all topological spaces such as `exp_zero` can be used on matrices
without issue, so are not repeated here. The topological results specific to matrices are:

* `matrix.exp_transpose`
* `matrix.exp_conj_transpose`
* `matrix.exp_diagonal`
* `matrix.exp_block_diagonal`
* `matrix.exp_block_diagonal'`

Lemmas like `exp_add_of_commute` require a canonical norm on the type; while there are multiple
sensible choices for the norm of a `matrix` (`matrix.normed_add_comm_group`,
`matrix.frobenius_normed_add_comm_group`, `matrix.linfty_op_normed_add_comm_group`), none of them
are canonical. In an application where a particular norm is chosen using
`local attribute [instance]`, then the usual lemmas about `exp` are fine. When choosing a norm is
undesirable, the results in this file can be used.

In this file, we copy across the lemmas about `exp`, but hide the requirement for a norm inside the
proof.

* `matrix.exp_add_of_commute`
* `matrix.exp_sum_of_commute`
* `matrix.exp_nsmul`
* `matrix.is_unit_exp`
* `matrix.exp_units_conj`
* `matrix.exp_units_conj'`

Additionally, we prove some results about `matrix.has_inv` and `matrix.div_inv_monoid`, as the
results for general rings are instead stated about `ring.inverse`:

* `matrix.exp_neg`
* `matrix.exp_zsmul`
* `matrix.exp_conj`
* `matrix.exp_conj'`

## Implementation notes

This file runs into some sharp edges on typeclass search in lean 3, especially regarding pi types.
To work around this, we copy a handful of instances for when lean can't find them by itself.
Hopefully we will be able to remove these in Lean 4.

## TODO

* Show that `matrix.det (exp 𝕂 A) = exp 𝕂 (matrix.trace A)`

## References

* https://en.wikipedia.org/wiki/Matrix_exponential
-/
open_locale matrix big_operators

section hacks_for_pi_instance_search

/-- A special case of `pi.topological_ring` for when `R` is not dependently typed. -/
instance function.topological_ring (I : Type*) (R : Type*)
  [non_unital_ring R] [topological_space R] [topological_ring R] :
  topological_ring (I → R) :=
pi.topological_ring

/-- A special case of `function.algebra` for when A is a `ring` not a `semiring` -/
instance function.algebra_ring (I : Type*) {R : Type*} (A : Type*) [comm_semiring R]
  [ring A] [algebra R A] : algebra R (I → A) :=
pi.algebra _ _

/-- A special case of `pi.algebra` for when `f = λ i, matrix (m i) (m i) A`. -/
instance pi.matrix_algebra (I R A : Type*) (m : I → Type*)
  [comm_semiring R] [semiring A] [algebra R A]
  [Π i, fintype (m i)] [Π i, decidable_eq (m i)] :
  algebra R (Π i, matrix (m i) (m i) A) :=
@pi.algebra I R (λ i, matrix (m i) (m i) A) _ _ (λ i, matrix.algebra)

/-- A special case of `pi.topological_ring` for when `f = λ i, matrix (m i) (m i) A`. -/
instance pi.matrix_topological_ring (I A : Type*) (m : I → Type*)
  [ring A] [topological_space A] [topological_ring A]
  [Π i, fintype (m i)] :
  topological_ring (Π i, matrix (m i) (m i) A) :=
@pi.topological_ring _ (λ i, matrix (m i) (m i) A) _ _ (λ i, matrix.topological_ring)

end hacks_for_pi_instance_search

variables (𝕂 : Type*) {m n p : Type*} {n' : m → Type*} {𝔸 : Type*}

namespace matrix

section topological

section ring
variables [fintype m] [decidable_eq m] [fintype n] [decidable_eq n]
  [Π i, fintype (n' i)] [Π i, decidable_eq (n' i)]
  [field 𝕂] [ring 𝔸] [topological_space 𝔸] [topological_ring 𝔸] [algebra 𝕂 𝔸] [t2_space 𝔸]

lemma exp_diagonal (v : m → 𝔸) : exp 𝕂 (diagonal v) = diagonal (exp 𝕂 v) :=
by simp_rw [exp_eq_tsum, diagonal_pow, ←diagonal_smul, ←diagonal_tsum]

lemma exp_block_diagonal (v : m → matrix n n 𝔸) :
  exp 𝕂 (block_diagonal v) = block_diagonal (exp 𝕂 v) :=
by simp_rw [exp_eq_tsum, ←block_diagonal_pow, ←block_diagonal_smul, ←block_diagonal_tsum]

lemma exp_block_diagonal' (v : Π i, matrix (n' i) (n' i) 𝔸) :
  exp 𝕂 (block_diagonal' v) = block_diagonal' (exp 𝕂 v) :=
by simp_rw [exp_eq_tsum, ←block_diagonal'_pow, ←block_diagonal'_smul, ←block_diagonal'_tsum]

lemma exp_conj_transpose [star_ring 𝔸] [has_continuous_star 𝔸] (A : matrix m m 𝔸) :
  exp 𝕂 Aᴴ = (exp 𝕂 A)ᴴ :=
(star_exp A).symm

lemma is_hermitian.exp [star_ring 𝔸] [has_continuous_star 𝔸] {A : matrix m m 𝔸}
  (h : A.is_hermitian) : (exp 𝕂 A).is_hermitian :=
(exp_conj_transpose _ _).symm.trans $ congr_arg _ h

end ring

section comm_ring
variables [fintype m] [decidable_eq m] [field 𝕂]
  [comm_ring 𝔸] [topological_space 𝔸] [topological_ring 𝔸] [algebra 𝕂 𝔸] [t2_space 𝔸]

lemma exp_transpose (A : matrix m m 𝔸) : exp 𝕂 Aᵀ = (exp 𝕂 A)ᵀ :=
by simp_rw [exp_eq_tsum, transpose_tsum, transpose_smul, transpose_pow]

lemma is_symm.exp {A : matrix m m 𝔸} (h : A.is_symm) : (exp 𝕂 A).is_symm :=
(exp_transpose _ _).symm.trans $ congr_arg _ h

end comm_ring

end topological

section normed

variables [is_R_or_C 𝕂]
  [fintype m] [decidable_eq m]
  [fintype n] [decidable_eq n]
  [Π i, fintype (n' i)] [Π i, decidable_eq (n' i)]
  [normed_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸]

lemma exp_add_of_commute (A B : matrix m m 𝔸) (h : commute A B) :
  exp 𝕂 (A + B) = exp 𝕂 A ⬝ exp 𝕂 B :=
begin
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact exp_add_of_commute h,
end

lemma exp_sum_of_commute {ι} (s : finset ι) (f : ι → matrix m m 𝔸)
  (h : (s : set ι).pairwise $ λ i j, commute (f i) (f j)) :
  exp 𝕂 (∑ i in s, f i) = s.noncomm_prod (λ i, exp 𝕂 (f i))
    (λ i hi j hj _, (h.of_refl hi hj).exp 𝕂) :=
begin
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact exp_sum_of_commute s f h,
end

lemma exp_nsmul (n : ℕ) (A : matrix m m 𝔸) :
  exp 𝕂 (n • A) = exp 𝕂 A ^ n :=
begin
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact exp_nsmul n A,
end

lemma is_unit_exp (A : matrix m m 𝔸) : is_unit (exp 𝕂 A) :=
begin
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact is_unit_exp _ A,
end

lemma exp_units_conj (U : (matrix m m 𝔸)ˣ) (A : matrix m m 𝔸)  :
  exp 𝕂 (↑U ⬝ A ⬝ ↑(U⁻¹) : matrix m m 𝔸) = ↑U ⬝ exp 𝕂 A ⬝ ↑(U⁻¹) :=
begin
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact exp_units_conj _ U A,
end

lemma exp_units_conj' (U : (matrix m m 𝔸)ˣ) (A : matrix m m 𝔸)  :
  exp 𝕂 (↑(U⁻¹) ⬝ A ⬝ U : matrix m m 𝔸) = ↑(U⁻¹) ⬝ exp 𝕂 A ⬝ U :=
exp_units_conj 𝕂 U⁻¹ A

end normed

section normed_comm

variables [is_R_or_C 𝕂]
  [fintype m] [decidable_eq m]
  [fintype n] [decidable_eq n]
  [Π i, fintype (n' i)] [Π i, decidable_eq (n' i)]
  [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸]

lemma exp_neg (A : matrix m m 𝔸) : exp 𝕂 (-A) = (exp 𝕂 A)⁻¹ :=
begin
  rw nonsing_inv_eq_ring_inverse,
  letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring,
  letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring,
  letI : normed_algebra 𝕂 (matrix m m 𝔸) := matrix.linfty_op_normed_algebra,
  exact (ring.inverse_exp _ A).symm,
end

lemma exp_zsmul (z : ℤ) (A : matrix m m 𝔸) : exp 𝕂 (z • A) = exp 𝕂 A ^ z :=
begin
  obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg,
  { rw [zpow_coe_nat, coe_nat_zsmul, exp_nsmul] },
  { have : is_unit (exp 𝕂 A).det := (matrix.is_unit_iff_is_unit_det _).mp (is_unit_exp _ _),
    rw [matrix.zpow_neg this, zpow_coe_nat, neg_smul,
        exp_neg, coe_nat_zsmul, exp_nsmul] },
end

lemma exp_conj (U : matrix m m 𝔸) (A : matrix m m 𝔸) (hy : is_unit U) :
  exp 𝕂 (U ⬝ A ⬝ U⁻¹) = U ⬝ exp 𝕂 A ⬝ U⁻¹ :=
let ⟨u, hu⟩ := hy in hu ▸ by simpa only [matrix.coe_units_inv] using exp_units_conj 𝕂 u A

lemma exp_conj' (U : matrix m m 𝔸) (A : matrix m m 𝔸) (hy : is_unit U) :
  exp 𝕂 (U⁻¹ ⬝ A ⬝ U) = U⁻¹ ⬝ exp 𝕂 A ⬝ U :=
let ⟨u, hu⟩ := hy in hu ▸ by simpa only [matrix.coe_units_inv] using exp_units_conj' 𝕂 u A

end normed_comm

end matrix