/-
Copyright (c) 2017 Daniel Selsam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Daniel Selsam

Miscellaneous facts and theorems about tensors.

We view tensors as a field extended component-wise.  As such, they
form an ordered (but not linearly-ordered) commutative ring.  They
also have division, except the precondition for cancellation is not `x
≠ 0` but `|x| > 0`, which we simplify to `x > 0`.

Note: the axioms are by no means minimal.
-/
import .tensor .id .reference .env .dvec

-- TODO(dhs): move these elsewhere once #1659 is resolved.
attribute [congr] dif_ctx_simp_congr
attribute [simp] dif_pos dif_neg

namespace certigrad

namespace T
open list

axiom const_scalar : ∀ (α : ℝ), const α [] = α
attribute [simp] const_scalar

axiom const_mul {shape : S} : Π (α β : ℝ), const (α * β) shape = const α shape * const β shape
axiom const_neg {shape : S} : Π (α : ℝ), const (- α) shape = - const α shape
axiom const_inv {shape : S} : Π (α : ℝ), const α⁻¹ shape = (const α shape)⁻¹

axiom const_zero {shape : S} : const 0 shape = 0
axiom const_one {shape : S} : const 1 shape = 1
axiom const_bit0 {shape : S} : Π (α : ℝ), const (bit0 α) shape = bit0 (const α shape)
axiom const_bit1 {shape : S} : Π (α : ℝ), const (bit1 α) shape = bit1 (const α shape)

--attribute [simp] const_mul const_neg const_inv const_zero const_one const_bit0 const_bit1

-- Module structure
axiom smul.def (α : ℝ) (shape : S) (x : T shape) : α ⬝ x = const α shape * x
axiom smul_neg (α : ℝ) : ∀ {shape : S} (x : T shape), α ⬝ (- x) = - (α ⬝ x)
axiom smul_addr (α : ℝ) : ∀ (shape : S) (x y : T shape), α ⬝ (x + y) = α ⬝ x + α ⬝ y
axiom smul_addl (α β : ℝ) : ∀ (shape : S) (x : T shape), (α + β) ⬝ x = α ⬝ x + β ⬝ x
axiom smul_group (α β : ℝ) : ∀ (shape : S) (x : T shape), (α * β) ⬝ x = α ⬝ (β ⬝ x)
axiom smul_flip (α β : ℝ) : ∀ (shape : S) (x : T shape), α ⬝ (β ⬝ x) = β ⬝ (α ⬝ x)
axiom one_smul : ∀ (shape : S) (x : T shape), (1 : ℝ) ⬝ x = x

axiom smul_zero (α : ℝ) : ∀ (shape : S), α ⬝ (0 : T shape) = 0
axiom zero_smul : ∀ (shape : S) (x : T shape), (0 : ℝ) ⬝ x = 0
axiom smul_mul_scalar_right (α : ℝ) : ∀ (x y : ℝ), α ⬝ (x * y) = x ⬝ (α ⬝ y)
axiom smul_mul₁ (α : ℝ) : ∀ {shape : S} (x y : T shape), y * (α ⬝ x) = α ⬝ (x * y)
axiom smul_mul₂ (α : ℝ) : ∀ {shape : S} (x y : T shape), (α ⬝ x) * y = α ⬝ (x * y)
axiom smul_comm (α β : ℝ) : α ⬝ β = β ⬝ α
axiom smul_sum {shape : S} (α : ℝ) (x : T shape) : α ⬝ sum x = sum (α ⬝ x)
axiom smul_div {shape : S} (α : ℝ) (x y : T shape) : α ⬝ (x / y) = (α ⬝ x) / y
axiom smul_scale : ∀ (α : ℝ) (shape : S) (x : T shape), (α ⬝ 1) * x = α ⬝ x
axiom smul_scalar : ∀ (α x : ℝ), (α ⬝ x) = α * x

-- sum
axiom sum_empty_vec (x : T [0]) : sum x = 0
axiom sum_mat_no_cols {nrows : ℕ} (x : T [nrows, 0]) : sum x = 0
axiom sum_zero : Π {shape : S}, sum (0 : T shape) = 0
axiom sum_add {shape : S} (x y : T shape) : sum (x + y) = sum x + sum y
axiom sum_neg {shape : S} (x : T shape) : sum (- x) = - (sum x)
axiom sum_smul {shape : S} (α : ℝ) (x : T shape) : sum (α ⬝ x) = α * sum x

-- Misc
axiom sqrt_mul {shape : S} : ∀ (x y : T shape), sqrt (x * y) = sqrt x * sqrt y
axiom sqrt_square {shape : S} : ∀ (x : T shape), sqrt (square x) = x
axiom prod_mul {shape : S} : ∀ (x y : T shape), prod (x * y) = prod x * prod y
axiom mul_inv_pos {shape : S} : ∀ {x y : T shape}, x > 0 → y > 0 → (x * y)⁻¹ = x⁻¹ * y⁻¹
axiom inv_mul_cancel {shape : S} : ∀ {x : T shape}, x > 0 → (x⁻¹ * x) = 1
axiom mul_inv_cancel {shape : S} : ∀ {x : T shape}, x > 0 → (x * x⁻¹) = 1
axiom div_one {shape : S} : ∀ {x : T shape}, x / 1 = x
axiom log_one {shape : S} : log (1 : T shape) = (0 : T shape)
axiom log_const {shape : S} (α : ℝ) : log (const α shape) = const (log α) shape
axiom exp_inv {shape : S} (x : T shape) : (exp x)⁻¹ = exp (- x)
axiom neg_div : ∀ {shape : S} {x y : T shape}, -x / y = -(x / y)
axiom log_prod : ∀ {shape : S} {x : T shape}, x > 0 → log (prod x) = sum (log x)
axiom log_mul : ∀ {shape : S} {x y : T shape}, x > 0 → y > 0 → log (x * y) = log x + log y
axiom log_exp : ∀ {shape : S} {x : T shape}, log (exp x) = x
axiom log_sqrt : ∀ {shape : S} {x : T shape}, log (sqrt x) = 2⁻¹ * log x
axiom log_inv : ∀ {shape : S} {x : T shape}, log (x⁻¹) = - log x

-- Signs
axiom nz_of_pos {shape : S} : ∀ {x : T shape}, x > 0 → x ≠ 0
axiom nz_of_div {shape : S} : ∀ {x y : T  shape}, x ≠ 0 → y ≠ 0 → x / y ≠ 0
axiom nz_iff {shape : S} : ∀ {x : T shape}, x ≠ 0 ↔ x > 0 ∨ x < 0
axiom nneg_of_pos {shape : S} : ∀ {x : T shape}, x > 0 → x ≥ 0
axiom sqrt_pos {shape : S} : ∀ {x : T shape}, x > 0 → sqrt x > 0
axiom pos_of_sqrt_pos {shape : S} : ∀ {x : T shape}, sqrt x > 0 → x > 0
axiom square_nneg {shape : S} : ∀ {x : T shape}, square x ≥ 0
axiom square_pos_of_pos {shape : S} : ∀ {x : T shape}, 0 < x → 0 < square x
axiom square_pos_of_neg {shape : S} : ∀ {x : T shape}, x < 0 → 0 < square x
axiom exp_pos {shape : S} : ∀ {x : T shape}, exp x > 0
axiom sigmoid_pos {shape : S} : ∀ {x : T shape}, sigmoid x > 0
axiom sigmoid_lt1 {shape : S} : ∀ {x : T shape}, sigmoid x < 1
axiom lt1_alt {shape : S} : ∀ {x : T shape}, x < 1 → 0 < 1 - x
axiom one_plus_pos {shape : S} : ∀ {x : T shape}, x > 0 → 1 + x > 0
axiom one_plus_pos_iff {shape : S} : ∀ {x : T shape}, 0 < 1 + x ↔ (- 1 < x)
axiom plus_one_pos {shape : S} : ∀ {x : T shape}, x > 0 → x + 1 > 0
axiom one_pos {shape : S} : (1 : T shape) > 0
axiom neg_of_pos {shape : S} {x : T shape} : x > 0 → - x < 0
axiom const_pos_of_pos {shape : S} {x : ℝ} : x > 0 → const x shape > 0
axiom mul_pos_of_pos_pos {shape : S} {x y : T shape} : x > 0 → y > 0 → x * y > 0
axiom eps_pos {shape : S} : eps shape > 0
axiom pi_pos {shape : S} : pi shape > 0
axiom inv_pos {shape : S} {x : T shape} : x > 0 → x⁻¹ > 0
axiom div_pos_pos {shape : S} {x y : T shape} : x > 0 → y > 0 → x / y > 0
axiom add_pos_of_pos_pos {shape : S} {x y : T shape} : x > 0 → y > 0 → x + y > 0
lemma two_pos {shape : S} : (2 : T shape) > 0 := one_plus_pos one_pos
lemma two_pi_pos {shape : S} : 2 * pi shape > 0 := mul_pos_of_pos_pos two_pos pi_pos
lemma msigmoid_pos {shape : S} {x : T shape} : 0 < 1 - sigmoid x := lt1_alt sigmoid_lt1

-- div
axiom div_mul_cancel {shape : S} : ∀ {x y : T shape}, y > 0 → (x / y) * y = x
axiom div_div_eq_div_mul {shape : S} : ∀ (x y z : T shape), (x / y) / z = x / (y * z)
axiom div_mul_div {shape : S} : ∀ (x y z w : T shape), (x / y) * (z / w) = (x * z) / (y * w)
axiom mul_div_mul {shape : S} : ∀ (x y z : T shape), x * (y / z) = (x / z) * y
axiom mul_div_mul_alt {shape : S} : ∀ (x y z : T shape), x * (y / z) = (x * y / z)
axiom one_div_inv {shape : S} : ∀ (x : T shape), 1 / x = x⁻¹
axiom div_mul_inv {shape : S} : ∀ (x y : T shape), x / y = x * y⁻¹
axiom div_self {shape : S} : ∀ {x : T shape}, x > 0 → x / x = 1
axiom square_div {shape : S} : ∀ {x y : T shape}, square (x / y) = square x / square y

