/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.algebra.basic
import linear_algebra.prod

/-!
# Trivial Square-Zero Extension

Given a module `M` over a ring `R`, the trivial square-zero extension of `M` over `R` is defined
to be the `R`-algebra `R ⊕ M` with multiplication given by
`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + r₂ m₁`.

It is a square-zero extension because `M^2 = 0`.

## Main definitions

* `triv_sq_zero_ext.inl`, `triv_sq_zero_ext.inr`: the canonical inclusions into
  `triv_sq_zero_ext R M`.
* `triv_sq_zero_ext.fst`, `triv_sq_zero_ext.snd`: the canonical projections from
  `triv_sq_zero_ext R M`.
* `triv_sq_zero_ext.algebra`: the associated `R`-algebra structure.
* `triv_sq_zero_ext.lift`: the universal property of the trivial square-zero extension; algebra
  morphisms `triv_sq_zero_ext R M →ₐ[R] A` are uniquely defined by linear maps `M →ₗ[R] A` for
  which the product of any two elements in the range is zero.

-/

universes u v w

/--
"Trivial Square-Zero Extension".

Given a module `M` over a ring `R`, the trivial square-zero extension of `M` over `R` is defined
to be the `R`-algebra `R × M` with multiplication given by
`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + r₂ m₁`.

It is a square-zero extension because `M^2 = 0`.
-/
def triv_sq_zero_ext (R : Type u) (M : Type v) :=
R × M

local notation `tsze` := triv_sq_zero_ext

namespace triv_sq_zero_ext

section basic
variables {R : Type u} {M : Type v}

/-- The canonical inclusion `R → triv_sq_zero_ext R M`. -/
def inl [has_zero M] (r : R) : tsze R M :=
(r, 0)

/-- The canonical inclusion `M → triv_sq_zero_ext R M`. -/
def inr [has_zero R] (m : M) : tsze R M :=
(0, m)

/-- The canonical projection `triv_sq_zero_ext R M → R`. -/
def fst (x : tsze R M) : R :=
x.1

/-- The canonical projection `triv_sq_zero_ext R M → M`. -/
def snd (x : tsze R M) : M :=
x.2

@[simp] lemma fst_mk (r : R) (m : M) : fst (r, m) = r := rfl
@[simp] lemma snd_mk (r : R) (m : M) : snd (r, m) = m := rfl

@[ext] lemma ext {x y : tsze R M} (h1 : x.fst = y.fst) (h2 : x.snd = y.snd) : x = y :=
prod.ext h1 h2

section
variables (M)
@[simp] lemma fst_inl [has_zero M] (r : R) : (inl r : tsze R M).fst = r := rfl
@[simp] lemma snd_inl [has_zero M] (r : R) : (inl r : tsze R M).snd = 0 := rfl
end

section
variables (R)
@[simp] lemma fst_inr [has_zero R] (m : M) : (inr m : tsze R M).fst = 0 := rfl
@[simp]

lemma inl_injective [has_zero M] : function.injective (inl : R → tsze R M) :=
function.left_inverse.injective $ fst_inl _

lemma inr_injective [has_zero R] : function.injective (inr : M → tsze R M) :=
function.left_inverse.injective $ snd_inr _

end basic

/-! ### Structures inherited from `prod`

Additive operators and scalar multiplication operate elementwise. -/

section additive

variables {T : Type*} {S : Type*} {R : Type u} {M : Type v}

instance [inhabited R] [inhabited M] : inhabited (tsze R M) :=
prod.inhabited

instance [has_zero R] [has_zero M] : has_zero (tsze R M) :=
prod.has_zero

instance [has_add R] [has_add M] : has_add (tsze R M) :=
prod.has_add

instance [has_neg R] [has_neg M] : has_neg (tsze R M) :=
prod.has_neg

instance [add_semigroup R] [add_semigroup M] : add_semigroup (tsze R M) :=
prod.add_semigroup

instance [add_zero_class R] [add_zero_class M] : add_zero_class (tsze R M) :=
prod.add_zero_class

instance [add_monoid R] [add_monoid M] : add_monoid (tsze R M) :=
prod.add_monoid

instance [add_group R] [add_group M] : add_group (tsze R M) :=
prod.add_group

instance [add_comm_semigroup R] [add_comm_semigroup M] : add_comm_semigroup (tsze R M) :=
prod.add_comm_semigroup

instance [add_comm_monoid R] [add_comm_monoid M] : add_comm_monoid (tsze R M) :=
prod.add_comm_monoid

instance [add_comm_group R] [add_comm_group M] : add_comm_group (tsze R M) :=
prod.add_comm_group

instance [has_scalar S R] [has_scalar S M] : has_scalar S (tsze R M) :=
prod.has_scalar

instance [has_scalar T R] [has_scalar T M] [has_scalar S R] [has_scalar S M] [has_scalar T S]
  [is_scalar_tower T S R] [is_scalar_tower T S M] : is_scalar_tower T S (tsze R M) :=
prod.is_scalar_tower

instance [has_scalar T R] [has_scalar T M] [has_scalar S R] [has_scalar S M]
  [smul_comm_class T S R] [smul_comm_class T S M] : smul_comm_class T S (tsze R M) :=
prod.smul_comm_class

instance [has_scalar S R] [has_scalar S M] [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M]
  [is_central_scalar S R] [is_central_scalar S M] : is_central_scalar S (tsze R M) :=
prod.is_central_scalar

instance [monoid S] [mul_action S R] [mul_action S M] : mul_action S (tsze R M) :=
prod.mul_action

instance [monoid S] [add_monoid R] [add_monoid M]
  [distrib_mul_action S R] [distrib_mul_action S M] : distrib_mul_action S (tsze R M) :=
prod.distrib_mul_action

instance [semiring S] [add_comm_monoid R] [add_comm_monoid M]
  [module S R] [module S M] : module S (tsze R M) :=
prod.module

@[simp] lemma fst_zero [has_zero R] [has_zero M] : (0 : tsze R M).fst = 0 := rfl
@[simp] lemma snd_zero [has_zero R] [has_zero M] : (0 : tsze R M).snd = 0 := rfl

@[simp] lemma fst_add [has_add R] [has_add M] (x₁ x₂ : tsze R M) :
  (x₁ + x₂).fst = x₁.fst + x₂.fst := rfl
@[simp] lemma snd_add [has_add R] [has_add M] (x₁ x₂ : tsze R M) :
  (x₁ + x₂).snd = x₁.snd + x₂.snd := rfl

@[simp] lemma fst_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).fst = -x.fst := rfl
@[simp] lemma snd_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).snd = -x.snd := rfl

@[simp] lemma fst_smul [has_scalar S R] [has_scalar S M] (s : S) (x : tsze R M) :
  (s • x).fst = s • x.fst := rfl
@[simp] lemma snd_smul [has_scalar S R] [has_scalar S M] (s : S) (x : tsze R M) :
  (s • x).snd = s • x.snd := rfl

section
variables (M)

@[simp] lemma inl_zero [has_zero R] [has_zero M] : (inl 0 : tsze R M) = 0 := rfl

@[simp] lemma inl_add [has_add R] [add_zero_class M] (r₁ r₂ : R) :
  (inl (r₁ + r₂) : tsze R M) = inl r₁ + inl r₂ :=
ext rfl (add_zero 0).symm

@[simp] lemma inl_neg [has_neg R] [add_group M] (r : R) :
  (inl (-r) : tsze R M) = -inl r :=
ext rfl neg_zero.symm

@[simp] lemma inl_smul [monoid S] [add_monoid M] [has_scalar S R] [distrib_mul_action S M]
  (s : S) (r : R) : (inl (s • r) : tsze R M) = s • inl r :=
ext rfl (smul_zero s).symm

end

section
variables (R)

@[simp] lemma inr_zero [has_zero R] [has_zero M] : (inr 0 : tsze R M) = 0 := rfl

@[simp] lemma inr_add [add_zero_class R] [add_zero_class M] (m₁ m₂ : M) :
  (inr (m₁ + m₂) : tsze R M) = inr m₁ + inr m₂ :=
ext (add_zero 0).symm rfl

@[simp] lemma inr_neg [add_group R] [has_neg M] (m : M) :
  (inr (-m) : tsze R M) = -inr m :=
ext neg_zero.symm rfl

@[simp] lemma inr_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_scalar S M]
  (r : S) (m : M) : (inr (r • m) : tsze R M) = r • inr m :=
ext (smul_zero' _ _).symm rfl

end

lemma inl_fst_add_inr_snd_eq [add_zero_class R] [add_zero_class M] (x : tsze R M) :
  inl x.fst + inr x.snd = x :=
ext (add_zero x.1) (zero_add x.2)

/-- To show a property hold on all `triv_sq_zero_ext R M` it suffices to show it holds
on terms of the form `inl r + inr m`.

This can be used as `induction x using triv_sq_zero_ext.ind`. -/
lemma ind {R M} [add_zero_class R] [add_zero_class M] {P : triv_sq_zero_ext R M → Prop}
  (h : ∀ r m, P (inl r + inr m)) (x) : P x :=
inl_fst_add_inr_snd_eq x ▸ h x.1 x.2

/-- This cannot be marked `@[ext]` as it ends up being used instead of `linear_map.prod_ext` when
working with `R × M`. -/
lemma linear_map_ext {N} [semiring S] [add_comm_monoid R] [add_comm_monoid M] [add_comm_monoid N]
  [module S R] [module S M] [module S N] ⦃f g : tsze R M →ₗ[S] N⦄
  (hl : ∀ r, f (inl r) = g (inl r)) (hr : ∀ m, f (inr m) = g (inr m)) :
  f = g :=
linear_map.prod_ext (linear_map.ext hl) (linear_map.ext hr)

variables (R M)

/-- The canonical `R`-linear inclusion `M → triv_sq_zero_ext R M`. -/
@[simps apply]
def inr_hom [semiring R] [add_comm_monoid M] [module R M] : M →ₗ[R] tsze R M :=
{ to_fun := inr, ..linear_map.inr R R M }

/-- The canonical `R`-linear projection `triv_sq_zero_ext R M → M`. -/
@[simps apply]
def snd_hom [semiring R] [add_comm_monoid M] [module R M] : tsze R M →ₗ[R] M :=
{ to_fun := snd, ..linear_map.snd _ _ _ }

end additive

/-! ### Multiplicative structure -/

section mul
variables {R : Type u} {M : Type v}

instance [has_one R] [has_zero M] : has_one (tsze R M) :=
⟨(1, 0)⟩

instance [has_mul R] [has_add M] [has_scalar R M] : has_mul (tsze R M) :=
⟨λ x y, (x.1 * y.1, x.1 • y.2 + y.1 • x.2)⟩

@[simp] lemma fst_one [has_one R] [has_zero M] : (1 : tsze R M).fst = 1 := rfl
@[simp] lemma snd_one [has_one R] [has_zero M] : (1 : tsze R M).snd = 0 := rfl

@[simp] lemma fst_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) :
  (x₁ * x₂).fst = x₁.fst * x₂.fst := rfl
@[simp] lemma snd_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) :
  (x₁ * x₂).snd = x₁.fst • x₂.snd + x₂.fst • x₁.snd := rfl

section
variables (M)

@[simp] lemma inl_one [has_one R] [has_zero M] : (inl 1 : tsze R M) = 1 := rfl

@[simp] lemma inl_mul [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) :
  (inl (r₁ * r₂) : tsze R M) = inl r₁ * inl r₂ :=
ext rfl $ show (0 : M) = r₁ • 0 + r₂ • 0, by rw [smul_zero, zero_add, smul_zero]

lemma inl_mul_inl [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) :
  (inl r₁ * inl r₂ : tsze R M) = inl (r₁ * r₂) :=
(inl_mul M r₁ r₂).symm

end

section
variables (R)

@[simp] lemma inr_mul_inr [semiring R] [add_comm_monoid M] [module R M] (m₁ m₂ : M) :
  (inr m₁ * inr m₂ : tsze R M) = 0 :=
ext (mul_zero _) $ show (0 : R) • m₂ + (0 : R) • m₁ = 0, by rw [zero_smul, zero_add, zero_smul]

end

lemma inl_mul_inr [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) :
  (inl r * inr m : tsze R M) = inr (r • m) :=
ext (mul_zero r) $ show r • m + (0 : R) • 0 = r • m, by rw [smul_zero, add_zero]

lemma inr_mul_inl [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) :
  (inr m * inl r : tsze R M) = inr (r • m) :=
ext (zero_mul r) $ show (0 : R) • 0 + r • m = r • m, by rw [smul_zero, zero_add]

instance [monoid R] [add_monoid M] [distrib_mul_action R M] : mul_one_class (tsze R M) :=
{ one_mul := λ x, ext (one_mul x.1) $ show (1 : R) • x.2 + x.1 • 0 = x.2,
    by rw [one_smul, smul_zero, add_zero],
  mul_one := λ x, ext (mul_one x.1) $ show (x.1 • 0 : M) + (1 : R) • x.2 = x.2,
    by rw [smul_zero, zero_add, one_smul],
  .. triv_sq_zero_ext.has_one,
  .. triv_sq_zero_ext.has_mul }

instance [add_monoid_with_one R] [add_monoid M] : add_monoid_with_one (tsze R M) :=
{ nat_cast := λ n, (n, 0),
  nat_cast_zero := by simp [nat.cast],
  nat_cast_succ := λ _, by ext; simp [nat.cast],
  .. triv_sq_zero_ext.add_monoid,
  .. triv_sq_zero_ext.has_one }

instance [semiring R] [add_comm_monoid M] [module R M] : non_assoc_semiring (tsze R M) :=
{ zero_mul := λ x, ext (zero_mul x.1) $ show (0 : R) • x.2 + x.1 • 0 = 0,
    by rw [zero_smul, zero_add, smul_zero],
  mul_zero := λ x, ext (mul_zero x.1) $ show (x.1 • 0 : M) + (0 : R) • x.2 = 0,
    by rw [smul_zero, zero_add, zero_smul],
  left_distrib := λ x₁ x₂ x₃, ext (mul_add x₁.1 x₂.1 x₃.1) $
    show x₁.1 • (x₂.2 + x₃.2) + (x₂.1 + x₃.1) • x₁.2 =
      x₁.1 • x₂.2 + x₂.1 • x₁.2 + (x₁.1 • x₃.2 + x₃.1 • x₁.2),
    by simp_rw [smul_add, add_smul, add_add_add_comm],
  right_distrib := λ x₁ x₂ x₃, ext (add_mul x₁.1 x₂.1 x₃.1) $
    show (x₁.1 + x₂.1) • x₃.2 + x₃.1 • (x₁.2 + x₂.2) =
      x₁.1 • x₃.2 + x₃.1 • x₁.2 + (x₂.1 • x₃.2 + x₃.1 • x₂.2),
    by simp_rw [add_smul, smul_add, add_add_add_comm],
  .. triv_sq_zero_ext.add_monoid_with_one,
  .. triv_sq_zero_ext.mul_one_class,
  .. triv_sq_zero_ext.add_comm_monoid }

