-- from lean4 src/doc/examples/tc.lean

namespace tc

/-!
# A Certified Type Checker

In this example, we build a certified type checker for a simple expression
language.

Remark: this example is based on an example in the book [Certified Programming with Dependent Types](http://adam.chlipala.net/cpdt/) by Adam Chlipala.
-/
inductive Expr where
  | nat  : Nat → Expr
  | plus : Expr → Expr → Expr
  | bool : Bool → Expr
  | and  : Expr → Expr → Expr
  deriving Repr

def e1 : Expr := .nat 42
#eval e1

def e2 : Expr := .nat 17
#eval e2

def e3 : Expr := .bool false
#eval e3

def e4 : Expr := .bool true
#eval e4

def e5 : Expr := .plus e1 e2
#eval e5

def e6 : Expr := .plus e1 e3
#eval e6

def e7 : Expr := .and e1 e3
#eval e7

def e8 : Expr := .and e4 e3
#eval e8

/-!
We define a simple language of types using the inductive datatype `Ty`, and
its typing rules using the inductive predicate `HasType`.
-/
inductive Ty where
  | nat
  | bool
  deriving DecidableEq, Repr

inductive HasType : Expr → Ty → Prop
  | nat  : HasType (.nat v) .nat
  | plus : HasType a .nat → HasType b .nat → HasType (.plus a b) .nat
  | bool : HasType (.bool v) .bool
  | and  : HasType a .bool → HasType b .bool → HasType (.and a b) .bool

/-!
We can easily show that if `e` has type `t₁` and type `t₂`, then `t₁` and `t₂` must be equal
by using the the `cases` tactic. This tactic creates a new subgoal for every constructor,
and automatically discharges unreachable cases. The tactic combinator `tac₁ <;> tac₂` applies
`tac₂` to each subgoal produced by `tac₁`. Then, the tactic `rfl` is used to close all produced
goals using reflexivity.
-/
theorem HasType.det (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
  cases h₁ <;> cases h₂ <;> rfl

/-!
The inductive type `Maybe p` has two contructors: `found a h` and `unknown`.
The former contains an element `a : α` and a proof that `a` satisfies the predicate `p`.
The constructor `unknown` is used to encode "failure".
-/

inductive Maybe (p : α → Prop) where
  | found : (a : α) → p a → Maybe p
  | unknown

/-!
We define a notation for `Maybe` that is similar to the builtin notation for the Lean builtin type `Subtype`.
-/
notation "{{ " x " | " p " }}" => Maybe (fun x => p)

/-!
The function `Expr.typeCheck e` returns a type `ty` and a proof that `e` has type `ty`,
or `unknown`.
Recall that, `def Expr.typeCheck ...` in Lean is notation for `namespace Expr def typeCheck ... end Expr`.
The term `.found .nat .nat` is sugar for `Maybe.found Ty.nat HasType.nat`. Lean can infer the namespaces using
the expected types.
-/
def Expr.typeCheck (e : Expr) : {{ ty | HasType e ty }} :=
  match e with
  | nat ..   => .found .nat .nat
  | bool ..  => .found .bool .bool
  | plus a b =>
    match a.typeCheck, b.typeCheck with
    | .found .nat h₁, .found .nat h₂ => .found .nat (.plus h₁ h₂)
    | _, _ => .unknown
  | and a b =>
    match a.typeCheck, b.typeCheck with
    | .found .bool h₁, .found .bool h₂ => .found .bool (.and h₁ h₂)
    | _, _ => .unknown

-- def h1 := e3.typeCheck = Maybe.found Ty.bool (.bool e3 Ty.bool)
-- #eval h1

theorem Expr.typeCheck_correct (h₁ : HasType e ty) (h₂ : e.typeCheck ≠ .unknown)
        : e.typeCheck = .found ty h := by
  revert h₂
  cases typeCheck e with
  | found ty' h' => intro; have := HasType.det h₁ h'; subst this; rfl
  | unknown => intros; contradiction

-- def c3 := e3.typeCheck_correct

/-!
Now, we prove that if `Expr.typeCheck e` returns `Maybe.unknown`, then forall `ty`, `HasType e ty` does not hold.
The notation `e.typeCheck` is sugar for `Expr.typeCheck e`. Lean can infer this because we explicitly said that `e` has type `Expr`.
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used to to rename "inaccessible" variables.
We say a variable is inaccessible if it is introduced by a tactic (e.g., `cases`) or has been shadowed by another variable introduced
by the user. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
the cases corresponding to the constructors `Expr.nat` and `Expr.bool`.
-/
theorem Expr.typeCheck_complete {e : Expr} : e.typeCheck = .unknown → ¬ HasType e ty := by
  induction e with simp [typeCheck]
  | plus a b iha ihb =>
    split
    next => intros; contradiction
    next ra rb hnp =>
      -- Recall that `hnp` is a hypothesis generated by the `split` tactic
      -- that asserts the previous case was not taken
      intro h ht
      cases ht with
      | plus h₁ h₂ => exact hnp h₁ h₂ (typeCheck_correct h₁ (iha · h₁)) (typeCheck_correct h₂ (ihb · h₂))
  | and a b iha ihb =>
    split
    next => intros; contradiction
    next ra rb hnp =>
      intro h ht
      cases ht with
      | and h₁ h₂ =>  exact hnp h₁ h₂ (typeCheck_correct h₁ (iha · h₁)) (typeCheck_correct h₂ (ihb · h₂))

/-!
Finally, we show that type checking for `e` can be decided using `Expr.typeCheck`.
-/
instance (e : Expr) (t : Ty) : Decidable (HasType e t) :=
  match h' : e.typeCheck with
  | .found t' ht' =>
    if heq : t = t' then
      isTrue (heq ▸ ht')
    else
      isFalse fun ht => heq (HasType.det ht ht')
  | .unknown => isFalse (Expr.typeCheck_complete h')

end tc


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

! This file was ported from Lean 3 source module combinatorics.simple_graph.degree_sum
! leanprover-community/mathlib commit 90659cbe25e59ec302e2fb92b00e9732160cc620
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Basic
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Data.Nat.Parity
import Mathlib.Data.ZMod.Parity

/-!
# Degree-sum formula and handshaking lemma

The degree-sum formula is that the sum of the degrees of the vertices in
a finite graph is equal to twice the number of edges.  The handshaking lemma,
a corollary, is that the number of odd-degree vertices is even.

## Main definitions

- `SimpleGraph.sum_degrees_eq_twice_card_edges` is the degree-sum formula.
- `SimpleGraph.even_card_odd_degree_vertices` is the handshaking lemma.
- `SimpleGraph.odd_card_odd_degree_vertices_ne` is that the number of odd-degree
  vertices different from a given odd-degree vertex is odd.
- `SimpleGraph.exists_ne_odd_degree_of_exists_odd_degree` is that the existence of an
  odd-degree vertex implies the existence of another one.

## Implementation notes

We give a combinatorial proof by using the facts that (1) the map from
darts to vertices is such that each fiber has cardinality the degree
of the corresponding vertex and that (2) the map from darts to edges is 2-to-1.

## Tags

simple graphs, sums, degree-sum formula, handshaking lemma
-/

open Finset

open BigOperators

namespace SimpleGraph

universe u

variable {V : Type u} (G : SimpleGraph V)

section DegreeSum

variable [Fintype V] [DecidableRel G.Adj]

-- Porting note: Changed to `Fintype (Sym2 V)` to match Combinatorics.SimpleGraph.Basic
variable [Fintype (Sym2 V)]

theorem dart_fst_fiber [DecidableEq V] (v : V) :
    (univ.filter fun d : G.Dart => d.fst = v) = univ.image (G.dartOfNeighborSet v) := by
  ext d
  simp only [mem_image, true_and_iff, mem_filter, SetCoe.exists, mem_univ, exists_prop_of_true]
  constructor
  · rintro rfl
    exact ⟨_, d.is_adj, by ext <;> rfl⟩
  · rintro ⟨e, he, rfl⟩
    rfl
#align simple_graph.dart_fst_fiber SimpleGraph.dart_fst_fiber

theorem dart_fst_fiber_card_eq_degree [DecidableEq V] (v : V) :
    (univ.filter fun d : G.Dart => d.fst = v).card = G.degree v := by
  simpa only [dart_fst_fiber, Finset.card_univ, card_neighborSet_eq_degree] using
    card_image_of_injective univ (G.dartOfNeighborSet_injective v)
#align simple_graph.dart_fst_fiber_card_eq_degree SimpleGraph.dart_fst_fiber_card_eq_degree

theorem dart_card_eq_sum_degrees : Fintype.card G.Dart = ∑ v, G.degree v := by
  haveI := Classical.decEq V
  simp only [← card_univ, ← dart_fst_fiber_card_eq_degree]
  exact card_eq_sum_card_fiberwise (by simp)
#align simple_graph.dart_card_eq_sum_degrees SimpleGraph.dart_card_eq_sum_degrees

variable {G} [DecidableEq V]

theorem Dart.edge_fiber (d : G.Dart) :
    (univ.filter fun d' : G.Dart => d'.edge = d.edge) = {d, d.symm} :=
  Finset.ext fun d' => by simpa using dart_edge_eq_iff d' d
#align simple_graph.dart.edge_fiber SimpleGraph.Dart.edge_fiber

variable (G)

theorem dart_edge_fiber_card (e : Sym2 V) (h : e ∈ G.edgeSet) :
    (univ.filter fun d : G.Dart => d.edge = e).card = 2 := by
  refine' Sym2.ind (fun v w h => _) e h
  let d : G.Dart := ⟨(v, w), h⟩
  convert congr_arg card d.edge_fiber
  rw [card_insert_of_not_mem, card_singleton]
  rw [mem_singleton]
  exact d.symm_ne.symm
#align simple_graph.dart_edge_fiber_card SimpleGraph.dart_edge_fiber_card

theorem dart_card_eq_twice_card_edges : Fintype.card G.Dart = 2 * G.edgeFinset.card := by
  rw [← card_univ]
  rw [@card_eq_sum_card_fiberwise _ _ _ Dart.edge _ G.edgeFinset fun d _h =>
      by rw [mem_edgeFinset]; apply Dart.edge_mem]
  rw [← mul_comm, sum_const_nat]
  intro e h
  apply G.dart_edge_fiber_card e
  rwa [← mem_edgeFinset]
#align simple_graph.dart_card_eq_twice_card_edges SimpleGraph.dart_card_eq_twice_card_edges

/-- The degree-sum formula.  This is also known as the handshaking lemma, which might
more specifically refer to `SimpleGraph.even_card_odd_degree_vertices`. -/
theorem sum_degrees_eq_twice_card_edges : (∑ v, G.degree v) = 2 * G.edgeFinset.card :=
  G.dart_card_eq_sum_degrees.symm.trans G.dart_card_eq_twice_card_edges
#align simple_graph.sum_degrees_eq_twice_card_edges SimpleGraph.sum_degrees_eq_twice_card_edges

end DegreeSum

/-- The handshaking lemma.  See also `SimpleGraph.sum_degrees_eq_twice_card_edges`. -/
theorem even_card_odd_degree_vertices [Fintype V] [DecidableRel G.Adj] :
    Even (univ.filter fun v => Odd (G.degree v)).card := by
  classical
    have h := congr_arg (fun n => ↑n : ℕ → ZMod 2) G.sum_degrees_eq_twice_card_edges
    simp only [ZMod.nat_cast_self, MulZeroClass.zero_mul, Nat.cast_mul] at h
    rw [Nat.cast_sum, ← sum_filter_ne_zero] at h
    rw [@sum_congr _ _ _ _ (fun v => (G.degree v : ZMod 2)) (fun _v => (1 : ZMod 2)) _ rfl] at h
    · simp only [filter_congr, mul_one, nsmul_eq_mul, sum_const, Ne.def] at h
      rw [← ZMod.eq_zero_iff_even]
      convert h
      exact ZMod.ne_zero_iff_odd.symm
    · intro v
      simp only [true_and_iff, mem_filter, mem_univ, Ne.def]
      rw [ZMod.eq_zero_iff_even, ZMod.eq_one_iff_odd, Nat.odd_iff_not_even, imp_self]
      trivial
#align simple_graph.even_card_odd_degree_vertices SimpleGraph.even_card_odd_degree_vertices

theorem odd_card_odd_degree_vertices_ne [Fintype V] [DecidableEq V] [DecidableRel G.Adj] (v : V)
    (h : Odd (G.degree v)) : Odd (univ.filter fun w => w ≠ v ∧ Odd (G.degree w)).card := by
  rcases G.even_card_odd_degree_vertices with ⟨k, hg⟩
  have hk : 0 < k := by
    have hh : (filter (fun v : V => Odd (G.degree v)) univ).Nonempty := by
      use v
      simp only [true_and_iff, mem_filter, mem_univ]
      exact h
    rwa [← card_pos, hg, ← two_mul, zero_lt_mul_left] at hh
    exact zero_lt_two
  have hc : (fun w : V => w ≠ v ∧ Odd (G.degree w)) = fun w : V => Odd (G.degree w) ∧ w ≠ v := by
    ext w
    rw [and_comm]
  simp only [hc, filter_congr]
  rw [← filter_filter, filter_ne', card_erase_of_mem]
  · refine' ⟨k - 1, tsub_eq_of_eq_add <| hg.trans _⟩
    rw [add_assoc, one_add_one_eq_two, ← Nat.mul_succ, ← two_mul]
    congr
    exact (tsub_add_cancel_of_le <| Nat.succ_le_iff.2 hk).symm
  · simpa only [true_and_iff, mem_filter, mem_univ]
#align simple_graph.odd_card_odd_degree_vertices_ne SimpleGraph.odd_card_odd_degree_vertices_ne

theorem exists_ne_odd_degree_of_exists_odd_degree [Fintype V] [DecidableRel G.Adj] (v : V)
    (h : Odd (G.degree v)) : ∃ w : V, w ≠ v ∧ Odd (G.degree w) := by
  haveI := Classical.decEq V
  rcases G.odd_card_odd_degree_vertices_ne v h with ⟨k, hg⟩
  have hg' : (filter (fun w : V => w ≠ v ∧ Odd (G.degree w)) univ).card > 0 := by
    rw [hg]
    apply Nat.succ_pos
  rcases card_pos.mp hg' with ⟨w, hw⟩
  simp only [true_and_iff, mem_filter, mem_univ, Ne.def] at hw
  exact ⟨w, hw⟩
#align simple_graph.exists_ne_odd_degree_of_exists_odd_degree SimpleGraph.exists_ne_odd_degree_of_exists_odd_degree

end SimpleGraph


-- Cancelativa_de_la_suma_por_la_derecha.lean
-- Cancelativa de la suma por la derecha.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 1-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo y a, b, c ∈ R tales que
--    a + b = c + b
-- entonces
--    a = c
-- ---------------------------------------------------------------------

import algebra.ring
import tactic

variables {R : Type*} [ring R]
variables {a b c : R}

-- 1ª demostración
-- ===============

example
  (h : a + b = c + b)
  : a = c :=
calc a
     = a + 0        : by rw add_zero
 ... = a + (b + -b) : by rw add_right_neg
 ... = (a + b) + -b : by rw add_assoc
 ... = (c + b) + -b : by rw h
 ... = c + (b + -b) : by rw ← add_assoc
 ... = c + 0        : by rw ← add_right_neg
 ... = c            : by rw add_zero

-- 2ª demostración
-- ===============

example
  (h : a + b = c + b)
  : a = c :=
calc a
     = a + 0        : by simp
 ... = a + (b + -b) : by simp
 ... = (a + b) + -b : by simp
 ... = (c + b) + -b : by rw h
 ... = c + (b + -b) : by simp
 ... = c + 0        : by simp
 ... = c            : by simp

-- 3ª demostración
-- ===============

lemma aux : (a + b) + -b = a :=
by finish

example
  (h : a + b = c + b)
  : a = c :=
calc a
     = (a + b) + -b : aux.symm
 ... = (c + b) + -b : congr_arg (λ x, x + -b) h
 ... = c            : aux

-- 4ª demostración
-- ===============

example
  (h : a + b = c + b)
  : a = c :=
by finish


import group_theory.subgroup.basic
import analysis.normed.group.basic
import topology.metric_space.basic

import group_theory.free_group
import data.set.basic
import algebra.hom.group

import topology.metric_space.basic
import data.list.basic
import data.finset
import data.set
import data.real.ennreal
import order.complete_lattice
import order.bounded_order

import fg_norm

noncomputable theory

theorem nat.Inf_le_Inf {s t : set ℕ} (hs : s.nonempty) (ht : s ⊆ t) : Inf t ≤ Inf s
:= nat.Inf_le $ ht $ nat.Inf_mem hs

@[class]
structure generated_group (G : Type*) extends group G :=
(gens : set G)
(closure_eq_top : subgroup.closure gens = ⊤)

variables {G : Type*} [generated_group G] [decidable_eq G]

namespace generated_group

open generated_group

def of (x : free_group (gens : set G)) : G := begin
  refine free_group.lift _ x,
  intro g,
  use g,
end

def of_mul (x : free_group (gens : set G)) (y : free_group (gens : set G)) : of (x * y) = of x * of y :=
begin
  unfold of,
  simp,
end

def words (x : G) : set (free_group (gens : set G)) := of ⁻¹' { x }

def words_of {x : G} {w : free_group (gens : set G)} (h : w ∈ words x) : of w = x :=
begin
  unfold words at h,
  simp only [set.mem_preimage, set.mem_singleton_iff] at h,
  exact h,
end

def words_inv (x : G) : (words x) = has_inv.inv '' (words x⁻¹) :=
begin
  unfold words,
  ext,
  split,
  {
    simp only [set.mem_preimage, set.mem_singleton_iff, set.image_inv, set.mem_inv],
    intro h,
    rw ← h,
    simp only [map_inv, of],
  },
  {
    simp only [set.image_inv, set.mem_inv, set.mem_preimage, set.mem_singleton_iff],
    intro h,
    have hk : (of x_1⁻¹)⁻¹ = x,
    { exact inv_eq_iff_inv_eq.mp (eq.symm h) },
    rw ← hk,
    simp [of],
  },
end

def push_inv (x : G) : (words x⁻¹) = has_inv.inv '' (words x) :=
begin
  have k := words_inv x⁻¹,
  finish,
end

def words_nonempty (x : G) : (words x).nonempty :=
begin
  have hk := @closure_eq_top G _,
  unfold words,
  unfold set.nonempty,
  simp only [set.mem_preimage, set.mem_singleton_iff],

  set f : (gens → G) := (λ a : (gens : set G), a) with hf,

  have hr : set.range f = (gens : set G),
  {
    ext,
    split,
    { finish, },
    { intro h,
      use x_1,
      use h,
      finish, },
  },

  have h : _ = subgroup.closure (set.range f) := free_group.lift.range_eq_closure  ,

  rw hr at h,
  rw hk at h,

  rw monoid_hom.range_top_iff_surjective at h,

  unfold of,

  rw ← hf ,

  exact h x,
end

def nat_norm (x : G) : nat := Inf $ free_group.nat_norm '' (words x)

def norm (x : G) : ℝ := nat_norm x

instance : has_norm G := ⟨norm⟩

def dist (x : G) (y : G) : ℝ := ∥ x * y⁻¹ ∥

instance : has_dist G := ⟨dist⟩

def norm_eq (x : G) : ∥ x ∥ = nat_norm x := rfl

def norm_inv_le (x : G) : ∥ x⁻¹ ∥ ≤ ∥ x ∥ :=
begin
  rw norm_eq, rw norm_eq,
  norm_cast,

  rw nat_norm, rw nat_norm,
  apply nat.Inf_le_Inf,
  {
    have hne := words_nonempty x,
    exact set.nonempty.image free_group.nat_norm hne,
  },
  {
    rw push_inv,
    intros nw hnw,
    simp only [set.mem_image] at hnw,
    simp only [set.image_inv, set.mem_image, set.mem_inv],
    cases hnw with fw hfw,
    use fw⁻¹,
    simp,
    refine ⟨ hfw.1, _ ⟩,
    rw ← hfw.2,
    symmetry,
    have k := free_group.norm_inv fw,
    rw free_group.norm_eq at k,
    rw free_group.norm_eq at k,
    norm_cast at k,
    assumption,
  },
end

def norm_inv (x : G) : ∥ x ∥ = ∥ x⁻¹ ∥ :=
begin
  have h := norm_inv_le x,
  have hi := norm_inv_le x⁻¹,
  simp at hi,
  finish,
end

def dist_eq (x y : G) : dist x y = nat_norm (x * y⁻¹) := rfl

def dist_self (x : G) : dist x x = 0 :=
begin
  rw dist_eq,
  norm_cast,

  rw nat_norm,

  suffices : Inf (free_group.nat_norm '' words (x * x⁻¹)) ≤ 0,
  { exact le_zero_iff.mp this, },

  suffices : 0 ∈ free_group.nat_norm '' words (x * x⁻¹),
  { apply nat.Inf_le this, },

  simp only [mul_right_inv, set.mem_image],
  use 1,

  split,
  { simp only [words, of], },
  { unfold free_group.nat_norm,
    rw list.length_eq_zero,
    exact free_group.one_to_word,
  },
end

def dist_comm (x y : G) : dist x y = dist y x :=
begin
  rw dist_eq, rw dist_eq,
  norm_cast,

  set z := x * y⁻¹,
  set zi := y * x⁻¹,

  have h : zi = z⁻¹,
  { simp only [mul_inv_rev, inv_inv], },

  have hk := norm_inv z,
  rw norm_eq at hk,
  rw norm_eq at hk,
  norm_cast at hk,
  rwa h,
end

def dist_triangle (x y z : G) : (dist x z) ≤ (dist x y) + (dist y z) :=
begin
  rw dist_eq,
  rw dist_eq,
  rw dist_eq,
  norm_cast,

  set xz := x * z⁻¹ with hxz,
  set xy := x * y⁻¹ with hxy,
  set yz := y * z⁻¹ with hyz,

  unfold nat_norm,

  have h1 := nat.Inf_mem (by simp [words_nonempty] : (free_group.nat_norm '' words xy).nonempty),
  have h2 := nat.Inf_mem (by simp [words_nonempty] : (free_group.nat_norm '' words yz).nonempty),

  cases h1 with wxy hwxy,
  cases h2 with wyz hwyz,

  rw ← hwyz.2,
  rw ← hwxy.2,

  have h : wxy * wyz ∈ words xz,
  {
    unfold words,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    rw of_mul,
    have hxyw := words_of hwxy.1,
    have hyzw := words_of hwyz.1,
    rw hxyw,
    rw hyzw,
    rw hxy,
    rw hyz,
    rw hxz,
    group,
  },

  have h2 : free_group.nat_norm (wxy * wyz) ∈ free_group.nat_norm '' (words xz),
  { exact set.mem_image_of_mem free_group.nat_norm h, },

  have h3 : Inf ( free_group.nat_norm '' words xz ) ≤ free_group.nat_norm (wxy * wyz ),
  {
    exact cInf_le' h2,
  },

  have h4 : free_group.nat_norm( wxy * wyz ) ≤ wxy.nat_norm + wyz.nat_norm,
  {
     have h5 : ∥ wxy * wyz ∥ ≤ ∥ wxy ∥ + ∥ wyz ∥ := free_group.norm_triangle _ _,
     rw free_group.norm_eq at h5,
     rw free_group.norm_eq at h5,
     rw free_group.norm_eq at h5,
     norm_cast at h5,
     assumption,
  },

  finish,
end

def eq_of_dist_eq_zero (x y : G) : dist x y = 0 → x = y :=
begin
  rw dist_eq,
  intro h,
  norm_cast at h,

  unfold nat_norm at h,

  rw nat.Inf_eq_zero at h,
  cases h,
  { simp only [set.mem_image] at h,
    rcases h with ⟨ w, hw1, hw2 ⟩,
    have hk := free_group.norm_zero_eq_one w,
    have hi : w = 1, { apply hk, rw free_group.norm_eq, norm_cast, assumption, },

    rw hi at hw1,

    unfold words at hw1,
    simp [of] at hw1,
    group, -- this should be simpler?
    rw hw1,
    group,
  },
  {
    exfalso,
    have hne := words_nonempty (x * y⁻¹),
    finish,
  },
end

instance : pseudo_metric_space G :=
{ dist               := dist,
  dist_self          := dist_self,
  dist_comm          := dist_comm,
  dist_triangle      := dist_triangle }

instance : metric_space G :=
{ eq_of_dist_eq_zero := eq_of_dist_eq_zero }

end generated_group


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.determinant
! leanprover-community/mathlib commit c3019c79074b0619edb4b27553a91b2e82242395
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Pequiv
import Mathbin.Data.Matrix.Block
import Mathbin.Data.Matrix.Notation
import Mathbin.Data.Fintype.BigOperators
import Mathbin.GroupTheory.Perm.Fin
import Mathbin.GroupTheory.Perm.Sign
import Mathbin.Algebra.Algebra.Basic
import Mathbin.Tactic.Ring
import Mathbin.LinearAlgebra.Alternating
import Mathbin.LinearAlgebra.Pi

/-!
# Determinant of a matrix

This file defines the determinant of a matrix, `matrix.det`, and its essential properties.

## Main definitions

 - `matrix.det`: the determinant of a square matrix, as a sum over permutations
 - `matrix.det_row_alternating`: the determinant, as an `alternating_map` in the rows of the matrix

## Main results

 - `det_mul`: the determinant of `A ⬝ B` is the product of determinants
 - `det_zero_of_row_eq`: the determinant is zero if there is a repeated row
 - `det_block_diagonal`: the determinant of a block diagonal matrix is a product
   of the blocks' determinants

## Implementation notes

It is possible to configure `simp` to compute determinants. See the file
`test/matrix.lean` for some examples.

-/

universe u v w z

open Equiv Equiv.Perm Finset Function

namespace Matrix

open Matrix BigOperators

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

variable {R : Type v} [CommRing R]

-- mathport name: «exprε »
local notation "ε " σ:arg => ((sign σ : ℤ) : R)

/-- `det` is an `alternating_map` in the rows of the matrix. -/
def detRowAlternating : AlternatingMap R (n → R) R n :=
  ((MultilinearMap.mkPiAlgebra R n R).compLinearMap LinearMap.proj).alternatization
#align matrix.det_row_alternating Matrix.detRowAlternating

/-- The determinant of a matrix given by the Leibniz formula. -/
abbrev det (M : Matrix n n R) : R :=
  detRowAlternating M
#align matrix.det Matrix.det

theorem det_apply (M : Matrix n n R) : M.det = ∑ σ : Perm n, σ.sign • ∏ i, M (σ i) i :=
  MultilinearMap.alternatization_apply _ M
#align matrix.det_apply Matrix.det_apply

-- This is what the old definition was. We use it to avoid having to change the old proofs below
theorem det_apply' (M : Matrix n n R) : M.det = ∑ σ : Perm n, ε σ * ∏ i, M (σ i) i := by
  simp [det_apply, Units.smul_def]
#align matrix.det_apply' Matrix.det_apply'

@[simp]
theorem det_diagonal {d : n → R} : det (diagonal d) = ∏ i, d i :=
  by
  rw [det_apply']
  refine' (Finset.sum_eq_single 1 _ _).trans _
  · intro σ h1 h2
    cases' not_forall.1 (mt Equiv.ext h2) with x h3
    convert MulZeroClass.mul_zero _
    apply Finset.prod_eq_zero
    · change x ∈ _
      simp
    exact if_neg h3
  · simp
  · simp
#align matrix.det_diagonal Matrix.det_diagonal

@[simp]
theorem det_zero (h : Nonempty n) : det (0 : Matrix n n R) = 0 :=
  (detRowAlternating : AlternatingMap R (n → R) R n).map_zero
#align matrix.det_zero Matrix.det_zero

@[simp]
theorem det_one : det (1 : Matrix n n R) = 1 := by rw [← diagonal_one] <;> simp [-diagonal_one]
#align matrix.det_one Matrix.det_one

theorem det_isEmpty [IsEmpty n] {A : Matrix n n R} : det A = 1 := by simp [det_apply]
#align matrix.det_is_empty Matrix.det_isEmpty

@[simp]
theorem coe_det_isEmpty [IsEmpty n] : (det : Matrix n n R → R) = Function.const _ 1 :=
  by
  ext
  exact det_is_empty
#align matrix.coe_det_is_empty Matrix.coe_det_isEmpty

theorem det_eq_one_of_card_eq_zero {A : Matrix n n R} (h : Fintype.card n = 0) : det A = 1 :=
  haveI : IsEmpty n := fintype.card_eq_zero_iff.mp h
  det_is_empty
#align matrix.det_eq_one_of_card_eq_zero Matrix.det_eq_one_of_card_eq_zero

/-- If `n` has only one element, the determinant of an `n` by `n` matrix is just that element.
Although `unique` implies `decidable_eq` and `fintype`, the instances might
not be syntactically equal. Thus, we need to fill in the args explicitly. -/
@[simp]
theorem det_unique {n : Type _} [Unique n] [DecidableEq n] [Fintype n] (A : Matrix n n R) :
    det A = A default default := by simp [det_apply, univ_unique]
#align matrix.det_unique Matrix.det_unique

theorem det_eq_elem_of_subsingleton [Subsingleton n] (A : Matrix n n R) (k : n) : det A = A k k :=
  by
  convert det_unique _
  exact uniqueOfSubsingleton k
#align matrix.det_eq_elem_of_subsingleton Matrix.det_eq_elem_of_subsingleton

theorem det_eq_elem_of_card_eq_one {A : Matrix n n R} (h : Fintype.card n = 1) (k : n) :
    det A = A k k :=
  haveI : Subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le
  det_eq_elem_of_subsingleton _ _
#align matrix.det_eq_elem_of_card_eq_one Matrix.det_eq_elem_of_card_eq_one

theorem det_mul_aux {M N : Matrix n n R} {p : n → n} (H : ¬Bijective p) :
    (∑ σ : Perm n, ε σ * ∏ x, M (σ x) (p x) * N (p x) x) = 0 :=
  by
  obtain ⟨i, j, hpij, hij⟩ : ∃ i j, p i = p j ∧ i ≠ j :=
    by
    rw [← Finite.injective_iff_bijective, injective] at H
    push_neg  at H
    exact H
  exact
    sum_involution (fun σ _ => σ * swap i j)
      (fun σ _ =>
        by
        have : (∏ x, M (σ x) (p x)) = ∏ x, M ((σ * swap i j) x) (p x) :=
          Fintype.prod_equiv (swap i j) _ _ (by simp [apply_swap_eq_self hpij])
        simp [this, sign_swap hij, prod_mul_distrib])
      (fun σ _ _ => (not_congr mul_swap_eq_iff).mpr hij) (fun _ _ => mem_univ _) fun σ _ =>
      mul_swap_involutive i j σ
#align matrix.det_mul_aux Matrix.det_mul_aux

@[simp]
theorem det_mul (M N : Matrix n n R) : det (M ⬝ N) = det M * det N :=
  calc
    det (M ⬝ N) = ∑ p : n → n, ∑ σ : Perm n, ε σ * ∏ i, M (σ i) (p i) * N (p i) i := by
      simp only [det_apply', mul_apply, prod_univ_sum, mul_sum, Fintype.piFinset_univ] <;>
        rw [Finset.sum_comm]
    _ =
        ∑ p in (@univ (n → n) _).filterₓ Bijective,
          ∑ σ : Perm n, ε σ * ∏ i, M (σ i) (p i) * N (p i) i :=
      (Eq.symm <|
        sum_subset (filter_subset _ _) fun f _ hbij =>
          det_mul_aux <| by simpa only [true_and_iff, mem_filter, mem_univ] using hbij)
    _ = ∑ τ : Perm n, ∑ σ : Perm n, ε σ * ∏ i, M (σ i) (τ i) * N (τ i) i :=
      (sum_bij (fun p h => Equiv.ofBijective p (mem_filter.1 h).2) (fun _ _ => mem_univ _)
        (fun _ _ => rfl) (fun _ _ _ _ h => by injection h) fun b _ =>
        ⟨b, mem_filter.2 ⟨mem_univ _, b.Bijective⟩, coe_fn_injective rfl⟩)
    _ = ∑ σ : Perm n, ∑ τ : Perm n, (∏ i, N (σ i) i) * ε τ * ∏ j, M (τ j) (σ j) := by
      simp only [mul_comm, mul_left_comm, prod_mul_distrib, mul_assoc]
    _ = ∑ σ : Perm n, ∑ τ : Perm n, (∏ i, N (σ i) i) * (ε σ * ε τ) * ∏ i, M (τ i) i :=
      (sum_congr rfl fun σ _ =>
        Fintype.sum_equiv (Equiv.mulRight σ⁻¹) _ _ fun τ =>
          by
          have : (∏ j, M (τ j) (σ j)) = ∏ j, M ((τ * σ⁻¹) j) j :=
            by
            rw [← (σ⁻¹ : _ ≃ _).prod_comp]
            simp only [Equiv.Perm.coe_mul, apply_inv_self]
          have h : ε σ * ε (τ * σ⁻¹) = ε τ :=
            calc
              ε σ * ε (τ * σ⁻¹) = ε (τ * σ⁻¹ * σ) :=
                by
                rw [mul_comm, sign_mul (τ * σ⁻¹)]
                simp only [Int.cast_mul, Units.val_mul]
              _ = ε τ := by simp only [inv_mul_cancel_right]

          simp_rw [Equiv.coe_mulRight, h]
          simp only [this])
    _ = det M * det N := by simp only [det_apply', Finset.mul_sum, mul_comm, mul_left_comm]

#align matrix.det_mul Matrix.det_mul

/-- The determinant of a matrix, as a monoid homomorphism. -/
def detMonoidHom : Matrix n n R →* R where
  toFun := det
  map_one' := det_one
  map_mul' := det_mul
#align matrix.det_monoid_hom Matrix.detMonoidHom

@[simp]
theorem coe_detMonoidHom : (detMonoidHom : Matrix n n R → R) = det :=
  rfl
#align matrix.coe_det_monoid_hom Matrix.coe_detMonoidHom

/-- On square matrices, `mul_comm` applies under `det`. -/
theorem det_mul_comm (M N : Matrix m m R) : det (M ⬝ N) = det (N ⬝ M) := by
  rw [det_mul, det_mul, mul_comm]
#align matrix.det_mul_comm Matrix.det_mul_comm

/-- On square matrices, `mul_left_comm` applies under `det`. -/
theorem det_mul_left_comm (M N P : Matrix m m R) : det (M ⬝ (N ⬝ P)) = det (N ⬝ (M ⬝ P)) := by
  rw [← Matrix.mul_assoc, ← Matrix.mul_assoc, det_mul, det_mul_comm M N, ← det_mul]
#align matrix.det_mul_left_comm Matrix.det_mul_left_comm

/-- On square matrices, `mul_right_comm` applies under `det`. -/
theorem det_mul_right_comm (M N P : Matrix m m R) : det (M ⬝ N ⬝ P) = det (M ⬝ P ⬝ N) := by
  rw [Matrix.mul_assoc, Matrix.mul_assoc, det_mul, det_mul_comm N P, ← det_mul]
#align matrix.det_mul_right_comm Matrix.det_mul_right_comm

theorem det_units_conj (M : (Matrix m m R)ˣ) (N : Matrix m m R) :
    det (↑M ⬝ N ⬝ ↑M⁻¹ : Matrix m m R) = det N := by
  rw [det_mul_right_comm, ← mul_eq_mul, ← mul_eq_mul, Units.mul_inv, one_mul]
#align matrix.det_units_conj Matrix.det_units_conj

theorem det_units_conj' (M : (Matrix m m R)ˣ) (N : Matrix m m R) :
    det (↑M⁻¹ ⬝ N ⬝ ↑M : Matrix m m R) = det N :=
  det_units_conj M⁻¹ N
#align matrix.det_units_conj' Matrix.det_units_conj'

/-- Transposing a matrix preserves the determinant. -/
@[simp]
theorem det_transpose (M : Matrix n n R) : Mᵀ.det = M.det :=
  by
  rw [det_apply', det_apply']
  refine' Fintype.sum_bijective _ inv_involutive.bijective _ _ _
  intro σ
  rw [sign_inv]
  congr 1
  apply Fintype.prod_equiv σ
  intros
  simp
#align matrix.det_transpose Matrix.det_transpose

/-- Permuting the columns changes the sign of the determinant. -/
theorem det_permute (σ : Perm n) (M : Matrix n n R) :
    (Matrix.det fun i => M (σ i)) = σ.sign * M.det :=
  ((detRowAlternating : AlternatingMap R (n → R) R n).map_perm M σ).trans (by simp [Units.smul_def])
#align matrix.det_permute Matrix.det_permute

/-- Permuting rows and columns with the same equivalence has no effect. -/
@[simp]
theorem det_submatrix_equiv_self (e : n ≃ m) (A : Matrix m m R) : det (A.submatrix e e) = det A :=
  by
  rw [det_apply', det_apply']
  apply Fintype.sum_equiv (Equiv.permCongr e)
  intro σ
  rw [Equiv.Perm.sign_permCongr e σ]
  congr 1
  apply Fintype.prod_equiv e
  intro i
  rw [Equiv.permCongr_apply, Equiv.symm_apply_apply, submatrix_apply]
#align matrix.det_submatrix_equiv_self Matrix.det_submatrix_equiv_self

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_submatrix_equiv_self`; this one is unsuitable because
`matrix.reindex_apply` unfolds `reindex` first.
-/
theorem det_reindex_self (e : m ≃ n) (A : Matrix m m R) : det (reindex e e A) = det A :=
  det_submatrix_equiv_self e.symm A
#align matrix.det_reindex_self Matrix.det_reindex_self

/-- The determinant of a permutation matrix equals its sign. -/
@[simp]
theorem det_permutation (σ : Perm n) : Matrix.det (σ.toPEquiv.toMatrix : Matrix n n R) = σ.sign :=
  by
  rw [← Matrix.mul_one (σ.to_pequiv.to_matrix : Matrix n n R), PEquiv.toPEquiv_mul_matrix,
    det_permute, det_one, mul_one]
#align matrix.det_permutation Matrix.det_permutation

theorem det_smul (A : Matrix n n R) (c : R) : det (c • A) = c ^ Fintype.card n * det A :=
  calc
    det (c • A) = det (Matrix.mul (diagonal fun _ => c) A) := by rw [smul_eq_diagonal_mul]
    _ = det (diagonal fun _ => c) * det A := (det_mul _ _)
    _ = c ^ Fintype.card n * det A := by simp [card_univ]

#align matrix.det_smul Matrix.det_smul

@[simp]
theorem det_smul_of_tower {α} [Monoid α] [DistribMulAction α R] [IsScalarTower α R R]
    [SMulCommClass α R R] (c : α) (A : Matrix n n R) : det (c • A) = c ^ Fintype.card n • det A :=
  by rw [← smul_one_smul R c A, det_smul, smul_pow, one_pow, smul_mul_assoc, one_mul]
#align matrix.det_smul_of_tower Matrix.det_smul_of_tower

theorem det_neg (A : Matrix n n R) : det (-A) = (-1) ^ Fintype.card n * det A := by
  rw [← det_smul, neg_one_smul]
#align matrix.det_neg Matrix.det_neg

/-- A variant of `matrix.det_neg` with scalar multiplication by `units ℤ` instead of multiplication
by `R`. -/
theorem det_neg_eq_smul (A : Matrix n n R) : det (-A) = (-1 : Units ℤ) ^ Fintype.card n • det A :=
  by rw [← det_smul_of_tower, Units.neg_smul, one_smul]
#align matrix.det_neg_eq_smul Matrix.det_neg_eq_smul

/-- Multiplying each row by a fixed `v i` multiplies the determinant by
the product of the `v`s. -/
theorem det_mul_row (v : n → R) (A : Matrix n n R) :
    det (of fun i j => v j * A i j) = (∏ i, v i) * det A :=
  calc
    det (of fun i j => v j * A i j) = det (A ⬝ diagonal v) :=
      congr_arg det <| by
        ext
        simp [mul_comm]
    _ = (∏ i, v i) * det A := by rw [det_mul, det_diagonal, mul_comm]

#align matrix.det_mul_row Matrix.det_mul_row

/-- Multiplying each column by a fixed `v j` multiplies the determinant by
the product of the `v`s. -/
theorem det_mul_column (v : n → R) (A : Matrix n n R) :
    det (of fun i j => v i * A i j) = (∏ i, v i) * det A :=
  MultilinearMap.map_smul_univ _ v A
#align matrix.det_mul_column Matrix.det_mul_column

@[simp]
theorem det_pow (M : Matrix m m R) (n : ℕ) : det (M ^ n) = det M ^ n :=
  (detMonoidHom : Matrix m m R →* R).map_pow M n
#align matrix.det_pow Matrix.det_pow

section HomMap

variable {S : Type w} [CommRing S]

theorem RingHom.map_det (f : R →+* S) (M : Matrix n n R) : f M.det = Matrix.det (f.mapMatrix M) :=
  by simp [Matrix.det_apply', f.map_sum, f.map_prod]
#align ring_hom.map_det RingHom.map_det

theorem RingEquiv.map_det (f : R ≃+* S) (M : Matrix n n R) : f M.det = Matrix.det (f.mapMatrix M) :=
  f.toRingHom.map_det _
#align ring_equiv.map_det RingEquiv.map_det

theorem AlgHom.map_det [Algebra R S] {T : Type z} [CommRing T] [Algebra R T] (f : S →ₐ[R] T)
    (M : Matrix n n S) : f M.det = Matrix.det (f.mapMatrix M) :=
  f.toRingHom.map_det _
#align alg_hom.map_det AlgHom.map_det

theorem AlgEquiv.map_det [Algebra R S] {T : Type z} [CommRing T] [Algebra R T] (f : S ≃ₐ[R] T)
    (M : Matrix n n S) : f M.det = Matrix.det (f.mapMatrix M) :=
  f.toAlgHom.map_det _
#align alg_equiv.map_det AlgEquiv.map_det

end HomMap

@[simp]
theorem det_conjTranspose [StarRing R] (M : Matrix m m R) : det Mᴴ = star (det M) :=
  ((starRingEnd R).map_det _).symm.trans <| congr_arg star M.det_transpose
#align matrix.det_conj_transpose Matrix.det_conjTranspose

section DetZero

/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

theorem det_eq_zero_of_row_eq_zero {A : Matrix n n R} (i : n) (h : ∀ j, A i j = 0) : det A = 0 :=
  (detRowAlternating : AlternatingMap R (n → R) R n).map_coord_zero i (funext h)
#align matrix.det_eq_zero_of_row_eq_zero Matrix.det_eq_zero_of_row_eq_zero

theorem det_eq_zero_of_column_eq_zero {A : Matrix n n R} (j : n) (h : ∀ i, A i j = 0) : det A = 0 :=
  by
  rw [← det_transpose]
  exact det_eq_zero_of_row_eq_zero j h
#align matrix.det_eq_zero_of_column_eq_zero Matrix.det_eq_zero_of_column_eq_zero

variable {M : Matrix n n R} {i j : n}

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq (i_ne_j : i ≠ j) (hij : M i = M j) : M.det = 0 :=
  (detRowAlternating : AlternatingMap R (n → R) R n).map_eq_zero_of_eq M hij i_ne_j
#align matrix.det_zero_of_row_eq Matrix.det_zero_of_row_eq

/-- If a matrix has a repeated column, the determinant will be zero. -/
theorem det_zero_of_column_eq (i_ne_j : i ≠ j) (hij : ∀ k, M k i = M k j) : M.det = 0 :=
  by
  rw [← det_transpose, det_zero_of_row_eq i_ne_j]
  exact funext hij
#align matrix.det_zero_of_column_eq Matrix.det_zero_of_column_eq

end DetZero

theorem det_updateRow_add (M : Matrix n n R) (j : n) (u v : n → R) :
    det (updateRow M j <| u + v) = det (updateRow M j u) + det (updateRow M j v) :=
  (detRowAlternating : AlternatingMap R (n → R) R n).map_add M j u v
#align matrix.det_update_row_add Matrix.det_updateRow_add

theorem det_updateColumn_add (M : Matrix n n R) (j : n) (u v : n → R) :
    det (updateColumn M j <| u + v) = det (updateColumn M j u) + det (updateColumn M j v) :=
  by
  rw [← det_transpose, ← update_row_transpose, det_update_row_add]
  simp [update_row_transpose, det_transpose]
#align matrix.det_update_column_add Matrix.det_updateColumn_add

theorem det_updateRow_smul (M : Matrix n n R) (j : n) (s : R) (u : n → R) :
    det (updateRow M j <| s • u) = s * det (updateRow M j u) :=
  (detRowAlternating : AlternatingMap R (n → R) R n).map_smul M j s u
#align matrix.det_update_row_smul Matrix.det_updateRow_smul

theorem det_updateColumn_smul (M : Matrix n n R) (j : n) (s : R) (u : n → R) :
    det (updateColumn M j <| s • u) = s * det (updateColumn M j u) :=
  by
  rw [← det_transpose, ← update_row_transpose, det_update_row_smul]
  simp [update_row_transpose, det_transpose]
#align matrix.det_update_column_smul Matrix.det_updateColumn_smul

theorem det_updateRow_smul' (M : Matrix n n R) (j : n) (s : R) (u : n → R) :
    det (updateRow (s • M) j u) = s ^ (Fintype.card n - 1) * det (updateRow M j u) :=
  MultilinearMap.map_update_smul _ M j s u
#align matrix.det_update_row_smul' Matrix.det_updateRow_smul'

theorem det_updateColumn_smul' (M : Matrix n n R) (j : n) (s : R) (u : n → R) :
    det (updateColumn (s • M) j u) = s ^ (Fintype.card n - 1) * det (updateColumn M j u) :=
  by
  rw [← det_transpose, ← update_row_transpose, transpose_smul, det_update_row_smul']
  simp [update_row_transpose, det_transpose]
#align matrix.det_update_column_smul' Matrix.det_updateColumn_smul'

section DetEq

/-! ### `det_eq` section

Lemmas showing the determinant is invariant under a variety of operations.
-/

theorem det_eq_of_eq_mul_det_one {A B : Matrix n n R} (C : Matrix n n R) (hC : det C = 1)
    (hA : A = B ⬝ C) : det A = det B :=
  calc
    det A = det (B ⬝ C) := congr_arg _ hA
    _ = det B * det C := (det_mul _ _)
    _ = det B := by rw [hC, mul_one]

#align matrix.det_eq_of_eq_mul_det_one Matrix.det_eq_of_eq_mul_det_one

theorem det_eq_of_eq_det_one_mul {A B : Matrix n n R} (C : Matrix n n R) (hC : det C = 1)
    (hA : A = C ⬝ B) : det A = det B :=
  calc
    det A = det (C ⬝ B) := congr_arg _ hA
    _ = det C * det B := (det_mul _ _)
    _ = det B := by rw [hC, one_mul]

#align matrix.det_eq_of_eq_det_one_mul Matrix.det_eq_of_eq_det_one_mul

theorem det_updateRow_add_self (A : Matrix n n R) {i j : n} (hij : i ≠ j) :
    det (updateRow A i (A i + A j)) = det A := by
  simp [det_update_row_add,
    det_zero_of_row_eq hij (update_row_self.trans (update_row_ne hij.symm).symm)]
#align matrix.det_update_row_add_self Matrix.det_updateRow_add_self

theorem det_updateColumn_add_self (A : Matrix n n R) {i j : n} (hij : i ≠ j) :
    det (updateColumn A i fun k => A k i + A k j) = det A :=
  by
  rw [← det_transpose, ← update_row_transpose, ← det_transpose A]
  exact det_update_row_add_self Aᵀ hij
#align matrix.det_update_column_add_self Matrix.det_updateColumn_add_self

theorem det_updateRow_add_smul_self (A : Matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
    det (updateRow A i (A i + c • A j)) = det A := by
  simp [det_update_row_add, det_update_row_smul,
    det_zero_of_row_eq hij (update_row_self.trans (update_row_ne hij.symm).symm)]
#align matrix.det_update_row_add_smul_self Matrix.det_updateRow_add_smul_self

theorem det_updateColumn_add_smul_self (A : Matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
    det (updateColumn A i fun k => A k i + c • A k j) = det A :=
  by
  rw [← det_transpose, ← update_row_transpose, ← det_transpose A]
  exact det_update_row_add_smul_self Aᵀ hij c
#align matrix.det_update_column_add_smul_self Matrix.det_updateColumn_add_smul_self

theorem det_eq_of_forall_row_eq_smul_add_const_aux {A B : Matrix n n R} {s : Finset n} :
    ∀ (c : n → R) (hs : ∀ i, i ∉ s → c i = 0) (k : n) (hk : k ∉ s)
      (A_eq : ∀ i j, A i j = B i j + c i * B k j), det A = det B :=
  by
  revert B
  refine' s.induction_on _ _
  · intro A c hs k hk A_eq
    have : ∀ i, c i = 0 := by
      intro i
      specialize hs i
      contrapose! hs
      simp [hs]
    congr
    ext (i j)
    rw [A_eq, this, MulZeroClass.zero_mul, add_zero]
  · intro i s hi ih B c hs k hk A_eq
    have hAi : A i = B i + c i • B k := funext (A_eq i)
    rw [@ih (update_row B i (A i)) (Function.update c i 0), hAi, det_update_row_add_smul_self]
    · exact mt (fun h => show k ∈ insert i s from h ▸ Finset.mem_insert_self _ _) hk
    · intro i' hi'
      rw [Function.update_apply]
      split_ifs with hi'i
      · rfl
      · exact hs i' fun h => hi' ((finset.mem_insert.mp h).resolve_left hi'i)
    · exact fun h => hk (Finset.mem_insert_of_mem h)
    · intro i' j'
      rw [update_row_apply, Function.update_apply]
      split_ifs with hi'i
      · simp [hi'i]
      rw [A_eq, update_row_ne fun h : k = i => hk <| h ▸ Finset.mem_insert_self k s]
#align matrix.det_eq_of_forall_row_eq_smul_add_const_aux Matrix.det_eq_of_forall_row_eq_smul_add_const_aux

/-- If you add multiples of row `B k` to other rows, the determinant doesn't change. -/
theorem det_eq_of_forall_row_eq_smul_add_const {A B : Matrix n n R} (c : n → R) (k : n)
    (hk : c k = 0) (A_eq : ∀ i j, A i j = B i j + c i * B k j) : det A = det B :=
  det_eq_of_forall_row_eq_smul_add_const_aux c
    (fun i =>
      not_imp_comm.mp fun hi =>
        Finset.mem_erase.mpr
          ⟨mt (fun h : i = k => show c i = 0 from h.symm ▸ hk) hi, Finset.mem_univ i⟩)
    k (Finset.not_mem_erase k Finset.univ) A_eq
#align matrix.det_eq_of_forall_row_eq_smul_add_const Matrix.det_eq_of_forall_row_eq_smul_add_const

theorem det_eq_of_forall_row_eq_smul_add_pred_aux {n : ℕ} (k : Fin (n + 1)) :
    ∀ (c : Fin n → R) (hc : ∀ i : Fin n, k < i.succ → c i = 0)
      {M N : Matrix (Fin n.succ) (Fin n.succ) R} (h0 : ∀ j, M 0 j = N 0 j)
      (hsucc : ∀ (i : Fin n) (j), M i.succ j = N i.succ j + c i * M i.cast_succ j), det M = det N :=
  by
  refine' Fin.induction _ (fun k ih => _) k <;> intro c hc M N h0 hsucc
  · congr
    ext (i j)
    refine' Fin.cases (h0 j) (fun i => _) i
    rw [hsucc, hc i (Fin.succ_pos _), MulZeroClass.zero_mul, add_zero]
  set M' := update_row M k.succ (N k.succ) with hM'
  have hM : M = update_row M' k.succ (M' k.succ + c k • M k.cast_succ) :=
    by
    ext (i j)
    by_cases hi : i = k.succ
    · simp [hi, hM', hsucc, update_row_self]
    rw [update_row_ne hi, hM', update_row_ne hi]
  have k_ne_succ : k.cast_succ ≠ k.succ := (Fin.castSucc_lt_succ k).Ne
  have M_k : M k.cast_succ = M' k.cast_succ := (update_row_ne k_ne_succ).symm
  rw [hM, M_k, det_update_row_add_smul_self M' k_ne_succ.symm, ih (Function.update c k 0)]
  · intro i hi
    rw [Fin.lt_iff_val_lt_val, Fin.coe_castSucc, Fin.val_succ, Nat.lt_succ_iff] at hi
    rw [Function.update_apply]
    split_ifs with hik
    · rfl
    exact hc _ (fin.succ_lt_succ_iff.mpr (lt_of_le_of_ne hi (Ne.symm hik)))
  · rwa [hM', update_row_ne (Fin.succ_ne_zero _).symm]
  intro i j
  rw [Function.update_apply]
  split_ifs with hik
  · rw [MulZeroClass.zero_mul, add_zero, hM', hik, update_row_self]
  rw [hM', update_row_ne ((Fin.succ_injective _).Ne hik), hsucc]
  by_cases hik2 : k < i
  · simp [hc i (fin.succ_lt_succ_iff.mpr hik2)]
  rw [update_row_ne]
  apply ne_of_lt
  rwa [Fin.lt_iff_val_lt_val, Fin.coe_castSucc, Fin.val_succ, Nat.lt_succ_iff, ← not_lt]
#align matrix.det_eq_of_forall_row_eq_smul_add_pred_aux Matrix.det_eq_of_forall_row_eq_smul_add_pred_aux

/-- If you add multiples of previous rows to the next row, the determinant doesn't change. -/
theorem det_eq_of_forall_row_eq_smul_add_pred {n : ℕ} {A B : Matrix (Fin (n + 1)) (Fin (n + 1)) R}
    (c : Fin n → R) (A_zero : ∀ j, A 0 j = B 0 j)
    (A_succ : ∀ (i : Fin n) (j), A i.succ j = B i.succ j + c i * A i.cast_succ j) : det A = det B :=
  det_eq_of_forall_row_eq_smul_add_pred_aux (Fin.last _) c
    (fun i hi => absurd hi (not_lt_of_ge (Fin.le_last _))) A_zero A_succ
#align matrix.det_eq_of_forall_row_eq_smul_add_pred Matrix.det_eq_of_forall_row_eq_smul_add_pred

/-- If you add multiples of previous columns to the next columns, the determinant doesn't change. -/
theorem det_eq_of_forall_col_eq_smul_add_pred {n : ℕ} {A B : Matrix (Fin (n + 1)) (Fin (n + 1)) R}
    (c : Fin n → R) (A_zero : ∀ i, A i 0 = B i 0)
    (A_succ : ∀ (i) (j : Fin n), A i j.succ = B i j.succ + c j * A i j.cast_succ) : det A = det B :=
  by
  rw [← det_transpose A, ← det_transpose B]
  exact det_eq_of_forall_row_eq_smul_add_pred c A_zero fun i j => A_succ j i
#align matrix.det_eq_of_forall_col_eq_smul_add_pred Matrix.det_eq_of_forall_col_eq_smul_add_pred

end DetEq

@[simp]
theorem det_blockDiagonal {o : Type _} [Fintype o] [DecidableEq o] (M : o → Matrix n n R) :
    (blockDiagonal M).det = ∏ k, (M k).det :=
  by
  -- Rewrite the determinants as a sum over permutations.
  simp_rw [det_apply']
  -- The right hand side is a product of sums, rewrite it as a sum of products.
  rw [Finset.prod_sum]
  simp_rw [Finset.mem_univ, Finset.prod_attach_univ, Finset.univ_pi_univ]
  -- We claim that the only permutations contributing to the sum are those that
  -- preserve their second component.
  let preserving_snd : Finset (Equiv.Perm (n × o)) :=
    finset.univ.filter fun σ => ∀ x, (σ x).snd = x.snd
  have mem_preserving_snd :
    ∀ {σ : Equiv.Perm (n × o)}, σ ∈ preserving_snd ↔ ∀ x, (σ x).snd = x.snd := fun σ =>
    finset.mem_filter.trans ⟨fun h => h.2, fun h => ⟨Finset.mem_univ _, h⟩⟩
  rw [← Finset.sum_subset (Finset.subset_univ preserving_snd) _]
  -- And that these are in bijection with `o → equiv.perm m`.
  rw [(Finset.sum_bij
        (fun (σ : ∀ k : o, k ∈ Finset.univ → Equiv.Perm n) _ =>
          prod_congr_left fun k => σ k (Finset.mem_univ k))
        _ _ _ _).symm]
  · intro σ _
    rw [mem_preserving_snd]
    rintro ⟨k, x⟩
    simp only [prod_congr_left_apply]
  · intro σ _
    rw [Finset.prod_mul_distrib, ← Finset.univ_product_univ, Finset.prod_product_right]
    simp only [sign_prod_congr_left, Units.coe_prod, Int.cast_prod, block_diagonal_apply_eq,
      prod_congr_left_apply]
  · intro σ σ' _ _ eq
    ext (x hx k)
    simp only at eq
    have :
      ∀ k x,
        prod_congr_left (fun k => σ k (Finset.mem_univ _)) (k, x) =
          prod_congr_left (fun k => σ' k (Finset.mem_univ _)) (k, x) :=
      fun k x => by rw [Eq]
    simp only [prod_congr_left_apply, Prod.mk.inj_iff] at this
    exact (this k x).1
  · intro σ hσ
    rw [mem_preserving_snd] at hσ
    have hσ' : ∀ x, (σ⁻¹ x).snd = x.snd := by
      intro x
      conv_rhs => rw [← perm.apply_inv_self σ x, hσ]
    have mk_apply_eq : ∀ k x, ((σ (x, k)).fst, k) = σ (x, k) :=
      by
      intro k x
      ext
      · simp only
      · simp only [hσ]
    have mk_inv_apply_eq : ∀ k x, ((σ⁻¹ (x, k)).fst, k) = σ⁻¹ (x, k) :=
      by
      intro k x
      conv_lhs => rw [← perm.apply_inv_self σ (x, k)]
      ext
      · simp only [apply_inv_self]
      · simp only [hσ']
    refine' ⟨fun k _ => ⟨fun x => (σ (x, k)).fst, fun x => (σ⁻¹ (x, k)).fst, _, _⟩, _, _⟩
    · intro x
      simp only [mk_apply_eq, inv_apply_self]
    · intro x
      simp only [mk_inv_apply_eq, apply_inv_self]
    · apply Finset.mem_univ
    · ext ⟨k, x⟩
      · simp only [[anonymous], prod_congr_left_apply]
      · simp only [prod_congr_left_apply, hσ]
  · intro σ _ hσ
    rw [mem_preserving_snd] at hσ
    obtain ⟨⟨k, x⟩, hkx⟩ := not_forall.mp hσ
    rw [Finset.prod_eq_zero (Finset.mem_univ (k, x)), MulZeroClass.mul_zero]
    rw [← @Prod.mk.eta _ _ (σ (k, x)), block_diagonal_apply_ne]
    exact hkx
#align matrix.det_block_diagonal Matrix.det_blockDiagonal

/-- The determinant of a 2×2 block matrix with the lower-left block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.det_of_upper_triangular`. -/
@[simp]
theorem det_fromBlocks_zero₂₁ (A : Matrix m m R) (B : Matrix m n R) (D : Matrix n n R) :
    (Matrix.fromBlocks A B 0 D).det = A.det * D.det := by
  classical
    simp_rw [det_apply']
    convert(sum_subset (subset_univ ((sum_congr_hom m n).range : Set (perm (Sum m n))).toFinset)
          _).symm
    rw [sum_mul_sum]
    simp_rw [univ_product_univ]
    rw [(sum_bij (fun (σ : perm m × perm n) _ => Equiv.sumCongr σ.fst σ.snd) _ _ _ _).symm]
    · intro σ₁₂ h
      simp only
      erw [Set.mem_toFinset, MonoidHom.mem_range]
      use σ₁₂
      simp only [sum_congr_hom_apply]
    · simp only [forall_prop_of_true, Prod.forall, mem_univ]
      intro σ₁ σ₂
      rw [Fintype.prod_sum_type]
      simp_rw [Equiv.sumCongr_apply, Sum.map_inr, Sum.map_inl, from_blocks_apply₁₁,
        from_blocks_apply₂₂]
      rw [mul_mul_mul_comm]
      congr
      rw [sign_sum_congr, Units.val_mul, Int.cast_mul]
    · intro σ₁ σ₂ h₁ h₂
      dsimp only
      intro h
      have h2 : ∀ x, perm.sum_congr σ₁.fst σ₁.snd x = perm.sum_congr σ₂.fst σ₂.snd x :=
        by
        intro x
        exact congr_fun (congr_arg to_fun h) x
      simp only [Sum.map_inr, Sum.map_inl, perm.sum_congr_apply, Sum.forall] at h2
      ext
      · exact h2.left x
      · exact h2.right x
    · intro σ hσ
      erw [Set.mem_toFinset, MonoidHom.mem_range] at hσ
      obtain ⟨σ₁₂, hσ₁₂⟩ := hσ
      use σ₁₂
      rw [← hσ₁₂]
      simp
    · intro σ hσ hσn
      have h1 : ¬∀ x, ∃ y, Sum.inl y = σ (Sum.inl x) :=
        by
        by_contra
        rw [Set.mem_toFinset] at hσn
        apply absurd (mem_sum_congr_hom_range_of_perm_maps_to_inl _) hσn
        rintro x ⟨a, ha⟩
        rw [← ha]
        exact h a
      obtain ⟨a, ha⟩ := not_forall.mp h1
      cases' hx : σ (Sum.inl a) with a2 b
      · have hn := (not_exists.mp ha) a2
        exact absurd hx.symm hn
      · rw [Finset.prod_eq_zero (Finset.mem_univ (Sum.inl a)), MulZeroClass.mul_zero]
        rw [hx, from_blocks_apply₂₁]
        rfl
#align matrix.det_from_blocks_zero₂₁ Matrix.det_fromBlocks_zero₂₁

/-- The determinant of a 2×2 block matrix with the upper-right block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.det_of_lower_triangular`. -/
@[simp]
theorem det_fromBlocks_zero₁₂ (A : Matrix m m R) (C : Matrix n m R) (D : Matrix n n R) :
    (Matrix.fromBlocks A 0 C D).det = A.det * D.det := by
  rw [← det_transpose, from_blocks_transpose, transpose_zero, det_from_blocks_zero₂₁, det_transpose,
    det_transpose]
#align matrix.det_from_blocks_zero₁₂ Matrix.det_fromBlocks_zero₁₂

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column 0. -/
theorem det_succ_column_zero {n : ℕ} (A : Matrix (Fin n.succ) (Fin n.succ) R) :
    det A = ∑ i : Fin n.succ, (-1) ^ (i : ℕ) * A i 0 * det (A.submatrix i.succAbove Fin.succ) :=
  by
  rw [Matrix.det_apply, Finset.univ_perm_fin_succ, ← Finset.univ_product_univ]
  simp only [Finset.sum_map, Equiv.toEmbedding_apply, Finset.sum_product, Matrix.submatrix]
  refine' Finset.sum_congr rfl fun i _ => Fin.cases _ (fun i => _) i
  ·
    simp only [Fin.prod_univ_succ, Matrix.det_apply, Finset.mul_sum,
      Equiv.Perm.decomposeFin_symm_apply_zero, Fin.val_zero, one_mul,
      Equiv.Perm.decomposeFin.symm_sign, Equiv.swap_self, if_true, id.def, eq_self_iff_true,
      Equiv.Perm.decomposeFin_symm_apply_succ, Fin.succAbove_zero, Equiv.coe_refl, pow_zero,
      mul_smul_comm, of_apply]
  -- `univ_perm_fin_succ` gives a different embedding of `perm (fin n)` into
  -- `perm (fin n.succ)` than the determinant of the submatrix we want,
  -- permute `A` so that we get the correct one.
  have : (-1 : R) ^ (i : ℕ) = i.cycle_range.sign := by simp [Fin.sign_cycleRange]
  rw [Fin.val_succ, pow_succ, this, mul_assoc, mul_assoc, mul_left_comm ↑(Equiv.Perm.sign _), ←
    det_permute, Matrix.det_apply, Finset.mul_sum, Finset.mul_sum]
  -- now we just need to move the corresponding parts to the same place
  refine' Finset.sum_congr rfl fun σ _ => _
  rw [Equiv.Perm.decomposeFin.symm_sign, if_neg (Fin.succ_ne_zero i)]
  calc
    ((-1 * σ.sign : ℤ) • ∏ i', A (equiv.perm.decompose_fin.symm (Fin.succ i, σ) i') i') =
        (-1 * σ.sign : ℤ) •
          (A (Fin.succ i) 0 * ∏ i', A ((Fin.succ i).succAbove (Fin.cycleRange i (σ i'))) i'.succ) :=
      by
      simp only [Fin.prod_univ_succ, Fin.succAbove_cycleRange,
        Equiv.Perm.decomposeFin_symm_apply_zero, Equiv.Perm.decomposeFin_symm_apply_succ]
    _ =
        -1 *
          (A (Fin.succ i) 0 *
            (σ.sign : ℤ) • ∏ i', A ((Fin.succ i).succAbove (Fin.cycleRange i (σ i'))) i'.succ) :=
      by
      simp only [mul_assoc, mul_comm, _root_.neg_mul, one_mul, zsmul_eq_mul, neg_inj, neg_smul,
        Fin.succAbove_cycleRange]

#align matrix.det_succ_column_zero Matrix.det_succ_column_zero

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row 0. -/
theorem det_succ_row_zero {n : ℕ} (A : Matrix (Fin n.succ) (Fin n.succ) R) :
    det A = ∑ j : Fin n.succ, (-1) ^ (j : ℕ) * A 0 j * det (A.submatrix Fin.succ j.succAbove) :=
  by
  rw [← det_transpose A, det_succ_column_zero]
  refine' Finset.sum_congr rfl fun i _ => _
  rw [← det_transpose]
  simp only [transpose_apply, transpose_submatrix, transpose_transpose]
#align matrix.det_succ_row_zero Matrix.det_succ_row_zero

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row `i`. -/
theorem det_succ_row {n : ℕ} (A : Matrix (Fin n.succ) (Fin n.succ) R) (i : Fin n.succ) :
    det A =
      ∑ j : Fin n.succ, (-1) ^ (i + j : ℕ) * A i j * det (A.submatrix i.succAbove j.succAbove) :=
  by
  simp_rw [pow_add, mul_assoc, ← mul_sum]
  have : det A = (-1 : R) ^ (i : ℕ) * i.cycle_range⁻¹.sign * det A := by
    calc
      det A = ↑((-1 : ℤˣ) ^ (i : ℕ) * (-1 : ℤˣ) ^ (i : ℕ) : ℤˣ) * det A := by simp
      _ = (-1 : R) ^ (i : ℕ) * i.cycle_range⁻¹.sign * det A := by simp [-Int.units_mul_self]

  rw [this, mul_assoc]
  congr
  rw [← det_permute, det_succ_row_zero]
  refine' Finset.sum_congr rfl fun j _ => _
  rw [mul_assoc, Matrix.submatrix, Matrix.submatrix]
  congr
  · rw [Equiv.Perm.inv_def, Fin.cycleRange_symm_zero]
  · ext (i' j')
    rw [Equiv.Perm.inv_def, Fin.cycleRange_symm_succ]
#align matrix.det_succ_row Matrix.det_succ_row

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column `j`. -/
theorem det_succ_column {n : ℕ} (A : Matrix (Fin n.succ) (Fin n.succ) R) (j : Fin n.succ) :
    det A =
      ∑ i : Fin n.succ, (-1) ^ (i + j : ℕ) * A i j * det (A.submatrix i.succAbove j.succAbove) :=
  by
  rw [← det_transpose, det_succ_row _ j]
  refine' Finset.sum_congr rfl fun i _ => _
  rw [add_comm, ← det_transpose, transpose_apply, transpose_submatrix, transpose_transpose]
#align matrix.det_succ_column Matrix.det_succ_column

/-- Determinant of 0x0 matrix -/
@[simp]
theorem det_fin_zero {A : Matrix (Fin 0) (Fin 0) R} : det A = 1 :=
  det_isEmpty
#align matrix.det_fin_zero Matrix.det_fin_zero

/-- Determinant of 1x1 matrix -/
theorem det_fin_one (A : Matrix (Fin 1) (Fin 1) R) : det A = A 0 0 :=
  det_unique A
#align matrix.det_fin_one Matrix.det_fin_one

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem det_fin_one_of (a : R) :
    det
        («expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation") =
      a :=
  det_fin_one _
#align matrix.det_fin_one_of Matrix.det_fin_one_of

/-- Determinant of 2x2 matrix -/
theorem det_fin_two (A : Matrix (Fin 2) (Fin 2) R) : det A = A 0 0 * A 1 1 - A 0 1 * A 1 0 :=
  by
  simp [Matrix.det_succ_row_zero, Fin.sum_univ_succ]
  ring
#align matrix.det_fin_two Matrix.det_fin_two

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
@[simp]
theorem det_fin_two_of (a b c d : R) :
    Matrix.det
        («expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation") =
      a * d - b * c :=
  det_fin_two _
#align matrix.det_fin_two_of Matrix.det_fin_two_of

/-- Determinant of 3x3 matrix -/
theorem det_fin_three (A : Matrix (Fin 3) (Fin 3) R) :
    det A =
      A 0 0 * A 1 1 * A 2 2 - A 0 0 * A 1 2 * A 2 1 - A 0 1 * A 1 0 * A 2 2 +
            A 0 1 * A 1 2 * A 2 0 +
          A 0 2 * A 1 0 * A 2 1 -
        A 0 2 * A 1 1 * A 2 0 :=
  by
  simp [Matrix.det_succ_row_zero, Fin.sum_univ_succ]
  ring
#align matrix.det_fin_three Matrix.det_fin_three

end Matrix


def f : Nat → Nat → Nat
| 0,   b => b+1
| a+1, b => f a (f a b)

theorem ex1 (b)   : f 0 b = b+1 := rfl
theorem ex2 (b)   : f 1 b = (b+1)+1 := rfl
theorem ex3 (b)   : f 2 b = b+1+1+1+1 := rfl
theorem ex4 (a b) : f (a+1) b = f a (f a b) := rfl

#eval f 2 5


structure {u v} Category :=
  ( Obj : Type u )
  ( Hom : Obj → Obj → Type v )
  ( identity : Π X : Obj, Hom X X )
  ( compose  : Π { X Y Z : Obj }, Hom X Y → Hom Y Z → Hom X Z )
  ( left_identity  : ∀ { X Y : Obj } (f : Hom X Y), compose (identity X) f = f )

attribute [simp] Category.left_identity

structure {u1 v1 u2 v2} Functor (C : Category.{ u1 v1 }) (D : Category.{ u2 v2 }) :=
  (onObjects   : C.Obj → D.Obj)
  (onMorphisms : Π { X Y : C.Obj },
                C.Hom X Y → D.Hom (onObjects X) (onObjects Y))

structure {u1 v1 u2 v2} Full     { C : Category.{u1 v1} } { D : Category.{u2 v2} } ( F : Functor C D ) :=
  ( preimage : ∀ { X Y : C.Obj } ( f : D.Hom (F.onObjects X) (F.onObjects Y) ), C.Hom X Y )
  ( witness  : ∀ { X Y : C.Obj } ( f : D.Hom (F.onObjects X) (F.onObjects Y) ), F.onMorphisms (preimage f) = f )

structure Idempotent ( C : Category ) :=
   ( object : C.Obj )
   ( idempotent : C.Hom object object )

definition IdempotentCompletion ( C: Category ) : Category :=
{
  Obj            := Idempotent C,
  Hom            := λ X Y, { f : C.Hom X.object Y.object // C.compose X.idempotent f = f ∧ C.compose f Y.idempotent = f },
  identity       := λ X, ⟨ X.idempotent, sorry ⟩,
  compose        := λ X Y Z f g, ⟨ C.compose f.val g.val, sorry ⟩,
  left_identity  := sorry
}

definition functor_to_IdempotentCompletion ( C : Category ) : Functor C (IdempotentCompletion C) := {
  onObjects     := λ X, ⟨ X, C.identity X ⟩,
  onMorphisms   := λ _ _ f, ⟨ f, sorry ⟩
}

open tactic

-- fsplit is just split, but we use fapply on the constructors, rather than apply.
-- This is essential so we actually get given all the goals, rather than some of them turning into metavariables.
meta def fsplit : tactic unit :=
do [c] ← target >>= get_constructors_for | tactic.fail "fsplit tactic failed, target is not an inductive datatype with only one constructor",
   mk_const c >>= fapply >> skip

lemma embedding_in_IdempotentCompletition ( C: Category ) : Full (functor_to_IdempotentCompletion C) :=
begin
fsplit,
intros,
dsimp at * {md := semireducible},
induction f,
simp at *,
 -- now, perversely, we run some tactics on the second goal, before closing the first goal
 any_goals {intros},
 any_goals {fapply subtype.eq},
 any_goals {dsimp},
 any_goals {dsimp at * {md := semireducible}},
 any_goals {induction f},
 any_goals {dsimp},
-- finally, we actually get to business.
exact f_val,
refl,
end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Kexing Ying, Eric Wieser
-/
import linear_algebra.quadratic_form.basic
import analysis.special_functions.pow
import data.real.sign

/-!
# Real quadratic forms

Sylvester's law of inertia `equivalent_one_neg_one_weighted_sum_squared`:
A real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1 or 0.

When the real quadratic form is nondegerate we can take the weights to be ±1,
as in `equivalent_one_zero_neg_one_weighted_sum_squared`.

-/

namespace quadratic_form

open_locale big_operators
open real finset

variables {ι : Type*} [fintype ι]

/-- The isometry between a weighted sum of squares with weights `u` on the
(non-zero) real numbers and the weighted sum of squares with weights `sign ∘ u`. -/
noncomputable def isometry_sign_weighted_sum_squares
  [decidable_eq ι] (w : ι → ℝ) :
  isometry (weighted_sum_squares ℝ w) (weighted_sum_squares ℝ (sign ∘ w)) :=
begin
  let u := λ i, if h : w i = 0 then (1 : ℝˣ) else units.mk0 (w i) h,
  have hu' : ∀ i : ι, (sign (u i) * u i) ^ - (1 / 2 : ℝ) ≠ 0,
  { intro i, refine (ne_of_lt (real.rpow_pos_of_pos
      (sign_mul_pos_of_ne_zero _ $ units.ne_zero _) _)).symm},
  convert ((weighted_sum_squares ℝ w).isometry_basis_repr
    ((pi.basis_fun ℝ ι).units_smul (λ i, (is_unit_iff_ne_zero.2 $ hu' i).unit))),
  ext1 v,
  rw [basis_repr_apply, weighted_sum_squares_apply, weighted_sum_squares_apply],
  refine sum_congr rfl (λ j hj, _),
  have hsum : (∑ (i : ι), v i • ((is_unit_iff_ne_zero.2 $ hu' i).unit : ℝ) •
    (pi.basis_fun ℝ ι) i) j = v j • (sign (u j) * u j) ^ - (1 / 2 : ℝ),
  { rw [finset.sum_apply, sum_eq_single j, pi.basis_fun_apply, is_unit.unit_spec,
        linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply, function.update_same,
        smul_eq_mul, smul_eq_mul, smul_eq_mul, mul_one],
    intros i _ hij,
    rw [pi.basis_fun_apply, linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply,
        function.update_noteq hij.symm, pi.zero_apply, smul_eq_mul, smul_eq_mul,
        mul_zero, mul_zero],
    intro hj', exact false.elim (hj' hj) },
  simp_rw basis.units_smul_apply,
  erw [hsum],
  simp only [u, function.comp, smul_eq_mul],
  split_ifs,
  { simp only [h, zero_smul, zero_mul, sign_zero] },
  have hwu : w j = u j,
  { simp only [u, dif_neg h, units.coe_mk0] },
  simp only [hwu, units.coe_mk0],
  suffices : (u j : ℝ).sign * v j * v j = (sign (u j) * u j) ^ - (1 / 2 : ℝ) *
    (sign (u j) * u j) ^ - (1 / 2 : ℝ) * u j * v j * v j,
  { erw [← mul_assoc, this], ring },
  rw [← real.rpow_add (sign_mul_pos_of_ne_zero _ $ units.ne_zero _),
      show - (1 / 2 : ℝ) + - (1 / 2) = -1, by ring, real.rpow_neg_one, mul_inv₀,
      inv_sign, mul_assoc (sign (u j)) (u j)⁻¹,
      inv_mul_cancel (units.ne_zero _), mul_one],
  apply_instance
end

/-- **Sylvester's law of inertia**: A nondegenerate real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1. -/
theorem equivalent_one_neg_one_weighted_sum_squared
  {M : Type*} [add_comm_group M] [module ℝ M] [finite_dimensional ℝ M]
  (Q : quadratic_form ℝ M) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank ℝ M) → ℝ,
  (∀ i, w i = -1 ∨ w i = 1) ∧ equivalent Q (weighted_sum_squares ℝ w) :=
let ⟨w, ⟨hw₁⟩⟩ := Q.equivalent_weighted_sum_squares_units_of_nondegenerate' hQ in
  ⟨sign ∘ coe ∘ w,
   λ i, sign_apply_eq_of_ne_zero (w i) (w i).ne_zero,
   ⟨hw₁.trans (isometry_sign_weighted_sum_squares (coe ∘ w))⟩⟩

/-- **Sylvester's law of inertia**: A real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1 or 0. -/
theorem equivalent_one_zero_neg_one_weighted_sum_squared
  {M : Type*} [add_comm_group M] [module ℝ M] [finite_dimensional ℝ M]
  (Q : quadratic_form ℝ M) :
  ∃ w : fin (finite_dimensional.finrank ℝ M) → ℝ,
  (∀ i, w i = -1 ∨ w i = 0 ∨ w i = 1) ∧ equivalent Q (weighted_sum_squares ℝ w) :=
let ⟨w, ⟨hw₁⟩⟩ := Q.equivalent_weighted_sum_squares in
  ⟨sign ∘ coe ∘ w,
   λ i, sign_apply_eq (w i),
   ⟨hw₁.trans (isometry_sign_weighted_sum_squares w)⟩⟩

end quadratic_form


theorem e01 : P → Q → P :=
begin
    assume p q,
    /-
       p : P
       q : Q
       |- P
    -/
    exact p
    /-
        no goals
    -/
end

theorem e02 : (P → Q → R) → (P → Q) → P → R :=
begin
    assume pqr pq p,

    /-
        pqr : P -> Q -> R
        pq  : P -> Q
        p   : P
        |-  R
    -/

    apply pqr,

    /-
        (Case 1)
        pqr : P -> Q -> R
        pq  : P -> Q
        p   : P
        |-  P

        (Case 2)
        pqr : P -> Q -> R
        pq  : P -> Q
        p   : P
        |-  Q
    -/

    exact p,

    /-
        gets rid of Case 1
    -/

    apply pq,

    /-
        pqr : P -> Q -> R
        pq  : P -> Q
        p   : P
        |-  P
    -/

    exact p,

    /-
        no goals
    -/
end

theorem e03 : (P → Q) → P ∧ R → Q ∧ R :=
begin

    assume pq pnr,

    /-
        pq : P -> Q
        pnr : P ∧ R
        |-  Q ∧ R
    -/

    cases pnr with p r,
    /-
        pq : P -> Q
        p : P
        r : R
        |- Q ∧ R
    -/
    constructor,
    /-
        (Case 1)
        pq : P -> Q
        p : P
        r : R
        |- Q

        (Case 2)
        pq : P -> Q
        p : P
        r : R
        |- R
    -/
    apply pq,
    /-
        (Case 1)
        pq : P -> Q
        p : P
        r : R
        |- P

        (Case 2)
        pq : P -> Q
        p : P
        r : R
        |- R
    -/
    exact p,
    /-
        gets rid of Case 1
    -/
    exact r,
    /-
        no goals (gets rid of Case 2)
    -/
end

theorem e04 : (P → Q) → P ∨ R → Q ∨ R :=
begin
    assume pq por,
    /-
        pq : P -> Q
        por  : P ∨ R
        |- Q ∨ R
    -/
    cases por with p r,
    /-
        (Case 1)
        pq : P -> Q
        p : P
        |- Q ∨ R

        (Case 2)
        pq : P -> Q
        r : R
        |- Q ∨ R
    -/
    left,
    /-
        (Case 1)
        pq : P -> Q
        p : P
        |- Q

        (Case 2)
        pq : P -> Q
        r : R
        |- Q ∨ R
    -/
    apply pq,
    /-
        (Case 1)
        pq : P -> Q
        p : P
        |- P

        (Case 2)
        pq : P -> Q
        r : R
        |- Q ∨ R
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    right,
    /-
        (Case 2)
        pq : P -> Q
        r : R
        |- R
    -/
    exact r,
    /-
        No goals (Gets rid of Case 2)
    -/
end

theorem e05 : P ∨ Q → R ↔ (P → R) ∧ (Q → R) :=
begin
    constructor,
    /-
        (Case 1)
        P ∨ Q → R → (P → R) ∧ (Q → R)

        (Case 2)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    assume pqr,
    /-
        (Case 1)
        pqr : P ∨ Q → R
        := (P → R) ∧ (Q → R)

        (Case 2)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    constructor,
     /-
        (Case 1)
        pqr : P ∨ Q → R
        := (P → R)

        (Case 2)
        pqr : P ∨ Q → R
        := (Q → R)

        (Case 3)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    assume p,
     /-
        (Case 1)
        pqr : P ∨ Q → R
        p : P
        := R

        (Case 2)
        pqr : P ∨ Q → R
        := (Q → R)

        (Case 3)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    apply pqr,
    /-
        (Case 1)
        pqr : P ∨ Q → R
        p : P
        :=  P ∨ Q

        (Case 2)
        pqr : P ∨ Q → R
        := (Q → R)

        (Case 3)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    left,
    /-
        (Case 1)
        pqr : P ∨ Q → R
        p : P
        :=  P

        (Case 2)
        pqr : P ∨ Q → R
        := (Q → R)

        (Case 3)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    assume q,
    /-
        (Case 2)
        pqr : P ∨ Q → R
        q : Q
        := R

        (Case 3)
        (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    apply pqr,
    /-
       (Case 2)
       pqr : P ∨ Q → R
       q : Q
       :=  P ∨ Q

       (Case 3)
       (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    right,
     /-
       (Case 2)
       pqr : P ∨ Q → R
       q : Q
       :=  Q

       (Case 3)
       (P → R) ∧ (Q → R) → P ∨ Q → R
    -/
    exact q,
    /-
        Gets rid of Case 2
    -/
    assume prqr pq,
    /-
        (Case 3)
        prqr : (P → R) ∧ (Q → R)
        pq :  P ∨ Q
        := R
    -/
    cases prqr with pr qr,
    /-
        (Case 3)
        pr : P → R
        qr : Q → R
        pq : P ∨ Q
        := R
    -/
    cases pq with p q,
    /-
        (Case 3)
        pr : P → R
        qr : Q → R
        p : P
        := R

        (Case 4)
        pr : P → R
        qr : Q → R
        q : Q
        := R
    -/
    apply pr,
    /-
        (Case 3)
        pr : P → R
        qr : Q → R
        p : P
        := P

        (Case 4)
        pr : P → R
        qr : Q → R
        q : Q
        := R
    -/
    exact p,
    /-
        Gets rid of Case 3
    -/
    apply qr,
    /-
        (Case 4)
        pr : P → R
        qr : Q → R
        q : Q
        := Q
    -/
    exact q,
    /-
        No goals (Gets rid of Case 4)
    -/
end

theorem e06 : P → ¬ ¬ P :=
begin
    assume p np,
    /-
        p : P
        np : ¬ P
        |- false
    -/
    apply np,
    /-
        p : P
        np : ¬ P
        |- P
    -/
    exact p,
    /-
        No goals
    -/
end

theorem e07 : P ∧ true ↔ P :=
begin
    constructor,
    /-
        (Case 1)
        P ∧ true → P

        (Case 2)
        P → P ∧ true
    -/
    assume pt,
    /-
        (Case 1)
        pt : P ∧ true
        := P

        (Case 2)
        P → P ∧ true
    -/
    cases pt with p t,
     /-
        (Case 1)
        p : P
        t : true
         := P

        (Case 2)
        P → P ∧ true
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    assume p,
    /-
        (Case 2)
        p : P
        ⊢ P ∧ true
    -/
    constructor,
    /-
        (Case 2)
        p : P
        ⊢  P

        (Case 3)
        p : P
        ⊢ true
    -/
    exact p,
    -/
        Gets rid of Case 2
    -/
    constructor,
    -/
        No goals (Gets rid of Case 3)
    -/
end

theorem e08 : P ∨ false ↔ P :=
begin
    constructor,
    /-
        (Case 1)
        P ∨ false → P

        (Case 2)
        P → P ∨ false
    -/
    assume pf,
    /-
        (Case 1)
        pf : P ∨ false
        ⊢ P

        (Case 2)
        P → P ∨ false
    -/
    cases pf with p f,
    /-
        (Case 1)
        p: P
        ⊢ P

        (Case 2)
        f : false
        ⊢ P

        (Case 3)
        P → P ∨ false
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    cases f,
    /-
        Gets rid of Case 2
    -/
    assume p,
    /-
        (Case 3)
        p: P
        ⊢ P ∨ false
    -/
    left,
    /-
        (Case 3)
        p: P
        ⊢
    -/
    exact p,
    /-
        No goals (Gets rid of Case 3)
    -/
end

theorem e09 : P ∧ false ↔ false :=
begin
    constructor,
    /-
        (Case 1)
        P ∧ false → false

        (Case 2)
        false → P ∧ false
    -/
    assume pf,
    /-
        (Case 1)
        pf: P ∧ false
        ⊢ false

        (Case 2)
        false → P ∧ false
    -/
    cases pf with p f,
    /-
        (Case 1)
        p : P
        f : false
        ⊢ false

        (Case 2)
        false → P ∧ false
    -/
    exact f,
    /-
        Gets rid of Case 1
    -/
    assume f,
    /-
       (Case 2)
       f: false
       ⊢ P ∧ false
    -/
    constructor,
    /-
       (Case 2)
       f: false
       ⊢ P

       (Case 3)
       f: false
       ⊢ false
    -/
    cases f,
    -/
        Gets rid of Case 2
    -/
    exact f,
    -/
        No goals (Gets rid of Case 3)
    -/
end

theorem e10 : P ∨ true ↔ true :=
begin
    constructor,
    /-
        (Case 1)
        P ∨ true → true

        (Case 2)
        true → P ∨ true
    -/
    assume pt,
    /-
        (Case 1)
        pt: P ∨ true
        ⊢ true

        (Case 2)
        true → P ∨ true
    -/
    cases pt with p t
     /-
        (Case 1)
        p: P
        ⊢ true

        (Case 2)
        t : true
        ⊢ true

        (Case 3)
        true → P ∨ true
    -/
    constructor,
    /-
        Gets rid of Case 1
    -/
    exact t,
    /-
        Gets rid of Case 2
    -/
    assume t,
    /-
        (Case 3)
        t : true
        ⊢ P ∨ true
    -/
    right,
    /-
        (Case 3)
        t : true
        ⊢ true
    -/
    exact t,
    /-
        No goals (Gets rid of Case 3)
    -/
end

/-
Part 2 (10 points)
(this part relies in material only covered in the lectures
from 14/10/22)

We play the game of logic poker :-)

    You have to classify the propositions into
    a) provable intuitionistically (i.e. in plain lean)
    b) provable classically (using em : P ∨ ¬ P or raa : ¬¬ P → P).
    c) not provable classically.
    and then you have to prove the propositions in a) and b) accordingly.

    Here is how you score:
    We start with 10 points :-)
    For any proposition which you didn't classify correctly (or not at all)
    you loose 1 point. :-(
    For any proposition which is provable but you didn't prove you loose
    1 point. :-(
    We stop subtracting points at 0. :-)

    Write the classification as a comment using -- after the proposition.

    You are only allowed to use the tactics introduced in the lecture
    (i.e. assume, exact, apply, constructor, cases, left, right, have, trivial)

    Please only use the tactics in the way indicated in the script,
    otherwise you may lose upto 2 style points.

    For propositions classified into c) just keep "sorry," as the proof.
-/

open classical

theorem raa : ¬ ¬ P → P :=
begin
  assume nnp,
  cases (em P) with p np,
    exact p,
    have f : false,
      apply nnp,
      exact np,
    cases f,
end

theorem p01 : (P → Q) → (R → P) → (R → Q) :=
begin
    assume pq rp r,
    /-
        pq : P → Q
        rp : R → P
        r : R
        ⊢ Q
    -/
    apply pq,
    /-
        pq : P → Q
        rp : R → P
        r : R
        ⊢ P
    -/
    apply rp,
     /-
        pq : P → Q
        rp : R → P
        r : R
        ⊢ R
    -/
    exact r,
    /-
        No goals
    -/
end

theorem p02 : (P → Q) → (P → R) → (Q → R) :=
begin
  assume pq pr q,
  sorry,
end

theorem p03 : (P → Q) → (Q → R) → (P → R) :=
begin
    assume pq qr p,
    /-
        pq : P → Q
        qr : Q → R
        p : P
        ⊢ R
    -/
    apply qr,
    /-
        pq : P → Q
        qr : Q → R
        p : P
        ⊢ Q
    -/
    apply pq,
    /-
        pq : P → Q
        qr : Q → R
        p : P
        ⊢ P
    -/
    exact p,
    /-
        No goals
    -/
end

theorem e04 : P → (P → Q) → P ∧ Q :=
begin
    assume p pq,
    /-
        p : P
        pq : P → Q
        ⊢  P ∧ Q
    -/
    constructor,
    /-
        (Case 1)
        p : P
        pq : P → Q
        ⊢  P

        (Case 2)
        p : P
        pq : P → Q
        ⊢  Q
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    apply pq,
    /-
        (Case 2)
        p : P
        pq : P → Q
        ⊢  P
    -/
    exact p,
    /-
        No goals (Gets rid of Case 2)
    -/
end

theorem p05 : P ∨ Q → (P → Q) → Q :=
begin
    assume poq pq,
    /-
        poq : P ∨ Q
        pq : P → Q
        ⊢ Q
    -/
    cases poq with p q,
    /-
        (Case 1)
        p : P
        pq : P → Q
        ⊢ Q

        (Case 2)
        q : Q
        pq : P → Q
        ⊢ Q
    -/
    apply pq,
    /-
        (Case 1)
        p : P
        pq : P → Q
        ⊢ P

         (Case 2)
        q : Q
        pq : P → Q
        ⊢ Q
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    exact q,
    /-
        No goals (Gets rid of Case 2)
    -/
end

theorem p06 : (P → Q) → ¬ P ∨ Q :=
begin
    assume pq,
    /-
        pq : P → Q
        ⊢ ¬ P ∨ Q
    -/
    apply raa,
    /-
        pq : P → Q
        ⊢ ¬¬ (¬ P ∨ Q)
    -/
    assume h,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        ⊢ false
    -/
    apply h,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        ⊢ ¬P ∨ Q
    -/
    left,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        ⊢ ¬P
    -/
    assume p,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        p : P
        ⊢ false
    -/
    apply h,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        p : P
        ⊢ ¬P ∨ Q
    -/
    right,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        p : P
        ⊢ Q
    -/
    apply pq,
    /-
        pq : P → Q
        h : ¬(¬P ∨ Q)
        p : P
        ⊢ P
    -/
    exact np,
    /-
        No goals
    -/
end

theorem p07 : (¬ P ∨ Q) → P → Q :=
begin
    assume h p,
    /-
        h : ¬ P ∨ Q
        p : P
        ⊢ Q
    -/
    cases h with np q,
    /-
        (Case 1)
        np : ¬ P
        p : P
        ⊢ Q
        (Case 2)
        q : Q
        p : P
        ⊢ Q
    -/
    have f : false,
    /-
        (Case 1)
        np : ¬ P
        p : P
        ⊢ false

        (Case 2)
        np : ¬ P
        p : P
        f : false
        ⊢ Q

        (Case 3)
        q : Q
        p : P
        ⊢ Q
    -/
    apply np,
    /-
        (Case 1)
        np : ¬ P
        p : P
        ⊢ P

        (Case 2)
        np : ¬ P
        p : P
        f : false
        ⊢ Q

        (Case 3)
        q : Q
        p : P
        ⊢ Q
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    cases f,
    /-
        Gets rid of Case 2
    -/
    exact q,
    /-
        No goals (Gets rid of Case 3)
    -/
end

theorem p08 : ¬ (P ↔ ¬ P) :=
begin
    assume h,
    /-
        h : P ↔ ¬ P
        ⊢ false
    -/
    cases h with a b,
    /-
        (Case 1)
        a : P → ¬ P
        b : ¬ P → P
        ⊢ false
    -/
    have np : ¬ P,
    /-
        (Case 1)
        a : P → ¬ P
        b : ¬ P → P
        ⊢ ¬ P

        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ false
    -/
    assume npp,
    /-
        (Case 1)
        a : P → ¬ P
        b : ¬ P → P
        npp : P
        ⊢ false

        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ false
    -/
    apply a,
    /-
        (Case 1)
        a : P → ¬ P
        b : ¬ P → P
        npp : P
        ⊢ P

        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ false
    -/
    exact npp,
    /-
        (Case 1)
        a : P → ¬ P
        b : ¬ P → P
        npp : P
        ⊢ P

        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ false
    -/
    exact npp,
    /-
        Gets rid of Case 1
    -/
    apply a,
    /-
        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ P
    -/
    apply b,
    /-
        (Case 2)
        a : P → ¬ P
        b : ¬ P → P
        np : ¬ P
        ⊢ ¬ P
    -/
    exact np,
    apply b,
    exact np,
end

theorem p09 : ¬ P ↔ ¬ ¬ ¬ P :=
begin
    constructor,
    /-
        (Case 1)
        ¬ P → ¬ ¬ ¬ P

        (Case 2)
        ¬ ¬ ¬ P → ¬ P
    -/
    assume np nnp,
    /-
        (Case 1)
        np : ¬ P
        nnp : ¬ ¬ P
        ⊢ false

        (Case 2)
        ¬ ¬ ¬ P → ¬ P
    -/
    apply nnp,
    /-
        (Case 1)
        np : ¬ P
        nnp : ¬ ¬ P
        ⊢ ¬ P

        (Case 2)
        ¬ ¬ ¬ P → ¬ P
    -/
    exact np,
    /-
        Gets rid of Case 1
    -/
    assume nnnp p,
    /-
        (Case 2)
        nnnp : ¬ ¬ ¬ P
        p : P
        ⊢ false
    -/
    apply nnnp,
    /-
        (Case 2)
        nnnp : ¬ ¬ ¬ P
        p : P
        ⊢ ¬ ¬ P
    -/
    assume np,
    /-
        (Case 2)
        nnnp : ¬ ¬ ¬ P
        p : P
        np : ¬ P
        ⊢ false
    -/
    apply np,
    /-
        (Case 2)
        nnnp : ¬ ¬ ¬ P
        p : P
        np : ¬ P
        ⊢ P
    -/
    exact p
    /-
        No goals (Gets rid of Case 2)
    -/
end

theorem p10 : ((P → Q) → P) → P :=
begin
  assume pqp,
  apply raa,
  assume nnp,
  apply nnp,
  apply pqp,
  assume p,
  have f : false,
  apply nnp,
  exact p,
  cases f,
end


import tactic

variables (P Q R : Prop)

example : P → P :=
begin
    intro hP,
    exact hP,
end

example : P → (Q → P) :=
begin
    intro hP,
    intro hQ,
    exact hP,
end

example : P → Q → P :=
begin
    intro hP,
    intro hQ,
    exact hP,
end

theorem modus_ponens : P → (P → Q) → Q :=
begin
    intro hP,
    intro hPQ,
    apply hPQ,
    exact hP,
end

theorem transitivity : (P → Q) → (Q → R) → (P → R) :=
begin
    intro hPQ,
    intro hQR,
    intro hP,
    apply hQR,
    apply hPQ,
    exact hP,
end

example : (P → Q → R) → (P → Q) → (P → R) :=
begin
    intro hPQR,
    intro hPQ,
    intro hP,
    apply hPQR,
    exact hP,
    apply hPQ,
    exact hP,
end

-- in Lean, the definition of ¬ P is 'P → false'
-- one can prove it by considerind what happens if the value of P is true or false
example : P → ¬ (¬ P) :=
begin
    intro hP,
    change(¬ P → false),
    intro hnP,
    change P → false at hnP,
    apply hnP,
    exact hP,
end

example : P ∧ Q → P :=
begin
    intro hPaQ,
    cases hPaQ with hP hQ,
    exact hP,
end

theorem and.elim' : P ∧ Q → (P → Q → R) → R :=
begin
    intro hPaQ,
    intro hPQR,
    cases hPaQ with hP hQ,
    apply hPQR,
    exact hP,
    exact hQ,
end

theorem and.intro' : P → Q → P ∧ Q :=
begin
    intro hP,
    intro hQ,
    split,
    exact hP,
    exact hQ,
end


/-
Copyright (c) 2022 Praneeth Kolichala. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Praneeth Kolichala
-/
import topology.homotopy.equiv
import category_theory.equivalence
import algebraic_topology.fundamental_groupoid.product

/-!
# Homotopic maps induce naturally isomorphic functors

## Main definitions

  - `fundamental_groupoid_functor.homotopic_maps_nat_iso H` The natural isomorphism
    between the induced functors `f : π(X) ⥤ π(Y)` and `g : π(X) ⥤ π(Y)`, given a homotopy
    `H : f ∼ g`

  - `fundamental_groupoid_functor.equiv_of_homotopy_equiv hequiv` The equivalence of the categories
    `π(X)` and `π(Y)` given a homotopy equivalence `hequiv : X ≃ₕ Y` between them.

## Implementation notes
  - In order to be more universe polymorphic, we define `continuous_map.homotopy.ulift_map`
  which lifts a homotopy from `I × X → Y` to `(Top.of ((ulift I) × X)) → Y`. This is because
  this construction uses `fundamental_groupoid_functor.prod_to_prod_Top` to convert between
  pairs of paths in I and X and the corresponding path after passing through a homotopy `H`.
  But `fundamental_groupoid_functor.prod_to_prod_Top` requires two spaces in the same universe.
-/

noncomputable theory

universe u

open fundamental_groupoid
open category_theory
open fundamental_groupoid_functor

open_locale fundamental_groupoid
open_locale unit_interval

namespace unit_interval

/-- The path 0 ⟶ 1 in I -/
def path01 : path (0 : I) 1 := { to_fun := id, source' := rfl, target' := rfl }

/-- The path 0 ⟶ 1 in ulift I -/
def upath01 : path (ulift.up 0 : ulift.{u} I) (ulift.up 1) :=
{ to_fun := ulift.up, source' := rfl, target' := rfl }

local attribute [instance] path.homotopic.setoid
/-- The homotopy path class of 0 → 1 in `ulift I` -/
def uhpath01 : @from_top (Top.of $ ulift.{u} I) (ulift.up (0 : I)) ⟶ from_top (ulift.up 1) :=
⟦upath01⟧

end unit_interval

namespace continuous_map.homotopy
open unit_interval (uhpath01)

local attribute [instance] path.homotopic.setoid

section casts

/-- Abbreviation for `eq_to_hom` that accepts points in a topological space -/
abbreviation hcast {X : Top} {x₀ x₁ : X} (hx : x₀ = x₁) : from_top x₀ ⟶ from_top x₁ := eq_to_hom hx

@[simp] lemma hcast_def {X : Top} {x₀ x₁ : X} (hx₀ : x₀ = x₁) : hcast hx₀ = eq_to_hom hx₀ := rfl

variables {X₁ X₂ Y : Top.{u}} {f : C(X₁, Y)} {g : C(X₂, Y)}
  {x₀ x₁ : X₁} {x₂ x₃ : X₂} {p : path x₀ x₁} {q : path x₂ x₃} (hfg : ∀ t, f (p t) = g (q t))

include hfg

/-- If `f(p(t) = g(q(t))` for two paths `p` and `q`, then the induced path homotopy classes
`f(p)` and `g(p)` are the same as well, despite having a priori different types -/
lemma heq_path_of_eq_image : (πₘ f).map ⟦p⟧ == (πₘ g).map ⟦q⟧ :=
by { simp only [map_eq, ← path.homotopic.map_lift], apply path.homotopic.hpath_hext, exact hfg, }

private lemma start_path : f x₀ = g x₂ := by { convert hfg 0; simp only [path.source], }
private lemma end_path : f x₁ = g x₃ := by { convert hfg 1; simp only [path.target], }

lemma eq_path_of_eq_image :
  (πₘ f).map ⟦p⟧ = hcast (start_path hfg) ≫ (πₘ g).map ⟦q⟧ ≫ hcast (end_path hfg).symm :=
by { rw functor.conj_eq_to_hom_iff_heq, exact heq_path_of_eq_image hfg }

end casts

/- We let `X` and `Y` be spaces, and `f` and `g` be homotopic maps between them -/
variables {X Y : Top.{u}} {f g : C(X, Y)} (H : continuous_map.homotopy f g)
  {x₀ x₁ : X} (p : from_top x₀ ⟶ from_top x₁)

/-!
These definitions set up the following diagram, for each path `p`:

            f(p)
        *--------*
        | \      |
    H₀  |   \ d  |  H₁
        |     \  |
        *--------*
            g(p)

Here, `H₀ = H.eval_at x₀` is the path from `f(x₀)` to `g(x₀)`,
and similarly for `H₁`. Similarly, `f(p)` denotes the
path in Y that the induced map `f` takes `p`, and similarly for `g(p)`.

Finally, `d`, the diagonal path, is H(0 ⟶ 1, p), the result of the induced `H` on
`path.homotopic.prod (0 ⟶ 1) p`, where `(0 ⟶ 1)` denotes the path from `0` to `1` in `I`.

It is clear that the diagram commutes (`H₀ ≫ g(p) = d = f(p) ≫ H₁`), but unfortunately,
many of the paths do not have defeq starting/ending points, so we end up needing some casting.
-/

/-- Interpret a homotopy `H : C(I × X, Y) as a map C(ulift I × X, Y) -/
def ulift_map : C(Top.of (ulift.{u} I × X), Y) :=
⟨λ x, H (x.1.down, x.2),
  H.continuous.comp ((continuous_induced_dom.comp continuous_fst).prod_mk continuous_snd)⟩

@[simp] lemma ulift_apply (i : ulift.{u} I) (x : X) : H.ulift_map (i, x) = H (i.down, x) := rfl

/-- An abbreviation for `prod_to_prod_Top`, with some types already in place to help the
 typechecker. In particular, the first path should be on the ulifted unit interval. -/
abbreviation prod_to_prod_Top_I {a₁ a₂ : Top.of (ulift I)} {b₁ b₂ : X}
  (p₁ : from_top a₁ ⟶ from_top a₂) (p₂ : from_top b₁ ⟶ from_top b₂) :=
@category_theory.functor.map _ _ _ _ (prod_to_prod_Top (Top.of $ ulift I) X)
  (a₁, b₁) (a₂, b₂) (p₁, p₂)

/-- The diagonal path `d` of a homotopy `H` on a path `p` -/
def diagonal_path : from_top (H (0, x₀)) ⟶ from_top (H (1, x₁)) :=
(πₘ H.ulift_map).map (prod_to_prod_Top_I uhpath01 p)

/-- The diagonal path, but starting from `f x₀` and going to `g x₁` -/
def diagonal_path' : from_top (f x₀) ⟶ from_top (g x₁) :=
hcast (H.apply_zero x₀).symm ≫ (H.diagonal_path p) ≫ hcast (H.apply_one x₁)

/-- Proof that `f(p) = H(0 ⟶ 0, p)`, with the appropriate casts -/
lemma apply_zero_path : (πₘ f).map p = hcast (H.apply_zero x₀).symm ≫
(πₘ H.ulift_map).map (prod_to_prod_Top_I (𝟙 (ulift.up 0)) p) ≫
hcast (H.apply_zero x₁) :=
begin
  apply quotient.induction_on p,
  intro p',
  apply @eq_path_of_eq_image _ _ _ _ H.ulift_map _ _ _ _ _ ((path.refl (ulift.up _)).prod p'),
  simp,
end

/-- Proof that `g(p) = H(1 ⟶ 1, p)`, with the appropriate casts -/
lemma apply_one_path : (πₘ g).map p = hcast (H.apply_one x₀).symm ≫
((πₘ H.ulift_map).map (prod_to_prod_Top_I (𝟙 (ulift.up 1)) p)) ≫
hcast (H.apply_one x₁) :=
begin
  apply quotient.induction_on p,
  intro p',
  apply @eq_path_of_eq_image _ _ _ _ H.ulift_map _ _ _ _ _ ((path.refl (ulift.up _)).prod p'),
  simp,
end

/-- Proof that `H.eval_at x = H(0 ⟶ 1, x ⟶ x)`, with the appropriate casts -/
lemma eval_at_eq (x : X) : ⟦H.eval_at x⟧ =
  hcast (H.apply_zero x).symm ≫
(πₘ H.ulift_map).map (prod_to_prod_Top_I uhpath01 (𝟙 x)) ≫
hcast (H.apply_one x).symm.symm :=
begin
  dunfold prod_to_prod_Top_I uhpath01 hcast,
  refine (@functor.conj_eq_to_hom_iff_heq (πₓ Y) _ _ _ _ _ _ _ _ _).mpr _,
  simp only [id_eq_path_refl, prod_to_prod_Top_map, path.homotopic.prod_lift, map_eq,
    ← path.homotopic.map_lift],
  apply path.homotopic.hpath_hext, intro, refl,
end

/- Finally, we show `d = f(p) ≫ H₁ = H₀ ≫ g(p)` -/
lemma eq_diag_path :
  (πₘ f).map p ≫ ⟦H.eval_at x₁⟧ = H.diagonal_path' p ∧
  (⟦H.eval_at x₀⟧ ≫ (πₘ g).map p : from_top (f x₀) ⟶ from_top (g x₁)) = H.diagonal_path' p :=
begin
  rw [H.apply_zero_path, H.apply_one_path, H.eval_at_eq, H.eval_at_eq],
  dunfold prod_to_prod_Top_I,
  split; { slice_lhs 2 5 { simp [← category_theory.functor.map_comp], }, refl, },
end

end continuous_map.homotopy

namespace fundamental_groupoid_functor
open category_theory
open_locale fundamental_groupoid
local attribute [instance] path.homotopic.setoid

variables {X Y : Top.{u}} {f g : C(X, Y)} (H : continuous_map.homotopy f g)

/-- Given a homotopy H : f ∼ g, we have an associated natural isomorphism between the induced
functors `f` and `g` -/
def homotopic_maps_nat_iso : πₘ f ⟶ πₘ g :=
{ app := λ x, ⟦H.eval_at x⟧,
  naturality' := λ x y p, by rw [(H.eq_diag_path p).1, (H.eq_diag_path p).2] }

instance : is_iso (homotopic_maps_nat_iso H) := by apply nat_iso.is_iso_of_is_iso_app

open_locale continuous_map

/-- Homotopy equivalent topological spaces have equivalent fundamental groupoids. -/
def equiv_of_homotopy_equiv (hequiv : X ≃ₕ Y) : πₓ X ≌ πₓ Y :=
begin
  apply equivalence.mk
    (πₘ hequiv.to_fun : πₓ X ⥤ πₓ Y)
    (πₘ hequiv.inv_fun : πₓ Y ⥤ πₓ X);
  simp only [Groupoid.hom_to_functor, Groupoid.id_to_functor],
  { convert (as_iso (homotopic_maps_nat_iso hequiv.left_inv.some)).symm,
    exacts [((π).map_id X).symm, ((π).map_comp _ _).symm] },
  { convert as_iso (homotopic_maps_nat_iso hequiv.right_inv.some),
    exacts [((π).map_comp _ _).symm, ((π).map_id Y).symm] },
end

end fundamental_groupoid_functor


/-
Copyright (c) 2022 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler
-/
import measure_theory.integral.interval_integral
import measure_theory.integral.integral_eq_improper

/-!
# Integrals with exponential decay at ∞

As easy special cases of general theorems in the library, we prove the following test
for integrability:

* `integrable_of_is_O_exp_neg`: If `f` is continuous on `[a,∞)`, for some `a ∈ ℝ`, and there
  exists `b > 0` such that `f(x) = O(exp(-b x))` as `x → ∞`, then `f` is integrable on `(a, ∞)`.
-/

noncomputable theory
open real interval_integral measure_theory set filter

/-- Integral of `exp (-b * x)` over `(a, X)` is bounded as `X → ∞`. -/
lemma integral_exp_neg_le {b : ℝ} (a X : ℝ) (h2 : 0 < b) :
  (∫ x in a .. X, exp (-b * x)) ≤ exp (-b * a) / b :=
begin
  rw integral_deriv_eq_sub' (λ x, -exp (-b * x) / b),
  -- goal 1/4: F(X) - F(a) is bounded
  { simp only [tsub_le_iff_right],
    rw [neg_div b (exp (-b * a)), neg_div b (exp (-b * X)), add_neg_self, neg_le, neg_zero],
    exact (div_pos (exp_pos _) h2).le, },
  -- goal 2/4: the derivative of F is exp(-b x)
  { ext1, simp [h2.ne'] },
  -- goal 3/4: F is differentiable
  { intros x hx, simp [h2.ne'], },
  -- goal 4/4: exp(-b x) is continuous
  { apply continuous.continuous_on, continuity }
end

/-- `exp (-b * x)` is integrable on `(a, ∞)`. -/
lemma exp_neg_integrable_on_Ioi (a : ℝ) {b : ℝ} (h : 0 < b) :
  integrable_on (λ x : ℝ, exp (-b * x)) (Ioi a) :=
begin
  have : ∀ (X : ℝ), integrable_on (λ x : ℝ, exp (-b * x) ) (Ioc a X),
  { intro X, exact (continuous_const.mul continuous_id).exp.integrable_on_Ioc },
  apply (integrable_on_Ioi_of_interval_integral_norm_bounded (exp (-b * a) / b) a this tendsto_id),
  simp only [eventually_at_top, norm_of_nonneg (exp_pos _).le],
  exact ⟨a, λ b2 hb2, integral_exp_neg_le a b2 h⟩,
end

/-- If `f` is continuous on `[a, ∞)`, and is `O (exp (-b * x))` at `∞` for some `b > 0`, then
`f` is integrable on `(a, ∞)`. -/
lemma integrable_of_is_O_exp_neg {f : ℝ → ℝ} {a b : ℝ} (h0 : 0 < b)
  (h1 : continuous_on f (Ici a)) (h2 : f =O[at_top] (λ x, exp (-b * x))) :
  integrable_on f (Ioi a) :=
begin
  cases h2.is_O_with with c h3,
  rw [asymptotics.is_O_with_iff, eventually_at_top] at h3,
  cases h3 with r bdr,
  let v := max a r,
  -- show integrable on `(a, v]` from continuity
  have int_left : integrable_on f (Ioc a v),
  { rw ←(interval_integrable_iff_integrable_Ioc_of_le (le_max_left a r)),
    have u : Icc a v ⊆ Ici a := Icc_subset_Ici_self,
    exact (h1.mono u).interval_integrable_of_Icc (le_max_left a r), },
  suffices : integrable_on f (Ioi v),
  { have t : integrable_on f (Ioc a v ∪ Ioi v) := integrable_on_union.mpr ⟨int_left, this⟩,
    simpa only [Ioc_union_Ioi_eq_Ioi, le_max_iff, le_refl, true_or] using t },
  -- now show integrable on `(v, ∞)` from asymptotic
  split,
  { exact (h1.mono $ Ioi_subset_Ici $ le_max_left a r).ae_strongly_measurable measurable_set_Ioi },
  have : has_finite_integral (λ x : ℝ, c * exp (-b * x)) (volume.restrict (Ioi v)),
  { exact (exp_neg_integrable_on_Ioi v h0).has_finite_integral.const_mul c },
  apply this.mono,
  refine (ae_restrict_iff' measurable_set_Ioi).mpr _,
  refine ae_of_all _ (λ x h1x, _),
  rw [norm_mul, norm_eq_abs],
  rw [mem_Ioi] at h1x,
  specialize bdr x ((le_max_right a r).trans h1x.le),
  exact bdr.trans (mul_le_mul_of_nonneg_right (le_abs_self c) (norm_nonneg _))
end