axiom div_add_div_same {shape : S} (x y z : T shape) : x / z + y / z = (x + y) / z
lemma div_add_div_same_symm {shape : S} (x y z : T shape) : (x + y) / z = x / z + y / z := by rw div_add_div_same
lemma div_sub_div_same {shape : S} (x y z : T shape) : x / z - y / z = (x - y) / z := by simp [T.div_add_div_same_symm, neg_div]
lemma div_sub_div_same_symm {shape : S} (x y z : T shape) : (x - y) / z = x / z - y / z := by rw div_sub_div_same
lemma div_self_square {shape : S} {x : T shape} (H_pos : x > 0) : x / (x * x)= x⁻¹ :=
calc  x / (x * x)
    = (x / x) / x : by rw -div_div_eq_div_mul
... = 1 / x : by rw div_self H_pos
... = x⁻¹ : by rw one_div_inv

-- integrable
axiom is_integrable_const : Π {shape₁ shape₂ : S} (c : T shape₂), is_integrable (λ (x : T shape₁), c)

lemma is_integrable_zero {shape₁ shape₂ : S} : is_integrable (λ (x : T shape₁), (0 : T shape₂)) := is_integrable_const (0 : T shape₂)

axiom is_integrable_scale : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (α : ℝ),
  is_integrable f ↔ is_integrable (λ x, α ⬝ f x)

axiom is_integrable_neg : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂),
  is_integrable f ↔ is_integrable (λ x, - f x)

axiom is_integrable_div : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂) (Hy : y > 0),
  is_integrable f ↔ is_integrable (λ x, (f x) / y)

axiom is_integrable_add : Π {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂),
  (is_integrable f ∧ is_integrable g) ↔ is_integrable (λ x, f x + g x)

axiom is_integrable_tmulT {ishape oshape fshape : S} (M : T (ishape ++ oshape)) (f : T fshape → T oshape) :
  is_integrable f ↔ is_integrable (λ x, tmulT M (f x))

axiom is_integrable_sum : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂),
  (is_integrable f) ↔ is_integrable (λ x, sum (f x))

axiom is_integrable_fscale : Π {shape₁ shape₂ : S} (f : T shape₁ → ℝ) (y : T shape₂),
  is_integrable f ↔ is_integrable (λ x, f x ⬝ y)

-- (provable)
axiom is_integrable_const_middle : Π {shape₁ shape₂ : S} (pdf : T shape₁ → ℝ) (c : T shape₂),
  is_integrable (λ (x : T shape₁), pdf x) ↔ is_integrable (λ (x : T shape₁), pdf x ⬝ c)

axiom is_integrable_add_middle : Π {shape₁ shape₂ : S} (pdf : T shape₁ → ℝ) (f g : T shape₁ → T shape₂),
  (is_integrable (λ (x : T shape₁), pdf x ⬝ f x) ∧ is_integrable (λ (x : T shape₁), pdf x ⬝ g x)) ↔ is_integrable (λ (x : T shape₁), pdf x ⬝ (f x + g x))

-- (provable)
axiom is_integrable_tmulT_middle {ishape oshape fshape : S} (M : T (ishape ++ oshape)) (pdf : T fshape → ℝ) (f : T fshape → T oshape) :
  is_integrable (λ (x : T fshape), pdf x ⬝ f x) ↔ is_integrable (λ (x : T fshape), pdf x ⬝ tmulT M (f x))

-- uniformly integrable
axiom is_uniformly_integrable_around_binary : Π {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₁ → T shape₂ → T shape₃) (θ : T shape₁),
  (is_uniformly_integrable_around (λ θ₀ x, f θ₀ θ x) θ ∧ is_uniformly_integrable_around (λ θ₀ x, f θ θ₀ x) θ) ↔ is_uniformly_integrable_around (λ θ₀ x, f θ₀ θ₀ x) θ

lemma uint_left {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₁ → T shape₂ → T shape₃) (θ : T shape₁) :
  is_uniformly_integrable_around (λ θ₀ x, f θ₀ θ₀ x) θ → is_uniformly_integrable_around (λ θ₀ x, f θ₀ θ x) θ :=
assume H_uint, (iff.mpr (is_uniformly_integrable_around_binary f θ) H_uint)^.left

lemma uint_right {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₁ → T shape₂ → T shape₃) (θ : T shape₁) :
  is_uniformly_integrable_around (λ θ₀ x, f θ₀ θ₀ x) θ → is_uniformly_integrable_around (λ θ₀ x, f θ θ₀ x) θ :=
assume H_uint, (iff.mpr (is_uniformly_integrable_around_binary f θ) H_uint)^.right

-- (provable)
axiom is_uniformly_integrable_around_binary_grad : Π {shape₁ shape₂ : S} (f₁ f₂ : T shape₁ → T shape₂ → ℝ) (θ : T shape₁),
  (∀ x, is_cdifferentiable (λ θ₀, f₁ θ₀ x) θ) → (∀ x, is_cdifferentiable (λ θ₀, f₂ θ₀ x) θ) →
  (is_uniformly_integrable_around (λ θ₀ x, f₂ θ₀ x ⬝ ∇ (λ θ₁, f₁ θ₁ x) θ₀) θ ∧ is_uniformly_integrable_around (λ θ₀ x, f₁ θ₀ x ⬝ ∇ (λ θ₁, f₂ θ₁ x) θ₀) θ ↔
   is_uniformly_integrable_around (λ θ₀ x, ∇ (λ θ₁, f₁ θ₁ x ⬝ f₂ θ₁ x) θ₀) θ)

lemma uint_grad_left {shape₁ shape₂ : S} (f₁ f₂ : T shape₁ → T shape₂ → ℝ) (θ : T shape₁) :
  (∀ x, is_cdifferentiable (λ θ₀, f₁ θ₀ x) θ) → (∀ x, is_cdifferentiable (λ θ₀, f₂ θ₀ x) θ) →
   is_uniformly_integrable_around (λ θ₀ x, ∇ (λ θ₁, f₁ θ₁ x ⬝ f₂ θ₁ x) θ₀) θ → is_uniformly_integrable_around (λ θ₀ x, f₂ θ₀ x ⬝ ∇ (λ θ₁, f₁ θ₁ x) θ₀) θ :=
assume H_cdiff₁ H_cdiff₂ H_uint_grad, (iff.mpr (is_uniformly_integrable_around_binary_grad f₁ f₂ θ H_cdiff₁ H_cdiff₂) H_uint_grad)^.left

lemma uint_grad_right {shape₁ shape₂ : S} (f₁ f₂ : T shape₁ → T shape₂ → ℝ) (θ : T shape₁) :
  (∀ x, is_cdifferentiable (λ θ₀, f₁ θ₀ x) θ) → (∀ x, is_cdifferentiable (λ θ₀, f₂ θ₀ x) θ) →
   is_uniformly_integrable_around (λ θ₀ x, ∇ (λ θ₁, f₁ θ₁ x ⬝ f₂ θ₁ x) θ₀) θ → is_uniformly_integrable_around (λ θ₀ x, f₁ θ₀ x ⬝ ∇ (λ θ₁, f₂ θ₁ x) θ₀) θ :=
assume H_cdiff₁ H_cdiff₂ H_uint_grad, (iff.mpr (is_uniformly_integrable_around_binary_grad f₁ f₂ θ H_cdiff₁ H_cdiff₂) H_uint_grad)^.right

-- integrals
axiom integral_scale : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (α : ℝ),
  ∫ (λ x, α ⬝ f x) = α ⬝ ∫ (λ x, f x)

axiom integral_neg : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂),
  ∫ (λ x, - (f x)) = - ∫ (λ x, f x)

axiom integral_div : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂),
  ∫ (λ x, (f x) / y) = ∫ (λ x, f x) / y

axiom integral_add : Π {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂),
  is_integrable f → is_integrable g → ∫ (λ x, f x + g x) = ∫ (λ x, f x) + ∫ (λ x, g x)

axiom integral_fscale : Π {shape₁ shape₂ : S} (f : T shape₁ → ℝ) (y : T shape₂),
  ∫ (λ x, f x ⬝ y) = ∫ (λ x, f x) ⬝ y

axiom integral_pos : ∀ {shape₁ shape₂ : S} (f : T shape₁ → T shape₂), (∀ x, f x > 0) → ∫ (λ x, f x) > 0
axiom integral_nneg : ∀ {shape₁ shape₂ : S} (f : T shape₁ → T shape₂), (∀ x, f x ≥ 0) → ∫ (λ x, f x) ≥ 0

lemma integral_congr {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) (H_fg : ∀ x, f x = g x) : ∫ f = ∫ g :=
  show ∫ (λ x, f x) = ∫ (λ x, g x), by rw (funext H_fg)

axiom integral_sum : Π {shape₁ shape₂ : S} (f : T shape₁ → T shape₂), is_integrable f → ∫ (λ x, sum (f x)) = sum (∫ (λ x, f x))

axiom smul_tmulT {ishape oshape : S} (α : ℝ) (M : T (ishape ++ oshape)) (y : T oshape) :
  α ⬝ (tmulT M y) = tmulT M (α ⬝ y)

axiom integral_tmulT {ishape oshape fshape : S} (M : T (ishape ++ oshape)) (f : T fshape → T oshape) :
  ∫ (λ x, tmulT M (f x)) = tmulT M (∫ f)