instance [comm_monoid R] [add_monoid M] [distrib_mul_action R M] : monoid (tsze R M) :=
{ mul_assoc := λ x y z, ext (mul_assoc x.1 y.1 z.1) $
    show (x.1 * y.1) • z.2 + z.1 • (x.1 • y.2 + y.1 • x.2) =
      x.1 • (y.1 • z.2 + z.1 • y.2) + (y.1 * z.1) • x.2,
    by simp_rw [smul_add, ← mul_smul, add_assoc, mul_comm],
  .. triv_sq_zero_ext.mul_one_class }

instance [comm_monoid R] [add_comm_monoid M] [distrib_mul_action R M] : comm_monoid (tsze R M) :=
{ mul_comm := λ x₁ x₂, ext (mul_comm x₁.1 x₂.1) $
    show x₁.1 • x₂.2 + x₂.1 • x₁.2 = x₂.1 • x₁.2 + x₁.1 • x₂.2, from add_comm _ _,
  .. triv_sq_zero_ext.monoid }

instance [comm_semiring R] [add_comm_monoid M] [module R M] : comm_semiring (tsze R M) :=
{ .. triv_sq_zero_ext.comm_monoid,
  .. triv_sq_zero_ext.non_assoc_semiring }

variables (R M)

/-- The canonical inclusion of rings `R → triv_sq_zero_ext R M`. -/
@[simps apply]
def inl_hom [semiring R] [add_comm_monoid M] [module R M] : R →+* tsze R M :=
{ to_fun := inl,
  map_one' := inl_one M,
  map_mul' := inl_mul M,
  map_zero' := inl_zero M,
  map_add' := inl_add M }

end mul

section algebra
variables (S : Type*) (R : Type u) (M : Type v)
variables [comm_semiring S] [comm_semiring R] [add_comm_monoid M]
variables [algebra S R] [module S M] [module R M] [is_scalar_tower S R M]

instance algebra'  : algebra S (tsze R M) :=
{ commutes' := λ r x, mul_comm _ _,
  smul_def' := λ r x, ext (algebra.smul_def _ _) $
    show r • x.2 = algebra_map S R r • x.2 + x.1 • 0, by rw [smul_zero, add_zero, algebra_map_smul],
  .. (triv_sq_zero_ext.inl_hom R M).comp (algebra_map S R) }

-- shortcut instance for the common case
instance : algebra R (tsze R M) := triv_sq_zero_ext.algebra' _ _ _

lemma algebra_map_eq_inl : ⇑(algebra_map R (tsze R M)) = inl := rfl
lemma algebra_map_eq_inl_hom : algebra_map R (tsze R M) = inl_hom R M := rfl
lemma algebra_map_eq_inl' (s : S) : algebra_map S (tsze R M) s = inl (algebra_map S R s) := rfl

/-- The canonical `R`-algebra projection `triv_sq_zero_ext R M → R`. -/
@[simps]
def fst_hom : tsze R M →ₐ[R] R :=
{ to_fun := fst,
  map_one' := fst_one,
  map_mul' := fst_mul,
  map_zero' := fst_zero,
  map_add' := fst_add,
  commutes' := fst_inl M }

variables {R S M}

lemma alg_hom_ext {A} [semiring A] [algebra R A] ⦃f g : tsze R M →ₐ[R] A⦄
  (h : ∀ m, f (inr m) = g (inr m)) :
  f = g :=
alg_hom.to_linear_map_injective $ linear_map_ext (λ r, (f.commutes _).trans (g.commutes _).symm) h

@[ext]
lemma alg_hom_ext' {A} [semiring A] [algebra R A] ⦃f g : tsze R M →ₐ[R] A⦄
  (h : f.to_linear_map.comp (inr_hom R M) = g.to_linear_map.comp (inr_hom R M)) :
  f = g :=
alg_hom_ext $ linear_map.congr_fun h

variables {A : Type*} [semiring A] [algebra R A]

/-- There is an alg_hom from the trivial square zero extension to any `R`-algebra with a submodule
whose products are all zero.

See `triv_sq_zero_ext.lift` for this as an equiv. -/
def lift_aux (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) : tsze R M →ₐ[R] A :=
alg_hom.of_linear_map
  ((algebra.linear_map _ _).comp (fst_hom R M).to_linear_map + f.comp (snd_hom R M))
  (show algebra_map R _ 1 + f (0 : M) = 1, by rw [map_zero, map_one, add_zero])
  (triv_sq_zero_ext.ind $ λ r₁ m₁, triv_sq_zero_ext.ind $ λ r₂ m₂, begin
    dsimp,
    simp only [add_zero, zero_add, add_mul, mul_add, smul_mul_smul, hf, smul_zero],
    rw [←ring_hom.map_mul, linear_map.map_add, ←algebra.commutes _ (f _), ←algebra.smul_def,
        ←algebra.smul_def, add_right_comm, add_assoc, linear_map.map_smul, linear_map.map_smul],
  end)

@[simp] lemma lift_aux_apply_inr (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) (m : M) :
  lift_aux f hf (inr m) = f m :=
show algebra_map R A 0 + f m = f m, by rw [ring_hom.map_zero, zero_add]

@[simp] lemma lift_aux_comp_inr_hom (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) :
  (lift_aux f hf).to_linear_map.comp (inr_hom R M) = f :=
linear_map.ext $ lift_aux_apply_inr f hf

/- When applied to `inr` itself, `lift_aux` is the identity. -/
@[simp]
lemma lift_aux_inr_hom : lift_aux (inr_hom R M) (inr_mul_inr R) = alg_hom.id R (tsze R M) :=
alg_hom_ext' $ lift_aux_comp_inr_hom _ _

/-- A universal property of the trivial square-zero extension, providing a unique
`triv_sq_zero_ext R M →ₐ[R] A` for every linear map `M →ₗ[R] A` whose range has no non-zero
products.

This isomorphism is named to match the very similar `complex.lift`. -/
@[simps]
def lift : {f : M →ₗ[R] A // ∀ x y, f x * f y = 0} ≃ (tsze R M →ₐ[R] A) :=
{ to_fun := λ f, lift_aux f f.prop,
  inv_fun := λ F, ⟨F.to_linear_map.comp (inr_hom R M), λ x y,
    (F.map_mul _ _).symm.trans $ (F.congr_arg $ inr_mul_inr _ _ _).trans F.map_zero⟩,
  left_inv := λ f, subtype.ext $ lift_aux_comp_inr_hom _ _,
  right_inv := λ F, alg_hom_ext' $ lift_aux_comp_inr_hom _ _, }

end algebra

end triv_sq_zero_ext


import data.list algebra.ring tactic.omega defs single height tactics

lemma branch_son : ∀ t s : bintree, ⟨ t ⟩ → is_son s t → ⟨ s ⟩ :=
begin
  intros t,
  induction t,
  begin intros s H1 H2, cases H2 end, -- single case
  repeat { -- left and right cases
    begin intros s H1 H2, cases H1, cases H2, assumption end,
  },
  begin
    intros s H1 H2,
    cases H1, cases H2, assumption, auto_branch,
    cases H2, auto_branch, assumption
  end
end

lemma branch_with_two_sons : ∀ b b' : bintree,
      ⟨⟦b, b'⟧⟩ → b = ● ∨ b' = ● :=
begin
  intros b b' H1,
  cases H1,
  begin right, refl end,
  begin left, refl end
end

def gen_link : ℕ → bintree
| 0 := ●
| (nat.succ n) := ⟦●, gen_link n⟧

lemma gen_link_branch : ∀ n, ⟨gen_link n⟩ :=
begin
  intros n, induction n,
  unfold gen_link, auto_branch,
  unfold gen_link, auto_branch
end

lemma gen_link_height : ∀ n, height (gen_link n) = n + 1 :=
begin
  intros n,
  induction n,
  simp, unfold gen_link height,
  unfold gen_link height,
  have ht : _ := height_ge1 (gen_link n_n),
  have ht' : _ := ge.le ht,
  have ht2 : _ := max_eq_right ht', rewrite ht2, omega
end

lemma height_max_1_left : ∀ t, max (height t) 1 = height t :=
begin
  intros t, have ht : 1 ≤ height t := ge.le (height_ge1 _),
  apply max_eq_left, assumption
end

lemma height_max_1_right : ∀ t, max 1 (height t) = height t :=
begin
  intros t, have ht : 1 ≤ height t := ge.le (height_ge1 _),
  apply max_eq_right, assumption
end

lemma grow_high_bintree : ∀ t, ⟨t⟩ → ∀ h, (∃ t', ⟨t'⟩ ∧ (t ↣ t') ∧ height t' = height t + h) :=
begin
  intros t a,
  induction a,
  begin intros, existsi (gen_link h), split, exact gen_link_branch _, split, apply grow.single_grow, rewrite (gen_link_height _), unfold height, omega end,
  begin
    intros h, cases a_ih h, existsi ⟦w∣⟧, split,
    auto_branch, split,
    auto_grow,
    unfold height, rewrite h_1.right.right, omega
  end,
  begin
    intros h, cases a_ih h, existsi ⟦w, ●⟧, split,
    auto_branch, split,
    auto_grow,
    unfold height, repeat {rewrite height_max_1_left},
    rewrite h_1.right.right, omega
  end,
  begin
    intros h, cases a_ih h, existsi ⟦∣w⟧, split,
    auto_branch, split,
    auto_grow,
    unfold height, rewrite h_1.right.right, omega,
  end,
  begin
    intros h, cases a_ih h, existsi ⟦●, w⟧, split,
    auto_branch, split,
    auto_grow,
    unfold height, repeat {rewrite height_max_1_right},
    rewrite h_1.right.right, omega
  end
end

lemma branch_grow : ∀ b b' : bintree, ⟨ b ⟩ → (b' ↣ b) → ⟨ b' ⟩ :=
begin
  intros b b' h1 h2,
  induction h2,
  auto_branch,
  cases h1, auto_branch,
  cases h1, auto_branch,
  cases h1,
  repeat{
    try {rewrite (single_grow _ h2_a_1)},
    try {rewrite (single_grow _ h2_a)},
    auto_branch
  }
end

lemma branch_prefix : ∀ b t t' : bintree, ⟨b⟩ → (t ↣ b) → (t' ↣ b)
                                 → (height t ≤ height t') → (t ↣ t') :=
begin
  intros b,
  induction b,
  begin -- base case, which is trivial since b = ●
    intros, auto_grow
  end,
  begin -- left
    intros t t' h1 h2 h3 h4,
    cases t,
    begin auto_grow end,
    begin
      cases h3,
      begin
        unfold height at h4, simp at h4, exfalso, exact h4
      end,
      begin
        cases h2,
        unfold height at h4,
        cases h1,
        have ht : height t ≤ height h3_t, omega,
        have ht' : (t ↣ h3_t), apply b_ih, repeat {assumption},
        auto_grow
      end
    end,
    cases h3, cases h2, cases h2,
    cases h3, cases h2, cases h2,
  end,
  begin -- right
    intros t t' h1 h2 h3 h4,
    cases t,
    begin auto_grow end,
    cases h3, cases h2, cases h2,
    begin
      cases h3,
      begin
        unfold height at h4, simp at h4,
        exfalso, exact h4
      end,
      begin
        cases h2,
        unfold height at h4,
        cases h1, simp at h4,
        have ht' : (t ↣ h3_t), apply b_ih, repeat {assumption},
        auto_grow
      end
    end,
    cases h3, cases h2, cases h2
  end,
  begin -- full
    intros t t' h1 h2 h3 h4,
    cases t,
    begin auto_grow end,
    cases h3, cases h2, cases h2, cases h2,
    cases t',
    begin
      unfold height at h4,
      simp at h4, exfalso, exact h4
    end,
    begin cases h3 end,
    begin cases h3 end,
    begin
      cases h2, cases h3, unfold height at h4,
      have h4' : max (height t_a) (height t_a_1) ≤ max (height t'_a) (height t'_a_1), omega,
      have ht : max (height t'_a) (height t'_a_1) = height t'_a ∨ max (height t'_a) (height t'_a_1) = height t'_a_1, apply max_choice,
      have ht' : max (height t_a) (height t_a_1) ≤ height t'_a ∨ max (height t_a) (height t_a_1) ≤ height t'_a_1,
      begin
        cases ht,
        begin rewrite ht at h4, left, omega end,
        begin rewrite ht at h4, right, omega end,
      end,
      cases ht',
      begin
        have hl : _ := le_of_max_le_left ht',
        have hr : _ := le_of_max_le_right ht',
        cases h1,
        begin
          have res_l : (t_a ↣ t'_a),
          begin apply b_ih_a, repeat {assumption} end,
          auto_grow
        end,
        begin
          auto_grow, unfold height at *, auto_grow
        end
      end,
      begin
        have hl : _ := le_of_max_le_left ht',
        have hr : _ := le_of_max_le_right ht',
        cases h1,
        begin
          auto_grow, unfold height at *, auto_grow, auto_grow
        end,
        begin
          have res_r : (t_a_1 ↣ t'_a_1),
          begin apply b_ih_a_1, repeat {assumption} end,
          auto_grow
        end
      end
    end
  end
end


import hom

namespace UA
  universe u_lang

  section
    universe u_t
    parameter [σ : signature.{u_lang}]

    /- *** `word` means an expression in the language of `σ`, with variables from `T` *** -/

    inductive word (T : Type u_t) : Type (max u_lang u_t)
    | var           : T → word
    | opr (f : σ.F) : (fin (arity_of f) → word) → word

    def vars {T : Type u_t} : word T → set T
    | (word.var t)     := {t}
    | (word.opr f xxx) := ⋃ i, vars (xxx i)

    theorem finitely_many_vars {T : Type u_t} (w : word T) : set.finite (vars w) :=
    begin
      induction w,

      rw vars,
      apply set.to_finite,

      apply set.finite_Union,
      assumption,
    end

    /- The words themselvs for a structure in the ovbious way. -/

    instance action_on_words (T : Type u_t) : action_on (word T) := λ f, word.opr f ∘ vector.nth

    def word_algebra (T : Type u_t) : Structure := ⟨word T, action_on_words T⟩

    @[simp] lemma action_of_word_algebra {T : Type u_t} {f www} :
    (word_algebra T).action f www = word.opr f www.nth := rfl

  end

  section
    universe u_str
    parameter [σ : signature.{u_lang}]
    include σ

    /- A `σ-structure` admits a canonical `evaluation` from its word algebra -/

    def eval {α : Type u_str} [act : action_on α] : word α → α
    | (word.var t)    := t
    | (word.opr f xxx) := act f (vector.of_fn (λ i, eval (xxx i)))

    instance eval_is_hom {α : Type u_str} [act : action_on α] : homomorphism (@eval α _) :=
    begin
      intros f www,
      rw UA.action_on_words,
      simp_rw eval,
      congr,
      apply vector.ext,
      intro i,
      simp,
    end

    def evaluation {A : Structure.{u_lang u_str}} : Homomorphism (word_algebra A) A :=
    ⟨eval, eval_is_hom⟩

  end

  /- `translatation` is the process of substituting for the variables in a word -/

  section
    universes u_s u_t

    def translate [σ : signature.{u_lang}] {S : Type u_s} {T : Type u_t}
    (φ : S → T) : word S → word T
    | (word.var t)     := word.var (φ t)
    | (word.opr f xxx) := word.opr f (λ i, translate (xxx i))
  end

  /- *** Introduce notation out of sight of any parameters ***
  -- previously this was declared 'local', to depend on the parameter σ, but this
  -- seemed to create a mysterious problem where there were two σ's floating around -/
  postfix `†` : 110 := translate -- right value?

  section
    universes u_r u_s u_t u_strA u_strB
    parameter [σ : signature.{u_lang}]
    include σ

    /- *** do not put this lemma through `simp_rw`, as it hangs ***
    -- Should probably investigate at some point. Especially don't expose this to `simp`,
    -- for the same reason, though it isn't unequivocally a simplification anyway.     -/
    lemma translation_functorial
    {R : Type u_r} {S : Type u_s} {T : Type u_t} (ψ : R → S) (φ : S → T) (w : word R) :
    (φ ∘ ψ)† w = (φ†) (ψ† w) :=
    begin
      induction w,
      refl,
      simp_rw translate,
      simp_rw w_ih,
      simp,
    end

    /- The property of being a `homomorphism` is in fact characterised by the
    -- preservation of evaluations of *any* word in the language.          -/

    lemma hom_preserves_eval
    {α : Type u_strA} {β : Type u_strB} [actA : action_on α] [actB : action_on β]
    {φ : α → β}
    [H : homomorphism φ] {w : word α} : φ (eval w) = eval (φ† w) :=
    begin
      induction w with _ f www h_ind, {
        refl,
      },
      {
        specialize H f (vector.of_fn (eval ∘ www)),
        simp_rw [eval, ← H, vector.map_of_of_fn],
        rw (funext h_ind : φ ∘ eval ∘ www = λ i, eval (φ† (www i))),
        refl,
      },
    end

    lemma hom_iff
    {α : Type u_strA} {β : Type u_strB} [actA : action_on α] [actB : action_on β]
    {φ : α → β} :
    homomorphism φ ↔ ∀ w : word α, φ (eval w) = eval (φ† w) :=
    begin

      split,

      introI,
      intro word,
      exact hom_preserves_eval,

      intros h f xxx,
      specialize h (word.opr f (word.var ∘ xxx.nth)),
      simp_rw [eval, vector.of_fn_nth] at h,
      simp_rw [h, translate, eval],
      congr,
      apply vector.ext,
      intro i,
      simp_rw [vector.nth_of_fn, vector.nth_map],

    end

  end

end UA


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.complex.cauchy_integral
import analysis.calculus.fderiv_analytic
import analysis.normed_space.completion

/-!
# Liouville's theorem

In this file we prove Liouville's theorem: if `f : E → F` is complex differentiable on the whole
space and its range is bounded, then the function is a constant. Various versions of this theorem
are formalized in `differentiable.apply_eq_apply_of_bounded`,
`differentiable.exists_const_forall_eq_of_bounded`, and
`differentiable.exists_eq_const_of_bounded`.

The proof is based on the Cauchy integral formula for the derivative of an analytic function, see
`complex.deriv_eq_smul_circle_integral`.
-/

open topological_space metric set filter asymptotics function measure_theory
open_locale topological_space filter nnreal real

universes u v
variables {E : Type u} [normed_group E] [normed_space ℂ E]
  {F : Type v} [normed_group F] [normed_space ℂ F]

local postfix `̂`:100 := uniform_space.completion

namespace complex

/-- If `f` is complex differentiable on a closed disc with center `c` and radius `R > 0`, then
`f' c` can be represented as an integral over the corresponding circle.

TODO: add a version for `w ∈ metric.ball c R`.

TODO: add a version for higher derivatives. -/
lemma deriv_eq_smul_circle_integral [complete_space F]
  {R : ℝ} {c : ℂ} {f : ℂ → F} (hR : 0 < R) (hf : diff_on_int_cont ℂ f (closed_ball c R)) :
  deriv f c = (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - c) ^ (-2 : ℤ) • f z :=
begin
  lift R to ℝ≥0 using hR.le,
  refine (hf.has_fpower_series_on_ball hR).has_fpower_series_at.deriv.trans _,
  simp only [cauchy_power_series_apply, one_div, zpow_neg₀, pow_one, smul_smul,
    zpow_two, mul_inv₀]
end

lemma norm_deriv_le_aux [complete_space F] {c : ℂ} {R C : ℝ} {f : ℂ → F} (hR : 0 < R)
  (hf : diff_on_int_cont ℂ f (closed_ball c R)) (hC : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) :
  ∥deriv f c∥ ≤ C / R :=
begin
  have : ∀ z ∈ sphere c R, ∥(z - c) ^ (-2 : ℤ) • f z∥ ≤ C / (R * R),
    from λ z (hz : abs (z - c) = R), by simpa [norm_smul, hz, zpow_two, ← div_eq_inv_mul]
      using (div_le_div_right (mul_pos hR hR)).2 (hC z hz),
  calc ∥deriv f c∥ = ∥(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - c) ^ (-2 : ℤ) • f z∥ :
    congr_arg norm (deriv_eq_smul_circle_integral hR hf)
  ... ≤ R * (C / (R * R)) :
    circle_integral.norm_two_pi_I_inv_smul_integral_le_of_norm_le_const hR.le this
  ... = C / R : by rw [mul_div_comm, div_self_mul_self', div_eq_mul_inv]
end

/-- If `f` is continuous on a closed disc of radius `R`, is complex differentiable on its interior,
and its values on the boundary circle of this disc are bounded from above by `C`, then the norm of
its derivative at the center is at most `C / R`. -/
lemma norm_deriv_le_of_forall_mem_sphere_norm_le {c : ℂ} {R C : ℝ} {f : ℂ → F} (hR : 0 < R)
  (hd : diff_on_int_cont ℂ f (closed_ball c R)) (hC : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) :
  ∥deriv f c∥ ≤ C / R :=
begin
  set e : F →L[ℂ] F̂ := uniform_space.completion.to_complL,
  have : has_deriv_at (e ∘ f) (e (deriv f c)) c,
    from e.has_fderiv_at.comp_has_deriv_at c
      (hd.differentiable_at' $ closed_ball_mem_nhds _ hR).has_deriv_at,
  calc ∥deriv f c∥ = ∥deriv (e ∘ f) c∥ :
    by { rw this.deriv, exact (uniform_space.completion.norm_coe _).symm }
  ... ≤ C / R :
    norm_deriv_le_aux hR (e.differentiable.comp_diff_on_int_cont hd)
      (λ z hz, (uniform_space.completion.norm_coe _).trans_le (hC z hz))
end

/-- An auxiliary lemma for Liouville's theorem `differentiable.apply_eq_apply_of_bounded`. -/
lemma liouville_theorem_aux {f : ℂ → F} (hf : differentiable ℂ f)
  (hb : bounded (range f)) (z w : ℂ) : f z = f w :=
begin
  suffices : ∀ c, deriv f c = 0, from is_const_of_deriv_eq_zero hf this z w,
  clear z w, intro c,
  obtain ⟨C, C₀, hC⟩ : ∃ C > (0 : ℝ), ∀ z, ∥f z∥ ≤ C,
  { rcases bounded_iff_forall_norm_le.1 hb with ⟨C, hC⟩,
    exact ⟨max C 1, lt_max_iff.2 (or.inr zero_lt_one),
      λ z, (hC (f z) (mem_range_self _)).trans (le_max_left _ _)⟩ },
  refine norm_le_zero_iff.1 (le_of_forall_le_of_dense $ λ ε ε₀, _),
  calc ∥deriv f c∥ ≤ C / (C / ε) :
    norm_deriv_le_of_forall_mem_sphere_norm_le (div_pos C₀ ε₀) hf.diff_on_int_cont (λ z _, hC z)
  ... = ε : div_div_cancel' C₀.lt.ne'
end

end complex

namespace differentiable

open complex

/-- **Liouville's theorem**: a complex differentiable bounded function `f : E → F` is a constant. -/
lemma apply_eq_apply_of_bounded {f : E → F} (hf : differentiable ℂ f) (hb : bounded (range f))
  (z w : E) : f z = f w :=
begin
  set g : ℂ → F := f ∘ (λ t : ℂ, t • (w - z) + z),
  suffices : g 0 = g 1, by simpa [g],
  apply liouville_theorem_aux,
  exacts [hf.comp ((differentiable_id.smul_const (w - z)).add_const z),
    hb.mono (range_comp_subset_range _ _)]
end

/-- **Liouville's theorem**: a complex differentiable bounded function is a constant. -/
lemma exists_const_forall_eq_of_bounded {f : E → F} (hf : differentiable ℂ f)
  (hb : bounded (range f)) : ∃ c, ∀ z, f z = c :=
⟨f 0, λ z, hf.apply_eq_apply_of_bounded hb _ _⟩

/-- **Liouville's theorem**: a complex differentiable bounded function is a constant. -/
lemma exists_eq_const_of_bounded {f : E → F} (hf : differentiable ℂ f)
  (hb : bounded (range f)) : ∃ c, f = const E c :=
(hf.exists_const_forall_eq_of_bounded hb).imp $ λ c, funext

end differentiable


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yourong Zang

! This file was ported from Lean 3 source module analysis.complex.real_deriv
! leanprover-community/mathlib commit e9be2fa75faa22892937c275e27a91cd558cf8c0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.ContDiff
import Mathbin.Analysis.Complex.Conformal
import Mathbin.Analysis.Calculus.Conformal.NormedSpace

/-! # Real differentiability of complex-differentiable functions

`has_deriv_at.real_of_complex` expresses that, if a function on `ℂ` is differentiable (over `ℂ`),
then its restriction to `ℝ` is differentiable over `ℝ`, with derivative the real part of the
complex derivative.

`differentiable_at.conformal_at` states that a real-differentiable function with a nonvanishing
differential from the complex plane into an arbitrary complex-normed space is conformal at a point
if it's holomorphic at that point. This is a version of Cauchy-Riemann equations.

`conformal_at_iff_differentiable_at_or_differentiable_at_comp_conj` proves that a real-differential
function with a nonvanishing differential between the complex plane is conformal at a point if and
only if it's holomorphic or antiholomorphic at that point.

## TODO

* The classical form of Cauchy-Riemann equations
* On a connected open set `u`, a function which is `conformal_at` each point is either holomorphic
throughout or antiholomorphic throughout.

## Warning

We do NOT require conformal functions to be orientation-preserving in this file.
-/

section RealDerivOfComplex

/-! ### Differentiability of the restriction to `ℝ` of complex functions -/

open Complex

variable {e : ℂ → ℂ} {e' : ℂ} {z : ℝ}

/-- If a complex function is differentiable at a real point, then the induced real function is also
differentiable at this point, with a derivative equal to the real part of the complex derivative. -/
theorem HasStrictDerivAt.real_of_complex (h : HasStrictDerivAt e e' z) :
    HasStrictDerivAt (fun x : ℝ => (e x).re) e'.re z :=
  by
  have A : HasStrictFderivAt (coe : ℝ → ℂ) of_real_clm z := of_real_clm.has_strict_fderiv_at
  have B :
    HasStrictFderivAt e ((ContinuousLinearMap.smulRight 1 e' : ℂ →L[ℂ] ℂ).restrictScalars ℝ)
      (of_real_clm z) :=
    h.has_strict_fderiv_at.restrict_scalars ℝ
  have C : HasStrictFderivAt re re_clm (e (of_real_clm z)) := re_clm.has_strict_fderiv_at
  simpa using (C.comp z (B.comp z A)).HasStrictDerivAt
#align has_strict_deriv_at.real_of_complex HasStrictDerivAt.real_of_complex

/-- If a complex function `e` is differentiable at a real point, then the function `ℝ → ℝ` given by
the real part of `e` is also differentiable at this point, with a derivative equal to the real part
of the complex derivative. -/
theorem HasDerivAt.real_of_complex (h : HasDerivAt e e' z) :
    HasDerivAt (fun x : ℝ => (e x).re) e'.re z :=
  by
  have A : HasFderivAt (coe : ℝ → ℂ) of_real_clm z := of_real_clm.has_fderiv_at
  have B :
    HasFderivAt e ((ContinuousLinearMap.smulRight 1 e' : ℂ →L[ℂ] ℂ).restrictScalars ℝ)
      (of_real_clm z) :=
    h.has_fderiv_at.restrict_scalars ℝ
  have C : HasFderivAt re re_clm (e (of_real_clm z)) := re_clm.has_fderiv_at
  simpa using (C.comp z (B.comp z A)).HasDerivAt
#align has_deriv_at.real_of_complex HasDerivAt.real_of_complex

theorem ContDiffAt.real_of_complex {n : ℕ∞} (h : ContDiffAt ℂ n e z) :
    ContDiffAt ℝ n (fun x : ℝ => (e x).re) z :=
  by
  have A : ContDiffAt ℝ n (coe : ℝ → ℂ) z := of_real_clm.cont_diff.cont_diff_at
  have B : ContDiffAt ℝ n e z := h.restrict_scalars ℝ
  have C : ContDiffAt ℝ n re (e z) := re_clm.cont_diff.cont_diff_at
  exact C.comp z (B.comp z A)
#align cont_diff_at.real_of_complex ContDiffAt.real_of_complex

theorem ContDiff.real_of_complex {n : ℕ∞} (h : ContDiff ℂ n e) :
    ContDiff ℝ n fun x : ℝ => (e x).re :=
  contDiff_iff_contDiffAt.2 fun x => h.ContDiffAt.real_of_complex
#align cont_diff.real_of_complex ContDiff.real_of_complex

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℂ E]

theorem HasStrictDerivAt.complexToReal_fderiv' {f : ℂ → E} {x : ℂ} {f' : E}
    (h : HasStrictDerivAt f f' x) :
    HasStrictFderivAt f (reClm.smul_right f' + I • imClm.smul_right f') x := by
  simpa only [Complex.restrictScalars_one_smul_right'] using
    h.has_strict_fderiv_at.restrict_scalars ℝ
#align has_strict_deriv_at.complex_to_real_fderiv' HasStrictDerivAt.complexToReal_fderiv'

theorem HasDerivAt.complexToReal_fderiv' {f : ℂ → E} {x : ℂ} {f' : E} (h : HasDerivAt f f' x) :
    HasFderivAt f (reClm.smul_right f' + I • imClm.smul_right f') x := by
  simpa only [Complex.restrictScalars_one_smul_right'] using h.has_fderiv_at.restrict_scalars ℝ
#align has_deriv_at.complex_to_real_fderiv' HasDerivAt.complexToReal_fderiv'

theorem HasDerivWithinAt.complexToReal_fderiv' {f : ℂ → E} {s : Set ℂ} {x : ℂ} {f' : E}
    (h : HasDerivWithinAt f f' s x) :
    HasFderivWithinAt f (reClm.smul_right f' + I • imClm.smul_right f') s x := by
  simpa only [Complex.restrictScalars_one_smul_right'] using
    h.has_fderiv_within_at.restrict_scalars ℝ
#align has_deriv_within_at.complex_to_real_fderiv' HasDerivWithinAt.complexToReal_fderiv'

theorem HasStrictDerivAt.complexToReal_fderiv {f : ℂ → ℂ} {f' x : ℂ} (h : HasStrictDerivAt f f' x) :
    HasStrictFderivAt f (f' • (1 : ℂ →L[ℝ] ℂ)) x := by
  simpa only [Complex.restrictScalars_one_smulRight] using h.has_strict_fderiv_at.restrict_scalars ℝ
#align has_strict_deriv_at.complex_to_real_fderiv HasStrictDerivAt.complexToReal_fderiv

theorem HasDerivAt.complexToReal_fderiv {f : ℂ → ℂ} {f' x : ℂ} (h : HasDerivAt f f' x) :
    HasFderivAt f (f' • (1 : ℂ →L[ℝ] ℂ)) x := by
  simpa only [Complex.restrictScalars_one_smulRight] using h.has_fderiv_at.restrict_scalars ℝ
#align has_deriv_at.complex_to_real_fderiv HasDerivAt.complexToReal_fderiv

theorem HasDerivWithinAt.complexToReal_fderiv {f : ℂ → ℂ} {s : Set ℂ} {f' x : ℂ}
    (h : HasDerivWithinAt f f' s x) : HasFderivWithinAt f (f' • (1 : ℂ →L[ℝ] ℂ)) s x := by
  simpa only [Complex.restrictScalars_one_smulRight] using h.has_fderiv_within_at.restrict_scalars ℝ
#align has_deriv_within_at.complex_to_real_fderiv HasDerivWithinAt.complexToReal_fderiv

/-- If a complex function `e` is differentiable at a real point, then its restriction to `ℝ` is
differentiable there as a function `ℝ → ℂ`, with the same derivative. -/
theorem HasDerivAt.comp_of_real (hf : HasDerivAt e e' ↑z) : HasDerivAt (fun y : ℝ => e ↑y) e' z :=
  by simpa only [of_real_clm_apply, of_real_one, mul_one] using hf.comp z of_real_clm.has_deriv_at
#align has_deriv_at.comp_of_real HasDerivAt.comp_of_real

/-- If a function `f : ℝ → ℝ` is differentiable at a (real) point `x`, then it is also
differentiable as a function `ℝ → ℂ`. -/
theorem HasDerivAt.of_real_comp {f : ℝ → ℝ} {u : ℝ} (hf : HasDerivAt f u z) :
    HasDerivAt (fun y : ℝ => ↑(f y) : ℝ → ℂ) u z := by
  simpa only [of_real_clm_apply, of_real_one, real_smul, mul_one] using
    of_real_clm.has_deriv_at.scomp z hf
#align has_deriv_at.of_real_comp HasDerivAt.of_real_comp

end RealDerivOfComplex

section Conformality

/-! ### Conformality of real-differentiable complex maps -/

open Complex ContinuousLinearMap

open ComplexConjugate

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

/-- A real differentiable function of the complex plane into some complex normed space `E` is
    conformal at a point `z` if it is holomorphic at that point with a nonvanishing differential.
    This is a version of the Cauchy-Riemann equations. -/
theorem DifferentiableAt.conformalAt (h : DifferentiableAt ℂ f z) (hf' : deriv f z ≠ 0) :
    ConformalAt f z :=
  by
  rw [conformalAt_iff_isConformalMap_fderiv, (h.has_fderiv_at.restrict_scalars ℝ).fderiv]
  apply isConformalMap_complex_linear
  simpa only [Ne.def, ext_ring_iff]
#align differentiable_at.conformal_at DifferentiableAt.conformalAt

/-- A complex function is conformal if and only if the function is holomorphic or antiholomorphic
    with a nonvanishing differential. -/
theorem conformalAt_iff_differentiableAt_or_differentiableAt_comp_conj {f : ℂ → ℂ} {z : ℂ} :
    ConformalAt f z ↔
      (DifferentiableAt ℂ f z ∨ DifferentiableAt ℂ (f ∘ conj) (conj z)) ∧ fderiv ℝ f z ≠ 0 :=
  by
  rw [conformalAt_iff_isConformalMap_fderiv]
  rw [isConformalMap_iff_is_complex_or_conj_linear]
  apply and_congr_left
  intro h
  have h_diff := h.imp_symm fderiv_zero_of_not_differentiableAt
  apply or_congr
  · rw [differentiableAt_iff_restrictScalars ℝ h_diff]
  rw [← conj_conj z] at h_diff
  rw [differentiableAt_iff_restrictScalars ℝ (h_diff.comp _ conj_cle.differentiable_at)]
  refine' exists_congr fun g => rfl.congr _
  have : fderiv ℝ conj (conj z) = _ := conj_cle.fderiv
  simp [fderiv.comp _ h_diff conj_cle.differentiable_at, this, conj_conj]
#align conformal_at_iff_differentiable_at_or_differentiable_at_comp_conj conformalAt_iff_differentiableAt_or_differentiableAt_comp_conj

end Conformality


/-
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

Extends theory on products
-/
import tactic.ext

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

@[simp] theorem prod.forall {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) :=
⟨assume h a b, h (a, b), assume h ⟨a, b⟩, h a b⟩

@[simp] theorem prod.exists {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

namespace prod

attribute [simp] prod.map

@[simp] lemma map_fst (f : α → γ) (g : β → δ) : ∀(p : α × β), (map f g p).1 = f (p.1)
| ⟨a, b⟩ := rfl

@[simp] lemma map_snd (f : α → γ) (g : β → δ) : ∀(p : α × β), (map f g p).2 = g (p.2)
| ⟨a, b⟩ := rfl

@[simp] theorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ (a₁ = a₂ ∧ b₁ = b₂) :=
⟨prod.mk.inj, by cc⟩

lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 :=
by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff]

@[extensionality]
lemma ext {α β} {p q : α × β} : p.1 = q.1 → p.2 = q.2 → p = q :=
by rw [ext_iff] ; intros ; split ; assumption

lemma id_prod : (λ (p : α × α), (p.1, p.2)) = id :=
by ext ; simp

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap : α × β → β × α := λp, (p.2, p.1)

@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x
| ⟨a, b⟩ := rfl

@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl

@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl

@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl

@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) :=
funext swap_swap

@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap :=
swap_swap

@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap :=
swap_swap

lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2)
| ⟨p₁, p₂⟩ ⟨q₁, q₂⟩ := by simp

theorem lex_def (r : α → α → Prop) (s : β → β → Prop)
  {p q : α × β} : prod.lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 :=
⟨λ h, by cases h; simp *,
 λ h, match p, q, h with
 | (a, b), (c, d), or.inl h := lex.left _ _ _ h
 | (a, b), (c, d), or.inr ⟨e, h⟩ :=
   by change a = c at e; subst e; exact lex.right _ _ h
 end⟩

instance lex.decidable [decidable_eq α] [decidable_eq β]
  (r : α → α → Prop) (s : β → β → Prop) [decidable_rel r] [decidable_rel s] :
  decidable_rel (prod.lex r s) :=
λ p q, decidable_of_decidable_of_iff (by apply_instance) (lex_def r s).symm

end prod


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Alex Kontorovich
-/
import order.filter.bases

/-!
# (Co)product of a family of filters

In this file we define two filters on `Π i, α i` and prove some basic properties of these filters.

* `filter.pi (f : Π i, filter (α i))` to be the maximal filter on `Π i, α i` such that
  `∀ i, filter.tendsto (function.eval i) (filter.pi f) (f i)`. It is defined as
  `Π i, filter.comap (function.eval i) (f i)`. This is a generalization of `filter.prod` to indexed
  products.

* `filter.Coprod (f : Π i, filter (α i))`: a generalization of `filter.coprod`; it is the supremum
  of `comap (eval i) (f i)`.
-/

open set function
open_locale classical filter

namespace filter

variables {ι : Type*} {α : ι → Type*} {f f₁ f₂ : Π i, filter (α i)} {s : Π i, set (α i)}

section pi

/-- The product of an indexed family of filters. -/
def pi (f : Π i, filter (α i)) : filter (Π i, α i) := ⨅ i, comap (eval i) (f i)

lemma tendsto_eval_pi (f : Π i, filter (α i)) (i : ι) :
  tendsto (eval i) (pi f) (f i) :=
tendsto_infi' i tendsto_comap

lemma tendsto_pi {β : Type*} {m : β → Π i, α i} {l : filter β} :
  tendsto m l (pi f) ↔ ∀ i, tendsto (λ x, m x i) l (f i) :=
by simp only [pi, tendsto_infi, tendsto_comap_iff]

lemma le_pi {g : filter (Π i, α i)} : g ≤ pi f ↔ ∀ i, tendsto (eval i) g (f i) := tendsto_pi

@[mono] lemma pi_mono (h : ∀ i, f₁ i ≤ f₂ i) : pi f₁ ≤ pi f₂ := infi_mono $ λ i, comap_mono $ h i

lemma mem_pi_of_mem (i : ι) {s : set (α i)} (hs : s ∈ f i) :
  eval i ⁻¹' s ∈ pi f :=
mem_infi_of_mem i $ preimage_mem_comap hs

lemma pi_mem_pi {I : set ι} (hI : finite I) (h : ∀ i ∈ I, s i ∈ f i) :
  I.pi s ∈ pi f :=
begin
  rw [pi_def, bInter_eq_Inter],
  refine mem_infi_of_Inter hI (λ i, _) subset.rfl,
  exact preimage_mem_comap (h i i.2)
end

lemma mem_pi {s : set (Π i, α i)} : s ∈ pi f ↔
  ∃ (I : set ι), finite I ∧ ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ I.pi t ⊆ s :=
begin
  split,
  { simp only [pi, mem_infi', mem_comap, pi_def],
    rintro ⟨I, If, V, hVf, hVI, rfl, -⟩, choose t htf htV using hVf,
    exact ⟨I, If, t, htf, Inter₂_mono (λ i _, htV i)⟩ },
  { rintro ⟨I, If, t, htf, hts⟩,
    exact mem_of_superset (pi_mem_pi If $ λ i _, htf i) hts }
end

lemma mem_pi' {s : set (Π i, α i)} : s ∈ pi f ↔
  ∃ (I : finset ι), ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ set.pi ↑I t ⊆ s :=
mem_pi.trans exists_finite_iff_finset

lemma mem_of_pi_mem_pi [∀ i, ne_bot (f i)] {I : set ι} (h : I.pi s ∈ pi f) {i : ι} (hi : i ∈ I) :
  s i ∈ f i :=
begin
  rcases mem_pi.1 h with ⟨I', I'f, t, htf, hts⟩,
  refine mem_of_superset (htf i) (λ x hx, _),
  have : ∀ i, (t i).nonempty, from λ i, nonempty_of_mem (htf i),
  choose g hg,
  have : update g i x ∈ I'.pi t,
  { intros j hj, rcases eq_or_ne j i with (rfl|hne); simp * },
  simpa using hts this i hi
end

@[simp] lemma pi_mem_pi_iff [∀ i, ne_bot (f i)] {I : set ι} (hI : finite I) :
  I.pi s ∈ pi f ↔ ∀ i ∈ I, s i ∈ f i :=
⟨λ h i hi, mem_of_pi_mem_pi h hi, pi_mem_pi hI⟩

lemma has_basis_pi {ι' : ι → Type} {s : Π i, ι' i → set (α i)} {p : Π i, ι' i → Prop}
  (h : ∀ i, (f i).has_basis (p i) (s i)) :
  (pi f).has_basis (λ If : set ι × Π i, ι' i, finite If.1 ∧ ∀ i ∈ If.1, p i (If.2 i))
    (λ If : set ι × Π i, ι' i, If.1.pi (λ i, s i $ If.2 i)) :=
begin
  have : (pi f).has_basis _ _ := has_basis_infi (λ i, (h i).comap (eval i : (Π j, α j) → α i)),
  convert this,
  ext,
  simp
end

@[simp] lemma pi_inf_principal_univ_pi_eq_bot :
  pi f ⊓ 𝓟 (set.pi univ s) = ⊥ ↔ ∃ i, f i ⊓ 𝓟 (s i) = ⊥ :=
begin
  split,
  { simp only [inf_principal_eq_bot, mem_pi], contrapose!,
    rintros (hsf : ∀ i, ∃ᶠ x in f i, x ∈ s i) I If t htf hts,
    have : ∀ i, (s i ∩ t i).nonempty, from λ i, ((hsf i).and_eventually (htf i)).exists,
    choose x hxs hxt,
    exact hts (λ i hi, hxt i) (mem_univ_pi.2 hxs) },
  { simp only [inf_principal_eq_bot],
    rintro ⟨i, hi⟩,
    filter_upwards [mem_pi_of_mem i hi] with x using mt (λ h, h i trivial), },
end

@[simp] lemma pi_inf_principal_pi_eq_bot [Π i, ne_bot (f i)] {I : set ι} :
  pi f ⊓ 𝓟 (set.pi I s) = ⊥ ↔ ∃ i ∈ I, f i ⊓ 𝓟 (s i) = ⊥ :=
begin
  rw [← univ_pi_piecewise I, pi_inf_principal_univ_pi_eq_bot],
  refine exists_congr (λ i, _),
  by_cases hi : i ∈ I; simp [hi, (‹Π i, ne_bot (f i)› i).ne]
end

@[simp] lemma pi_inf_principal_univ_pi_ne_bot :
  ne_bot (pi f ⊓ 𝓟 (set.pi univ s)) ↔ ∀ i, ne_bot (f i ⊓ 𝓟 (s i)) :=
by simp [ne_bot_iff]

@[simp] lemma pi_inf_principal_pi_ne_bot [Π i, ne_bot (f i)] {I : set ι} :
  ne_bot (pi f ⊓ 𝓟 (I.pi s)) ↔ ∀ i ∈ I, ne_bot (f i ⊓ 𝓟 (s i)) :=
by simp [ne_bot_iff]

instance pi_inf_principal_pi.ne_bot [h : ∀ i, ne_bot (f i ⊓ 𝓟 (s i))] {I : set ι} :
  ne_bot (pi f ⊓ 𝓟 (I.pi s)) :=
(pi_inf_principal_univ_pi_ne_bot.2 ‹_›).mono $ inf_le_inf_left _ $ principal_mono.2 $
  λ x hx i hi, hx i trivial

@[simp] lemma pi_eq_bot : pi f = ⊥ ↔ ∃ i, f i = ⊥ :=
by simpa using @pi_inf_principal_univ_pi_eq_bot ι α f (λ _, univ)

@[simp]

instance [∀ i, ne_bot (f i)] : ne_bot (pi f) := pi_ne_bot.2 ‹_›

end pi

/-! ### `n`-ary coproducts of filters -/

section Coprod

/-- Coproduct of filters. -/
protected def Coprod (f : Π i, filter (α i)) : filter (Π i, α i) :=
⨆ i : ι, comap (eval i) (f i)

lemma mem_Coprod_iff {s : set (Π i, α i)} :
  (s ∈ filter.Coprod f) ↔ (∀ i : ι, (∃ t₁ ∈ f i, eval i ⁻¹' t₁ ⊆ s)) :=
by simp [filter.Coprod]

lemma compl_mem_Coprod_iff {s : set (Π i, α i)} :
  sᶜ ∈ filter.Coprod f ↔ ∃ t : Π i, set (α i), (∀ i, (t i)ᶜ ∈ f i) ∧ s ⊆ set.pi univ (λ i, t i) :=
begin
  rw [(surjective_pi_map (λ i, @compl_surjective (set (α i)) _)).exists],
  simp_rw [mem_Coprod_iff, classical.skolem, exists_prop, @subset_compl_comm _ _ s,
    ← preimage_compl, ← subset_Inter_iff, ← univ_pi_eq_Inter, compl_compl]
end

lemma Coprod_ne_bot_iff' :
  ne_bot (filter.Coprod f) ↔ (∀ i, nonempty (α i)) ∧ ∃ d, ne_bot (f d) :=
by simp only [filter.Coprod, supr_ne_bot, ← exists_and_distrib_left, ← comap_eval_ne_bot_iff']

@[simp] lemma Coprod_ne_bot_iff [∀ i, nonempty (α i)] :
  ne_bot (filter.Coprod f) ↔ ∃ d, ne_bot (f d) :=
by simp [Coprod_ne_bot_iff', *]

lemma ne_bot.Coprod [∀ i, nonempty (α i)] {i : ι} (h : ne_bot (f i)) :
  ne_bot (filter.Coprod f) :=
Coprod_ne_bot_iff.2 ⟨i, h⟩

@[instance] lemma Coprod_ne_bot [∀ i, nonempty (α i)] [nonempty ι] (f : Π i, filter (α i))
  [H : ∀ i, ne_bot (f i)] : ne_bot (filter.Coprod f) :=
(H (classical.arbitrary ι)).Coprod

@[mono] lemma Coprod_mono (hf : ∀ i, f₁ i ≤ f₂ i) : filter.Coprod f₁ ≤ filter.Coprod f₂ :=
supr_mono $ λ i, comap_mono (hf i)

variables {β : ι → Type*} {m : Π i, α i → β i}

lemma map_pi_map_Coprod_le :
  map (λ (k : Π i, α i), λ i, m i (k i)) (filter.Coprod f) ≤ filter.Coprod (λ i, map (m i) (f i)) :=
begin
  simp only [le_def, mem_map, mem_Coprod_iff],
  intros s h i,
  obtain ⟨t, H, hH⟩ := h i,
  exact ⟨{x : α i | m i x ∈ t}, H, λ x hx, hH hx⟩
end

lemma tendsto.pi_map_Coprod {g : Π i, filter (β i)} (h : ∀ i, tendsto (m i) (f i) (g i)) :
  tendsto (λ (k : Π i, α i), λ i, m i (k i)) (filter.Coprod f) (filter.Coprod g) :=
map_pi_map_Coprod_le.trans (Coprod_mono h)

end Coprod

end filter


import rank_one_valuation
import seminormed_rings
import analysis.special_functions.pow
--import analysis.normed.field.basic
--import ring_theory.algebraic
import topology.algebra.valuation

noncomputable theory

open_locale nnreal

variables {K : Type*} [hK : normed_field K]
include hK

/- class is_nonarchimedean' {α : Type*} [add_group α] (f : α → ℝ≥0) : Prop :=
(add_le : ∀ a b, f (a + b) ≤ max (f a) (f b)) -/

def valuation_from_norm (h : is_nonarchimedean nnnorm) : valuation K ℝ≥0 :=
{ to_fun    := nnnorm,
  map_zero' := nnnorm_zero,
  map_one'  := nnnorm_one,
  map_mul'  := nnnorm_mul,
  map_add_le_max' := λ x y, h.add_le nnnorm_zero x y, }

lemma valuation_from_norm_apply (h : is_nonarchimedean nnnorm) (x : K):
  valuation_from_norm h x = ∥ x ∥₊ := rfl

instance foo : normed_add_comm_group K := non_unital_normed_ring.to_normed_add_comm_group

def normed_field.to_valued (h : is_nonarchimedean (nnnorm : K → ℝ≥0)) : valued K ℝ≥0 :=
{ v := valuation_from_norm h,
  is_topological_valuation := λ U,
  begin
    rw metric.mem_nhds_iff,
    refine ⟨λ h, _, λ h, _⟩,
    { obtain ⟨ε, hε, h⟩ := h,
      use units.mk0 ⟨ε, le_of_lt hε⟩ (ne_of_gt hε),
      intros x hx,
      exact h (mem_ball_zero_iff.mpr hx) },
    { obtain ⟨ε, hε⟩ := h,
      use [(ε : ℝ), nnreal.coe_pos.mpr (units.zero_lt _)],
      intros x hx,
      exact hε  (mem_ball_zero_iff.mp hx) },
  end,
  ..hK.to_uniform_space,
  ..non_unital_normed_ring.to_normed_add_comm_group }

omit hK

variables {L : Type*} [hL : field L] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
  [val : valued L Γ₀] [hv : is_rank_one val.v]
include hL val hv

def norm_def {e : ℝ} (he0 : 0 < e)  : L → ℝ :=
λ x : L, mult_with_top_R_to_R_monoid_with_zero_hom he0 (is_rank_one_hom val.v (valued.v x))

lemma norm_def_nonneg {e : ℝ} (he0 : 0 < e) (x : L) : 0 ≤ norm_def he0 x :=
begin
  simp only [norm_def, mult_with_top_R_to_R_monoid_with_zero_hom, monoid_with_zero_hom.coe_mk,
    mult_with_top_R_to_R],
  split_ifs,
  { exact le_refl _ },
  { exact real.rpow_nonneg_of_nonneg (le_of_lt he0) _ }
end

lemma norm_def_add_le {e : ℝ} (he0 : 0 < e) (he1 : e < 1) (x y : L) :
  norm_def he0 (x + y) ≤ max (norm_def he0 x) (norm_def he0 y) :=
begin
  simp only [norm_def, mult_with_top_R_to_R_monoid_with_zero_hom, monoid_with_zero_hom.coe_mk],
  rw le_max_iff,
  simp only [strict_mono.le_iff_le (mult_with_top_R_to_R_strict_mono he0 he1),
    strict_mono.le_iff_le (is_rank_one_strict_mono val.v)],
  rw ← le_max_iff,
  exact valuation.map_add_le_max' val.v _ _,
end

lemma norm_def_eq_zero  {e : ℝ} (he0 : 0 < e) {x : L} (hx : norm_def he0 x = 0) : x = 0 :=
begin
  simp only [norm_def, mult_with_top_R_to_R_monoid_with_zero_hom, monoid_with_zero_hom.coe_mk,
    mult_with_top_R_to_R] at hx,
  split_ifs at hx with h0 hn0,
  { rw [← order_dual.of_dual_bot, order_dual.of_dual_inj,  ← to_add_of_add ⊥,
      function.injective.eq_iff multiplicative.to_add.injective, ← order_dual.of_dual_top] at h0,
    exact (valuation.zero_iff _).mp (is_rank_one_hom_zero valued.v h0), },
  { rw real.rpow_eq_zero_iff_of_nonneg (le_of_lt he0) at hx,
    exact absurd hx.1 (ne_of_gt he0) },
end

def valued_field.to_normed_field {e : ℝ} (he0 : 0 < e) (he1 : e < 1) : normed_field L :=
{ norm               := norm_def he0,
  dist               := λ x y, norm_def he0 (x - y),
  dist_self          := λ x,
  begin
    simp only [sub_self, norm_def, valuation.map_zero, (is_rank_one_hom val.v).map_zero],
    exact (mult_with_top_R_to_R_monoid_with_zero_hom he0).map_zero',
  end,
  dist_comm          := λ x y, by { simp only [norm_def], rw [← neg_sub, valuation.map_neg] },
  dist_triangle      := λ x y z,
  begin
    simp only [← sub_add_sub_cancel x y z],
    exact le_trans (norm_def_add_le he0 he1 _ _)
      (max_le_add_of_nonneg (norm_def_nonneg he0 _) (norm_def_nonneg he0 _)),
  end,
  eq_of_dist_eq_zero := λ x y hxy, eq_of_sub_eq_zero (norm_def_eq_zero he0 hxy),
  dist_eq            := λ x y, rfl,
  norm_mul'          := λ x y, by simp only [norm_def, map_mul],
  to_uniform_space := valued.to_uniform_space,
  uniformity_dist := sorry,
  ..hL, }


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

! This file was ported from Lean 3 source module algebra.group.ulift
! leanprover-community/mathlib commit 564bcc44d2b394a50c0cd6340c14a6b02a50a99a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Cast.Defs
import Mathbin.Algebra.Hom.Equiv.Basic
import Mathbin.Algebra.GroupWithZero.InjSurj

/-!
# `ulift` instances for groups and monoids

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

This file defines instances for group, monoid, semigroup and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We use `tactic.pi_instance_derive_field`, even though it wasn't intended for this purpose,
which seems to work fine.

We also provide `ulift.mul_equiv : ulift R ≃* R` (and its additive analogue).
-/

universe u v

variable {α : Type u} {β : Type _} {x y : ULift.{v} α}

namespace ULift

#print ULift.one /-
@[to_additive]
instance one [One α] : One (ULift α) :=
  ⟨⟨1⟩⟩
#align ulift.has_one ULift.one
#align ulift.has_zero ULift.zero
-/

/- warning: ulift.one_down -> ULift.one_down is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : One.{u1} α], Eq.{succ u1} α (ULift.down.{u2, u1} α (OfNat.ofNat.{max u1 u2} (ULift.{u2, u1} α) 1 (OfNat.mk.{max u1 u2} (ULift.{u2, u1} α) 1 (One.one.{max u1 u2} (ULift.{u2, u1} α) (ULift.one.{u1, u2} α _inst_1))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : One.{u2} α], Eq.{succ u2} α (ULift.down.{u1, u2} α (OfNat.ofNat.{max u2 u1} (ULift.{u1, u2} α) 1 (One.toOfNat1.{max u2 u1} (ULift.{u1, u2} α) (ULift.one.{u2, u1} α _inst_1)))) (OfNat.ofNat.{u2} α 1 (One.toOfNat1.{u2} α _inst_1))
Case conversion may be inaccurate. Consider using '#align ulift.one_down ULift.one_downₓ'. -/
@[simp, to_additive]
theorem one_down [One α] : (1 : ULift α).down = 1 :=
  rfl
#align ulift.one_down ULift.one_down
#align ulift.zero_down ULift.zero_down

#print ULift.mul /-
@[to_additive]
instance mul [Mul α] : Mul (ULift α) :=
  ⟨fun f g => ⟨f.down * g.down⟩⟩
#align ulift.has_mul ULift.mul
#align ulift.has_add ULift.add
-/

#print ULift.mul_down /-
@[simp, to_additive]
theorem mul_down [Mul α] : (x * y).down = x.down * y.down :=
  rfl
#align ulift.mul_down ULift.mul_down
#align ulift.add_down ULift.add_down
-/

#print ULift.div /-
@[to_additive]
instance div [Div α] : Div (ULift α) :=
  ⟨fun f g => ⟨f.down / g.down⟩⟩
#align ulift.has_div ULift.div
#align ulift.has_sub ULift.sub
-/

#print ULift.div_down /-
@[simp, to_additive]
theorem div_down [Div α] : (x / y).down = x.down / y.down :=
  rfl
#align ulift.div_down ULift.div_down
#align ulift.sub_down ULift.sub_down
-/

#print ULift.inv /-
@[to_additive]
instance inv [Inv α] : Inv (ULift α) :=
  ⟨fun f => ⟨f.down⁻¹⟩⟩
#align ulift.has_inv ULift.inv
#align ulift.has_neg ULift.neg
-/

#print ULift.inv_down /-
@[simp, to_additive]
theorem inv_down [Inv α] : x⁻¹.down = x.down⁻¹ :=
  rfl
#align ulift.inv_down ULift.inv_down
#align ulift.neg_down ULift.neg_down
-/

#print ULift.smul /-
@[to_additive]
instance smul [SMul α β] : SMul α (ULift β) :=
  ⟨fun n x => up (n • x.down)⟩
#align ulift.has_smul ULift.smul
#align ulift.has_vadd ULift.vadd
-/

/- warning: ulift.smul_down -> ULift.smul_down is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u3} α β] (a : α) (b : ULift.{u2, u3} β), Eq.{succ u3} β (ULift.down.{u2, u3} β (SMul.smul.{u1, max u3 u2} α (ULift.{u2, u3} β) (ULift.smul.{u1, u3, u2} α β _inst_1) a b)) (SMul.smul.{u1, u3} α β _inst_1 a (ULift.down.{u2, u3} β b))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : SMul.{u2, u1} α β] (a : α) (b : ULift.{u3, u1} β), Eq.{succ u1} β (ULift.down.{u3, u1} β (HSMul.hSMul.{u2, max u3 u1, max u3 u1} α (ULift.{u3, u1} β) (ULift.{u3, u1} β) (instHSMul.{u2, max u3 u1} α (ULift.{u3, u1} β) (ULift.smul.{u2, u1, u3} α β _inst_1)) a b)) (HSMul.hSMul.{u2, u1, u1} α β β (instHSMul.{u2, u1} α β _inst_1) a (ULift.down.{u3, u1} β b))
Case conversion may be inaccurate. Consider using '#align ulift.smul_down ULift.smul_downₓ'. -/
@[simp, to_additive]
theorem smul_down [SMul α β] (a : α) (b : ULift.{v} β) : (a • b).down = a • b.down :=
  rfl
#align ulift.smul_down ULift.smul_down
#align ulift.vadd_down ULift.vadd_down

#print ULift.pow /-
@[to_additive SMul, to_additive_reorder 1]
instance pow [Pow α β] : Pow (ULift α) β :=
  ⟨fun x n => up (x.down ^ n)⟩
#align ulift.has_pow ULift.pow
#align ulift.has_smul ULift.smul
-/

/- warning: ulift.pow_down -> ULift.pow_down is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u3}} [_inst_1 : Pow.{u1, u3} α β] (a : ULift.{u2, u1} α) (b : β), Eq.{succ u1} α (ULift.down.{u2, u1} α (HPow.hPow.{max u1 u2, u3, max u1 u2} (ULift.{u2, u1} α) β (ULift.{u2, u1} α) (instHPow.{max u1 u2, u3} (ULift.{u2, u1} α) β (ULift.pow.{u1, u3, u2} α β _inst_1)) a b)) (HPow.hPow.{u1, u3, u1} α β α (instHPow.{u1, u3} α β _inst_1) (ULift.down.{u2, u1} α a) b)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Pow.{u2, u1} α β] (a : ULift.{u3, u2} α) (b : β), Eq.{succ u2} α (ULift.down.{u3, u2} α (HPow.hPow.{max u2 u3, u1, max u2 u3} (ULift.{u3, u2} α) β (ULift.{u3, u2} α) (instHPow.{max u2 u3, u1} (ULift.{u3, u2} α) β (ULift.pow.{u2, u1, u3} α β _inst_1)) a b)) (HPow.hPow.{u2, u1, u2} α β α (instHPow.{u2, u1} α β _inst_1) (ULift.down.{u3, u2} α a) b)
Case conversion may be inaccurate. Consider using '#align ulift.pow_down ULift.pow_downₓ'. -/
@[simp, to_additive smul_down, to_additive_reorder 1]
theorem pow_down [Pow α β] (a : ULift.{v} α) (b : β) : (a ^ b).down = a.down ^ b :=
  rfl
#align ulift.pow_down ULift.pow_down
#align ulift.smul_down ULift.smul_down

#print ULift.MulEquiv.ulift /-
/-- The multiplicative equivalence between `ulift α` and `α`.
-/
@[to_additive "The additive equivalence between `ulift α` and `α`."]
def ULift.MulEquiv.ulift [Mul α] : ULift α ≃* α :=
  { Equiv.ulift with map_mul' := fun x y => rfl }
#align mul_equiv.ulift ULift.MulEquiv.ulift
#align add_equiv.ulift AddEquiv.ulift
-/

#print ULift.semigroup /-
@[to_additive]
instance semigroup [Semigroup α] : Semigroup (ULift α) :=
  ULift.MulEquiv.ulift.Injective.Semigroup _ fun x y => rfl
#align ulift.semigroup ULift.semigroup
#align ulift.add_semigroup ULift.addSemigroup
-/

#print ULift.commSemigroup /-
@[to_additive]
instance commSemigroup [CommSemigroup α] : CommSemigroup (ULift α) :=
  Equiv.ulift.Injective.CommSemigroup _ fun x y => rfl
#align ulift.comm_semigroup ULift.commSemigroup
#align ulift.add_comm_semigroup ULift.addCommSemigroup
-/

#print ULift.mulOneClass /-
@[to_additive]
instance mulOneClass [MulOneClass α] : MulOneClass (ULift α) :=
  Equiv.ulift.Injective.MulOneClass _ rfl fun x y => rfl
#align ulift.mul_one_class ULift.mulOneClass
#align ulift.add_zero_class ULift.addZeroClass
-/

#print ULift.mulZeroOneClass /-
instance mulZeroOneClass [MulZeroOneClass α] : MulZeroOneClass (ULift α) :=
  Equiv.ulift.Injective.MulZeroOneClass _ rfl rfl fun x y => rfl
#align ulift.mul_zero_one_class ULift.mulZeroOneClass
-/

#print ULift.monoid /-
@[to_additive]
instance monoid [Monoid α] : Monoid (ULift α) :=
  Equiv.ulift.Injective.Monoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.monoid ULift.monoid
#align ulift.add_monoid ULift.addMonoid
-/

#print ULift.commMonoid /-
@[to_additive]
instance commMonoid [CommMonoid α] : CommMonoid (ULift α) :=
  Equiv.ulift.Injective.CommMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_monoid ULift.commMonoid
#align ulift.add_comm_monoid ULift.addCommMonoid
-/

instance [NatCast α] : NatCast (ULift α) :=
  ⟨fun n => up n⟩

instance [IntCast α] : IntCast (ULift α) :=
  ⟨fun n => up n⟩

/- warning: ulift.up_nat_cast -> ULift.up_natCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NatCast.{u1} α] (n : Nat), Eq.{succ (max u1 u2)} (ULift.{u2, u1} α) (ULift.up.{u2, u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α _inst_1))) n)) ((fun (a : Type) (b : Type.{max u1 u2}) [self : HasLiftT.{1, succ (max u1 u2)} a b] => self.0) Nat (ULift.{u2, u1} α) (HasLiftT.mk.{1, succ (max u1 u2)} Nat (ULift.{u2, u1} α) (CoeTCₓ.coe.{1, succ (max u1 u2)} Nat (ULift.{u2, u1} α) (Nat.castCoe.{max u1 u2} (ULift.{u2, u1} α) (ULift.natCast.{u1, u2} α _inst_1)))) n)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : NatCast.{u2} α] (n : Nat), Eq.{max (succ u2) (succ u1)} (ULift.{u1, u2} α) (ULift.up.{u1, u2} α (Nat.cast.{u2} α _inst_1 n)) (Nat.cast.{max u2 u1} (ULift.{u1, u2} α) (ULift.natCast.{u2, u1} α _inst_1) n)
Case conversion may be inaccurate. Consider using '#align ulift.up_nat_cast ULift.up_natCastₓ'. -/
@[simp, norm_cast]
theorem up_natCast [NatCast α] (n : ℕ) : up (n : α) = n :=
  rfl
#align ulift.up_nat_cast ULift.up_natCast

/- warning: ulift.up_int_cast -> ULift.up_intCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : IntCast.{u1} α] (n : Int), Eq.{succ (max u1 u2)} (ULift.{u2, u1} α) (ULift.up.{u2, u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α _inst_1))) n)) ((fun (a : Type) (b : Type.{max u1 u2}) [self : HasLiftT.{1, succ (max u1 u2)} a b] => self.0) Int (ULift.{u2, u1} α) (HasLiftT.mk.{1, succ (max u1 u2)} Int (ULift.{u2, u1} α) (CoeTCₓ.coe.{1, succ (max u1 u2)} Int (ULift.{u2, u1} α) (Int.castCoe.{max u1 u2} (ULift.{u2, u1} α) (ULift.intCast.{u1, u2} α _inst_1)))) n)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : IntCast.{u2} α] (n : Int), Eq.{max (succ u2) (succ u1)} (ULift.{u1, u2} α) (ULift.up.{u1, u2} α (Int.cast.{u2} α _inst_1 n)) (Int.cast.{max u2 u1} (ULift.{u1, u2} α) (ULift.intCast.{u2, u1} α _inst_1) n)
Case conversion may be inaccurate. Consider using '#align ulift.up_int_cast ULift.up_intCastₓ'. -/
@[simp, norm_cast]
theorem up_intCast [IntCast α] (n : ℤ) : up (n : α) = n :=
  rfl
#align ulift.up_int_cast ULift.up_intCast

/- warning: ulift.down_nat_cast -> ULift.down_natCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NatCast.{u1} α] (n : Nat), Eq.{succ u1} α (ULift.down.{u2, u1} α ((fun (a : Type) (b : Type.{max u1 u2}) [self : HasLiftT.{1, succ (max u1 u2)} a b] => self.0) Nat (ULift.{u2, u1} α) (HasLiftT.mk.{1, succ (max u1 u2)} Nat (ULift.{u2, u1} α) (CoeTCₓ.coe.{1, succ (max u1 u2)} Nat (ULift.{u2, u1} α) (Nat.castCoe.{max u1 u2} (ULift.{u2, u1} α) (ULift.natCast.{u1, u2} α _inst_1)))) n)) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α _inst_1))) n)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : NatCast.{u2} α] (n : Nat), Eq.{succ u2} α (ULift.down.{u1, u2} α (Nat.cast.{max u2 u1} (ULift.{u1, u2} α) (ULift.natCast.{u2, u1} α _inst_1) n)) (Nat.cast.{u2} α _inst_1 n)
Case conversion may be inaccurate. Consider using '#align ulift.down_nat_cast ULift.down_natCastₓ'. -/
@[simp, norm_cast]
theorem down_natCast [NatCast α] (n : ℕ) : down (n : ULift α) = n :=
  rfl
#align ulift.down_nat_cast ULift.down_natCast

/- warning: ulift.down_int_cast -> ULift.down_intCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : IntCast.{u1} α] (n : Int), Eq.{succ u1} α (ULift.down.{u2, u1} α ((fun (a : Type) (b : Type.{max u1 u2}) [self : HasLiftT.{1, succ (max u1 u2)} a b] => self.0) Int (ULift.{u2, u1} α) (HasLiftT.mk.{1, succ (max u1 u2)} Int (ULift.{u2, u1} α) (CoeTCₓ.coe.{1, succ (max u1 u2)} Int (ULift.{u2, u1} α) (Int.castCoe.{max u1 u2} (ULift.{u2, u1} α) (ULift.intCast.{u1, u2} α _inst_1)))) n)) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α _inst_1))) n)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : IntCast.{u2} α] (n : Int), Eq.{succ u2} α (ULift.down.{u1, u2} α (Int.cast.{max u2 u1} (ULift.{u1, u2} α) (ULift.intCast.{u2, u1} α _inst_1) n)) (Int.cast.{u2} α _inst_1 n)
Case conversion may be inaccurate. Consider using '#align ulift.down_int_cast ULift.down_intCastₓ'. -/
@[simp, norm_cast]
theorem down_intCast [IntCast α] (n : ℤ) : down (n : ULift α) = n :=
  rfl
#align ulift.down_int_cast ULift.down_intCast

#print ULift.addMonoidWithOne /-
instance addMonoidWithOne [AddMonoidWithOne α] : AddMonoidWithOne (ULift α) :=
  { ULift.one, ULift.addMonoid,
    ULift.natCast with
    natCast_zero := congr_arg ULift.up Nat.cast_zero
    natCast_succ := fun n => congr_arg ULift.up (Nat.cast_succ _) }
#align ulift.add_monoid_with_one ULift.addMonoidWithOne
-/

#print ULift.addCommMonoidWithOne /-
instance addCommMonoidWithOne [AddCommMonoidWithOne α] : AddCommMonoidWithOne (ULift α) :=
  { ULift.addMonoidWithOne, ULift.addCommMonoid with }
#align ulift.add_comm_monoid_with_one ULift.addCommMonoidWithOne
-/

#print ULift.monoidWithZero /-
instance monoidWithZero [MonoidWithZero α] : MonoidWithZero (ULift α) :=
  Equiv.ulift.Injective.MonoidWithZero _ rfl rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.monoid_with_zero ULift.monoidWithZero
-/

#print ULift.commMonoidWithZero /-
instance commMonoidWithZero [CommMonoidWithZero α] : CommMonoidWithZero (ULift α) :=
  Equiv.ulift.Injective.CommMonoidWithZero _ rfl rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_monoid_with_zero ULift.commMonoidWithZero
-/

#print ULift.divInvMonoid /-
@[to_additive]
instance divInvMonoid [DivInvMonoid α] : DivInvMonoid (ULift α) :=
  Equiv.ulift.Injective.DivInvMonoid _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.div_inv_monoid ULift.divInvMonoid
#align ulift.sub_neg_add_monoid ULift.subNegAddMonoid
-/

#print ULift.group /-
@[to_additive]
instance group [Group α] : Group (ULift α) :=
  Equiv.ulift.Injective.Group _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.group ULift.group
#align ulift.add_group ULift.addGroup
-/

#print ULift.commGroup /-
@[to_additive]
instance commGroup [CommGroup α] : CommGroup (ULift α) :=
  Equiv.ulift.Injective.CommGroup _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_group ULift.commGroup
#align ulift.add_comm_group ULift.addCommGroup
-/

#print ULift.addGroupWithOne /-
instance addGroupWithOne [AddGroupWithOne α] : AddGroupWithOne (ULift α) :=
  { ULift.addMonoidWithOne,
    ULift.addGroup with
    intCast := fun n => ⟨n⟩
    intCast_ofNat := fun n => congr_arg ULift.up (Int.cast_ofNat _)
    intCast_negSucc := fun n => congr_arg ULift.up (Int.cast_negSucc _) }
#align ulift.add_group_with_one ULift.addGroupWithOne
-/

#print ULift.addCommGroupWithOne /-
instance addCommGroupWithOne [AddCommGroupWithOne α] : AddCommGroupWithOne (ULift α) :=
  { ULift.addGroupWithOne, ULift.addCommGroup with }
#align ulift.add_comm_group_with_one ULift.addCommGroupWithOne
-/

#print ULift.groupWithZero /-
instance groupWithZero [GroupWithZero α] : GroupWithZero (ULift α) :=
  Equiv.ulift.Injective.GroupWithZero _ rfl rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.group_with_zero ULift.groupWithZero
-/

#print ULift.commGroupWithZero /-
instance commGroupWithZero [CommGroupWithZero α] : CommGroupWithZero (ULift α) :=
  Equiv.ulift.Injective.CommGroupWithZero _ rfl rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_group_with_zero ULift.commGroupWithZero
-/

#print ULift.leftCancelSemigroup /-
@[to_additive AddLeftCancelSemigroup]
instance leftCancelSemigroup [LeftCancelSemigroup α] : LeftCancelSemigroup (ULift α) :=
  Equiv.ulift.Injective.LeftCancelSemigroup _ fun _ _ => rfl
#align ulift.left_cancel_semigroup ULift.leftCancelSemigroup
#align ulift.add_left_cancel_semigroup ULift.addLeftCancelSemigroup
-/

#print ULift.rightCancelSemigroup /-
@[to_additive AddRightCancelSemigroup]
instance rightCancelSemigroup [RightCancelSemigroup α] : RightCancelSemigroup (ULift α) :=
  Equiv.ulift.Injective.RightCancelSemigroup _ fun _ _ => rfl
#align ulift.right_cancel_semigroup ULift.rightCancelSemigroup
#align ulift.add_right_cancel_semigroup ULift.addRightCancelSemigroup
-/

#print ULift.leftCancelMonoid /-
@[to_additive AddLeftCancelMonoid]
instance leftCancelMonoid [LeftCancelMonoid α] : LeftCancelMonoid (ULift α) :=
  Equiv.ulift.Injective.LeftCancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.left_cancel_monoid ULift.leftCancelMonoid
#align ulift.add_left_cancel_monoid ULift.addLeftCancelMonoid
-/

#print ULift.rightCancelMonoid /-
@[to_additive AddRightCancelMonoid]
instance rightCancelMonoid [RightCancelMonoid α] : RightCancelMonoid (ULift α) :=
  Equiv.ulift.Injective.RightCancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.right_cancel_monoid ULift.rightCancelMonoid
#align ulift.add_right_cancel_monoid ULift.addRightCancelMonoid
-/

#print ULift.cancelMonoid /-
@[to_additive AddCancelMonoid]
instance cancelMonoid [CancelMonoid α] : CancelMonoid (ULift α) :=
  Equiv.ulift.Injective.CancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.cancel_monoid ULift.cancelMonoid
#align ulift.add_cancel_monoid ULift.addCancelMonoid
-/

#print ULift.cancelCommMonoid /-
@[to_additive AddCancelCommMonoid]
instance cancelCommMonoid [CancelCommMonoid α] : CancelCommMonoid (ULift α) :=
  Equiv.ulift.Injective.CancelCommMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.cancel_comm_monoid ULift.cancelCommMonoid
#align ulift.add_cancel_comm_monoid ULift.addCancelCommMonoid
-/

#print ULift.nontrivial /-
instance nontrivial [Nontrivial α] : Nontrivial (ULift α) :=
  Equiv.ulift.symm.Injective.Nontrivial
#align ulift.nontrivial ULift.nontrivial
-/

-- TODO we don't do `ordered_cancel_comm_monoid` or `ordered_comm_group`
-- We'd need to add instances for `ulift` in `order.basic`.
end ULift


/- Simplifier -/

def mk_symm (xs : List α) :=
  xs ++ xs.reverse

@[simp] theorem reverse_mk_symm : (mk_symm xs).reverse = mk_symm xs := by
  simp [mk_symm]

theorem tst : (xs ++ mk_symm ys).reverse = mk_symm ys ++ xs.reverse := by
  simp

#print tst
-- Lean reverse_mk_symm, and List.reverse_append


/- Declaring Structures -/

namespace decs
  --structure <name> <parameters> <parent-structures> where
  --  <constructor> :: <fields>

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

  #check @Point.mk

  namespace Point
    example (a b : α) : (mk a b).x = a := by rfl

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

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

  end Point

end decs

/- Objects -/

namespace obj

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

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

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

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

  def q : Point3 Nat :=
    {x := 5, y := 5, z := 5}

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

  /-
  { x := 6, y := 2, z := 5 }
  -/
  #eval r

end obj

/- Inheritance -/

namespace Inheritance

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

  inductive Color where
  | red | green | blue
  deriving Repr

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

  def p : ColorPoint Nat :=
    {x := 1, y:= 2, c := Color.blue}

  /-
  { toPoint := { x := 1, y := 2 }, c := Inheritance.Color.blue }
  -/
  #eval p

end Inheritance


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

! This file was ported from Lean 3 source module algebra.lie.solvable
! leanprover-community/mathlib commit a50170a88a47570ed186b809ca754110590f9476
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Abelian
import Mathbin.Algebra.Lie.IdealOperations
import Mathbin.Order.Hom.Basic

/-!
# Solvable Lie algebras

Like groups, Lie algebras admit a natural concept of solvability. We define this here via the
derived series and prove some related results. We also define the radical of a Lie algebra and
prove that it is solvable when the Lie algebra is Noetherian.

## Main definitions

  * `lie_algebra.derived_series_of_ideal`
  * `lie_algebra.derived_series`
  * `lie_algebra.is_solvable`
  * `lie_algebra.is_solvable_add`
  * `lie_algebra.radical`
  * `lie_algebra.radical_is_solvable`
  * `lie_algebra.derived_length_of_ideal`
  * `lie_algebra.derived_length`
  * `lie_algebra.derived_abelian_of_ideal`

## Tags

lie algebra, derived series, derived length, solvable, radical
-/

universe u v w w₁ w₂

variable (R : Type u) (L : Type v) (M : Type w) {L' : Type w₁}

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

variable (I J : LieIdeal R L) {f : L' →ₗ⁅R⁆ L}

namespace LieAlgebra

/-- A generalisation of the derived series of a Lie algebra, whose zeroth term is a specified ideal.

It can be more convenient to work with this generalisation when considering the derived series of
an ideal since it provides a type-theoretic expression of the fact that the terms of the ideal's
derived series are also ideals of the enclosing algebra.

See also `lie_ideal.derived_series_eq_derived_series_of_ideal_comap` and
`lie_ideal.derived_series_eq_derived_series_of_ideal_map` below. -/
def derivedSeriesOfIdeal (k : ℕ) : LieIdeal R L → LieIdeal R L :=
  (fun I => ⁅I, I⁆)^[k]
#align lie_algebra.derived_series_of_ideal LieAlgebra.derivedSeriesOfIdeal

@[simp]
theorem derivedSeriesOfIdeal_zero : derivedSeriesOfIdeal R L 0 I = I :=
  rfl
#align lie_algebra.derived_series_of_ideal_zero LieAlgebra.derivedSeriesOfIdeal_zero

@[simp]
theorem derivedSeriesOfIdeal_succ (k : ℕ) :
    derivedSeriesOfIdeal R L (k + 1) I =
      ⁅derivedSeriesOfIdeal R L k I, derivedSeriesOfIdeal R L k I⁆ :=
  Function.iterate_succ_apply' (fun I => ⁅I, I⁆) k I
#align lie_algebra.derived_series_of_ideal_succ LieAlgebra.derivedSeriesOfIdeal_succ

/-- The derived series of Lie ideals of a Lie algebra. -/
abbrev derivedSeries (k : ℕ) : LieIdeal R L :=
  derivedSeriesOfIdeal R L k ⊤
#align lie_algebra.derived_series LieAlgebra.derivedSeries

theorem derivedSeries_def (k : ℕ) : derivedSeries R L k = derivedSeriesOfIdeal R L k ⊤ :=
  rfl
#align lie_algebra.derived_series_def LieAlgebra.derivedSeries_def

variable {R L}

-- mathport name: exprD
local notation "D" => derivedSeriesOfIdeal R L

theorem derivedSeriesOfIdeal_add (k l : ℕ) : D (k + l) I = D k (D l I) :=
  by
  induction' k with k ih
  · rw [zero_add, derived_series_of_ideal_zero]
  · rw [Nat.succ_add k l, derived_series_of_ideal_succ, derived_series_of_ideal_succ, ih]
#align lie_algebra.derived_series_of_ideal_add LieAlgebra.derivedSeriesOfIdeal_add

@[mono]
theorem derivedSeriesOfIdeal_le {I J : LieIdeal R L} {k l : ℕ} (h₁ : I ≤ J) (h₂ : l ≤ k) :
    D k I ≤ D l J := by
  revert l; induction' k with k ih <;> intro l h₂
  · rw [le_zero_iff] at h₂
    rw [h₂, derived_series_of_ideal_zero]
    exact h₁
  · have h : l = k.succ ∨ l ≤ k := by rwa [le_iff_eq_or_lt, Nat.lt_succ_iff] at h₂
    cases h
    · rw [h, derived_series_of_ideal_succ, derived_series_of_ideal_succ]
      exact LieSubmodule.mono_lie _ _ _ _ (ih (le_refl k)) (ih (le_refl k))
    · rw [derived_series_of_ideal_succ]
      exact le_trans (LieSubmodule.lie_le_left _ _) (ih h)
#align lie_algebra.derived_series_of_ideal_le LieAlgebra.derivedSeriesOfIdeal_le

theorem derivedSeriesOfIdeal_succ_le (k : ℕ) : D (k + 1) I ≤ D k I :=
  derivedSeriesOfIdeal_le (le_refl I) k.le_succ
#align lie_algebra.derived_series_of_ideal_succ_le LieAlgebra.derivedSeriesOfIdeal_succ_le

theorem derivedSeriesOfIdeal_le_self (k : ℕ) : D k I ≤ I :=
  derivedSeriesOfIdeal_le (le_refl I) (zero_le k)
#align lie_algebra.derived_series_of_ideal_le_self LieAlgebra.derivedSeriesOfIdeal_le_self

theorem derivedSeriesOfIdeal_mono {I J : LieIdeal R L} (h : I ≤ J) (k : ℕ) : D k I ≤ D k J :=
  derivedSeriesOfIdeal_le h (le_refl k)
#align lie_algebra.derived_series_of_ideal_mono LieAlgebra.derivedSeriesOfIdeal_mono

theorem derivedSeriesOfIdeal_antitone {k l : ℕ} (h : l ≤ k) : D k I ≤ D l I :=
  derivedSeriesOfIdeal_le (le_refl I) h
#align lie_algebra.derived_series_of_ideal_antitone LieAlgebra.derivedSeriesOfIdeal_antitone

theorem derivedSeriesOfIdeal_add_le_add (J : LieIdeal R L) (k l : ℕ) :
    D (k + l) (I + J) ≤ D k I + D l J :=
  by
  let D₁ : LieIdeal R L →o LieIdeal R L :=
    { toFun := fun I => ⁅I, I⁆
      monotone' := fun I J h => LieSubmodule.mono_lie I J I J h h }
  have h₁ : ∀ I J : LieIdeal R L, D₁ (I ⊔ J) ≤ D₁ I ⊔ J := by
    simp [LieSubmodule.lie_le_right, LieSubmodule.lie_le_left, le_sup_of_le_right]
  rw [← D₁.iterate_sup_le_sup_iff] at h₁
  exact h₁ k l I J
#align lie_algebra.derived_series_of_ideal_add_le_add LieAlgebra.derivedSeriesOfIdeal_add_le_add

theorem derived_series_of_bot_eq_bot (k : ℕ) : derivedSeriesOfIdeal R L k ⊥ = ⊥ :=
  by
  rw [eq_bot_iff]
  exact derived_series_of_ideal_le_self ⊥ k
#align lie_algebra.derived_series_of_bot_eq_bot LieAlgebra.derived_series_of_bot_eq_bot

theorem abelian_iff_derived_one_eq_bot : IsLieAbelian I ↔ derivedSeriesOfIdeal R L 1 I = ⊥ := by
  rw [derived_series_of_ideal_succ, derived_series_of_ideal_zero,
    LieSubmodule.lie_abelian_iff_lie_self_eq_bot]
#align lie_algebra.abelian_iff_derived_one_eq_bot LieAlgebra.abelian_iff_derived_one_eq_bot

theorem abelian_iff_derived_succ_eq_bot (I : LieIdeal R L) (k : ℕ) :
    IsLieAbelian (derivedSeriesOfIdeal R L k I) ↔ derivedSeriesOfIdeal R L (k + 1) I = ⊥ := by
  rw [add_comm, derived_series_of_ideal_add I 1 k, abelian_iff_derived_one_eq_bot]
#align lie_algebra.abelian_iff_derived_succ_eq_bot LieAlgebra.abelian_iff_derived_succ_eq_bot

end LieAlgebra

namespace LieIdeal

open LieAlgebra

variable {R L}

theorem derivedSeries_eq_derivedSeriesOfIdeal_comap (k : ℕ) :
    derivedSeries R I k = (derivedSeriesOfIdeal R L k I).comap I.incl :=
  by
  induction' k with k ih
  · simp only [derived_series_def, comap_incl_self, derived_series_of_ideal_zero]
  · simp only [derived_series_def, derived_series_of_ideal_succ] at ih⊢
    rw [ih]
    exact
      comap_bracket_incl_of_le I (derived_series_of_ideal_le_self I k)
        (derived_series_of_ideal_le_self I k)
#align lie_ideal.derived_series_eq_derived_series_of_ideal_comap LieIdeal.derivedSeries_eq_derivedSeriesOfIdeal_comap

theorem derivedSeries_eq_derivedSeriesOfIdeal_map (k : ℕ) :
    (derivedSeries R I k).map I.incl = derivedSeriesOfIdeal R L k I :=
  by
  rw [derived_series_eq_derived_series_of_ideal_comap, map_comap_incl, inf_eq_right]
  apply derived_series_of_ideal_le_self
#align lie_ideal.derived_series_eq_derived_series_of_ideal_map LieIdeal.derivedSeries_eq_derivedSeriesOfIdeal_map

theorem derivedSeries_eq_bot_iff (k : ℕ) :
    derivedSeries R I k = ⊥ ↔ derivedSeriesOfIdeal R L k I = ⊥ := by
  rw [← derived_series_eq_derived_series_of_ideal_map, map_eq_bot_iff, ker_incl, eq_bot_iff]
#align lie_ideal.derived_series_eq_bot_iff LieIdeal.derivedSeries_eq_bot_iff

theorem derivedSeries_add_eq_bot {k l : ℕ} {I J : LieIdeal R L} (hI : derivedSeries R I k = ⊥)
    (hJ : derivedSeries R J l = ⊥) : derivedSeries R (↥(I + J)) (k + l) = ⊥ :=
  by
  rw [LieIdeal.derivedSeries_eq_bot_iff] at hI hJ⊢
  rw [← le_bot_iff]
  let D := derived_series_of_ideal R L; change D k I = ⊥ at hI; change D l J = ⊥ at hJ
  calc
    D (k + l) (I + J) ≤ D k I + D l J := derived_series_of_ideal_add_le_add I J k l
    _ ≤ ⊥ := by
      rw [hI, hJ]
      simp

#align lie_ideal.derived_series_add_eq_bot LieIdeal.derivedSeries_add_eq_bot

theorem derivedSeries_map_le (k : ℕ) : (derivedSeries R L' k).map f ≤ derivedSeries R L k :=
  by
  induction' k with k ih
  · simp only [derived_series_def, derived_series_of_ideal_zero, le_top]
  · simp only [derived_series_def, derived_series_of_ideal_succ] at ih⊢
    exact le_trans (map_bracket_le f) (LieSubmodule.mono_lie _ _ _ _ ih ih)
#align lie_ideal.derived_series_map_le LieIdeal.derivedSeries_map_le

theorem derivedSeries_map_eq (k : ℕ) (h : Function.Surjective f) :
    (derivedSeries R L' k).map f = derivedSeries R L k :=
  by
  induction' k with k ih
  · change (⊤ : LieIdeal R L').map f = ⊤
    rw [← f.ideal_range_eq_map]
    exact f.ideal_range_eq_top_of_surjective h
  · simp only [derived_series_def, map_bracket_eq f h, ih, derived_series_of_ideal_succ]
#align lie_ideal.derived_series_map_eq LieIdeal.derivedSeries_map_eq

end LieIdeal

namespace LieAlgebra

/-- A Lie algebra is solvable if its derived series reaches 0 (in a finite number of steps). -/
class IsSolvable : Prop where
  solvable : ∃ k, derivedSeries R L k = ⊥
#align lie_algebra.is_solvable LieAlgebra.IsSolvable

instance isSolvableBot : IsSolvable R ↥(⊥ : LieIdeal R L) :=
  ⟨⟨0, Subsingleton.elim _ ⊥⟩⟩
#align lie_algebra.is_solvable_bot LieAlgebra.isSolvableBot

instance isSolvableAdd {I J : LieIdeal R L} [hI : IsSolvable R I] [hJ : IsSolvable R J] :
    IsSolvable R ↥(I + J) := by
  obtain ⟨k, hk⟩ := id hI; obtain ⟨l, hl⟩ := id hJ
  exact ⟨⟨k + l, LieIdeal.derivedSeries_add_eq_bot hk hl⟩⟩
#align lie_algebra.is_solvable_add LieAlgebra.isSolvableAdd

end LieAlgebra

variable {R L}

namespace Function

open LieAlgebra

theorem Injective.lieAlgebraIsSolvable [h₁ : IsSolvable R L] (h₂ : Injective f) : IsSolvable R L' :=
  by
  obtain ⟨k, hk⟩ := id h₁
  use k
  apply LieIdeal.bot_of_map_eq_bot h₂; rw [eq_bot_iff, ← hk]
  apply LieIdeal.derivedSeries_map_le
#align function.injective.lie_algebra_is_solvable Function.Injective.lieAlgebraIsSolvable

theorem Surjective.lieAlgebraIsSolvable [h₁ : IsSolvable R L'] (h₂ : Surjective f) :
    IsSolvable R L := by
  obtain ⟨k, hk⟩ := id h₁
  use k
  rw [← LieIdeal.derivedSeries_map_eq k h₂, hk]
  simp only [LieIdeal.map_eq_bot_iff, bot_le]
#align function.surjective.lie_algebra_is_solvable Function.Surjective.lieAlgebraIsSolvable

end Function

theorem LieHom.isSolvableRange (f : L' →ₗ⁅R⁆ L) [h : LieAlgebra.IsSolvable R L'] :
    LieAlgebra.IsSolvable R f.range :=
  f.surjective_rangeRestrict.lieAlgebraIsSolvable
#align lie_hom.is_solvable_range LieHom.isSolvableRange

namespace LieAlgebra

theorem solvable_iff_equiv_solvable (e : L' ≃ₗ⁅R⁆ L) : IsSolvable R L' ↔ IsSolvable R L :=
  by
  constructor <;> intro h
  · exact e.symm.injective.lie_algebra_is_solvable
  · exact e.injective.lie_algebra_is_solvable
#align lie_algebra.solvable_iff_equiv_solvable LieAlgebra.solvable_iff_equiv_solvable

theorem leSolvableIdealSolvable {I J : LieIdeal R L} (h₁ : I ≤ J) (h₂ : IsSolvable R J) :
    IsSolvable R I :=
  (LieIdeal.homOfLe_injective h₁).lieAlgebraIsSolvable
#align lie_algebra.le_solvable_ideal_solvable LieAlgebra.leSolvableIdealSolvable

variable (R L)

instance (priority := 100) ofAbelianIsSolvable [IsLieAbelian L] : IsSolvable R L :=
  by
  use 1
  rw [← abelian_iff_derived_one_eq_bot, lie_abelian_iff_equiv_lie_abelian LieIdeal.topEquiv]
  infer_instance
#align lie_algebra.of_abelian_is_solvable LieAlgebra.ofAbelianIsSolvable

/-- The (solvable) radical of Lie algebra is the `Sup` of all solvable ideals. -/
def radical :=
  supₛ { I : LieIdeal R L | IsSolvable R I }
#align lie_algebra.radical LieAlgebra.radical

/-- The radical of a Noetherian Lie algebra is solvable. -/
instance radicalIsSolvable [IsNoetherian R L] : IsSolvable R (radical R L) :=
  by
  have hwf := LieSubmodule.wellFounded_of_noetherian R L L
  rw [← CompleteLattice.isSupClosedCompact_iff_wellFounded] at hwf
  refine' hwf { I : LieIdeal R L | IsSolvable R I } ⟨⊥, _⟩ fun I hI J hJ => _
  · exact LieAlgebra.isSolvableBot R L
  · apply LieAlgebra.isSolvableAdd R L
    exacts[hI, hJ]
#align lie_algebra.radical_is_solvable LieAlgebra.radicalIsSolvable

/-- The `→` direction of this lemma is actually true without the `is_noetherian` assumption. -/
theorem LieIdeal.solvable_iff_le_radical [IsNoetherian R L] (I : LieIdeal R L) :
    IsSolvable R I ↔ I ≤ radical R L :=
  ⟨fun h => le_supₛ h, fun h => leSolvableIdealSolvable h inferInstance⟩
#align lie_algebra.lie_ideal.solvable_iff_le_radical LieAlgebra.LieIdeal.solvable_iff_le_radical

theorem center_le_radical : center R L ≤ radical R L :=
  have h : IsSolvable R (center R L) := by infer_instance
  le_supₛ h
#align lie_algebra.center_le_radical LieAlgebra.center_le_radical

/-- Given a solvable Lie ideal `I` with derived series `I = D₀ ≥ D₁ ≥ ⋯ ≥ Dₖ = ⊥`, this is the
natural number `k` (the number of inclusions).

For a non-solvable ideal, the value is 0. -/
noncomputable def derivedLengthOfIdeal (I : LieIdeal R L) : ℕ :=
  infₛ { k | derivedSeriesOfIdeal R L k I = ⊥ }
#align lie_algebra.derived_length_of_ideal LieAlgebra.derivedLengthOfIdeal

/-- The derived length of a Lie algebra is the derived length of its 'top' Lie ideal.

See also `lie_algebra.derived_length_eq_derived_length_of_ideal`. -/
noncomputable abbrev derivedLength : ℕ :=
  derivedLengthOfIdeal R L ⊤
#align lie_algebra.derived_length LieAlgebra.derivedLength

theorem derived_series_of_derived_length_succ (I : LieIdeal R L) (k : ℕ) :
    derivedLengthOfIdeal R L I = k + 1 ↔
      IsLieAbelian (derivedSeriesOfIdeal R L k I) ∧ derivedSeriesOfIdeal R L k I ≠ ⊥ :=
  by
  rw [abelian_iff_derived_succ_eq_bot]
  let s := { k | derived_series_of_ideal R L k I = ⊥ }
  change Inf s = k + 1 ↔ k + 1 ∈ s ∧ k ∉ s
  have hs : ∀ k₁ k₂ : ℕ, k₁ ≤ k₂ → k₁ ∈ s → k₂ ∈ s :=
    by
    intro k₁ k₂ h₁₂ h₁
    suffices derived_series_of_ideal R L k₂ I ≤ ⊥ by exact eq_bot_iff.mpr this
    change derived_series_of_ideal R L k₁ I = ⊥ at h₁
    rw [← h₁]
    exact derived_series_of_ideal_antitone I h₁₂
  exact Nat.infₛ_upward_closed_eq_succ_iff hs k
#align lie_algebra.derived_series_of_derived_length_succ LieAlgebra.derived_series_of_derived_length_succ

theorem derivedLength_eq_derivedLengthOfIdeal (I : LieIdeal R L) :
    derivedLength R I = derivedLengthOfIdeal R L I :=
  by
  let s₁ := { k | derivedSeries R I k = ⊥ }
  let s₂ := { k | derived_series_of_ideal R L k I = ⊥ }
  change Inf s₁ = Inf s₂
  congr ; ext k; exact I.derived_series_eq_bot_iff k
#align lie_algebra.derived_length_eq_derived_length_of_ideal LieAlgebra.derivedLength_eq_derivedLengthOfIdeal

variable {R L}

/-- Given a solvable Lie ideal `I` with derived series `I = D₀ ≥ D₁ ≥ ⋯ ≥ Dₖ = ⊥`, this is the
`k-1`th term in the derived series (and is therefore an Abelian ideal contained in `I`).

For a non-solvable ideal, this is the zero ideal, `⊥`. -/
noncomputable def derivedAbelianOfIdeal (I : LieIdeal R L) : LieIdeal R L :=
  match derivedLengthOfIdeal R L I with
  | 0 => ⊥
  | k + 1 => derivedSeriesOfIdeal R L k I
#align lie_algebra.derived_abelian_of_ideal LieAlgebra.derivedAbelianOfIdeal

theorem abelian_derivedAbelianOfIdeal (I : LieIdeal R L) : IsLieAbelian (derivedAbelianOfIdeal I) :=
  by
  dsimp only [derived_abelian_of_ideal]
  cases' h : derived_length_of_ideal R L I with k
  · exact is_lie_abelian_bot R L
  · rw [derived_series_of_derived_length_succ] at h
    exact h.1
#align lie_algebra.abelian_derived_abelian_of_ideal LieAlgebra.abelian_derivedAbelianOfIdeal

theorem derived_length_zero (I : LieIdeal R L) [hI : IsSolvable R I] :
    derivedLengthOfIdeal R L I = 0 ↔ I = ⊥ :=
  by
  let s := { k | derived_series_of_ideal R L k I = ⊥ }
  change Inf s = 0 ↔ _
  have hne : s ≠ ∅ := by
    obtain ⟨k, hk⟩ := id hI
    refine' Set.Nonempty.ne_empty ⟨k, _⟩
    rw [derived_series_def, LieIdeal.derivedSeries_eq_bot_iff] at hk
    exact hk
  simp [hne]
#align lie_algebra.derived_length_zero LieAlgebra.derived_length_zero

theorem abelian_of_solvable_ideal_eq_bot_iff (I : LieIdeal R L) [h : IsSolvable R I] :
    derivedAbelianOfIdeal I = ⊥ ↔ I = ⊥ :=
  by
  dsimp only [derived_abelian_of_ideal]
  cases' h : derived_length_of_ideal R L I with k
  · rw [derived_length_zero] at h
    rw [h]
    rfl
  · obtain ⟨h₁, h₂⟩ := (derived_series_of_derived_length_succ R L I k).mp h
    have h₃ : I ≠ ⊥ := by
      intro contra
      apply h₂
      rw [contra]
      apply derived_series_of_bot_eq_bot
    change derived_series_of_ideal R L k I = ⊥ ↔ I = ⊥
    constructor <;> contradiction
#align lie_algebra.abelian_of_solvable_ideal_eq_bot_iff LieAlgebra.abelian_of_solvable_ideal_eq_bot_iff

end LieAlgebra


theorem int_alg_c12_p20d
  (a b c : ℝ) :
  real.logb a c = (real.logb a b) * (real.logb b c) := sorry


import GMLInit.Data.Index.Basic
import GMLInit.Data.Index.Bind
import GMLInit.Data.Index.Map

protected abbrev List.prod {α β} (xs : List α) (ys : List β) : List (α × β) := xs.bind fun x => ys.map (Prod.mk x)

namespace Index
variable {α β} {xs : List α} {ys : List β}

def prod : Index xs × Index ys → Index (List.prod xs ys)
| (i,j) => Index.bind (λ x => ys.map (Prod.mk x)) ⟨i, j.map (Prod.mk i.val)⟩

def unprod (k : Index (List.prod xs ys)) : Index xs × Index ys :=
  match unbind (λ x => ys.map (Prod.mk x)) k with
  | ⟨i,j⟩ => (i, j.unmap (Prod.mk i.val))

theorem unprod_prod (i : Index xs × Index ys) : unprod (prod i) = i := by
  simp only [prod, unprod]
  rw [unbind_bind, unmap_map]

theorem prod_unprod (k : Index (List.prod xs ys)) : prod (unprod k) = k := by
  simp only [prod, unprod]
  rw [map_unmap, bind_unbind]

theorem prod_eq_iff_eq_unprod (i : Index xs × Index ys) (k : Index (List.prod xs ys)) : prod i = k ↔ i = unprod k := by
  constr
  · intro h; rw [←h, unprod_prod]
  · intro h; rw [h, prod_unprod]

theorem unprod_eq_iff_eq_prod (i : Index (List.prod xs ys)) (j : Index xs × Index ys) : unprod i = j ↔ i = prod j := by
  constr
  · intro h; rw [←h, prod_unprod]
  · intro h; rw [h, unprod_prod]

def prodEquiv (xs ys : List α) : Equiv (Index xs × Index ys) (Index (List.prod xs ys)) where
  fwd := prod
  rev := unprod
  spec := by
    intros
    constr
    · intro | rfl => exact unprod_prod ..
    · intro | rfl => exact prod_unprod ..

theorem val_prod (i : Index xs × Index ys) : (prod i).val = (i.fst.val, i.snd.val) := by
  rw [prod, val_bind, val_map]

theorem val_unprod (i : Index (List.prod xs ys)) : ((unprod i).fst.val, (unprod i).snd.val) = i.val := by
  rw [←prod_unprod i, val_prod, unprod_prod]

end Index