axiom integral_continuous : ∀ {ishape tshape fshape : S} (f : T ishape → T tshape → T fshape) (θ : T tshape),
  (∀ x, is_continuous (f x) θ) → is_continuous (λ θ₀, ∫ (λ x₀, f x₀ θ₀)) θ

-- D

axiom tmulT_scalar {shape : S} : ∀ (x : T (shape ++ [])) (y : ℝ), tmulT x y = y ⬝ (eq.rec_on (append_nil shape) x)
axiom D_scalar {shape : S} (f : T shape → ℝ) (θ : T shape) : (eq.rec_on (append_nil shape) (D f θ) : T shape) = ∇ f θ

-- dintegral

lemma dintegral_pos {oshape : S} : Π {shapes : list S} {f : dvec T shapes → T oshape}, (∀ x, f x > 0) → dintegral (λ x, f x) > 0
| [] f H := by apply H

| (shape::shapes) f H :=
begin
dunfold dintegral,
apply integral_pos,
intro x,
apply dintegral_pos,
intro xs,
apply H,
end

lemma dintegral_scale {shape : S} (α : ℝ) : Π {shapes : list S} (f : dvec T shapes → T shape),
  dintegral (λ (xs : dvec T shapes), α ⬝ f xs) = α ⬝ dintegral (λ xs, f xs)
| [] f := rfl

| (ds::shapes) f :=
begin
dunfold dintegral,
simp [λ x, @dintegral_scale shapes (λ v, f (x ::: v))],
rw integral_scale,
end

lemma is_dintegrable_scale {oshape : S} : Π {shapes : list S} (f : dvec T shapes → T oshape) (α : ℝ),
  is_dintegrable f ↔ is_dintegrable (λ x, α ⬝ f x)
| [] f α := begin split, all_goals { intro, exact trivial } end
| (shape::shapes) f α :=
begin
dunfold dintegral is_dintegrable,
split,
{ intro Hf, split,
  { simp only [dintegral_scale], exact iff.mp (is_integrable_scale _ α) Hf^.left },
  { intro x, exact iff.mp (is_dintegrable_scale _ _) (Hf^.right x) } },
{ intro Hαf, split,
  { simp only [dintegral_scale] at Hαf, exact iff.mpr (is_integrable_scale _ α) Hαf^.left },
  { intro x, exact iff.mpr (is_dintegrable_scale _ _) (Hαf^.right x) } }
end

lemma dintegral_add {shape : S} : Π {shapes : list S} (f g : dvec T shapes → T shape),
  is_dintegrable f → is_dintegrable g →
  dintegral (λ (xs : dvec T shapes), f xs + g xs) = dintegral (λ (xs : dvec T shapes), f xs) + dintegral (λ (xs : dvec T shapes), g xs)
| [] f g Hf Hg := rfl

| (ds::shapes) f g Hf Hg :=
begin
dunfold dintegral,
simp [λ x, @dintegral_add shapes (λ v, f (x ::: v)) (λ v, g (x :::v)) (Hf^.right x) (Hg^.right x)],
rw integral_add _ _ Hf^.left Hg^.left
end

lemma dintegral_div {shape : S} : Π {shapes : list S} (f : dvec T shapes → T shape) (y : T shape),
  dintegral (λ (xs : dvec T shapes), (f xs) / y) = dintegral (λ (xs : dvec T shapes), f xs) / y
| [] f y := rfl

| (ds::shapes) f y :=
begin
dunfold dintegral,
simp [λ x, @dintegral_div shapes (λ v, f (x ::: v)) y],
rw integral_div
end

lemma dintegral_add_middle {shape : S} : Π {shapes : list S} (pdf : dvec T shapes → ℝ) (f g : dvec T shapes → T shape),
  is_dintegrable (λ xs, pdf xs ⬝ f xs) → is_dintegrable (λ xs, pdf xs ⬝ g xs) →
  dintegral (λ (xs : dvec T shapes), pdf xs ⬝ (f xs + g xs)) = dintegral (λ (xs : dvec T shapes), pdf xs ⬝ f xs) + dintegral (λ (xs : dvec T shapes), pdf xs ⬝ g xs)
| [] pdf f g Hf Hg := begin dunfold dintegral, apply smul_addr end

| (ds::shapes) pdf f g Hf Hg :=
begin
dunfold dintegral,
simp [λ x, @dintegral_add_middle shapes (λ v, pdf (x ::: v)) (λ v, f (x ::: v)) (λ v, g (x :::v)) (Hf^.right x) (Hg^.right x)],
rw integral_add _ _ Hf^.left Hg^.left
end

lemma dintegral_neg_middle {shape : S} : Π {shapes : list S} (pdf : dvec T shapes → ℝ) (f : dvec T shapes → T shape),
  dintegral (λ (xs : dvec T shapes), pdf xs ⬝ - (f xs)) = - dintegral (λ (xs : dvec T shapes), pdf xs ⬝ f xs)
| [] pdf f := begin dunfold dintegral, apply smul_neg end

| (ds::shapes) pdf f :=
begin
dunfold dintegral,
simp [λ x, @dintegral_neg_middle shapes (λ v, pdf (x ::: v)) (λ v, f (x ::: v))],
rw integral_neg
end

lemma dintegral_mul (α : ℝ) : Π {shapes : list S} (f : dvec T shapes → ℝ),
  dintegral (λ (xs : dvec T shapes), α * f xs) = α * dintegral (λ xs, f xs) :=
begin
intros shapes f,
rw -(const_scalar α),
simp [λ s x, eq.symm (smul.def α s x)],
simp [λ α f, eq.symm (smul_scalar α f)],
exact (dintegral_scale α f)
end

lemma dintegral_scale_middle  {shape : S} (α : ℝ) : Π {shapes : list S} (f : dvec T shapes → ℝ) (g : dvec T shapes → T shape),
  dintegral (λ (xs : dvec T shapes), f xs ⬝ (α ⬝ g xs)) = α ⬝ dintegral (λ xs, f xs ⬝ g xs)
| [] f g :=
begin
dunfold dintegral,
simp [T.smul.def, mul_comm],
end

| (ds::shapes) f g :=
begin
dunfold dintegral,
simp [λ x, @dintegral_scale_middle shapes (λ v, f (x ::: v)) (λ v, g (x ::: v))],
rw integral_scale,
end

lemma dintegral_mul_middle (α : ℝ) : Π {shapes : list S} (f : dvec T shapes → ℝ) (g : dvec T shapes → ℝ),
  dintegral (λ (xs : dvec T shapes), f xs ⬝ (α * g xs)) = α * dintegral (λ xs, f xs ⬝ g xs) :=
begin
intros shapes f g,
rw -(const_scalar α),
simp [λ s x, eq.symm (smul.def α s x)],
simp [λ xs, eq.symm (smul_scalar α (g xs))],
rw dintegral_scale_middle α f g,
simp [smul_scalar]
end

lemma dintegral_tmulT  {shape₁ shape₂ : S} (M : T (shape₁ ++ shape₂)) : Π {shapes : list S} (f : dvec T shapes → T shape₂),
  dintegral (λ (xs : dvec T shapes), tmulT M (f xs)) = tmulT M (dintegral (λ xs, f xs))
| []           f := rfl

| (ds::shapes) f :=
begin
dunfold dintegral,
simp [λ x, @dintegral_tmulT shapes (λ v, f (x ::: v))],
rw integral_tmulT
end

lemma dintegral_tmulT_middle {shape₁ shape₂ : S} (M : T (shape₁ ++ shape₂)) : Π {shapes : list S} (f : dvec T shapes → ℝ) (g : dvec T shapes → T shape₂),
  dintegral (λ (xs : dvec T shapes), f xs ⬝ (tmulT M (g xs))) = tmulT M (dintegral (λ xs, f xs ⬝ g xs)) :=
begin
intros shapes f g,
simp [smul_tmulT, dintegral_tmulT]
end

lemma dintegral_const_middle {yshape : S} :
  ∀ {shapes : list S} (pdf : dvec T shapes → ℝ) (H_pdf_pos : ∀ x, pdf x > 0) (H_pdf_int1 : dintegral pdf = 1) (y : T yshape),
    dintegral (λ (xs : dvec T shapes), pdf xs ⬝ y) = y
| [] pdf H_pdf_pos H_pdf_int1 y :=
begin
dunfold dintegral,
dunfold dintegral at H_pdf_int1,
rw H_pdf_int1,
rw one_smul
end

| (shape::shapes) pdf H_pdf_pos H_pdf_int1 y :=
let pdf' : T shape → dvec T shapes → ℝ := λ x (xs : dvec T shapes), pdf (x ::: xs) / dintegral (λ (xs : dvec T shapes), pdf (x ::: xs)) in
have H_dpos : ∀ (x : T shape), dintegral (λ (xs : dvec T shapes), pdf (x ::: xs)) > 0, from λ x, dintegral_pos (λ x, H_pdf_pos _),
have H_pdf'_pos : ∀ (x : T shape) (xs : dvec T shapes), pdf' x xs > 0, from
  assume (x : T shape) (xs : dvec T shapes),
  have H₁ : pdf (x ::: xs) > 0, by apply H_pdf_pos,
  T.div_pos_pos H₁ (H_dpos x),

have H_pdf'_int1 : ∀ (x : T shape), dintegral (pdf' x) = 1, from
  assume (x : T shape),
  begin dsimp, rw T.dintegral_div, exact div_self (H_dpos x) end,

have H_inner₁ : ∀ (x : T shape), dintegral (λ (v : dvec T shapes), pdf (x ::: v) ⬝ y)
                     = dintegral (λ (v : dvec T shapes), (pdf' x v * dintegral (λ (vs : dvec T shapes), pdf (x ::: vs))) ⬝ y), from
  assume (x : T shape),
  begin dsimp, apply congr_arg, apply funext, intro xs, rw (T.div_mul_cancel (H_dpos _)) end,

have H_inner₂ : ∀ x, dintegral (λ (v : dvec T shapes), (pdf' x v * dintegral (λ (vs : dvec T shapes), pdf (x ::: vs))) ⬝ y)
                     = dintegral (λ (vs : dvec T shapes), pdf (x ::: vs)) ⬝ dintegral (λ (v : dvec T shapes), pdf' x v ⬝ y), from
  assume (x : T shape),
  begin dsimp, simp [smul_group, dintegral_scale] end,
begin
dunfold dintegral,
simp [H_inner₁, H_inner₂, (λ x, @dintegral_const_middle shapes (pdf' x) (H_pdf'_pos x) (H_pdf'_int1 x)), integral_fscale],
change dintegral (λ (vs : dvec T (shape::shapes)), pdf vs) ⬝ y = y,
rw [H_pdf_int1, one_smul]
end

-- btw axioms

axiom is_btw_id {shape : S} : is_btw_exp₂ (λ (x : T shape), x)
axiom is_btw_const {shape₁ shape₂ : S} (y : T shape₂) : is_btw_exp₂ (λ (x : T shape₁), y)
axiom is_btw_sigmoid {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_btw_exp₂ (λ (x : T shape₁), sigmoid (f x))
axiom is_btw_softplus {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ (λ (x : T shape₁), softplus (f x))
axiom is_btw_sum {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ (λ (x : T shape₁), sum (f x))
axiom is_btw_log_sigmoid {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂) : y > 0 → is_btw_exp₂ f →
  is_btw_exp₂ (λ (x : T shape₁), log (y + sigmoid (f x)))
axiom is_btw_log_1msigmoid {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂) : y > 0 → is_btw_exp₂ f →
  is_btw_exp₂ (λ (x : T shape₁), log (y + (1 - sigmoid (f x))))

axiom is_btw_gemm {shape : S} {m n p : ℕ} (f : T shape → T [m, n]) (g : T shape → T [n, p]) :
  is_btw_exp₂ f → is_btw_exp₂ g → is_btw_exp₂ (λ x, gemm (f x) (g x))

axiom is_btw_transpose {shape : S} {m n : ℕ} (f : T shape → T [m, n]) :
  is_btw_exp₂ f → is_btw_exp₂ (λ x, transpose (f x))

axiom is_btw_neg {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ (λ x, - (f x))
axiom is_btw_inv {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ (λ x, (f x)⁻¹)
axiom is_btw_add {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ g → is_btw_exp₂ (λ x, f x + g x)
axiom is_btw_mul {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ g → is_btw_exp₂ (λ x, f x * g x)
axiom is_btw_sub {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ g → is_btw_exp₂ (λ x, f x - g x)
axiom is_btw_div {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_btw_exp₂ f → is_btw_exp₂ g → is_btw_exp₂ (λ x, f x / g x)

axiom is_btw_exp {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_sub_quadratic f → is_btw_exp₂ (λ x, exp (f x))

-- sub quadratic axioms

axiom is_sub_quadratic_id {shape : S} : is_sub_quadratic (λ (x : T shape), x)
axiom is_sub_quadratic_const {shape₁ shape₂ : S} (y : T shape₂) : is_sub_quadratic (λ (x : T shape₁), y)

axiom is_sub_quadratic_gemm {shape : S} {m n p : ℕ} (f : T shape → T [m, n]) (g : T shape → T [n, p]) :
  is_sub_quadratic f → is_sub_quadratic g → is_sub_quadratic (λ x, gemm (f x) (g x))

axiom is_sub_quadratic_transpose {shape : S} {m n : ℕ} (f : T shape → T [m, n]) :
  is_sub_quadratic f → is_sub_quadratic (λ x, transpose (f x))

axiom is_sub_quadratic_softplus {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_sub_quadratic f → is_sub_quadratic (λ x, softplus (f x))

axiom is_sub_quadratic_neg {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) : is_sub_quadratic f → is_sub_quadratic (λ x, - (f x))
axiom is_sub_quadratic_mul₁ {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂) : is_sub_quadratic f → is_sub_quadratic (λ x, y * f x)
axiom is_sub_quadratic_mul₂ {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (y : T shape₂) : is_sub_quadratic f → is_sub_quadratic (λ x, f x * y)

axiom is_sub_quadratic_add {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_sub_quadratic f → is_sub_quadratic g → is_sub_quadratic (λ x, f x + g x)
axiom is_sub_quadratic_sub {shape₁ shape₂ : S} (f g : T shape₁ → T shape₂) : is_sub_quadratic f → is_sub_quadratic g → is_sub_quadratic (λ x, f x - g x)

-- is_bounded_btw_exp₂_around {shape₁ shape₂ shape₃ : S} (f : Π (x : T shape₁) (θ : T shape₂), T shape₃) (θ : T shape₂) : Prop

axiom is_bbtw_of_btw {shape₁ shape₂ shape₃ : S} (f : Π (x : T shape₁), T shape₃) (θ : T shape₂) :
  is_btw_exp₂ f → is_bounded_btw_exp₂_around (λ x θ₀, f x) θ

axiom is_bbtw_id {shape₁ shape₂ : S} (θ : T shape₂) : is_bounded_btw_exp₂_around (λ (x : T shape₁) (θ₀ : T shape₂), θ₀) θ

axiom is_bbtw_softplus {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, softplus (f x θ₀)) θ

axiom is_bbtw_sum {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, sum (f x θ₀)) θ

axiom is_bbtw_log_sigmoid {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (y : T shape₃) (θ : T shape₂) : y > 0 →
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, log (y + sigmoid (f x θ₀))) θ

axiom is_bbtw_log_1msigmoid {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (y : T shape₃) (θ : T shape₂) : y > 0 →
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, log (y + (1 - sigmoid (f x θ₀)))) θ

axiom is_bbtw_gemm {shape₁ shape₂ : S} {m n p : ℕ} (f : T shape₁ → T shape₂ → T [m, n]) (g : T shape₁ → T shape₂ → T [n, p]) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around g θ → is_bounded_btw_exp₂_around (λ x θ₀, gemm (f x θ₀) (g x θ₀)) θ

axiom is_bbtw_neg {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, - f x θ₀) θ

axiom is_bbtw_inv {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, (f x θ₀)⁻¹) θ

axiom is_bbtw_add {shape₁ shape₂ shape₃ : S} (f g : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around g θ → is_bounded_btw_exp₂_around (λ x θ₀, f x θ₀ + g x θ₀) θ

axiom is_bbtw_sub {shape₁ shape₂ shape₃ : S} (f g : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around g θ → is_bounded_btw_exp₂_around (λ x θ₀, f x θ₀ - g x θ₀) θ

axiom is_bbtw_mul {shape₁ shape₂ shape₃ : S} (f g : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around g θ → is_bounded_btw_exp₂_around (λ x θ₀, f x θ₀ * g x θ₀) θ

axiom is_bbtw_exp {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) :
  is_sub_quadratic (λ x, f x θ) → (∀ x, is_sub_quadratic (f x)) → is_bounded_btw_exp₂_around (λ x θ₀, exp (f x θ₀)) θ

lemma is_bbtw_bernoulli_neglogpdf {shape₁ shape₂ shape₃ : S} (f : T shape₁ → T shape₂ → T shape₃) (θ : T shape₂) (p : T shape₃) :
  is_bounded_btw_exp₂_around f θ → is_bounded_btw_exp₂_around (λ x θ₀, bernoulli_neglogpdf (sigmoid (f x θ₀)) p) θ :=
begin
intro H,
dunfold bernoulli_neglogpdf,
apply is_bbtw_neg, apply is_bbtw_sum, apply is_bbtw_add,
apply is_bbtw_mul, apply is_bbtw_of_btw, apply is_btw_const, apply is_bbtw_log_sigmoid, exact eps_pos, exact H,
apply is_bbtw_mul, apply is_bbtw_of_btw, apply is_btw_const, apply is_bbtw_log_1msigmoid, exact eps_pos, exact H
end

-- misc
axiom integral_scale_shift_var {shape fshape : S} (f : T shape → T fshape) (α β : T shape) : ∫ (λ x, f (α * x + β)) = ∫ (λ x, prod α⁻¹ ⬝ f x)

@[simp]
lemma force_ok {shape : S} (x : T shape) : force x shape = x := by { dunfold force, simp }

end T

-- helper tactic
section tactic
open tactic list
meta def prove_preconditions_core : tactic unit :=
first (assumption :: map applyc [`certigrad.T.sqrt_pos, `certigrad.T.square_pos_of_pos, `certigrad.T.exp_pos,
                                 `certigrad.T.sigmoid_pos, `certigrad.T.sigmoid_lt1, `certigrad.T.lt1_alt, `certigrad.T.one_plus_pos,
                                 `certigrad.T.plus_one_pos, `certigrad.T.one_pos, `certigrad.T.neg_of_pos, `certigrad.T.const_pos_of_pos,
                                 `certigrad.T.mul_pos_of_pos_pos, `certigrad.T.add_pos_of_pos_pos,
                                 `certigrad.T.pi_pos, `certigrad.T.eps_pos,
                                 `certigrad.T.inv_pos, `certigrad.T.div_pos_pos, `certigrad.T.two_pos, `certigrad.T.two_pi_pos])

meta def prove_preconditions : tactic unit := repeat prove_preconditions_core
end tactic

end certigrad


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

! This file was ported from Lean 3 source module linear_algebra.determinant
! leanprover-community/mathlib commit ce11c3c2a285bbe6937e26d9792fda4e51f3fe1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.GeneralLinearGroup
import Mathbin.LinearAlgebra.Matrix.Reindex
import Mathbin.Tactic.FieldSimp
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse
import Mathbin.LinearAlgebra.Matrix.Basis

/-!
# Determinant of families of vectors

This file defines the determinant of an endomorphism, and of a family of vectors
with respect to some basis. For the determinant of a matrix, see the file
`linear_algebra.matrix.determinant`.

## Main definitions

In the list below, and in all this file, `R` is a commutative ring (semiring
is sometimes enough), `M` and its variations are `R`-modules, `ι`, `κ`, `n` and `m` are finite
types used for indexing.

 * `basis.det`: the determinant of a family of vectors with respect to a basis,
   as a multilinear map
 * `linear_map.det`: the determinant of an endomorphism `f : End R M` as a
   multiplicative homomorphism (if `M` does not have a finite `R`-basis, the
   result is `1` instead)
 * `linear_equiv.det`: the determinant of an isomorphism `f : M ≃ₗ[R] M` as a
   multiplicative homomorphism (if `M` does not have a finite `R`-basis, the
   result is `1` instead)

## Tags

basis, det, determinant
-/

noncomputable section

open BigOperators

open Matrix

open LinearMap

open Submodule

universe u v w

open LinearMap Matrix Set Function

variable {R : Type _} [CommRing R]

variable {M : Type _} [AddCommGroup M] [Module R M]

variable {M' : Type _} [AddCommGroup M'] [Module R M']

variable {ι : Type _} [DecidableEq ι] [Fintype ι]

variable (e : Basis ι R M)

section Conjugate

variable {A : Type _} [CommRing A]

variable {m n : Type _} [Fintype m] [Fintype n]

/-- If `R^m` and `R^n` are linearly equivalent, then `m` and `n` are also equivalent. -/
def equivOfPiLequivPi {R : Type _} [CommRing R] [Nontrivial R] (e : (m → R) ≃ₗ[R] n → R) : m ≃ n :=
  Basis.indexEquiv (Basis.ofEquivFun e.symm) (Pi.basisFun _ _)
#align equiv_of_pi_lequiv_pi equivOfPiLequivPi

namespace Matrix

/-- If `M` and `M'` are each other's inverse matrices, they are square matrices up to
equivalence of types. -/
def indexEquivOfInv [Nontrivial A] [DecidableEq m] [DecidableEq n] {M : Matrix m n A}
    {M' : Matrix n m A} (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) : m ≃ n :=
  equivOfPiLequivPi (toLin'OfInv hMM' hM'M)
#align matrix.index_equiv_of_inv Matrix.indexEquivOfInv

theorem det_comm [DecidableEq n] (M N : Matrix n n A) : det (M ⬝ N) = det (N ⬝ M) := by
  rw [det_mul, det_mul, mul_comm]
#align matrix.det_comm Matrix.det_comm

/-- If there exists a two-sided inverse `M'` for `M` (indexed differently),
then `det (N ⬝ M) = det (M ⬝ N)`. -/
theorem det_comm' [DecidableEq m] [DecidableEq n] {M : Matrix n m A} {N : Matrix m n A}
    {M' : Matrix m n A} (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) : det (M ⬝ N) = det (N ⬝ M) :=
  by
  nontriviality A
  -- Although `m` and `n` are different a priori, we will show they have the same cardinality.
  -- This turns the problem into one for square matrices, which is easy.
  let e := index_equiv_of_inv hMM' hM'M
  rw [← det_submatrix_equiv_self e, ← submatrix_mul_equiv _ _ _ (Equiv.refl n) _, det_comm,
    submatrix_mul_equiv, Equiv.coe_refl, submatrix_id_id]
#align matrix.det_comm' Matrix.det_comm'

/-- If `M'` is a two-sided inverse for `M` (indexed differently), `det (M ⬝ N ⬝ M') = det N`.

See `matrix.det_conj` and `matrix.det_conj'` for the case when `M' = M⁻¹` or vice versa. -/
theorem det_conj_of_mul_eq_one [DecidableEq m] [DecidableEq n] {M : Matrix m n A}
    {M' : Matrix n m A} {N : Matrix n n A} (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
    det (M ⬝ N ⬝ M') = det N := by
  rw [← det_comm' hM'M hMM', ← Matrix.mul_assoc, hM'M, Matrix.one_mul]
#align matrix.det_conj_of_mul_eq_one Matrix.det_conj_of_mul_eq_one

end Matrix

end Conjugate

namespace LinearMap

/-! ### Determinant of a linear map -/

variable {A : Type _} [CommRing A] [Module A M]

variable {κ : Type _} [Fintype κ]

/-- The determinant of `linear_map.to_matrix` does not depend on the choice of basis. -/
theorem det_toMatrix_eq_det_toMatrix [DecidableEq κ] (b : Basis ι A M) (c : Basis κ A M)
    (f : M →ₗ[A] M) : det (LinearMap.toMatrix b b f) = det (LinearMap.toMatrix c c f) := by
  rw [← linearMap_toMatrix_mul_basis_toMatrix c b c, ← basis_toMatrix_mul_linearMap_toMatrix b c b,
      Matrix.det_conj_of_mul_eq_one] <;>
    rw [Basis.toMatrix_mul_toMatrix, Basis.toMatrix_self]
#align linear_map.det_to_matrix_eq_det_to_matrix LinearMap.det_toMatrix_eq_det_toMatrix

/-- The determinant of an endomorphism given a basis.

See `linear_map.det` for a version that populates the basis non-computably.

Although the `trunc (basis ι A M)` parameter makes it slightly more convenient to switch bases,
there is no good way to generalize over universe parameters, so we can't fully state in `det_aux`'s
type that it does not depend on the choice of basis. Instead you can use the `det_aux_def'` lemma,
or avoid mentioning a basis at all using `linear_map.det`.
-/
irreducible_def detAux : Trunc (Basis ι A M) → (M →ₗ[A] M) →* A :=
  Trunc.lift
    (fun b : Basis ι A M => detMonoidHom.comp (toMatrixAlgEquiv b : (M →ₗ[A] M) →* Matrix ι ι A))
    fun b c => MonoidHom.ext <| det_toMatrix_eq_det_toMatrix b c
#align linear_map.det_aux LinearMap.detAux

/-- Unfold lemma for `det_aux`.

See also `det_aux_def'` which allows you to vary the basis.
-/
theorem detAux_def (b : Basis ι A M) (f : M →ₗ[A] M) :
    LinearMap.detAux (Trunc.mk b) f = Matrix.det (LinearMap.toMatrix b b f) :=
  by
  rw [det_aux]
  rfl
#align linear_map.det_aux_def LinearMap.detAux_def

theorem detAux_def' {ι' : Type _} [Fintype ι'] [DecidableEq ι'] (tb : Trunc <| Basis ι A M)
    (b' : Basis ι' A M) (f : M →ₗ[A] M) :
    LinearMap.detAux tb f = Matrix.det (LinearMap.toMatrix b' b' f) :=
  by
  apply Trunc.induction_on tb
  intro b
  rw [det_aux_def, det_to_matrix_eq_det_to_matrix b b']
#align linear_map.det_aux_def' LinearMap.detAux_def'

@[simp]
theorem detAux_id (b : Trunc <| Basis ι A M) : LinearMap.detAux b LinearMap.id = 1 :=
  (LinearMap.detAux b).map_one
#align linear_map.det_aux_id LinearMap.detAux_id

@[simp]
theorem detAux_comp (b : Trunc <| Basis ι A M) (f g : M →ₗ[A] M) :
    LinearMap.detAux b (f.comp g) = LinearMap.detAux b f * LinearMap.detAux b g :=
  (LinearMap.detAux b).map_mul f g
#align linear_map.det_aux_comp LinearMap.detAux_comp

section

open Classical

-- Discourage the elaborator from unfolding `det` and producing a huge term by marking it
-- as irreducible.
/-- The determinant of an endomorphism independent of basis.

If there is no finite basis on `M`, the result is `1` instead.
-/
protected irreducible_def det : (M →ₗ[A] M) →* A :=
  if H : ∃ s : Finset M, Nonempty (Basis s A M) then LinearMap.detAux (Trunc.mk H.choose_spec.some)
  else 1
#align linear_map.det LinearMap.det

theorem coe_det [DecidableEq M] :
    ⇑(LinearMap.det : (M →ₗ[A] M) →* A) =
      if H : ∃ s : Finset M, Nonempty (Basis s A M) then
        LinearMap.detAux (Trunc.mk H.choose_spec.some)
      else 1 :=
  by
  ext
  unfold LinearMap.det
  split_ifs
  · congr
  -- use the correct `decidable_eq` instance
  rfl
#align linear_map.coe_det LinearMap.coe_det

end

-- Auxiliary lemma, the `simp` normal form goes in the other direction
-- (using `linear_map.det_to_matrix`)
theorem det_eq_det_toMatrix_of_finset [DecidableEq M] {s : Finset M} (b : Basis s A M)
    (f : M →ₗ[A] M) : f.det = Matrix.det (LinearMap.toMatrix b b f) :=
  by
  have : ∃ s : Finset M, Nonempty (Basis s A M) := ⟨s, ⟨b⟩⟩
  rw [LinearMap.coe_det, dif_pos, det_aux_def' _ b] <;> assumption
#align linear_map.det_eq_det_to_matrix_of_finset LinearMap.det_eq_det_toMatrix_of_finset

@[simp]
theorem det_toMatrix (b : Basis ι A M) (f : M →ₗ[A] M) : Matrix.det (toMatrix b b f) = f.det :=
  by
  haveI := Classical.decEq M
  rw [det_eq_det_to_matrix_of_finset b.reindex_finset_range, det_to_matrix_eq_det_to_matrix b]
#align linear_map.det_to_matrix LinearMap.det_toMatrix

@[simp]
theorem det_toMatrix' {ι : Type _} [Fintype ι] [DecidableEq ι] (f : (ι → A) →ₗ[A] ι → A) :
    det f.toMatrix' = f.det := by simp [← to_matrix_eq_to_matrix']
#align linear_map.det_to_matrix' LinearMap.det_toMatrix'

@[simp]
theorem det_toLin (b : Basis ι R M) (f : Matrix ι ι R) :
    LinearMap.det (Matrix.toLin b b f) = f.det := by
  rw [← LinearMap.det_toMatrix b, LinearMap.toMatrix_toLin]
#align linear_map.det_to_lin LinearMap.det_toLin

@[simp]
theorem det_toLin' (f : Matrix ι ι R) : LinearMap.det f.toLin' = f.det := by
  simp only [← to_lin_eq_to_lin', det_to_lin]
#align linear_map.det_to_lin' LinearMap.det_toLin'

/-- To show `P f.det` it suffices to consider `P (to_matrix _ _ f).det` and `P 1`. -/
@[elab_as_elim]
theorem det_cases [DecidableEq M] {P : A → Prop} (f : M →ₗ[A] M)
    (hb : ∀ (s : Finset M) (b : Basis s A M), P (toMatrix b b f).det) (h1 : P 1) : P f.det :=
  by
  unfold LinearMap.det
  split_ifs with h
  · convert hb _ h.some_spec.some
    apply det_aux_def'
  · exact h1
#align linear_map.det_cases LinearMap.det_cases

@[simp]
theorem det_comp (f g : M →ₗ[A] M) : (f.comp g).det = f.det * g.det :=
  LinearMap.det.map_mul f g
#align linear_map.det_comp LinearMap.det_comp

@[simp]
theorem det_id : (LinearMap.id : M →ₗ[A] M).det = 1 :=
  LinearMap.det.map_one
#align linear_map.det_id LinearMap.det_id

/-- Multiplying a map by a scalar `c` multiplies its determinant by `c ^ dim M`. -/
@[simp]
theorem det_smul {𝕜 : Type _} [Field 𝕜] {M : Type _} [AddCommGroup M] [Module 𝕜 M] (c : 𝕜)
    (f : M →ₗ[𝕜] M) : LinearMap.det (c • f) = c ^ FiniteDimensional.finrank 𝕜 M * LinearMap.det f :=
  by
  by_cases H : ∃ s : Finset M, Nonempty (Basis s 𝕜 M)
  · have : FiniteDimensional 𝕜 M := by
      rcases H with ⟨s, ⟨hs⟩⟩
      exact FiniteDimensional.of_fintype_basis hs
    simp only [← det_to_matrix (FiniteDimensional.finBasis 𝕜 M), LinearEquiv.map_smul,
      Fintype.card_fin, det_smul]
  ·
    classical
      have : FiniteDimensional.finrank 𝕜 M = 0 := finrank_eq_zero_of_not_exists_basis H
      simp [coe_det, H, this]
#align linear_map.det_smul LinearMap.det_smul

theorem det_zero' {ι : Type _} [Finite ι] [Nonempty ι] (b : Basis ι A M) :
    LinearMap.det (0 : M →ₗ[A] M) = 0 :=
  by
  haveI := Classical.decEq ι
  cases nonempty_fintype ι
  rwa [← det_to_matrix b, LinearEquiv.map_zero, det_zero]
#align linear_map.det_zero' LinearMap.det_zero'

/-- In a finite-dimensional vector space, the zero map has determinant `1` in dimension `0`,
and `0` otherwise. We give a formula that also works in infinite dimension, where we define
the determinant to be `1`. -/
@[simp]
theorem det_zero {𝕜 : Type _} [Field 𝕜] {M : Type _} [AddCommGroup M] [Module 𝕜 M] :
    LinearMap.det (0 : M →ₗ[𝕜] M) = (0 : 𝕜) ^ FiniteDimensional.finrank 𝕜 M := by
  simp only [← zero_smul 𝕜 (1 : M →ₗ[𝕜] M), det_smul, mul_one, MonoidHom.map_one]
#align linear_map.det_zero LinearMap.det_zero

theorem det_eq_one_of_subsingleton [Subsingleton M] (f : M →ₗ[R] M) : (f : M →ₗ[R] M).det = 1 :=
  by
  have b : Basis (Fin 0) R M := Basis.empty M
  rw [← f.det_to_matrix b]
  exact Matrix.det_isEmpty
#align linear_map.det_eq_one_of_subsingleton LinearMap.det_eq_one_of_subsingleton

theorem det_eq_one_of_finrank_eq_zero {𝕜 : Type _} [Field 𝕜] {M : Type _} [AddCommGroup M]
    [Module 𝕜 M] (h : FiniteDimensional.finrank 𝕜 M = 0) (f : M →ₗ[𝕜] M) :
    (f : M →ₗ[𝕜] M).det = 1 := by
  classical
    refine' @LinearMap.det_cases M _ 𝕜 _ _ _ (fun t => t = 1) f _ rfl
    intro s b
    have : IsEmpty s := by
      rw [← Fintype.card_eq_zero_iff]
      exact (FiniteDimensional.finrank_eq_card_basis b).symm.trans h
    exact Matrix.det_isEmpty
#align linear_map.det_eq_one_of_finrank_eq_zero LinearMap.det_eq_one_of_finrank_eq_zero

/-- Conjugating a linear map by a linear equiv does not change its determinant. -/
@[simp]
theorem det_conj {N : Type _} [AddCommGroup N] [Module A N] (f : M →ₗ[A] M) (e : M ≃ₗ[A] N) :
    LinearMap.det ((e : M →ₗ[A] N) ∘ₗ f ∘ₗ (e.symm : N →ₗ[A] M)) = LinearMap.det f := by
  classical
    by_cases H : ∃ s : Finset M, Nonempty (Basis s A M)
    · rcases H with ⟨s, ⟨b⟩⟩
      rw [← det_to_matrix b f, ← det_to_matrix (b.map e), to_matrix_comp (b.map e) b (b.map e),
        to_matrix_comp (b.map e) b b, ← Matrix.mul_assoc, Matrix.det_conj_of_mul_eq_one]
      ·
        rw [← to_matrix_comp, LinearEquiv.comp_coe, e.symm_trans_self, LinearEquiv.refl_toLinearMap,
          to_matrix_id]
      ·
        rw [← to_matrix_comp, LinearEquiv.comp_coe, e.self_trans_symm, LinearEquiv.refl_toLinearMap,
          to_matrix_id]
    · have H' : ¬∃ t : Finset N, Nonempty (Basis t A N) :=
        by
        contrapose! H
        rcases H with ⟨s, ⟨b⟩⟩
        exact ⟨_, ⟨(b.map e.symm).reindexFinsetRange⟩⟩
      simp only [coe_det, H, H', Pi.one_apply, dif_neg, not_false_iff]
#align linear_map.det_conj LinearMap.det_conj

/-- If a linear map is invertible, so is its determinant. -/
theorem isUnit_det {A : Type _} [CommRing A] [Module A M] (f : M →ₗ[A] M) (hf : IsUnit f) :
    IsUnit f.det := by
  obtain ⟨g, hg⟩ : ∃ g, f.comp g = 1 := hf.exists_right_inv
  have : LinearMap.det f * LinearMap.det g = 1 := by
    simp only [← LinearMap.det_comp, hg, MonoidHom.map_one]
  exact isUnit_of_mul_eq_one _ _ this
#align linear_map.is_unit_det LinearMap.isUnit_det

/-- If a linear map has determinant different from `1`, then the space is finite-dimensional. -/
theorem finiteDimensional_of_det_ne_one {𝕜 : Type _} [Field 𝕜] [Module 𝕜 M] (f : M →ₗ[𝕜] M)
    (hf : f.det ≠ 1) : FiniteDimensional 𝕜 M :=
  by
  by_cases H : ∃ s : Finset M, Nonempty (Basis s 𝕜 M)
  · rcases H with ⟨s, ⟨hs⟩⟩
    exact FiniteDimensional.of_fintype_basis hs
  ·
    classical
      simp [LinearMap.coe_det, H] at hf
      exact hf.elim
#align linear_map.finite_dimensional_of_det_ne_one LinearMap.finiteDimensional_of_det_ne_one

/-- If the determinant of a map vanishes, then the map is not onto. -/
theorem range_lt_top_of_det_eq_zero {𝕜 : Type _} [Field 𝕜] [Module 𝕜 M] {f : M →ₗ[𝕜] M}
    (hf : f.det = 0) : f.range < ⊤ :=
  by
  have : FiniteDimensional 𝕜 M := by simp [f.finite_dimensional_of_det_ne_one, hf]
  contrapose hf
  simp only [lt_top_iff_ne_top, Classical.not_not, ← is_unit_iff_range_eq_top] at hf
  exact isUnit_iff_ne_zero.1 (f.is_unit_det hf)
#align linear_map.range_lt_top_of_det_eq_zero LinearMap.range_lt_top_of_det_eq_zero

/-- If the determinant of a map vanishes, then the map is not injective. -/
theorem bot_lt_ker_of_det_eq_zero {𝕜 : Type _} [Field 𝕜] [Module 𝕜 M] {f : M →ₗ[𝕜] M}
    (hf : f.det = 0) : ⊥ < f.ker :=
  by
  have : FiniteDimensional 𝕜 M := by simp [f.finite_dimensional_of_det_ne_one, hf]
  contrapose hf
  simp only [bot_lt_iff_ne_bot, Classical.not_not, ← is_unit_iff_ker_eq_bot] at hf
  exact isUnit_iff_ne_zero.1 (f.is_unit_det hf)
#align linear_map.bot_lt_ker_of_det_eq_zero LinearMap.bot_lt_ker_of_det_eq_zero

end LinearMap

namespace LinearEquiv

/-- On a `linear_equiv`, the domain of `linear_map.det` can be promoted to `Rˣ`. -/
protected def det : (M ≃ₗ[R] M) →* Rˣ :=
  (Units.map (LinearMap.det : (M →ₗ[R] M) →* R)).comp
    (LinearMap.GeneralLinearGroup.generalLinearEquiv R M).symm.toMonoidHom
#align linear_equiv.det LinearEquiv.det

@[simp]
theorem coe_det (f : M ≃ₗ[R] M) : ↑f.det = LinearMap.det (f : M →ₗ[R] M) :=
  rfl
#align linear_equiv.coe_det LinearEquiv.coe_det

@[simp]
theorem coe_inv_det (f : M ≃ₗ[R] M) : ↑f.det⁻¹ = LinearMap.det (f.symm : M →ₗ[R] M) :=
  rfl
#align linear_equiv.coe_inv_det LinearEquiv.coe_inv_det

@[simp]
theorem det_refl : (LinearEquiv.refl R M).det = 1 :=
  Units.ext <| LinearMap.det_id
#align linear_equiv.det_refl LinearEquiv.det_refl

@[simp]
theorem det_trans (f g : M ≃ₗ[R] M) : (f.trans g).det = g.det * f.det :=
  map_mul _ g f
#align linear_equiv.det_trans LinearEquiv.det_trans

@[simp]
theorem det_symm (f : M ≃ₗ[R] M) : f.symm.det = f.det⁻¹ :=
  map_inv _ f
#align linear_equiv.det_symm LinearEquiv.det_symm

/-- Conjugating a linear equiv by a linear equiv does not change its determinant. -/
@[simp]
theorem det_conj (f : M ≃ₗ[R] M) (e : M ≃ₗ[R] M') : ((e.symm.trans f).trans e).det = f.det := by
  rw [← Units.eq_iff, coe_det, coe_det, ← comp_coe, ← comp_coe, LinearMap.det_conj]
#align linear_equiv.det_conj LinearEquiv.det_conj

end LinearEquiv

/-- The determinants of a `linear_equiv` and its inverse multiply to 1. -/
@[simp]
theorem LinearEquiv.det_mul_det_symm {A : Type _} [CommRing A] [Module A M] (f : M ≃ₗ[A] M) :
    (f : M →ₗ[A] M).det * (f.symm : M →ₗ[A] M).det = 1 := by simp [← LinearMap.det_comp]
#align linear_equiv.det_mul_det_symm LinearEquiv.det_mul_det_symm

/-- The determinants of a `linear_equiv` and its inverse multiply to 1. -/
@[simp]
theorem LinearEquiv.det_symm_mul_det {A : Type _} [CommRing A] [Module A M] (f : M ≃ₗ[A] M) :
    (f.symm : M →ₗ[A] M).det * (f : M →ₗ[A] M).det = 1 := by simp [← LinearMap.det_comp]
#align linear_equiv.det_symm_mul_det LinearEquiv.det_symm_mul_det

-- Cannot be stated using `linear_map.det` because `f` is not an endomorphism.
theorem LinearEquiv.isUnit_det (f : M ≃ₗ[R] M') (v : Basis ι R M) (v' : Basis ι R M') :
    IsUnit (LinearMap.toMatrix v v' f).det :=
  by
  apply is_unit_det_of_left_inverse
  simpa using (LinearMap.toMatrix_comp v v' v f.symm f).symm
#align linear_equiv.is_unit_det LinearEquiv.isUnit_det

/-- Specialization of `linear_equiv.is_unit_det` -/
theorem LinearEquiv.isUnit_det' {A : Type _} [CommRing A] [Module A M] (f : M ≃ₗ[A] M) :
    IsUnit (LinearMap.det (f : M →ₗ[A] M)) :=
  isUnit_of_mul_eq_one _ _ f.det_mul_det_symm
#align linear_equiv.is_unit_det' LinearEquiv.isUnit_det'

/-- The determinant of `f.symm` is the inverse of that of `f` when `f` is a linear equiv. -/
theorem LinearEquiv.det_coe_symm {𝕜 : Type _} [Field 𝕜] [Module 𝕜 M] (f : M ≃ₗ[𝕜] M) :
    (f.symm : M →ₗ[𝕜] M).det = (f : M →ₗ[𝕜] M).det⁻¹ := by
  field_simp [IsUnit.ne_zero f.is_unit_det']
#align linear_equiv.det_coe_symm LinearEquiv.det_coe_symm

/-- Builds a linear equivalence from a linear map whose determinant in some bases is a unit. -/
@[simps]
def LinearEquiv.ofIsUnitDet {f : M →ₗ[R] M'} {v : Basis ι R M} {v' : Basis ι R M'}
    (h : IsUnit (LinearMap.toMatrix v v' f).det) : M ≃ₗ[R] M'
    where
  toFun := f
  map_add' := f.map_add
  map_smul' := f.map_smul
  invFun := toLin v' v (toMatrix v v' f)⁻¹
  left_inv x :=
    calc
      toLin v' v (toMatrix v v' f)⁻¹ (f x) = toLin v v ((toMatrix v v' f)⁻¹ ⬝ toMatrix v v' f) x :=
        by rw [to_lin_mul v v' v, to_lin_to_matrix, LinearMap.comp_apply]
      _ = x := by simp [h]

  right_inv x :=
    calc
      f (toLin v' v (toMatrix v v' f)⁻¹ x) =
          toLin v' v' (toMatrix v v' f ⬝ (toMatrix v v' f)⁻¹) x :=
        by rw [to_lin_mul v' v v', LinearMap.comp_apply, to_lin_to_matrix v v']
      _ = x := by simp [h]

#align linear_equiv.of_is_unit_det LinearEquiv.ofIsUnitDet

@[simp]
theorem LinearEquiv.coe_ofIsUnitDet {f : M →ₗ[R] M'} {v : Basis ι R M} {v' : Basis ι R M'}
    (h : IsUnit (LinearMap.toMatrix v v' f).det) : (LinearEquiv.ofIsUnitDet h : M →ₗ[R] M') = f :=
  by
  ext x
  rfl
#align linear_equiv.coe_of_is_unit_det LinearEquiv.coe_ofIsUnitDet

/-- Builds a linear equivalence from a linear map on a finite-dimensional vector space whose
determinant is nonzero. -/
@[reducible]
def LinearMap.equivOfDetNeZero {𝕜 : Type _} [Field 𝕜] {M : Type _} [AddCommGroup M] [Module 𝕜 M]
    [FiniteDimensional 𝕜 M] (f : M →ₗ[𝕜] M) (hf : LinearMap.det f ≠ 0) : M ≃ₗ[𝕜] M :=
  have :
    IsUnit
      (LinearMap.toMatrix (FiniteDimensional.finBasis 𝕜 M) (FiniteDimensional.finBasis 𝕜 M)
          f).det :=
    by simp only [LinearMap.det_toMatrix, isUnit_iff_ne_zero.2 hf]
  LinearEquiv.ofIsUnitDet this
#align linear_map.equiv_of_det_ne_zero LinearMap.equivOfDetNeZero

theorem LinearMap.associated_det_of_eq_comp (e : M ≃ₗ[R] M) (f f' : M →ₗ[R] M)
    (h : ∀ x, f x = f' (e x)) : Associated f.det f'.det :=
  by
  suffices Associated (f' ∘ₗ ↑e).det f'.det
    by
    convert this using 2
    ext x
    exact h x
  rw [← mul_one f'.det, LinearMap.det_comp]
  exact Associated.mul_left _ (associated_one_iff_is_unit.mpr e.is_unit_det')
#align linear_map.associated_det_of_eq_comp LinearMap.associated_det_of_eq_comp

theorem LinearMap.associated_det_comp_equiv {N : Type _} [AddCommGroup N] [Module R N]
    (f : N →ₗ[R] M) (e e' : M ≃ₗ[R] N) : Associated (f ∘ₗ ↑e).det (f ∘ₗ ↑e').det :=
  by
  refine' LinearMap.associated_det_of_eq_comp (e.trans e'.symm) _ _ _
  intro x
  simp only [LinearMap.comp_apply, LinearEquiv.coe_coe, LinearEquiv.trans_apply,
    LinearEquiv.apply_symm_apply]
#align linear_map.associated_det_comp_equiv LinearMap.associated_det_comp_equiv

/-- The determinant of a family of vectors with respect to some basis, as an alternating
multilinear map. -/
def Basis.det : AlternatingMap R M R ι
    where
  toFun v := det (e.toMatrix v)
  map_add' := by
    intro inst v i x y
    cases Subsingleton.elim inst ‹_›
    simp only [e.to_matrix_update, LinearEquiv.map_add, Finsupp.coe_add]
    exact det_update_column_add _ _ _ _
  map_smul' := by
    intro inst u i c x
    cases Subsingleton.elim inst ‹_›
    simp only [e.to_matrix_update, Algebra.id.smul_eq_mul, LinearEquiv.map_smul]
    apply det_update_column_smul
  map_eq_zero_of_eq' := by
    intro v i j h hij
    rw [← Function.update_eq_self i v, h, ← det_transpose, e.to_matrix_update, ←
      update_row_transpose, ← e.to_matrix_transpose_apply]
    apply det_zero_of_row_eq hij
    rw [update_row_ne hij.symm, update_row_self]
#align basis.det Basis.det

theorem Basis.det_apply (v : ι → M) : e.det v = det (e.toMatrix v) :=
  rfl
#align basis.det_apply Basis.det_apply

theorem Basis.det_self : e.det e = 1 := by simp [e.det_apply]
#align basis.det_self Basis.det_self

@[simp]
theorem Basis.det_isEmpty [IsEmpty ι] : e.det = AlternatingMap.constOfIsEmpty R M 1 :=
  by
  ext v
  exact Matrix.det_isEmpty
#align basis.det_is_empty Basis.det_isEmpty

/-- `basis.det` is not the zero map. -/
theorem Basis.det_ne_zero [Nontrivial R] : e.det ≠ 0 := fun h => by simpa [h] using e.det_self
#align basis.det_ne_zero Basis.det_ne_zero

theorem is_basis_iff_det {v : ι → M} :
    LinearIndependent R v ∧ span R (Set.range v) = ⊤ ↔ IsUnit (e.det v) :=
  by
  constructor
  · rintro ⟨hli, hspan⟩
    set v' := Basis.mk hli hspan.ge with v'_eq
    rw [e.det_apply]
    convert LinearEquiv.isUnit_det (LinearEquiv.refl _ _) v' e using 2
    ext (i j)
    simp
  · intro h
    rw [Basis.det_apply, Basis.toMatrix_eq_toMatrix_constr] at h
    set v' := Basis.map e (LinearEquiv.ofIsUnitDet h) with v'_def
    have : ⇑v' = v := by
      ext i
      rw [v'_def, Basis.map_apply, LinearEquiv.ofIsUnitDet_apply, e.constr_basis]
    rw [← this]
    exact ⟨v'.linear_independent, v'.span_eq⟩
#align is_basis_iff_det is_basis_iff_det

theorem Basis.isUnit_det (e' : Basis ι R M) : IsUnit (e.det e') :=
  (is_basis_iff_det e).mp ⟨e'.LinearIndependent, e'.span_eq⟩
#align basis.is_unit_det Basis.isUnit_det

/-- Any alternating map to `R` where `ι` has the cardinality of a basis equals the determinant
map with respect to that basis, multiplied by the value of that alternating map on that basis. -/
theorem AlternatingMap.eq_smul_basis_det (f : AlternatingMap R M R ι) : f = f e • e.det :=
  by
  refine' Basis.ext_alternating e fun i h => _
  let σ : Equiv.Perm ι := Equiv.ofBijective i (Finite.injective_iff_bijective.1 h)
  change f (e ∘ σ) = (f e • e.det) (e ∘ σ)
  simp [AlternatingMap.map_perm, Basis.det_self]
#align alternating_map.eq_smul_basis_det AlternatingMap.eq_smul_basis_det

@[simp]
theorem AlternatingMap.map_basis_eq_zero_iff {ι : Type _} [Finite ι] (e : Basis ι R M)
    (f : AlternatingMap R M R ι) : f e = 0 ↔ f = 0 :=
  ⟨fun h => by
    cases nonempty_fintype ι
    letI := Classical.decEq ι
    simpa [h] using f.eq_smul_basis_det e, fun h => h.symm ▸ AlternatingMap.zero_apply _⟩
#align alternating_map.map_basis_eq_zero_iff AlternatingMap.map_basis_eq_zero_iff

theorem AlternatingMap.map_basis_ne_zero_iff {ι : Type _} [Finite ι] (e : Basis ι R M)
    (f : AlternatingMap R M R ι) : f e ≠ 0 ↔ f ≠ 0 :=
  not_congr <| f.map_basis_eq_zero_iff e
#align alternating_map.map_basis_ne_zero_iff AlternatingMap.map_basis_ne_zero_iff

variable {A : Type _} [CommRing A] [Module A M]

@[simp]
theorem Basis.det_comp (e : Basis ι A M) (f : M →ₗ[A] M) (v : ι → M) :
    e.det (f ∘ v) = f.det * e.det v := by
  rw [Basis.det_apply, Basis.det_apply, ← f.det_to_matrix e, ← Matrix.det_mul,
    e.to_matrix_eq_to_matrix_constr (f ∘ v), e.to_matrix_eq_to_matrix_constr v, ← to_matrix_comp,
    e.constr_comp]
#align basis.det_comp Basis.det_comp

@[simp]
theorem Basis.det_comp_basis [Module A M'] (b : Basis ι A M) (b' : Basis ι A M') (f : M →ₗ[A] M') :
    b'.det (f ∘ b) = LinearMap.det (f ∘ₗ (b'.Equiv b (Equiv.refl ι) : M' →ₗ[A] M)) :=
  by
  rw [Basis.det_apply, ← LinearMap.det_toMatrix b', LinearMap.toMatrix_comp _ b, Matrix.det_mul,
    LinearMap.toMatrix_basis_equiv, Matrix.det_one, mul_one]
  congr 1; ext (i j)
  rw [Basis.toMatrix_apply, LinearMap.toMatrix_apply]
#align basis.det_comp_basis Basis.det_comp_basis

theorem Basis.det_reindex {ι' : Type _} [Fintype ι'] [DecidableEq ι'] (b : Basis ι R M) (v : ι' → M)
    (e : ι ≃ ι') : (b.reindex e).det v = b.det (v ∘ e) := by
  rw [Basis.det_apply, Basis.toMatrix_reindex', det_reindex_alg_equiv, Basis.det_apply]
#align basis.det_reindex Basis.det_reindex

theorem Basis.det_reindex_symm {ι' : Type _} [Fintype ι'] [DecidableEq ι'] (b : Basis ι R M)
    (v : ι → M) (e : ι' ≃ ι) : (b.reindex e.symm).det (v ∘ e) = b.det v := by
  rw [Basis.det_reindex, Function.comp.assoc, e.self_comp_symm, Function.comp.right_id]
#align basis.det_reindex_symm Basis.det_reindex_symm

@[simp]
theorem Basis.det_map (b : Basis ι R M) (f : M ≃ₗ[R] M') (v : ι → M') :
    (b.map f).det v = b.det (f.symm ∘ v) := by
  rw [Basis.det_apply, Basis.toMatrix_map, Basis.det_apply]
#align basis.det_map Basis.det_map

theorem Basis.det_map' (b : Basis ι R M) (f : M ≃ₗ[R] M') :
    (b.map f).det = b.det.compLinearMap f.symm :=
  AlternatingMap.ext <| b.det_map f
#align basis.det_map' Basis.det_map'

@[simp]
theorem Pi.basisFun_det : (Pi.basisFun R ι).det = Matrix.detRowAlternating :=
  by
  ext M
  rw [Basis.det_apply, Basis.CoePiBasisFun.toMatrix_eq_transpose, det_transpose]
#align pi.basis_fun_det Pi.basisFun_det

/-- If we fix a background basis `e`, then for any other basis `v`, we can characterise the
coordinates provided by `v` in terms of determinants relative to `e`. -/
theorem Basis.det_smul_mk_coord_eq_det_update {v : ι → M} (hli : LinearIndependent R v)
    (hsp : ⊤ ≤ span R (range v)) (i : ι) :
    e.det v • (Basis.mk hli hsp).Coord i = e.det.toMultilinearMap.toLinearMap v i :=
  by
  apply (Basis.mk hli hsp).ext
  intro k
  rcases eq_or_ne k i with (rfl | hik) <;>
    simp only [Algebra.id.smul_eq_mul, Basis.coe_mk, LinearMap.smul_apply, LinearMap.coe_mk,
      MultilinearMap.toLinearMap_apply]
  · rw [Basis.mk_coord_apply_eq, mul_one, update_eq_self]
    congr
  · rw [Basis.mk_coord_apply_ne hik, MulZeroClass.mul_zero, eq_comm]
    exact e.det.map_eq_zero_of_eq _ (by simp [hik, Function.update_apply]) hik
#align basis.det_smul_mk_coord_eq_det_update Basis.det_smul_mk_coord_eq_det_update

/-- If a basis is multiplied columnwise by scalars `w : ι → Rˣ`, then the determinant with respect
to this basis is multiplied by the product of the inverse of these scalars. -/
theorem Basis.det_unitsSmul (e : Basis ι R M) (w : ι → Rˣ) :
    (e.units_smul w).det = (↑(∏ i, w i)⁻¹ : R) • e.det :=
  by
  ext f
  change
    (Matrix.det fun i j => (e.units_smul w).repr (f j) i) =
      (↑(∏ i, w i)⁻¹ : R) • Matrix.det fun i j => e.repr (f j) i
  simp only [e.repr_units_smul]
  convert Matrix.det_mul_column (fun i => (↑(w i)⁻¹ : R)) fun i j => e.repr (f j) i
  simp [← Finset.prod_inv_distrib]
#align basis.det_units_smul Basis.det_unitsSmul

/-- The determinant of a basis constructed by `units_smul` is the product of the given units. -/
@[simp]
theorem Basis.det_unitsSmul_self (w : ι → Rˣ) : e.det (e.units_smul w) = ∏ i, w i := by
  simp [Basis.det_apply]
#align basis.det_units_smul_self Basis.det_unitsSmul_self

/-- The determinant of a basis constructed by `is_unit_smul` is the product of the given units. -/
@[simp]
theorem Basis.det_isUnitSmul {w : ι → R} (hw : ∀ i, IsUnit (w i)) :
    e.det (e.isUnitSmul hw) = ∏ i, w i :=
  e.det_unitsSmul_self _
#align basis.det_is_unit_smul Basis.det_isUnitSmul


opaque f : Nat → Nat
@[simp] axiom fEq (x : Nat) (h : x ≠ 0) : f x = x

example (x : Nat) (h : x ≠ 0) : f x = x + 0 := by
  simp (discharger := trace_state; exact (fun h' => h') h)

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (discharger := trace_state; assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (discharger := assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (disch := assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  conv => lhs; simp (disch := assumption)
  trace_state
  conv => rhs; simp (disch := assumption)
  trace_state
  assumption