/-
Copyright (c) 2020 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Riccardo Brasca
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.splitting_field
import Mathlib.ring_theory.roots_of_unity
import Mathlib.algebra.polynomial.big_operators
import Mathlib.number_theory.arithmetic_function
import Mathlib.data.polynomial.lifts
import Mathlib.analysis.complex.roots_of_unity
import Mathlib.field_theory.separable
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Cyclotomic polynomials.

For `n : ℕ` and an integral domain `R`, we define a modified version of the `n`-th cyclotomic
polynomial with coefficients in `R`, denoted `cyclotomic' n R`, as `∏ (X - μ)`, where `μ` varies
over the primitive `n`th roots of unity. If there is a primitive `n`th root of unity in `R` then
this the standard definition. We then define the standard cyclotomic polynomial `cyclotomic n R`
with coefficients in any ring `R`.

## Main definition

* `cyclotomic n R` : the `n`-th cyclotomic polynomial with coefficients in `R`.

## Main results

* `int_coeff_of_cycl` : If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K`
comes from a polynomial with integer coefficients.
* `deg_of_cyclotomic` : The degree of `cyclotomic n` is `totient n`.
* `prod_cyclotomic_eq_X_pow_sub_one` : `X ^ n - 1 = ∏ (cyclotomic i)`, where `i` divides `n`.
* `cyclotomic_eq_prod_X_pow_sub_one_pow_moebius` : The Möbius inversion formula for
  `cyclotomic n R` over an abstract fraction field for `polynomial R`.
* `cyclotomic.irreducible` : `cyclotomic n ℤ` is irreducible.

## Implementation details

Our definition of `cyclotomic' n R` makes sense in any integral domain `R`, but the interesting
results hold if there is a primitive `n`-th root of unity in `R`. In particular, our definition is
not the standard one unless there is a primitive `n`th root of unity in `R`. For example,
`cyclotomic' 3 ℤ = 1`, since there are no primitive cube roots of unity in `ℤ`. The main example is
`R = ℂ`, we decided to work in general since the difficulties are essentially the same.
To get the standard cyclotomic polynomials, we use `int_coeff_of_cycl`, with `R = ℂ`, to get a
polynomial with integer coefficients and then we map it to `polynomial R`, for any ring `R`.
To prove `cyclotomic.irreducible`, the irreducibility of `cyclotomic n ℤ`, we show in
`minpoly_primitive_root_eq_cyclotomic` that `cyclotomic n ℤ` is the minimal polynomial of
any `n`-th primitive root of unity `μ : K`, where `K` is a field of characteristic `0`.
-/

namespace polynomial

/-- The modified `n`-th cyclotomic polynomial with coefficients in `R`, it is the usual cyclotomic
polynomial if there is a primitive `n`-th root of unity in `R`. -/
def cyclotomic' (n : ℕ) (R : Type u_1) [integral_domain R] : polynomial R :=
  finset.prod (primitive_roots n R) fun (μ : R) => X - coe_fn C μ

/-- The zeroth modified cyclotomic polyomial is `1`. -/
@[simp] theorem cyclotomic'_zero (R : Type u_1) [integral_domain R] : cyclotomic' 0 R = 1 := sorry

/-- The first modified cyclotomic polyomial is `X - 1`. -/
@[simp] theorem cyclotomic'_one (R : Type u_1) [integral_domain R] : cyclotomic' 1 R = X - 1 := sorry

/-- The second modified cyclotomic polyomial is `X + 1` if the characteristic of `R` is not `2`. -/
@[simp] theorem cyclotomic'_two (R : Type u_1) [integral_domain R] (p : ℕ) [char_p R p] (hp : p ≠ bit0 1) : cyclotomic' (bit0 1) R = X + 1 := sorry

/-- `cyclotomic' n R` is monic. -/
theorem cyclotomic'.monic (n : ℕ) (R : Type u_1) [integral_domain R] : monic (cyclotomic' n R) :=
  monic_prod_of_monic (primitive_roots n R) (fun (μ : R) => X - coe_fn C μ)
    fun (z : R) (hz : z ∈ primitive_roots n R) => monic_X_sub_C z

/-- `cyclotomic' n R` is different from `0`. -/
theorem cyclotomic'_ne_zero (n : ℕ) (R : Type u_1) [integral_domain R] : cyclotomic' n R ≠ 0 :=
  monic.ne_zero (cyclotomic'.monic n R)

/-- The natural degree of `cyclotomic' n R` is `totient n` if there is a primitive root of
unity in `R`. -/
theorem nat_degree_cyclotomic' {R : Type u_1} [integral_domain R] {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) : nat_degree (cyclotomic' n R) = nat.totient n := sorry

/-- The degree of `cyclotomic' n R` is `totient n` if there is a primitive root of unity in `R`. -/
theorem degree_cyclotomic' {R : Type u_1} [integral_domain R] {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) : degree (cyclotomic' n R) = ↑(nat.totient n) := sorry

/-- The roots of `cyclotomic' n R` are the primitive `n`-th roots of unity. -/
theorem roots_of_cyclotomic (n : ℕ) (R : Type u_1) [integral_domain R] : roots (cyclotomic' n R) = finset.val (primitive_roots n R) := sorry

/-- If there is a primitive `n`th root of unity in `K`, then `X ^ n - 1 = ∏ (X - μ)`, where `μ`
varies over the `n`-th roots of unity. -/
theorem X_pow_sub_one_eq_prod {K : Type u_1} [field K] {ζ : K} {n : ℕ} (hpos : 0 < n) (h : is_primitive_root ζ n) : X ^ n - 1 = finset.prod (nth_roots_finset n K) fun (ζ : K) => X - coe_fn C ζ := sorry

/-- `cyclotomic' n K` splits. -/
theorem cyclotomic'_splits {K : Type u_1} [field K] (n : ℕ) : splits (ring_hom.id K) (cyclotomic' n K) :=
  splits_prod (ring_hom.id K)
    fun (z : K) (hz : z ∈ primitive_roots n K) =>
      eq.mpr (id (propext (iff_true_intro (splits_X_sub_C (ring_hom.id K))))) trivial

/-- If there is a primitive `n`-th root of unity in `K`, then `X ^ n - 1`splits. -/
theorem X_pow_sub_one_splits {K : Type u_1} [field K] {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) : splits (ring_hom.id K) (X ^ n - coe_fn C 1) := sorry

/-- If there is a primitive `n`-th root of unity in `K`, then
`∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1`. -/
theorem prod_cyclotomic'_eq_X_pow_sub_one {K : Type u_1} [field K] {ζ : K} {n : ℕ} (hpos : 0 < n) (h : is_primitive_root ζ n) : (finset.prod (nat.divisors n) fun (i : ℕ) => cyclotomic' i K) = X ^ n - 1 := sorry

/-- If there is a primitive `n`-th root of unity in `K`, then
`cyclotomic' n K = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic' i K)`. -/
theorem cyclotomic'_eq_X_pow_sub_one_div {K : Type u_1} [field K] {ζ : K} {n : ℕ} (hpos : 0 < n) (h : is_primitive_root ζ n) : cyclotomic' n K = (X ^ n - 1) /ₘ finset.prod (nat.proper_divisors n) fun (i : ℕ) => cyclotomic' i K := sorry

/-- If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K` comes from a
polynomial with integer coefficients. -/
theorem int_coeff_of_cyclotomic {K : Type u_1} [field K] {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) : ∃ (P : polynomial ℤ), map (int.cast_ring_hom K) P = cyclotomic' n K ∧ degree P = degree (cyclotomic' n K) ∧ monic P := sorry

/-- If `K` is of characteristic `0` and there is a primitive `n`-th root of unity in `K`,
then `cyclotomic n K` comes from a unique polynomial with integer coefficients. -/
theorem unique_int_coeff_of_cycl {K : Type u_1} [field K] [char_zero K] {ζ : K} {n : ℕ+} (h : is_primitive_root ζ ↑n) : exists_unique fun (P : polynomial ℤ) => map (int.cast_ring_hom K) P = cyclotomic' (↑n) K := sorry

/-- The `n`-th cyclotomic polynomial with coefficients in `R`. -/
def cyclotomic (n : ℕ) (R : Type u_1) [ring R] : polynomial R :=
  dite (n = 0) (fun (h : n = 0) => 1) fun (h : ¬n = 0) => map (int.cast_ring_hom R) (classical.some sorry)

theorem int_cyclotomic_rw {n : ℕ} (h : n ≠ 0) : cyclotomic n ℤ = classical.some (int_coeff_of_cyclotomic (complex.is_primitive_root_exp n h)) := sorry

/-- `cyclotomic n R` comes from `cyclotomic n ℤ`. -/
theorem map_cyclotomic_int (n : ℕ) (R : Type u_1) [ring R] : map (int.cast_ring_hom R) (cyclotomic n ℤ) = cyclotomic n R := sorry

theorem int_cyclotomic_spec (n : ℕ) : map (int.cast_ring_hom ℂ) (cyclotomic n ℤ) = cyclotomic' n ℂ ∧
  degree (cyclotomic n ℤ) = degree (cyclotomic' n ℂ) ∧ monic (cyclotomic n ℤ) := sorry

theorem int_cyclotomic_unique {n : ℕ} {P : polynomial ℤ} (h : map (int.cast_ring_hom ℂ) P = cyclotomic' n ℂ) : P = cyclotomic n ℤ := sorry

/-- The definition of `cyclotomic n R` commutes with any ring homomorphism. -/
@[simp] theorem map_cyclotomic (n : ℕ) {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R →+* S) : map f (cyclotomic n R) = cyclotomic n S := sorry

/-- The zeroth cyclotomic polyomial is `1`. -/
@[simp] theorem cyclotomic_zero (R : Type u_1) [ring R] : cyclotomic 0 R = 1 := sorry

/-- The first cyclotomic polyomial is `X - 1`. -/
@[simp] theorem cyclotomic_one (R : Type u_1) [ring R] : cyclotomic 1 R = X - 1 := sorry

/-- The second cyclotomic polyomial is `X + 1`. -/
@[simp] theorem cyclotomic_two (R : Type u_1) [ring R] : cyclotomic (bit0 1) R = X + 1 := sorry

/-- `cyclotomic n` is monic. -/
theorem cyclotomic.monic (n : ℕ) (R : Type u_1) [ring R] : monic (cyclotomic n R) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (monic (cyclotomic n R))) (Eq.symm (map_cyclotomic_int n R))))
    (monic_map (int.cast_ring_hom R) (and.right (and.right (int_cyclotomic_spec n))))

/-- `cyclotomic n R` is different from `0`. -/
theorem cyclotomic_ne_zero (n : ℕ) (R : Type u_1) [ring R] [nontrivial R] : cyclotomic n R ≠ 0 :=
  monic.ne_zero (cyclotomic.monic n R)

/-- The degree of `cyclotomic n` is `totient n`. -/
theorem degree_cyclotomic (n : ℕ) (R : Type u_1) [ring R] [nontrivial R] : degree (cyclotomic n R) = ↑(nat.totient n) := sorry

/-- The natural degree of `cyclotomic n` is `totient n`. -/
theorem nat_degree_cyclotomic (n : ℕ) (R : Type u_1) [ring R] [nontrivial R] : nat_degree (cyclotomic n R) = nat.totient n := sorry

/-- The degree of `cyclotomic n R` is positive. -/
theorem degree_cyclotomic_pos (n : ℕ) (R : Type u_1) (hpos : 0 < n) [ring R] [nontrivial R] : 0 < degree (cyclotomic n R) := sorry

/-- `∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1`. -/
theorem prod_cyclotomic_eq_X_pow_sub_one {n : ℕ} (hpos : 0 < n) (R : Type u_1) [comm_ring R] : (finset.prod (nat.divisors n) fun (i : ℕ) => cyclotomic i R) = X ^ n - 1 := sorry

/-- `cyclotomic n R` can be expressed as a product in a fraction field of `polynomial R`
  using Möbius inversion. -/
theorem cyclotomic_eq_prod_X_pow_sub_one_pow_moebius {n : ℕ} (hpos : 0 < n) (R : Type u_1) [comm_ring R] [nontrivial R] {K : Type u_2} [field K] (f : fraction_map (polynomial R) K) : coe_fn (localization_map.to_map f) (cyclotomic n R) =
  finset.prod (nat.divisors_antidiagonal n)
    fun (i : ℕ × ℕ) =>
      coe_fn (localization_map.to_map f) (X ^ prod.snd i - 1) ^ coe_fn nat.arithmetic_function.moebius (prod.fst i) := sorry

/-- We have
`cyclotomic n R = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic i K)`. -/
theorem cyclotomic_eq_X_pow_sub_one_div {R : Type u_1} [comm_ring R] [nontrivial R] {n : ℕ} (hpos : 0 < n) : cyclotomic n R = (X ^ n - 1) /ₘ finset.prod (nat.proper_divisors n) fun (i : ℕ) => cyclotomic i R := sorry

/-- If `m` is a proper divisor of `n`, then `X ^ m - 1` divides
`∏ i in nat.proper_divisors n, cyclotomic i R`. -/
theorem X_pow_sub_one_dvd_prod_cyclotomic (R : Type u_1) [comm_ring R] {n : ℕ} {m : ℕ} (hpos : 0 < n) (hm : m ∣ n) (hdiff : m ≠ n) : X ^ m - 1 ∣ finset.prod (nat.proper_divisors n) fun (i : ℕ) => cyclotomic i R := sorry

/-- If there is a primitive `n`-th root of unity in `K`, then
`cyclotomic n K = ∏ μ in primitive_roots n R, (X - C μ)`. In particular,
`cyclotomic n K = cyclotomic' n K` -/
theorem cyclotomic_eq_prod_X_sub_primitive_roots {K : Type u_1} [field K] {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) : cyclotomic n K = finset.prod (primitive_roots n K) fun (μ : K) => X - coe_fn C μ := sorry

/-- Any `n`-th primitive root of unity is a root of `cyclotomic n ℤ`.-/
theorem is_root_cyclotomic {n : ℕ} {K : Type u_1} [field K] (hpos : 0 < n) {μ : K} (h : is_primitive_root μ n) : is_root (cyclotomic n K) μ := sorry

theorem eq_cyclotomic_iff {R : Type u_1} [comm_ring R] [nontrivial R] {n : ℕ} (hpos : 0 < n) (P : polynomial R) : P = cyclotomic n R ↔ (P * finset.prod (nat.proper_divisors n) fun (i : ℕ) => cyclotomic i R) = X ^ n - 1 := sorry

/-- If `p` is prime, then `cyclotomic p R = geom_series X p`. -/
theorem cyclotomic_eq_geom_series {R : Type u_1} [comm_ring R] [nontrivial R] {p : ℕ} (hp : nat.prime p) : cyclotomic p R = geom_series X p := sorry

/-- The constant term of `cyclotomic n R` is `1` if `2 ≤ n`. -/
theorem cyclotomic_coeff_zero (R : Type u_1) [comm_ring R] {n : ℕ} (hn : bit0 1 ≤ n) : coeff (cyclotomic n R) 0 = 1 := sorry

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, where `p` is a prime, then `a` and `p` are
coprime. -/
theorem coprime_of_root_cyclotomic {n : ℕ} (hpos : 0 < n) {p : ℕ} [hprime : fact (nat.prime p)] {a : ℕ} (hroot : is_root (cyclotomic n (zmod p)) (coe_fn (nat.cast_ring_hom (zmod p)) a)) : nat.coprime a p := sorry

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, then the multiplicative order of `a` modulo
`p` divides `n`. -/
theorem order_of_root_cyclotomic_dvd {n : ℕ} (hpos : 0 < n) {p : ℕ} [hprime : fact (nat.prime p)] {a : ℕ} (hroot : is_root (cyclotomic n (zmod p)) (coe_fn (nat.cast_ring_hom (zmod p)) a)) : order_of (zmod.unit_of_coprime a (coprime_of_root_cyclotomic hpos hroot)) ∣ n := sorry

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, where `p` is a prime that does not divide
`n`, then the multiplicative order of `a` modulo `p` is exactly `n`. -/
theorem order_of_root_cyclotomic {n : ℕ} (hpos : 0 < n) {p : ℕ} [hprime : fact (nat.prime p)] {a : ℕ} (hn : ¬p ∣ n) (hroot : is_root (cyclotomic n (zmod p)) (coe_fn (nat.cast_ring_hom (zmod p)) a)) : order_of (zmod.unit_of_coprime a (coprime_of_root_cyclotomic hpos hroot)) = n := sorry

end polynomial

/-- The minimal polynomial of a primitive `n`-th root of unity `μ` divides `cyclotomic n ℤ`. -/
theorem minpoly_primitive_root_dvd_cyclotomic {n : ℕ} {K : Type u_1} [field K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] : minpoly ℤ μ ∣ polynomial.cyclotomic n ℤ := sorry

/-- `cyclotomic n ℤ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
theorem cyclotomic_eq_minpoly {n : ℕ} {K : Type u_1} [field K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] : polynomial.cyclotomic n ℤ = minpoly ℤ μ := sorry

/-- `cyclotomic n ℤ` is irreducible. -/
theorem cyclotomic.irreducible {n : ℕ} (hpos : 0 < n) : irreducible (polynomial.cyclotomic n ℤ) := sorry


import .definitions

namespace nt

/-
We've committed a minor sin here. We use a computational definition of gcd
(Euclid's algorithm) but we never actually prove that it computes the gcd;
we just state enough properties of it to ram through the proof of Euclid's
lemma.

This is fine from a formal perspective, but the pedagogy leaves something to
be desired. One question is whether we need to talk about Euclid's algorithm
at all? Is it possible to give a conceptual definition of gcd, get these 5
facts and proceed from there to Euclid's lemma? Are there going to be
decidability issues that force us to write down the computational definition
anyway if we go this route?
-/

-- ripped from mathlib
lemma gcd_dvd (m n : ℕ) : (nat.gcd m n ∣ m) ∧ (nat.gcd m n ∣ n) :=
nat.gcd.induction m n
  (λn, by rw nat.gcd_zero_left; exact ⟨dvd_zero n, dvd_refl n⟩)
  (λm n npos, by rw ←nat.gcd_rec; exact λ ⟨IH₁, IH₂⟩, ⟨IH₂, (nat.dvd_mod_iff IH₂).1 IH₁⟩)

-- ripped from mathlib
lemma dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ nat.gcd m n :=
nat.gcd.induction m n (λn _ kn, by rw nat.gcd_zero_left; exact kn)
  (λn m mpos IH H1 H2, by rw nat.gcd_rec; exact IH ((nat.dvd_mod_iff H1).2 H2) H1)

-- ripped from mathlib
lemma gcd_mul_left (m n k : ℕ) : nat.gcd (m * n) (m * k) = m * nat.gcd n k :=
nat.gcd.induction n k
  (λk, by repeat {rw nat.mul_zero <|> rw nat.gcd_zero_left})
  (λk n H IH, by rwa [←nat.mul_mod_mul_left, ←nat.gcd_rec, ←nat.gcd_rec] at IH)

-- ripped from mathlib
lemma gcd_mul_right (m n k : ℕ) : nat.gcd (m * n) (k * n) = nat.gcd m k * n :=
by rw [mul_comm m n, mul_comm k n, mul_comm (nat.gcd m k) n, gcd_mul_left]

lemma p_not_dvd_coprime {p n : ℕ} :
  ¬ p ∣ n → irreducible p → nat.gcd p n = 1 :=
begin
  intros, simp [irreducible] at a_1,
  have hdiv : (nat.gcd p n ∣ p) ∧ (nat.gcd p n ∣ n), from gcd_dvd p n,
  have : nat.gcd p n ∣ p, from hdiv.left,
  have h : nat.gcd p n = p ∨ nat.gcd p n = 1, from
    a_1.right.right (nat.gcd p n) this,
  cases h,
  { have : p ∣ n, by simp [a_2] at hdiv; exact hdiv, contradiction },
  { assumption }
end

end nt


import data.list.basic

open list

variables {α : Type*} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

attribute [simp] reverse_mk_symm

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp at h; assumption


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import data.matrix.block
import linear_algebra.matrix.finite_dimensional
import linear_algebra.std_basis
import ring_theory.algebra_tower

/-!
# Linear maps and matrices

This file defines the maps to send matrices to a linear map,
and to send linear maps between modules with a finite bases
to matrices. This defines a linear equivalence between linear maps
between finite-dimensional vector spaces and matrices indexed by
the respective bases.

## Main definitions

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

 * `linear_map.to_matrix`: given bases `v₁ : ι → M₁` and `v₂ : κ → M₂`,
   the `R`-linear equivalence from `M₁ →ₗ[R] M₂` to `matrix κ ι R`
 * `matrix.to_lin`: the inverse of `linear_map.to_matrix`
 * `linear_map.to_matrix'`: the `R`-linear equivalence from `(n → R) →ₗ[R] (m → R)`
   to `matrix n m R` (with the standard basis on `n → R` and `m → R`)
 * `matrix.to_lin'`: the inverse of `linear_map.to_matrix'`
 * `alg_equiv_matrix`: given a basis indexed by `n`, the `R`-algebra equivalence between
   `R`-endomorphisms of `M` and `matrix n n R`

## Tags

linear_map, matrix, linear_equiv, diagonal, det, trace
-/

noncomputable theory

open linear_map matrix set submodule
open_locale big_operators
open_locale matrix

universes u v w

section to_matrix'

instance {n m} [fintype m] [decidable_eq m] [fintype n] [decidable_eq n] (R) [fintype R] :
  fintype (matrix m n R) := by unfold matrix; apply_instance

variables {R : Type*} [comm_ring R]
variables {l m n : Type*}

/-- `matrix.mul_vec M` is a linear map. -/
def matrix.mul_vec_lin [fintype n] (M : matrix m n R) : (n → R) →ₗ[R] (m → R) :=
{ to_fun := M.mul_vec,
  map_add' := λ v w, funext (λ i, dot_product_add _ _ _),
  map_smul' := λ c v, funext (λ i, dot_product_smul _ _ _) }

@[simp] lemma matrix.mul_vec_lin_apply [fintype n] (M : matrix m n R) (v : n → R) :
  matrix.mul_vec_lin M v = M.mul_vec v := rfl

variables [fintype n] [decidable_eq n]

@[simp] lemma matrix.mul_vec_std_basis (M : matrix m n R) (i j) :
  M.mul_vec (std_basis R (λ _, R) j 1) i = M i j :=
begin
  have : (∑ j', M i j' * if j = j' then 1 else 0) = M i j,
  { simp_rw [mul_boole, finset.sum_ite_eq, finset.mem_univ, if_true] },
  convert this,
  ext,
  split_ifs with h; simp only [std_basis_apply],
  { rw [h, function.update_same] },
  { rw [function.update_noteq (ne.symm h), pi.zero_apply] }
end

/-- Linear maps `(n → R) →ₗ[R] (m → R)` are linearly equivalent to `matrix m n R`. -/
def linear_map.to_matrix' : ((n → R) →ₗ[R] (m → R)) ≃ₗ[R] matrix m n R :=
{ to_fun := λ f i j, f (std_basis R (λ _, R) j 1) i,
  inv_fun := matrix.mul_vec_lin,
  right_inv := λ M, by { ext i j, simp only [matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply] },
  left_inv := λ f, begin
    apply (pi.basis_fun R n).ext,
    intro j, ext i,
    simp only [pi.basis_fun_apply, matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply]
  end,
  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply] },
  map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply,
                                               ring_hom.id_apply] } }

/-- A `matrix m n R` is linearly equivalent to a linear map `(n → R) →ₗ[R] (m → R)`. -/
def matrix.to_lin' : matrix m n R ≃ₗ[R] ((n → R) →ₗ[R] (m → R)) :=
linear_map.to_matrix'.symm

@[simp] lemma linear_map.to_matrix'_symm :
  (linear_map.to_matrix'.symm : matrix m n R ≃ₗ[R] _) = matrix.to_lin' :=
rfl

@[simp] lemma matrix.to_lin'_symm :
  (matrix.to_lin'.symm : ((n → R) →ₗ[R] (m → R)) ≃ₗ[R] _) = linear_map.to_matrix' :=
rfl

@[simp] lemma linear_map.to_matrix'_to_lin' (M : matrix m n R) :
  linear_map.to_matrix' (matrix.to_lin' M) = M :=
linear_map.to_matrix'.apply_symm_apply M

@[simp] lemma matrix.to_lin'_to_matrix' (f : (n → R) →ₗ[R] (m → R)) :
  matrix.to_lin' (linear_map.to_matrix' f) = f :=
matrix.to_lin'.apply_symm_apply f

@[simp] lemma linear_map.to_matrix'_apply (f : (n → R) →ₗ[R] (m → R)) (i j) :
  linear_map.to_matrix' f i j = f (λ j', if j' = j then 1 else 0) i :=
begin
  simp only [linear_map.to_matrix', linear_equiv.coe_mk],
  congr,
  ext j',
  split_ifs with h,
  { rw [h, std_basis_same] },
  apply std_basis_ne _ _ _ _ h
end

@[simp] lemma matrix.to_lin'_apply (M : matrix m n R) (v : n → R) :
  matrix.to_lin' M v = M.mul_vec v := rfl

@[simp] lemma matrix.to_lin'_one :
  matrix.to_lin' (1 : matrix n n R) = id :=
by { ext, simp [linear_map.one_apply, std_basis_apply] }

@[simp] lemma linear_map.to_matrix'_id :
  (linear_map.to_matrix' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
by { ext, rw [matrix.one_apply, linear_map.to_matrix'_apply, id_apply] }

@[simp] lemma matrix.to_lin'_mul [fintype m] [decidable_eq m] (M : matrix l m R)
  (N : matrix m n R) : matrix.to_lin' (M ⬝ N) = (matrix.to_lin' M).comp (matrix.to_lin' N) :=
by { ext, simp }

/-- Shortcut lemma for `matrix.to_lin'_mul` and `linear_map.comp_apply` -/
lemma matrix.to_lin'_mul_apply [fintype m] [decidable_eq m] (M : matrix l m R)
  (N : matrix m n R) (x) : matrix.to_lin' (M ⬝ N) x = (matrix.to_lin' M (matrix.to_lin' N x)) :=
by rw [matrix.to_lin'_mul, linear_map.comp_apply]

lemma linear_map.to_matrix'_comp [fintype l] [decidable_eq l]
  (f : (n → R) →ₗ[R] (m → R)) (g : (l → R) →ₗ[R] (n → R)) :
  (f.comp g).to_matrix' = f.to_matrix' ⬝ g.to_matrix' :=
suffices (f.comp g) = (f.to_matrix' ⬝ g.to_matrix').to_lin',
  by rw [this, linear_map.to_matrix'_to_lin'],
by rw [matrix.to_lin'_mul, matrix.to_lin'_to_matrix', matrix.to_lin'_to_matrix']

lemma linear_map.to_matrix'_mul [fintype m] [decidable_eq m]
  (f g : (m → R) →ₗ[R] (m → R)) :
  (f * g).to_matrix' = f.to_matrix' ⬝ g.to_matrix' :=
linear_map.to_matrix'_comp f g

@[simp] lemma linear_map.to_matrix'_algebra_map (x : R) :
  linear_map.to_matrix' (algebra_map R (module.End R (n → R)) x) = scalar n x :=
by simp [module.algebra_map_End_eq_smul_id]

lemma matrix.ker_to_lin'_eq_bot_iff {M : matrix n n R} :
  M.to_lin'.ker = ⊥ ↔ ∀ v, M.mul_vec v = 0 → v = 0 :=
by simp only [submodule.eq_bot_iff, linear_map.mem_ker, matrix.to_lin'_apply]

/-- If `M` and `M'` are each other's inverse matrices, they provide an equivalence between `m → A`
and `n → A` corresponding to `M.mul_vec` and `M'.mul_vec`. -/
@[simps]
def matrix.to_lin'_of_inv [fintype m] [decidable_eq m]
  {M : matrix m n R} {M' : matrix n m R}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  (m → R) ≃ₗ[R] (n → R) :=
{ to_fun := matrix.to_lin' M',
  inv_fun := M.to_lin',
  left_inv := λ x, by rw [← matrix.to_lin'_mul_apply, hMM', matrix.to_lin'_one, id_apply],
  right_inv := λ x, by rw [← matrix.to_lin'_mul_apply, hM'M, matrix.to_lin'_one, id_apply],
  .. matrix.to_lin' M' }

/-- Linear maps `(n → R) →ₗ[R] (n → R)` are algebra equivalent to `matrix n n R`. -/
def linear_map.to_matrix_alg_equiv' : ((n → R) →ₗ[R] (n → R)) ≃ₐ[R] matrix n n R :=
alg_equiv.of_linear_equiv linear_map.to_matrix' linear_map.to_matrix'_mul
  linear_map.to_matrix'_algebra_map

/-- A `matrix n n R` is algebra equivalent to a linear map `(n → R) →ₗ[R] (n → R)`. -/
def matrix.to_lin_alg_equiv' : matrix n n R ≃ₐ[R] ((n → R) →ₗ[R] (n → R)) :=
linear_map.to_matrix_alg_equiv'.symm

@[simp] lemma linear_map.to_matrix_alg_equiv'_symm :
  (linear_map.to_matrix_alg_equiv'.symm : matrix n n R ≃ₐ[R] _) = matrix.to_lin_alg_equiv' :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv'_symm :
  (matrix.to_lin_alg_equiv'.symm : ((n → R) →ₗ[R] (n → R)) ≃ₐ[R] _) =
    linear_map.to_matrix_alg_equiv' :=
rfl

@[simp] lemma linear_map.to_matrix_alg_equiv'_to_lin_alg_equiv' (M : matrix n n R) :
  linear_map.to_matrix_alg_equiv' (matrix.to_lin_alg_equiv' M) = M :=
linear_map.to_matrix_alg_equiv'.apply_symm_apply M

@[simp] lemma matrix.to_lin_alg_equiv'_to_matrix_alg_equiv' (f : (n → R) →ₗ[R] (n → R)) :
  matrix.to_lin_alg_equiv' (linear_map.to_matrix_alg_equiv' f) = f :=
matrix.to_lin_alg_equiv'.apply_symm_apply f

@[simp] lemma linear_map.to_matrix_alg_equiv'_apply (f : (n → R) →ₗ[R] (n → R)) (i j) :
  linear_map.to_matrix_alg_equiv' f i j = f (λ j', if j' = j then 1 else 0) i :=
by simp [linear_map.to_matrix_alg_equiv']

@[simp] lemma matrix.to_lin_alg_equiv'_apply (M : matrix n n R) (v : n → R) :
  matrix.to_lin_alg_equiv' M v = M.mul_vec v := rfl

@[simp] lemma matrix.to_lin_alg_equiv'_one :
  matrix.to_lin_alg_equiv' (1 : matrix n n R) = id :=
by { ext, simp [matrix.one_apply, std_basis_apply] }

@[simp] lemma linear_map.to_matrix_alg_equiv'_id :
  (linear_map.to_matrix_alg_equiv' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
by { ext, rw [matrix.one_apply, linear_map.to_matrix_alg_equiv'_apply, id_apply] }

@[simp] lemma matrix.to_lin_alg_equiv'_mul (M N : matrix n n R) :
  matrix.to_lin_alg_equiv' (M ⬝ N) =
    (matrix.to_lin_alg_equiv' M).comp (matrix.to_lin_alg_equiv' N) :=
by { ext, simp }

lemma linear_map.to_matrix_alg_equiv'_comp (f g : (n → R) →ₗ[R] (n → R)) :
  (f.comp g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
suffices (f.comp g) = (f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv').to_lin_alg_equiv',
  by rw [this, linear_map.to_matrix_alg_equiv'_to_lin_alg_equiv'],
by rw [matrix.to_lin_alg_equiv'_mul, matrix.to_lin_alg_equiv'_to_matrix_alg_equiv',
       matrix.to_lin_alg_equiv'_to_matrix_alg_equiv']

lemma linear_map.to_matrix_alg_equiv'_mul
  (f g : (n → R) →ₗ[R] (n → R)) :
  (f * g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
linear_map.to_matrix_alg_equiv'_comp f g

lemma matrix.rank_vec_mul_vec {K m n : Type u} [field K] [fintype n] [decidable_eq n]
  (w : m → K) (v : n → K) :
  rank (vec_mul_vec w v).to_lin' ≤ 1 :=
begin
  rw [vec_mul_vec_eq, matrix.to_lin'_mul],
  refine le_trans (rank_comp_le1 _ _) _,
  refine (rank_le_domain _).trans_eq _,
  rw [dim_fun', fintype.card_unit, nat.cast_one]
end

end to_matrix'

section to_matrix

variables {R : Type*} [comm_ring R]
variables {l m n : Type*} [fintype n] [fintype m] [decidable_eq n]
variables {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂] [module R M₁] [module R M₂]
variables (v₁ : basis n R M₁) (v₂ : basis m R M₂)

/-- Given bases of two modules `M₁` and `M₂` over a commutative ring `R`, we get a linear
equivalence between linear maps `M₁ →ₗ M₂` and matrices over `R` indexed by the bases. -/
def linear_map.to_matrix : (M₁ →ₗ[R] M₂) ≃ₗ[R] matrix m n R :=
linear_equiv.trans (linear_equiv.arrow_congr v₁.equiv_fun v₂.equiv_fun) linear_map.to_matrix'

/-- `linear_map.to_matrix'` is a particular case of `linear_map.to_matrix`, for the standard basis
`pi.basis_fun R n`. -/
lemma linear_map.to_matrix_eq_to_matrix' :
  linear_map.to_matrix (pi.basis_fun R n) (pi.basis_fun R n) = linear_map.to_matrix' :=
rfl

/-- Given bases of two modules `M₁` and `M₂` over a commutative ring `R`, we get a linear
equivalence between matrices over `R` indexed by the bases and linear maps `M₁ →ₗ M₂`. -/
def matrix.to_lin : matrix m n R ≃ₗ[R] (M₁ →ₗ[R] M₂) :=
(linear_map.to_matrix v₁ v₂).symm

/-- `matrix.to_lin'` is a particular case of `matrix.to_lin`, for the standard basis
`pi.basis_fun R n`. -/
lemma matrix.to_lin_eq_to_lin' :
  matrix.to_lin (pi.basis_fun R n) (pi.basis_fun R n) = matrix.to_lin' :=
rfl

@[simp] lemma linear_map.to_matrix_symm :
  (linear_map.to_matrix v₁ v₂).symm = matrix.to_lin v₁ v₂ :=
rfl

@[simp] lemma matrix.to_lin_symm :
  (matrix.to_lin v₁ v₂).symm = linear_map.to_matrix v₁ v₂ :=
rfl

@[simp] lemma matrix.to_lin_to_matrix (f : M₁ →ₗ[R] M₂) :
  matrix.to_lin v₁ v₂ (linear_map.to_matrix v₁ v₂ f) = f :=
by rw [← matrix.to_lin_symm, linear_equiv.apply_symm_apply]

@[simp] lemma linear_map.to_matrix_to_lin (M : matrix m n R) :
  linear_map.to_matrix v₁ v₂ (matrix.to_lin v₁ v₂ M) = M :=
by rw [← matrix.to_lin_symm, linear_equiv.symm_apply_apply]

lemma linear_map.to_matrix_apply (f : M₁ →ₗ[R] M₂) (i : m) (j : n) :
  linear_map.to_matrix v₁ v₂ f i j = v₂.repr (f (v₁ j)) i :=
begin
  rw [linear_map.to_matrix, linear_equiv.trans_apply, linear_map.to_matrix'_apply,
      linear_equiv.arrow_congr_apply, basis.equiv_fun_symm_apply, finset.sum_eq_single j,
      if_pos rfl, one_smul, basis.equiv_fun_apply],
  { intros j' _ hj',
    rw [if_neg hj', zero_smul] },
  { intro hj,
    have := finset.mem_univ j,
    contradiction }
end

lemma linear_map.to_matrix_transpose_apply (f : M₁ →ₗ[R] M₂) (j : n) :
  (linear_map.to_matrix v₁ v₂ f)ᵀ j = v₂.repr (f (v₁ j)) :=
funext $ λ i, f.to_matrix_apply _ _ i j

lemma linear_map.to_matrix_apply' (f : M₁ →ₗ[R] M₂) (i : m) (j : n) :
  linear_map.to_matrix v₁ v₂ f i j = v₂.repr (f (v₁ j)) i :=
linear_map.to_matrix_apply v₁ v₂ f i j

lemma linear_map.to_matrix_transpose_apply' (f : M₁ →ₗ[R] M₂) (j : n) :
  (linear_map.to_matrix v₁ v₂ f)ᵀ j = v₂.repr (f (v₁ j)) :=
linear_map.to_matrix_transpose_apply v₁ v₂ f j

lemma matrix.to_lin_apply (M : matrix m n R) (v : M₁) :
  matrix.to_lin v₁ v₂ M v = ∑ j, M.mul_vec (v₁.repr v) j • v₂ j :=
show v₂.equiv_fun.symm (matrix.to_lin' M (v₁.repr v)) = _,
by rw [matrix.to_lin'_apply, v₂.equiv_fun_symm_apply]

@[simp] lemma matrix.to_lin_self (M : matrix m n R) (i : n) :
  matrix.to_lin v₁ v₂ M (v₁ i) = ∑ j, M j i • v₂ j :=
begin
  rw [matrix.to_lin_apply, finset.sum_congr rfl (λ j hj, _)],
  rw [basis.repr_self, matrix.mul_vec, dot_product, finset.sum_eq_single i,
      finsupp.single_eq_same, mul_one],
  { intros i' _ i'_ne, rw [finsupp.single_eq_of_ne i'_ne.symm, mul_zero] },
  { intros,
    have := finset.mem_univ i,
    contradiction },
end

/-- This will be a special case of `linear_map.to_matrix_id_eq_basis_to_matrix`. -/
lemma linear_map.to_matrix_id : linear_map.to_matrix v₁ v₁ id = 1 :=
begin
  ext i j,
  simp [linear_map.to_matrix_apply, matrix.one_apply, finsupp.single, eq_comm]
end

lemma linear_map.to_matrix_one : linear_map.to_matrix v₁ v₁ 1 = 1 :=
linear_map.to_matrix_id v₁

@[simp]
lemma matrix.to_lin_one : matrix.to_lin v₁ v₁ 1 = id :=
by rw [← linear_map.to_matrix_id v₁, matrix.to_lin_to_matrix]

theorem linear_map.to_matrix_reindex_range [decidable_eq M₁] [decidable_eq M₂]
  (f : M₁ →ₗ[R] M₂) (k : m) (i : n) :
  linear_map.to_matrix v₁.reindex_range v₂.reindex_range f
      ⟨v₂ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix v₁ v₂ f k i :=
by simp_rw [linear_map.to_matrix_apply, basis.reindex_range_self, basis.reindex_range_repr]

variables {M₃ : Type*} [add_comm_group M₃] [module R M₃] (v₃ : basis l R M₃)

lemma linear_map.to_matrix_comp [fintype l] [decidable_eq m] (f : M₂ →ₗ[R] M₃) (g : M₁ →ₗ[R] M₂) :
  linear_map.to_matrix v₁ v₃ (f.comp g) =
  linear_map.to_matrix v₂ v₃ f ⬝ linear_map.to_matrix v₁ v₂ g :=
by simp_rw [linear_map.to_matrix, linear_equiv.trans_apply,
            linear_equiv.arrow_congr_comp _ v₂.equiv_fun, linear_map.to_matrix'_comp]

lemma linear_map.to_matrix_mul (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix v₁ v₁ (f * g) =
    linear_map.to_matrix v₁ v₁ f ⬝ linear_map.to_matrix v₁ v₁ g :=
by { rw [show (@has_mul.mul (M₁ →ₗ[R] M₁) _) = linear_map.comp, from rfl,
         linear_map.to_matrix_comp v₁ v₁ v₁ f g] }

@[simp] lemma linear_map.to_matrix_algebra_map (x : R) :
  linear_map.to_matrix v₁ v₁ (algebra_map R (module.End R M₁) x) = scalar n x :=
by simp [module.algebra_map_End_eq_smul_id, linear_map.to_matrix_id]

lemma linear_map.to_matrix_mul_vec_repr (f : M₁ →ₗ[R] M₂) (x : M₁) :
  (linear_map.to_matrix v₁ v₂ f).mul_vec (v₁.repr x) = v₂.repr (f x) :=
by { ext i,
     rw [← matrix.to_lin'_apply, linear_map.to_matrix, linear_equiv.trans_apply,
         matrix.to_lin'_to_matrix', linear_equiv.arrow_congr_apply, v₂.equiv_fun_apply],
     congr,
     exact v₁.equiv_fun.symm_apply_apply x }

lemma matrix.to_lin_mul [fintype l] [decidable_eq m] (A : matrix l m R) (B : matrix m n R) :
  matrix.to_lin v₁ v₃ (A ⬝ B) =
  (matrix.to_lin v₂ v₃ A).comp (matrix.to_lin v₁ v₂ B) :=
begin
  apply (linear_map.to_matrix v₁ v₃).injective,
  haveI : decidable_eq l := λ _ _, classical.prop_decidable _,
  rw linear_map.to_matrix_comp v₁ v₂ v₃,
  repeat { rw linear_map.to_matrix_to_lin },
end

/-- Shortcut lemma for `matrix.to_lin_mul` and `linear_map.comp_apply`. -/
lemma matrix.to_lin_mul_apply [fintype l] [decidable_eq m]
  (A : matrix l m R) (B : matrix m n R) (x) :
  matrix.to_lin v₁ v₃ (A ⬝ B) x =
    (matrix.to_lin v₂ v₃ A) (matrix.to_lin v₁ v₂ B x) :=
by rw [matrix.to_lin_mul v₁ v₂, linear_map.comp_apply]

/-- If `M` and `M` are each other's inverse matrices, `matrix.to_lin M` and `matrix.to_lin M'`
form a linear equivalence. -/
@[simps]
def matrix.to_lin_of_inv [decidable_eq m]
  {M : matrix m n R} {M' : matrix n m R}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  M₁ ≃ₗ[R] M₂ :=
{ to_fun := matrix.to_lin v₁ v₂ M,
  inv_fun := matrix.to_lin v₂ v₁ M',
  left_inv := λ x, by rw [← matrix.to_lin_mul_apply, hM'M, matrix.to_lin_one, id_apply],
  right_inv := λ x, by rw [← matrix.to_lin_mul_apply, hMM', matrix.to_lin_one, id_apply],
  .. matrix.to_lin v₁ v₂ M }

/-- Given a basis of a module `M₁` over a commutative ring `R`, we get an algebra
equivalence between linear maps `M₁ →ₗ M₁` and square matrices over `R` indexed by the basis. -/
def linear_map.to_matrix_alg_equiv :
  (M₁ →ₗ[R] M₁) ≃ₐ[R] matrix n n R :=
alg_equiv.of_linear_equiv (linear_map.to_matrix v₁ v₁) (linear_map.to_matrix_mul v₁)
  (linear_map.to_matrix_algebra_map v₁)

/-- Given a basis of a module `M₁` over a commutative ring `R`, we get an algebra
equivalence between square matrices over `R` indexed by the basis and linear maps `M₁ →ₗ M₁`. -/
def matrix.to_lin_alg_equiv : matrix n n R ≃ₐ[R] (M₁ →ₗ[R] M₁) :=
(linear_map.to_matrix_alg_equiv v₁).symm

@[simp] lemma linear_map.to_matrix_alg_equiv_symm :
  (linear_map.to_matrix_alg_equiv v₁).symm = matrix.to_lin_alg_equiv v₁ :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv_symm :
  (matrix.to_lin_alg_equiv v₁).symm = linear_map.to_matrix_alg_equiv v₁ :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv_to_matrix_alg_equiv (f : M₁ →ₗ[R] M₁) :
  matrix.to_lin_alg_equiv v₁ (linear_map.to_matrix_alg_equiv v₁ f) = f :=
by rw [← matrix.to_lin_alg_equiv_symm, alg_equiv.apply_symm_apply]

@[simp] lemma linear_map.to_matrix_alg_equiv_to_lin_alg_equiv (M : matrix n n R) :
  linear_map.to_matrix_alg_equiv v₁ (matrix.to_lin_alg_equiv v₁ M) = M :=
by rw [← matrix.to_lin_alg_equiv_symm, alg_equiv.symm_apply_apply]

lemma linear_map.to_matrix_alg_equiv_apply (f : M₁ →ₗ[R] M₁) (i j : n) :
  linear_map.to_matrix_alg_equiv v₁ f i j = v₁.repr (f (v₁ j)) i :=
by simp [linear_map.to_matrix_alg_equiv, linear_map.to_matrix_apply]

lemma linear_map.to_matrix_alg_equiv_transpose_apply (f : M₁ →ₗ[R] M₁) (j : n) :
  (linear_map.to_matrix_alg_equiv v₁ f)ᵀ j = v₁.repr (f (v₁ j)) :=
funext $ λ i, f.to_matrix_apply _ _ i j

lemma linear_map.to_matrix_alg_equiv_apply' (f : M₁ →ₗ[R] M₁) (i j : n) :
  linear_map.to_matrix_alg_equiv v₁ f i j = v₁.repr (f (v₁ j)) i :=
linear_map.to_matrix_alg_equiv_apply v₁ f i j

lemma linear_map.to_matrix_alg_equiv_transpose_apply' (f : M₁ →ₗ[R] M₁) (j : n) :
  (linear_map.to_matrix_alg_equiv v₁ f)ᵀ j = v₁.repr (f (v₁ j)) :=
linear_map.to_matrix_alg_equiv_transpose_apply v₁ f j

lemma matrix.to_lin_alg_equiv_apply (M : matrix n n R) (v : M₁) :
  matrix.to_lin_alg_equiv v₁ M v = ∑ j, M.mul_vec (v₁.repr v) j • v₁ j :=
show v₁.equiv_fun.symm (matrix.to_lin_alg_equiv' M (v₁.repr v)) = _,
by rw [matrix.to_lin_alg_equiv'_apply, v₁.equiv_fun_symm_apply]

@[simp] lemma matrix.to_lin_alg_equiv_self (M : matrix n n R) (i : n) :
  matrix.to_lin_alg_equiv v₁ M (v₁ i) = ∑ j, M j i • v₁ j :=
matrix.to_lin_self _ _ _ _

lemma linear_map.to_matrix_alg_equiv_id : linear_map.to_matrix_alg_equiv v₁ id = 1 :=
by simp_rw [linear_map.to_matrix_alg_equiv, alg_equiv.of_linear_equiv_apply,
            linear_map.to_matrix_id]

@[simp]
lemma matrix.to_lin_alg_equiv_one : matrix.to_lin_alg_equiv v₁ 1 = id :=
by rw [← linear_map.to_matrix_alg_equiv_id v₁, matrix.to_lin_alg_equiv_to_matrix_alg_equiv]

theorem linear_map.to_matrix_alg_equiv_reindex_range [decidable_eq M₁]
  (f : M₁ →ₗ[R] M₁) (k i : n) :
  linear_map.to_matrix_alg_equiv v₁.reindex_range f
      ⟨v₁ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix_alg_equiv v₁ f k i :=
by simp_rw [linear_map.to_matrix_alg_equiv_apply,
            basis.reindex_range_self, basis.reindex_range_repr]

lemma linear_map.to_matrix_alg_equiv_comp (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix_alg_equiv v₁ (f.comp g) =
  linear_map.to_matrix_alg_equiv v₁ f ⬝ linear_map.to_matrix_alg_equiv v₁ g :=
by simp [linear_map.to_matrix_alg_equiv, linear_map.to_matrix_comp v₁ v₁ v₁ f g]

lemma linear_map.to_matrix_alg_equiv_mul (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix_alg_equiv v₁ (f * g) =
    linear_map.to_matrix_alg_equiv v₁ f ⬝ linear_map.to_matrix_alg_equiv v₁ g :=
by { rw [show (@has_mul.mul (M₁ →ₗ[R] M₁) _) = linear_map.comp, from rfl,
         linear_map.to_matrix_alg_equiv_comp v₁ f g] }

lemma matrix.to_lin_alg_equiv_mul (A B : matrix n n R) :
  matrix.to_lin_alg_equiv v₁ (A ⬝ B) =
  (matrix.to_lin_alg_equiv v₁ A).comp (matrix.to_lin_alg_equiv v₁ B) :=
by convert matrix.to_lin_mul v₁ v₁ v₁ A B

end to_matrix

namespace algebra

section lmul

variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
variables [algebra R S] [algebra S T] [algebra R T] [is_scalar_tower R S T]
variables {m n : Type*} [fintype m] [decidable_eq m] [decidable_eq n]
variables (b : basis m R S) (c : basis n S T)

open algebra

lemma to_matrix_lmul' (x : S) (i j) :
  linear_map.to_matrix b b (lmul R S x) i j = b.repr (x * b j) i :=
by rw [linear_map.to_matrix_apply', lmul_apply]

@[simp] lemma to_matrix_lsmul (x : R) (i j) :
  linear_map.to_matrix b b (algebra.lsmul R S x) i j = if i = j then x else 0 :=
by { rw [linear_map.to_matrix_apply', algebra.lsmul_coe, linear_equiv.map_smul, finsupp.smul_apply,
         b.repr_self_apply, smul_eq_mul, mul_boole],
     congr' 1; simp only [eq_comm] }

/-- `left_mul_matrix b x` is the matrix corresponding to the linear map `λ y, x * y`.

`left_mul_matrix_eq_repr_mul` gives a formula for the entries of `left_mul_matrix`.

This definition is useful for doing (more) explicit computations with `algebra.lmul`,
such as the trace form or norm map for algebras.
-/
noncomputable def left_mul_matrix : S →ₐ[R] matrix m m R :=
{ to_fun := λ x, linear_map.to_matrix b b (algebra.lmul R S x),
  map_zero' := by rw [alg_hom.map_zero, linear_equiv.map_zero],
  map_one' := by rw [alg_hom.map_one, linear_map.to_matrix_one],
  map_add' := λ x y, by rw [alg_hom.map_add, linear_equiv.map_add],
  map_mul' := λ x y, by rw [alg_hom.map_mul, linear_map.to_matrix_mul, matrix.mul_eq_mul],
  commutes' := λ r, by { ext, rw [lmul_algebra_map, to_matrix_lsmul,
                                  algebra_map_matrix_apply, id.map_eq_self] } }

lemma left_mul_matrix_apply (x : S) :
  left_mul_matrix b x = linear_map.to_matrix b b (lmul R S x) := rfl

lemma left_mul_matrix_eq_repr_mul (x : S) (i j) :
  left_mul_matrix b x i j = b.repr (x * b j) i :=
-- This is defeq to just `to_matrix_lmul' b x i j`,
-- but the unfolding goes a lot faster with this explicit `rw`.
by rw [left_mul_matrix_apply, to_matrix_lmul' b x i j]

lemma left_mul_matrix_mul_vec_repr (x y : S) :
  (left_mul_matrix b x).mul_vec (b.repr y) = b.repr (x * y) :=
linear_map.to_matrix_mul_vec_repr b b (algebra.lmul R S x) y

@[simp] lemma to_matrix_lmul_eq (x : S) :
  linear_map.to_matrix b b (lmul R S x) = left_mul_matrix b x :=
rfl

lemma left_mul_matrix_injective : function.injective (left_mul_matrix b) :=
λ x x' h, calc x = algebra.lmul R S x 1 : (mul_one x).symm
             ... = algebra.lmul R S x' 1 : by rw (linear_map.to_matrix b b).injective h
             ... = x' : mul_one x'

variable [fintype n]

lemma smul_left_mul_matrix (x) (ik jk) :
  left_mul_matrix (b.smul c) x ik jk =
    left_mul_matrix b (left_mul_matrix c x ik.2 jk.2) ik.1 jk.1 :=
by simp only [left_mul_matrix_apply, linear_map.to_matrix_apply, mul_comm, basis.smul_apply,
              basis.smul_repr, finsupp.smul_apply, algebra.lmul_apply, id.smul_eq_mul,
              linear_equiv.map_smul, mul_smul_comm]

lemma smul_left_mul_matrix_algebra_map (x : S) :
  left_mul_matrix (b.smul c) (algebra_map _ _ x) = block_diagonal (λ k, left_mul_matrix b x) :=
begin
  ext ⟨i, k⟩ ⟨j, k'⟩,
  rw [smul_left_mul_matrix, alg_hom.commutes, block_diagonal_apply, algebra_map_matrix_apply],
  split_ifs with h; simp [h],
end

lemma smul_left_mul_matrix_algebra_map_eq (x : S) (i j k) :
  left_mul_matrix (b.smul c) (algebra_map _ _ x) (i, k) (j, k) = left_mul_matrix b x i j :=
by rw [smul_left_mul_matrix_algebra_map, block_diagonal_apply_eq]

lemma smul_left_mul_matrix_algebra_map_ne (x : S) (i j) {k k'}
  (h : k ≠ k') : left_mul_matrix (b.smul c) (algebra_map _ _ x) (i, k) (j, k') = 0 :=
by rw [smul_left_mul_matrix_algebra_map, block_diagonal_apply_ne _ _ _ h]

end lmul

end algebra

namespace linear_map

section finite_dimensional

open_locale classical

variables {K : Type*} [field K]
variables {V : Type*} [add_comm_group V] [module K V] [finite_dimensional K V]
variables {W : Type*} [add_comm_group W] [module K W] [finite_dimensional K W]

instance : finite_dimensional K (V →ₗ[K] W) :=
linear_equiv.finite_dimensional
  (linear_map.to_matrix (basis.of_vector_space K V) (basis.of_vector_space K W)).symm

/--
The dimension of the space of linear transformations is the product of the dimensions of the
domain and codomain.
-/
@[simp] lemma finrank_linear_map :
  finite_dimensional.finrank K (V →ₗ[K] W) =
  (finite_dimensional.finrank K V) * (finite_dimensional.finrank K W) :=
begin
  let hbV := basis.of_vector_space K V,
  let hbW := basis.of_vector_space K W,
  rw [linear_equiv.finrank_eq (linear_map.to_matrix hbV hbW), matrix.finrank_matrix,
    finite_dimensional.finrank_eq_card_basis hbV, finite_dimensional.finrank_eq_card_basis hbW,
    mul_comm],
end

end finite_dimensional
end linear_map

section

variables {R : Type v} [comm_ring R] {n : Type*} [decidable_eq n]
variables {M M₁ M₂ : Type*} [add_comm_group M] [module R M]
variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]

/-- The natural equivalence between linear endomorphisms of finite free modules and square matrices
is compatible with the algebra structures. -/
def alg_equiv_matrix' [fintype n] : module.End R (n → R) ≃ₐ[R] matrix n n R :=
{ map_mul'  := linear_map.to_matrix'_comp,
  map_add'  := linear_map.to_matrix'.map_add,
  commutes' := λ r, by { change (r • (linear_map.id : module.End R _)).to_matrix' = r • 1,
                         rw ←linear_map.to_matrix'_id, refl, apply_instance },
  ..linear_map.to_matrix' }

/-- A linear equivalence of two modules induces an equivalence of algebras of their
endomorphisms. -/
def linear_equiv.alg_conj (e : M₁ ≃ₗ[R] M₂) :
  module.End R M₁ ≃ₐ[R] module.End R M₂ :=
{ map_mul'  := λ f g, by apply e.arrow_congr_comp,
  map_add'  := e.conj.map_add,
  commutes' := λ r, by { change e.conj (r • linear_map.id) = r • linear_map.id,
                         rw [linear_equiv.map_smul, linear_equiv.conj_id], },
  ..e.conj }

/-- A basis of a module induces an equivalence of algebras from the endomorphisms of the module to
square matrices. -/
def alg_equiv_matrix [fintype n] (h : basis n R M) : module.End R M ≃ₐ[R] matrix n n R :=
h.equiv_fun.alg_conj.trans alg_equiv_matrix'

end


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/

import data.nat.cast
import data.fintype.basic
import tactic.wlog

/-!
# Characteristic zero

A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered
as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R`
except for the existence of `1` in this file characteristic zero is defined for additive monoids
with `1`.

## Main definition

`char_zero` is the typeclass of an additive monoid with one such that the natural homomorphism
from the natural numbers into it is injective.

## Main statements

* A linearly ordered semiring has characteristic zero.
* Characteristic zero implies that the additive monoid is infinite.

## TODO

* Once order of a group is defined for infinite additive monoids redefine or at least connect to
  order of `1` in the additive monoid with one.
* Unify with `char_p` (possibly using an out-parameter)
-/

/-- Typeclass for monoids with characteristic zero.
  (This is usually stated on fields but it makes sense for any additive monoid with 1.) -/
class char_zero (R : Type*) [add_monoid R] [has_one R] : Prop :=
(cast_injective : function.injective (coe : ℕ → R))

theorem char_zero_of_inj_zero {R : Type*} [add_left_cancel_monoid R] [has_one R]
  (H : ∀ n:ℕ, (n:R) = 0 → n = 0) : char_zero R :=
⟨λ m n, begin
   assume h,
   wlog hle : m ≤ n,
   rcases nat.le.dest hle with ⟨k, rfl⟩,
   rw [nat.cast_add, eq_comm, add_right_eq_self] at h,
   rw [H k h, add_zero]
 end⟩

/-- Note this is not an instance as `char_zero` implies `nontrivial`,
and this would risk forming a loop. -/
lemma ordered_semiring.to_char_zero {R : Type*} [ordered_semiring R] [nontrivial R] :
  char_zero R :=
⟨nat.strict_mono_cast.injective⟩

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_semiring.to_char_zero {R : Type*}
  [linear_ordered_semiring R] : char_zero R :=
ordered_semiring.to_char_zero

namespace nat
variables {R : Type*} [add_monoid R] [has_one R] [char_zero R]

theorem cast_injective : function.injective (coe : ℕ → R) :=
char_zero.cast_injective

@[simp, norm_cast] theorem cast_inj {m n : ℕ} : (m : R) = n ↔ m = n :=
cast_injective.eq_iff

@[simp, norm_cast] theorem cast_eq_zero {n : ℕ} : (n : R) = 0 ↔ n = 0 :=
by rw [← cast_zero, cast_inj]

@[norm_cast] theorem cast_ne_zero {n : ℕ} : (n : R) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

lemma cast_add_one_ne_zero (n : ℕ) : (n + 1 : R) ≠ 0 :=
by exact_mod_cast n.succ_ne_zero

@[simp, norm_cast]
theorem cast_dvd_char_zero {k : Type*} [field k] [char_zero k] {m n : ℕ}
  (n_dvd : n ∣ m) : ((m / n : ℕ) : k) = m / n :=
begin
  by_cases hn : n = 0,
  { subst hn,
    simp },
  { exact cast_dvd n_dvd (cast_ne_zero.mpr hn), },
end

end nat

section

variables (M : Type*) [add_monoid M] [has_one M] [char_zero M]

@[priority 100] -- see Note [lower instance priority]
instance char_zero.infinite : infinite M :=
infinite.of_injective coe nat.cast_injective

variable {M}

@[field_simps] lemma two_ne_zero' : (2:M) ≠ 0 :=
have ((2:ℕ):M) ≠ 0, from nat.cast_ne_zero.2 dec_trivial,
by rwa [nat.cast_two] at this

end

section
variables {R : Type*} [semiring R] [no_zero_divisors R] [char_zero R]

@[simp]
lemma add_self_eq_zero {a : R} : a + a = 0 ↔ a = 0 :=
by simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero', false_or]

@[simp]
lemma bit0_eq_zero {a : R} : bit0 a = 0 ↔ a = 0 := add_self_eq_zero
@[simp]
lemma zero_eq_bit0 {a : R} : 0 = bit0 a ↔ a = 0 :=
by { rw [eq_comm], exact bit0_eq_zero }
end

section
variables {R : Type*} [ring R] [no_zero_divisors R] [char_zero R]

lemma nat_mul_inj {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) : n = 0 ∨ a = b :=
begin
  rw [←sub_eq_zero, ←mul_sub, mul_eq_zero, sub_eq_zero] at h,
  exact_mod_cast h,
end

lemma nat_mul_inj' {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) (w : n ≠ 0) : a = b :=
by simpa [w] using nat_mul_inj h

lemma bit0_injective : function.injective (bit0 : R → R) :=
λ a b h, begin
  dsimp [bit0] at h,
  simp only [(two_mul a).symm, (two_mul b).symm] at h,
  refine nat_mul_inj' _ two_ne_zero,
  exact_mod_cast h,
end

lemma bit1_injective : function.injective (bit1 : R → R) :=
λ a b h, begin
  simp only [bit1, add_left_inj] at h,
  exact bit0_injective h,
end

@[simp] lemma bit0_eq_bit0 {a b : R} : bit0 a = bit0 b ↔ a = b :=
bit0_injective.eq_iff

@[simp] lemma bit1_eq_bit1 {a b : R} : bit1 a = bit1 b ↔ a = b :=
bit1_injective.eq_iff

@[simp]
lemma bit1_eq_one {a : R} : bit1 a = 1 ↔ a = 0 :=
by rw [show (1 : R) = bit1 0, by simp, bit1_eq_bit1]

@[simp]
lemma one_eq_bit1 {a : R} : 1 = bit1 a ↔ a = 0 :=
by { rw [eq_comm], exact bit1_eq_one }

end

section
variables {R : Type*} [division_ring R] [char_zero R]

@[simp] lemma half_add_self (a : R) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero']

@[simp] lemma add_halves' (a : R) : a / 2 + a / 2 = a :=
by rw [← add_div, half_add_self]

lemma sub_half (a : R) : a - a / 2 = a / 2 :=
by rw [sub_eq_iff_eq_add, add_halves']

lemma half_sub (a : R) : a / 2 - a = - (a / 2) :=
by rw [← neg_sub, sub_half]

end

namespace with_top

instance {R : Type*} [add_monoid R] [has_one R] [char_zero R] : char_zero (with_top R) :=
{ cast_injective := λ m n h, by rwa [← coe_nat, ← coe_nat n, coe_eq_coe, nat.cast_inj] at h }

end with_top


theorem succ_ne_zero (a : mynat) : succ a ≠ 0 :=
begin
symmetry,
exact zero_ne_succ a,
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.basic
import data.list.range

/-! # `multiset.range n` gives `{0, 1, ..., n-1}` as a multiset. -/

open list nat

namespace multiset

/- range -/

/-- `range n` is the multiset lifted from the list `range n`,
  that is, the set `{0, 1, ..., n-1}`. -/
def range (n : ℕ) : multiset ℕ := range n

@[simp] theorem range_zero : range 0 = 0 := rfl

@[simp] theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n :=
by rw [range, range_succ, ← coe_add, add_comm]; refl

@[simp] theorem card_range (n : ℕ) : card (range n) = n := length_range _

theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n := range_subset

@[simp] theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n := mem_range

@[simp] theorem not_mem_range_self {n : ℕ} : n ∉ range n := not_mem_range_self

theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) := list.self_mem_range_succ n

lemma range_add (a b : ℕ) : range (a + b) = range a + (range b).map (λ x, a + x) :=
congr_arg coe (list.range_add _ _)

lemma range_disjoint_map_add (a : ℕ) (m : multiset ℕ) :
  (range a).disjoint (m.map (λ x, a + x)) :=
begin
  intros x hxa hxb,
  rw [range, mem_coe, list.mem_range] at hxa,
  obtain ⟨c, _, rfl⟩ := mem_map.1 hxb,
  exact (self_le_add_right _ _).not_lt hxa,
end

lemma range_add_eq_union (a b : ℕ) : range (a + b) = range a ∪ (range b).map (λ x, a + x) :=
by { rw [range_add, add_eq_union_iff_disjoint], apply range_disjoint_map_add }

end multiset


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

The primitive recursive functions are the least collection of functions
nat -> nat which are closed under projections (using the mkpair
pairing function), composition, zero, successor, and primitive recursion
(i.e. nat.rec where the motive is C n := nat).

We can extend this definition to a large class of basic types by
using canonical encodings of types as natural numbers (Gödel numbering),
which we implement through the type class `encodable`. (More precisely,
we need that the composition of encode with decode yields a
primitive recursive function, so we have the `primcodable` type class
for this.)
-/
import data.equiv.list

open denumerable encodable

namespace nat

def elim {C : Sort*} : C → (ℕ → C → C) → ℕ → C := @nat.rec (λ _, C)

@[simp] theorem elim_zero {C} (a f) : @nat.elim C a f 0 = a := rfl
@[simp] theorem elim_succ {C} (a f n) :
  @nat.elim C a f (succ n) = f n (nat.elim a f n) := rfl

def cases {C : Sort*} (a : C) (f : ℕ → C) : ℕ → C := nat.elim a (λ n _, f n)

@[simp] theorem cases_zero {C} (a f) : @nat.cases C a f 0 = a := rfl
@[simp] theorem cases_succ {C} (a f n) : @nat.cases C a f (succ n) = f n := rfl

@[simp, reducible] def unpaired {α} (f : ℕ → ℕ → α) (n : ℕ) : α :=
f n.unpair.1 n.unpair.2

/-- The primitive recursive functions `ℕ → ℕ`. -/
inductive primrec : (ℕ → ℕ) → Prop
| zero : primrec (λ n, 0)
| succ : primrec succ
| left : primrec (λ n, n.unpair.1)
| right : primrec (λ n, n.unpair.2)
| pair {f g} : primrec f → primrec g → primrec (λ n, mkpair (f n) (g n))
| comp {f g} : primrec f → primrec g → primrec (λ n, f (g n))
| prec {f g} : primrec f → primrec g → primrec (unpaired (λ z n,
   n.elim (f z) (λ y IH, g $ mkpair z $ mkpair y IH)))

namespace primrec

theorem of_eq {f g : ℕ → ℕ} (hf : primrec f) (H : ∀ n, f n = g n) : primrec g :=
(funext H : f = g) ▸ hf

theorem const : ∀ (n : ℕ), primrec (λ _, n)
| 0 := zero
| (n+1) := succ.comp (const n)

protected theorem id : primrec id :=
(left.pair right).of_eq $ λ n, by simp

theorem prec1 {f} (m : ℕ) (hf : primrec f) : primrec (λ n,
   n.elim m (λ y IH, f $ mkpair y IH)) :=
((prec (const m) (hf.comp right)).comp
  (zero.pair primrec.id)).of_eq $
λ n, by simp; dsimp; rw [unpair_mkpair]

theorem cases1 {f} (m : ℕ) (hf : primrec f) : primrec (nat.cases m f) :=
(prec1 m (hf.comp left)).of_eq $ by simp [cases]

theorem cases {f g} (hf : primrec f) (hg : primrec g) :
  primrec (unpaired (λ z n, n.cases (f z) (λ y, g $ mkpair z y))) :=
(prec hf (hg.comp (pair left (left.comp right)))).of_eq $ by simp [cases]

protected theorem swap : primrec (unpaired (function.swap mkpair)) :=
(pair right left).of_eq $ λ n, by simp

theorem swap' {f} (hf : primrec (unpaired f)) : primrec (unpaired (function.swap f)) :=
(hf.comp primrec.swap).of_eq $ λ n, by simp

theorem pred : primrec pred :=
(cases1 0 primrec.id).of_eq $ λ n, by cases n; simp *

theorem add : primrec (unpaired (+)) :=
(prec primrec.id ((succ.comp right).comp right)).of_eq $
λ p, by simp; induction p.unpair.2; simp [*, -add_comm, add_succ]

theorem sub : primrec (unpaired has_sub.sub) :=
(prec primrec.id ((pred.comp right).comp right)).of_eq $
λ p, by simp; induction p.unpair.2; simp [*, -add_comm, sub_succ]

theorem mul : primrec (unpaired (*)) :=
(prec zero (add.comp (pair left (right.comp right)))).of_eq $
λ p, by simp; induction p.unpair.2; simp [*, mul_succ]

theorem pow : primrec (unpaired (^)) :=
(prec (const 1) (mul.comp (pair (right.comp right) left))).of_eq $
λ p, by simp; induction p.unpair.2; simp [*, pow_succ]

end primrec

end nat

/-- A `primcodable` type is an `encodable` type for which
  the encode/decode functions are primitive recursive. -/
class primcodable (α : Type*) extends encodable α :=
(prim : nat.primrec (λ n, encodable.encode (decode n)))

namespace primcodable
open nat.primrec

@[priority 0] instance of_denumerable (α) [denumerable α] : primcodable α :=
⟨succ.of_eq $ by simp⟩

def of_equiv (α) {β} [primcodable α] (e : β ≃ α) : primcodable β :=
{ prim := (primcodable.prim α).of_eq $ λ n,
    show encode (decode α n) =
      (option.cases_on (option.map e.symm (decode α n))
        0 (λ a, nat.succ (encode (e a))) : ℕ),
    by cases decode α n; dsimp; simp,
  ..encodable.of_equiv α e }

instance empty : primcodable empty :=
⟨zero⟩

instance unit : primcodable punit :=
⟨(cases1 1 zero).of_eq $ λ n, by cases n; simp⟩

instance option {α : Type*} [h : primcodable α] : primcodable (option α) :=
⟨(cases1 1 ((cases1 0 (succ.comp succ)).comp (primcodable.prim α))).of_eq $
  λ n, by cases n; simp; cases decode α n; refl⟩

instance bool : primcodable bool :=
⟨(cases1 1 (cases1 2 zero)).of_eq $
λ n, begin
  cases n, {refl}, cases n, {refl},
  rw decode_ge_two, {refl},
  exact dec_trivial
end⟩

end primcodable

/-- `primrec f` means `f` is primitive recursive (after
  encoding its input and output as natural numbers). -/
def primrec {α β} [primcodable α] [primcodable β] (f : α → β) : Prop :=
nat.primrec (λ n, encode ((decode α n).map f))

namespace primrec
variables {α : Type*} {β : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable σ]
open nat.primrec

protected theorem encode : primrec (@encode α _) :=
(primcodable.prim α).of_eq $ λ n, by cases decode α n; refl

protected theorem decode : primrec (decode α) :=
succ.comp (primcodable.prim α)

theorem dom_denumerable {α β} [denumerable α] [primcodable β]
  {f : α → β} : primrec f ↔ nat.primrec (λ n, encode (f (of_nat α n))) :=
⟨λ h, (pred.comp h).of_eq $ λ n, by simp; refl,
 λ h, (succ.comp h).of_eq $ λ n, by simp; refl⟩

theorem nat_iff {f : ℕ → ℕ} : primrec f ↔ nat.primrec f :=
dom_denumerable

theorem encdec : primrec (λ n, encode (decode α n)) :=
nat_iff.2 (primcodable.prim α)

theorem option_some : primrec (@some α) :=
((cases1 0 (succ.comp succ)).comp (primcodable.prim α)).of_eq $
λ n, by cases decode α n; simp

theorem of_eq {f g : α → σ} (hf : primrec f) (H : ∀ n, f n = g n) : primrec g :=
(funext H : f = g) ▸ hf

theorem const (x : σ) : primrec (λ a : α, x) :=
((cases1 0 (const (encode x).succ)).comp (primcodable.prim α)).of_eq $
λ n, by cases decode α n; refl

protected theorem id : primrec (@id α) :=
(primcodable.prim α).of_eq $ by simp

theorem comp {f : β → σ} {g : α → β}
  (hf : primrec f) (hg : primrec g) : primrec (λ a, f (g a)) :=
((cases1 0 (hf.comp $ pred.comp hg)).comp (primcodable.prim α)).of_eq $
λ n, begin
  cases decode α n, {refl},
  simp [encodek]
end

theorem succ : primrec nat.succ := nat_iff.2 nat.primrec.succ

theorem pred : primrec nat.pred := nat_iff.2 nat.primrec.pred

theorem encode_iff {f : α → σ} : primrec (λ a, encode (f a)) ↔ primrec f :=
⟨λ h, nat.primrec.of_eq h $ λ n, by cases decode α n; refl,
 primrec.encode.comp⟩

theorem of_nat_iff {α β} [denumerable α] [primcodable β]
  {f : α → β} : primrec f ↔ primrec (λ n, f (of_nat α n)) :=
dom_denumerable.trans $ nat_iff.symm.trans encode_iff

protected theorem of_nat (α) [denumerable α] : primrec (of_nat α) :=
of_nat_iff.1 primrec.id

theorem option_some_iff {f : α → σ} : primrec (λ a, some (f a)) ↔ primrec f :=
⟨λ h, encode_iff.1 $ pred.comp $ encode_iff.2 h, option_some.comp⟩

theorem of_equiv {β} {e : β ≃ α} :
  by haveI := primcodable.of_equiv α e; exact
  primrec e :=
(primcodable.prim α).of_eq $ λ n,
show _ = encode (option.map e (option.map _ _)),
by cases decode α n; simp

theorem of_equiv_symm {β} {e : β ≃ α} :
  by haveI := primcodable.of_equiv α e; exact
  primrec e.symm :=
by letI := primcodable.of_equiv α e; exact
encode_iff.1
  (show primrec (λ a, encode (e (e.symm a))), by simp [primrec.encode])

theorem of_equiv_iff {β} (e : β ≃ α)
  {f : σ → β} :
  by haveI := primcodable.of_equiv α e; exact
  primrec (λ a, e (f a)) ↔ primrec f :=
by letI := primcodable.of_equiv α e; exact
⟨λ h, (of_equiv_symm.comp h).of_eq (λ a, by simp), of_equiv.comp⟩

theorem of_equiv_symm_iff {β} (e : β ≃ α)
  {f : σ → α} :
  by haveI := primcodable.of_equiv α e; exact
  primrec (λ a, e.symm (f a)) ↔ primrec f :=
by letI := primcodable.of_equiv α e; exact
⟨λ h, (of_equiv.comp h).of_eq (λ a, by simp), of_equiv_symm.comp⟩

end primrec

namespace primcodable
open nat.primrec

instance prod {α β} [primcodable α] [primcodable β] : primcodable (α × β) :=
⟨((cases zero ((cases zero succ).comp
  (pair right ((primcodable.prim β).comp left)))).comp
  (pair right ((primcodable.prim α).comp left))).of_eq $
λ n, begin
  simp [nat.unpaired],
  cases decode α n.unpair.1; simp, {refl},
  cases decode β n.unpair.2; simp, {refl},
  refl
end⟩

end primcodable

namespace primrec
variables {α : Type*} {σ : Type*} [primcodable α] [primcodable σ]
open nat.primrec

theorem fst {α β} [primcodable α] [primcodable β] :
  primrec (@prod.fst α β) :=
((cases zero ((cases zero (nat.primrec.succ.comp left)).comp
  (pair right ((primcodable.prim β).comp left)))).comp
  (pair right ((primcodable.prim α).comp left))).of_eq $
λ n, begin
  simp,
  cases decode α n.unpair.1; simp,
  cases decode β n.unpair.2; simp
end

theorem snd {α β} [primcodable α] [primcodable β] :
  primrec (@prod.snd α β) :=
((cases zero ((cases zero (nat.primrec.succ.comp right)).comp
  (pair right ((primcodable.prim β).comp left)))).comp
  (pair right ((primcodable.prim α).comp left))).of_eq $
λ n, begin
  simp,
  cases decode α n.unpair.1; simp,
  cases decode β n.unpair.2; simp
end

theorem pair {α β γ} [primcodable α] [primcodable β] [primcodable γ]
  {f : α → β} {g : α → γ} (hf : primrec f) (hg : primrec g) :
  primrec (λ a, (f a, g a)) :=
((cases1 0 (nat.primrec.succ.comp $
  pair (nat.primrec.pred.comp hf) (nat.primrec.pred.comp hg))).comp
  (primcodable.prim α)).of_eq $
λ n, by cases decode α n; simp [encodek]; refl

theorem unpair : primrec nat.unpair :=
(pair (nat_iff.2 nat.primrec.left) (nat_iff.2 nat.primrec.right)).of_eq $
λ n, by simp

theorem list_nth₁ : ∀ (l : list α), primrec l.nth
| []     := dom_denumerable.2 zero
| (a::l) := dom_denumerable.2 $
  (cases1 (encode a).succ $ dom_denumerable.1 $ list_nth₁ l).of_eq $
  λ n, by cases n; simp

end primrec

/-- `primrec₂ f` means `f` is a binary primitive recursive function.
  This is technically unnecessary since we can always curry all
  the arguments together, but there are enough natural two-arg
  functions that it is convenient to express this directly. -/
def primrec₂ {α β σ} [primcodable α] [primcodable β] [primcodable σ] (f : α → β → σ) :=
primrec (λ p : α × β, f p.1 p.2)

/-- `primrec_pred p` means `p : α → Prop` is a (decidable)
  primitive recursive predicate, which is to say that
  `to_bool ∘ p : α → bool` is primitive recursive. -/
def primrec_pred {α} [primcodable α] (p : α → Prop)
  [decidable_pred p] := primrec (λ a, to_bool (p a))

/-- `primrec_rel p` means `p : α → β → Prop` is a (decidable)
  primitive recursive relation, which is to say that
  `to_bool ∘ p : α → β → bool` is primitive recursive. -/
def primrec_rel {α β} [primcodable α] [primcodable β]
  (s : α → β → Prop) [∀ a b, decidable (s a b)] :=
primrec₂ (λ a b, to_bool (s a b))

namespace primrec₂
variables {α : Type*} {β : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable σ]

theorem of_eq {f g : α → β → σ} (hg : primrec₂ f) (H : ∀ a b, f a b = g a b) : primrec₂ g :=
(by funext a b; apply H : f = g) ▸ hg

theorem const (x : σ) : primrec₂ (λ (a : α) (b : β), x) := primrec.const _

protected theorem pair : primrec₂ (@prod.mk α β) :=
primrec.pair primrec.fst primrec.snd

theorem left : primrec₂ (λ (a : α) (b : β), a) := primrec.fst

theorem right : primrec₂ (λ (a : α) (b : β), b) := primrec.snd

theorem mkpair : primrec₂ nat.mkpair :=
by simp [primrec₂, primrec]; constructor

theorem unpaired {f : ℕ → ℕ → α} : primrec (nat.unpaired f) ↔ primrec₂ f :=
⟨λ h, by simpa using h.comp mkpair,
 λ h, h.comp primrec.unpair⟩

theorem unpaired' {f : ℕ → ℕ → ℕ} : nat.primrec (nat.unpaired f) ↔ primrec₂ f :=
primrec.nat_iff.symm.trans unpaired

theorem encode_iff {f : α → β → σ} : primrec₂ (λ a b, encode (f a b)) ↔ primrec₂ f :=
primrec.encode_iff

theorem option_some_iff {f : α → β → σ} : primrec₂ (λ a b, some (f a b)) ↔ primrec₂ f :=
primrec.option_some_iff

theorem of_nat_iff {α β σ}
  [denumerable α] [denumerable β] [primcodable σ]
  {f : α → β → σ} : primrec₂ f ↔ primrec₂ (λ m n : ℕ,
    f (of_nat α m) (of_nat β n)) :=
(primrec.of_nat_iff.trans $ by simp).trans unpaired

theorem uncurry {f : α → β → σ} : primrec (function.uncurry f) ↔ primrec₂ f :=
by rw [show function.uncurry f = λ (p : α × β), f p.1 p.2,
       from funext $ λ ⟨a, b⟩, rfl]; refl

theorem curry {f : α × β → σ} : primrec₂ (function.curry f) ↔ primrec f :=
by rw [← uncurry, function.uncurry_curry]

end primrec₂

section comp
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] [primcodable σ]

theorem primrec.comp₂ {f : γ → σ} {g : α → β → γ}
  (hf : primrec f) (hg : primrec₂ g) :
  primrec₂ (λ a b, f (g a b)) := hf.comp hg

theorem primrec₂.comp
  {f : β → γ → σ} {g : α → β} {h : α → γ}
  (hf : primrec₂ f) (hg : primrec g) (hh : primrec h) :
  primrec (λ a, f (g a) (h a)) := hf.comp (hg.pair hh)

theorem primrec₂.comp₂
  {f : γ → δ → σ} {g : α → β → γ} {h : α → β → δ}
  (hf : primrec₂ f) (hg : primrec₂ g) (hh : primrec₂ h) :
  primrec₂ (λ a b, f (g a b) (h a b)) := hf.comp hg hh

theorem primrec_pred.comp
  {p : β → Prop} [decidable_pred p] {f : α → β} :
  primrec_pred p → primrec f →
  primrec_pred (λ a, p (f a)) := primrec.comp

theorem primrec_rel.comp
  {R : β → γ → Prop} [∀ a b, decidable (R a b)] {f : α → β} {g : α → γ} :
  primrec_rel R → primrec f → primrec g →
  primrec_pred (λ a, R (f a) (g a)) := primrec₂.comp

theorem primrec_rel.comp₂
  {R : γ → δ → Prop} [∀ a b, decidable (R a b)] {f : α → β → γ} {g : α → β → δ} :
  primrec_rel R → primrec₂ f → primrec₂ g →
  primrec_rel (λ a b, R (f a b) (g a b)) := primrec_rel.comp

end comp

theorem primrec_pred.of_eq {α} [primcodable α]
  {p q : α → Prop} [decidable_pred p] [decidable_pred q]
  (hp : primrec_pred p) (H : ∀ a, p a ↔ q a) : primrec_pred q :=
primrec.of_eq hp (λ a, to_bool_congr (H a))

theorem primrec_rel.of_eq {α β} [primcodable α] [primcodable β]
  {r s : α → β → Prop} [∀ a b, decidable (r a b)] [∀ a b, decidable (s a b)]
  (hr : primrec_rel r) (H : ∀ a b, r a b ↔ s a b) : primrec_rel s :=
primrec₂.of_eq hr (λ a b, to_bool_congr (H a b))

namespace primrec₂
variables {α : Type*} {β : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable σ]
open nat.primrec

theorem swap {f : α → β → σ} (h : primrec₂ f) : primrec₂ (function.swap f) :=
h.comp₂ primrec₂.right primrec₂.left

theorem nat_iff {f : α → β → σ} : primrec₂ f ↔
  nat.primrec (nat.unpaired $ λ m n : ℕ,
    encode $ (decode α m).bind $ λ a, (decode β n).map (f a)) :=
have ∀ (a : option α) (b : option β),
  option.map (λ (p : α × β), f p.1 p.2)
    (option.bind a (λ (a : α), option.map (prod.mk a) b)) =
  option.bind a (λ a, option.map (f a) b),
by intros; cases a; [refl, {cases b; refl}],
by simp [primrec₂, primrec, this]

theorem nat_iff' {f : α → β → σ} : primrec₂ f ↔ primrec₂ (λ m n : ℕ,
  option.bind (decode α m) (λ a, option.map (f a) (decode β n))) :=
nat_iff.trans $ unpaired'.trans encode_iff

end primrec₂

namespace primrec
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] [primcodable σ]

theorem to₂ {f : α × β → σ} (hf : primrec f) : primrec₂ (λ a b, f (a, b)) :=
hf.of_eq $ λ ⟨a, b⟩, rfl

theorem nat_elim {f : α → β} {g : α → ℕ × β → β}
  (hf : primrec f) (hg : primrec₂ g) :
  primrec₂ (λ a (n : ℕ), n.elim (f a) (λ n IH, g a (n, IH))) :=
primrec₂.nat_iff.2 $ ((nat.primrec.cases nat.primrec.zero $
    (nat.primrec.prec hf $ nat.primrec.comp hg $ nat.primrec.left.pair $
      (nat.primrec.left.comp nat.primrec.right).pair $
      nat.primrec.pred.comp $ nat.primrec.right.comp nat.primrec.right).comp $
    nat.primrec.right.pair $
      nat.primrec.right.comp nat.primrec.left).comp $
  nat.primrec.id.pair $ (primcodable.prim α).comp nat.primrec.left).of_eq $
λ n, begin
  simp,
  cases decode α n.unpair.1 with a, {refl},
  simp [encodek],
  induction n.unpair.2 with m; simp [encodek],
  simp [ih, encodek]
end

theorem nat_elim' {f : α → ℕ} {g : α → β} {h : α → ℕ × β → β}
  (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
  primrec (λ a, (f a).elim (g a) (λ n IH, h a (n, IH))) :=
(nat_elim hg hh).comp primrec.id hf

theorem nat_elim₁ {f : ℕ → α → α} (a : α) (hf : primrec₂ f) :
  primrec (nat.elim a f) :=
nat_elim' primrec.id (const a) $ comp₂ hf primrec₂.right

theorem nat_cases' {f : α → β} {g : α → ℕ → β}
  (hf : primrec f) (hg : primrec₂ g) :
  primrec₂ (λ a, nat.cases (f a) (g a)) :=
nat_elim hf $ hg.comp₂ primrec₂.left $
  comp₂ fst primrec₂.right

theorem nat_cases {f : α → ℕ} {g : α → β} {h : α → ℕ → β}
  (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
  primrec (λ a, (f a).cases (g a) (h a)) :=
(nat_cases' hg hh).comp primrec.id hf

theorem nat_cases₁ {f : ℕ → α} (a : α) (hf : primrec f) :
  primrec (nat.cases a f) :=
nat_cases primrec.id (const a) (comp₂ hf primrec₂.right)

theorem nat_iterate {f : α → ℕ} {g : α → β} {h : α → β → β}
  (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
  primrec (λ a, (h a)^[f a] (g a)) :=
(nat_elim' hf hg (hh.comp₂ primrec₂.left $ snd.comp₂ primrec₂.right)).of_eq $
λ a, by induction f a; simp [*, -nat.iterate_succ, nat.iterate_succ']

theorem option_cases {o : α → option β} {f : α → σ} {g : α → β → σ}
  (ho : primrec o) (hf : primrec f) (hg : primrec₂ g) :
  @primrec _ σ _ _ (λ a, option.cases_on (o a) (f a) (g a)) :=
encode_iff.1 $
(nat_cases (encode_iff.2 ho) (encode_iff.2 hf) $
  pred.comp₂ $ primrec₂.encode_iff.2 $
  (primrec₂.nat_iff'.1 hg).comp₂
    ((@primrec.encode α _).comp fst).to₂
    primrec₂.right).of_eq $
λ a, by cases o a with b; simp [encodek]; refl

theorem option_bind {f : α → option β} {g : α → β → option σ}
  (hf : primrec f) (hg : primrec₂ g) :
  primrec (λ a, (f a).bind (g a)) :=
(option_cases hf (const none) hg).of_eq $
λ a, by cases f a; refl

theorem option_bind₁ {f : α → option σ} (hf : primrec f) :
  primrec (λ o, option.bind o f) :=
option_bind primrec.id (hf.comp snd).to₂

theorem option_map {f : α → option β} {g : α → β → σ}
  (hf : primrec f) (hg : primrec₂ g) : primrec (λ a, (f a).map (g a)) :=
option_bind hf (option_some.comp₂ hg)

theorem option_map₁ {f : α → σ} (hf : primrec f) : primrec (option.map f) :=
option_map primrec.id (hf.comp snd).to₂

theorem option_iget [inhabited α] : primrec (@option.iget α _) :=
(option_cases primrec.id (const $ default α) primrec₂.right).of_eq $
λ o, by cases o; refl

theorem option_is_some : primrec (@option.is_some α) :=
(option_cases primrec.id (const ff) (const tt).to₂).of_eq $
λ o, by cases o; refl

theorem bind_decode_iff {f : α → β → option σ} : primrec₂ (λ a n,
  (decode β n).bind (f a)) ↔ primrec₂ f :=
⟨λ h, by simpa [encodek] using
   h.comp fst ((@primrec.encode β _).comp snd),
 λ h, option_bind (primrec.decode.comp snd) $
   h.comp (fst.comp fst) snd⟩

theorem map_decode_iff {f : α → β → σ} : primrec₂ (λ a n,
  (decode β n).map (f a)) ↔ primrec₂ f :=
bind_decode_iff.trans primrec₂.option_some_iff

theorem nat_add : primrec₂ ((+) : ℕ → ℕ → ℕ) :=
primrec₂.unpaired'.1 nat.primrec.add

theorem nat_sub : primrec₂ (has_sub.sub : ℕ → ℕ → ℕ) :=
primrec₂.unpaired'.1 nat.primrec.sub

theorem nat_mul : primrec₂ ((*) : ℕ → ℕ → ℕ) :=
primrec₂.unpaired'.1 nat.primrec.mul

theorem cond {c : α → bool} {f : α → σ} {g : α → σ}
  (hc : primrec c) (hf : primrec f) (hg : primrec g) :
  primrec (λ a, cond (c a) (f a) (g a)) :=
(nat_cases (encode_iff.2 hc) hg (hf.comp fst).to₂).of_eq $
λ a, by cases c a; refl

theorem ite {c : α → Prop} [decidable_pred c] {f : α → σ} {g : α → σ}
  (hc : primrec_pred c) (hf : primrec f) (hg : primrec g) :
  primrec (λ a, if c a then f a else g a) :=
by simpa using cond hc hf hg

theorem nat_le : primrec_rel ((≤) : ℕ → ℕ → Prop) :=
(nat_cases nat_sub (const tt) (const ff).to₂).of_eq $
λ p, begin
  dsimp [function.swap],
  cases e : p.1 - p.2 with n,
  { simp [nat.sub_eq_zero_iff_le.1 e] },
  { simp [not_le.2 (nat.lt_of_sub_eq_succ e)] }
end

theorem nat_min : primrec₂ (@min ℕ _) := ite nat_le fst snd
theorem nat_max : primrec₂ (@max ℕ _) := ite nat_le snd fst

theorem dom_bool (f : bool → α) : primrec f :=
(cond primrec.id (const (f tt)) (const (f ff))).of_eq $
λ b, by cases b; refl

theorem dom_bool₂ (f : bool → bool → α) : primrec₂ f :=
(cond fst
  ((dom_bool (f tt)).comp snd)
  ((dom_bool (f ff)).comp snd)).of_eq $
λ ⟨a, b⟩, by cases a; refl

protected theorem bnot : primrec bnot := dom_bool _
protected theorem band : primrec₂ band := dom_bool₂ _
protected theorem bor : primrec₂ bor := dom_bool₂ _

protected theorem not {p : α → Prop} [decidable_pred p]
  (hp : primrec_pred p) : primrec_pred (λ a, ¬ p a) :=
(primrec.bnot.comp hp).of_eq $ λ n, by simp

protected theorem and {p q : α → Prop}
  [decidable_pred p] [decidable_pred q]
  (hp : primrec_pred p) (hq : primrec_pred q) :
  primrec_pred (λ a, p a ∧ q a) :=
(primrec.band.comp hp hq).of_eq $ λ n, by simp

protected theorem or {p q : α → Prop}
  [decidable_pred p] [decidable_pred q]
  (hp : primrec_pred p) (hq : primrec_pred q) :
  primrec_pred (λ a, p a ∨ q a) :=
(primrec.bor.comp hp hq).of_eq $ λ n, by simp

protected theorem eq [decidable_eq α] : primrec_rel (@eq α) :=
have primrec_rel (λ a b : ℕ, a = b), from
  (primrec.and nat_le nat_le.swap).of_eq $
  λ a, by simp [le_antisymm_iff],
(this.comp₂
  (primrec.encode.comp₂ primrec₂.left)
  (primrec.encode.comp₂ primrec₂.right)).of_eq $
λ a b, encode_injective.eq_iff

theorem nat_lt : primrec_rel ((<) : ℕ → ℕ → Prop) :=
(nat_le.comp snd fst).not.of_eq $ λ p, by simp

theorem option_guard {p : α → β → Prop}
  [∀ a b, decidable (p a b)] (hp : primrec_rel p)
  {f : α → β} (hf : primrec f) :
  primrec (λ a, option.guard (p a) (f a)) :=
ite (hp.comp primrec.id hf) (option_some_iff.2 hf) (const none)

theorem option_orelse :
  primrec₂ ((<|>) : option α → option α → option α) :=
(option_cases fst snd (fst.comp fst).to₂).of_eq $
λ ⟨o₁, o₂⟩, by cases o₁; cases o₂; refl

protected theorem decode2 : primrec (decode2 α) :=
option_bind primrec.decode $
option_guard ((@primrec.eq _ _ nat.decidable_eq).comp
  (encode_iff.2 snd) (fst.comp fst)) snd

theorem list_find_index₁ {p : α → β → Prop}
  [∀ a b, decidable (p a b)] (hp : primrec_rel p) :
  ∀ (l : list β), primrec (λ a, l.find_index (p a))
| [] := const 0
| (a::l) := ite (hp.comp primrec.id (const a)) (const 0)
  (succ.comp (list_find_index₁ l))

theorem list_index_of₁ [decidable_eq α] (l : list α) :
  primrec (λ a, l.index_of a) := list_find_index₁ primrec.eq l

theorem dom_fintype [fintype α] (f : α → σ) : primrec f :=
let ⟨l, nd, m⟩ := fintype.exists_univ_list α in
option_some_iff.1 $ begin
  haveI := decidable_eq_of_encodable α,
  refine ((list_nth₁ (l.map f)).comp (list_index_of₁ l)).of_eq (λ a, _),
  rw [list.nth_map, list.nth_le_nth (list.index_of_lt_length.2 (m _)),
      list.index_of_nth_le]; refl
end

theorem nat_bodd_div2 : primrec nat.bodd_div2 :=
(nat_elim' primrec.id (const (ff, 0))
  (((cond fst
      (pair (const ff) (succ.comp snd))
      (pair (const tt) snd)).comp snd).comp snd).to₂).of_eq $
λ n, begin
  simp [-nat.bodd_div2_eq],
  induction n with n IH, {refl},
  simp [-nat.bodd_div2_eq, nat.bodd_div2, *],
  rcases nat.bodd_div2 n with ⟨_|_, m⟩; simp [nat.bodd_div2]
end

theorem nat_bodd : primrec nat.bodd := fst.comp nat_bodd_div2
theorem nat_div2 : primrec nat.div2 := snd.comp nat_bodd_div2

theorem nat_bit0 : primrec (@bit0 ℕ _) :=
nat_add.comp primrec.id primrec.id

theorem nat_bit1 : primrec (@bit1 ℕ _ _) :=
nat_add.comp nat_bit0 (const 1)

theorem nat_bit : primrec₂ nat.bit :=
(cond primrec.fst
  (nat_bit1.comp primrec.snd)
  (nat_bit0.comp primrec.snd)).of_eq $
λ n, by cases n.1; refl

theorem nat_div_mod : primrec₂ (λ n k : ℕ, (n / k, n % k)) :=
let f (a : ℕ × ℕ) : ℕ × ℕ := a.1.elim (0, 0) (λ _ IH,
  if nat.succ IH.2 = a.2
  then (nat.succ IH.1, 0)
  else (IH.1, nat.succ IH.2)) in
have hf : primrec f, from
nat_elim' fst (const (0, 0)) $
  ((ite ((@primrec.eq ℕ _ _).comp (succ.comp $ snd.comp snd) fst)
      (pair (succ.comp $ fst.comp snd) (const 0))
      (pair (fst.comp snd) (succ.comp $ snd.comp snd)))
    .comp (pair (snd.comp fst) (snd.comp snd))).to₂,
suffices ∀ k n, (n / k, n % k) = f (n, k),
from hf.of_eq $ λ ⟨m, n⟩, by simp [this],
λ k n, begin
  have : (f (n, k)).2 + k * (f (n, k)).1 = n
    ∧ (0 < k → (f (n, k)).2 < k)
    ∧ (k = 0 → (f (n, k)).1 = 0),
  { induction n with n IH, {exact ⟨rfl, id, λ _, rfl⟩},
    rw [λ n:ℕ, show f (n.succ, k) =
      _root_.ite ((f (n, k)).2.succ = k)
      (nat.succ (f (n, k)).1, 0)
      ((f (n, k)).1, (f (n, k)).2.succ), from rfl],
    by_cases h : (f (n, k)).2.succ = k; simp [h],
    { have := congr_arg nat.succ IH.1,
      refine ⟨_, λ k0, nat.no_confusion (h.trans k0)⟩,
      rwa [← nat.succ_add, h, add_comm, ← nat.mul_succ] at this },
    { exact ⟨by rw [nat.succ_add, IH.1],
        λ k0, lt_of_le_of_ne (IH.2.1 k0) h, IH.2.2⟩ } },
  revert this, cases f (n, k) with D M,
  simp, intros h₁ h₂ h₃,
  cases nat.eq_zero_or_pos k,
  { simp [h, h₃ h] at h₁ ⊢, simp [h₁] },
  { exact (nat.div_mod_unique h).2 ⟨h₁, h₂ h⟩ }
end

theorem nat_div : primrec₂ ((/) : ℕ → ℕ → ℕ) := fst.comp₂ nat_div_mod
theorem nat_mod : primrec₂ ((%) : ℕ → ℕ → ℕ) := snd.comp₂ nat_div_mod

end primrec

section
variables {α : Type*} {β : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable σ]

variable (H : nat.primrec (λ n, encodable.encode (decode (list β) n)))
include H
open primrec

private def prim : primcodable (list β) := ⟨H⟩

private lemma list_cases'
  {f : α → list β} {g : α → σ} {h : α → β × list β → σ}
  (hf : by haveI := prim H; exact primrec f) (hg : primrec g)
  (hh : by haveI := prim H; exact primrec₂ h) :
  @primrec _ σ _ _ (λ a, list.cases_on (f a) (g a) (λ b l, h a (b, l))) :=
by letI := prim H; exact
have @primrec _ (option σ) _ _ (λ a,
  (decode (option (β × list β)) (encode (f a))).map
  (λ o, option.cases_on o (g a) (h a))), from
((@map_decode_iff _ (option (β × list β)) _ _ _ _ _).2 $
    to₂ $ option_cases snd (hg.comp fst)
  (hh.comp₂ (fst.comp₂ primrec₂.left) primrec₂.right))
    .comp primrec.id (encode_iff.2 hf),
option_some_iff.1 $ this.of_eq $
λ a, by cases f a with b l; simp [encodek]; refl

private lemma list_foldl'
  {f : α → list β} {g : α → σ} {h : α → σ × β → σ}
  (hf : by haveI := prim H; exact primrec f) (hg : primrec g)
  (hh : by haveI := prim H; exact primrec₂ h) :
  primrec (λ a, (f a).foldl (λ s b, h a (s, b)) (g a)) :=
by letI := prim H; exact
let G (a : α) (IH : σ × list β) : σ × list β :=
  list.cases_on IH.2 IH (λ b l, (h a (IH.1, b), l)) in
let F (a : α) (n : ℕ) := nat.iterate (G a) n (g a, f a) in
have primrec (λ a, (F a (encode (f a))).1), from
fst.comp $ nat_iterate (encode_iff.2 hf) (pair hg hf) $
  list_cases' H (snd.comp snd) snd $ to₂ $ pair
    (hh.comp (fst.comp fst) $
      pair ((fst.comp snd).comp fst) (fst.comp snd))
    (snd.comp snd),
this.of_eq $ λ a, begin
  have : ∀ n, F a n =
    ((list.take n (f a)).foldl (λ s b, h a (s, b)) (g a),
      list.drop n (f a)),
  { intro, simp [F],
    generalize : f a = l, generalize : g a = x,
    induction n with n IH generalizing l x, {refl},
    simp, cases l with b l; simp [IH] },
  rw [this, list.take_all_of_ge (length_le_encode _)]
end

private lemma list_cons' : by haveI := prim H; exact primrec₂ (@list.cons β) :=
by letI := prim H; exact
encode_iff.1 (succ.comp $
primrec₂.mkpair.comp (encode_iff.2 fst) (encode_iff.2 snd))

private lemma list_reverse' : by haveI := prim H; exact
  primrec (@list.reverse β) :=
by letI := prim H; exact
(list_foldl' H primrec.id (const []) $ to₂ $
   ((list_cons' H).comp snd fst).comp snd).of_eq
(suffices ∀ l r, list.foldl (λ (s : list β) (b : β), b :: s) r l = list.reverse_core l r,
from λ l, this l [],
λ l, by induction l; simp [*, list.reverse_core])

end

namespace primcodable
variables {α : Type*} {β : Type*}
variables [primcodable α] [primcodable β]
open primrec

instance sum : primcodable (α ⊕ β) :=
⟨primrec.nat_iff.1 $
(encode_iff.2 (cond nat_bodd
  (((@primrec.decode β _).comp nat_div2).option_map $ to₂ $
     nat_bit.comp (const tt) (primrec.encode.comp snd))
  (((@primrec.decode α _).comp nat_div2).option_map $ to₂ $
     nat_bit.comp (const ff) (primrec.encode.comp snd)))).of_eq $
λ n, show _ = encode (decode_sum n), begin
  simp [decode_sum],
  cases nat.bodd n; simp [decode_sum],
  { cases decode α n.div2; refl },
  { cases decode β n.div2; refl }
end⟩

instance list : primcodable (list α) := ⟨
by letI H := primcodable.prim (list ℕ); exact
have primrec₂ (λ (a : α) (o : option (list ℕ)),
  o.map (list.cons (encode a))), from
option_map snd $
  (list_cons' H).comp ((@primrec.encode α _).comp (fst.comp fst)) snd,
have primrec (λ n, (of_nat (list ℕ) n).reverse.foldl
  (λ o m, (decode α m).bind (λ a, o.map (list.cons (encode a))))
   (some [])), from
list_foldl' H
  ((list_reverse' H).comp (primrec.of_nat (list ℕ)))
  (const (some []))
  (primrec.comp₂ (bind_decode_iff.2 $ primrec₂.swap this) primrec₂.right),
nat_iff.1 $ (encode_iff.2 this).of_eq $ λ n, begin
  rw list.foldl_reverse,
  apply nat.case_strong_induction_on n, {refl},
  intros n IH, simp,
  cases decode α n.unpair.1 with a, {refl},
  simp,
  suffices : ∀ (o : option (list ℕ)) p (_ : encode o = encode p),
    encode (option.map (list.cons (encode a)) o) =
    encode (option.map (list.cons a) p),
  from this _ _ (IH _ (nat.unpair_le_right n)),
  intros o p IH,
  cases o; cases p; injection IH with h,
  exact congr_arg (λ k, (nat.mkpair (encode a) k).succ.succ) h
end⟩

end primcodable

namespace primrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

theorem sum_inl : primrec (@sum.inl α β) :=
encode_iff.1 $ nat_bit0.comp primrec.encode

theorem sum_inr : primrec (@sum.inr α β) :=
encode_iff.1 $ nat_bit1.comp primrec.encode

theorem sum_cases
  {f : α → β ⊕ γ} {g : α → β → σ} {h : α → γ → σ}
  (hf : primrec f) (hg : primrec₂ g) (hh : primrec₂ h) :
  @primrec _ σ _ _ (λ a, sum.cases_on (f a) (g a) (h a)) :=
option_some_iff.1 $
(cond (nat_bodd.comp $ encode_iff.2 hf)
  (option_map (primrec.decode.comp $ nat_div2.comp $ encode_iff.2 hf) hh)
  (option_map (primrec.decode.comp $ nat_div2.comp $ encode_iff.2 hf) hg)).of_eq $
λ a, by cases f a with b c;
  simp [nat.div2_bit, nat.bodd_bit, encodek]; refl

theorem list_cons : primrec₂ (@list.cons α) :=
list_cons' (primcodable.prim _)

theorem list_cases
  {f : α → list β} {g : α → σ} {h : α → β × list β → σ} :
  primrec f → primrec g → primrec₂ h →
  @primrec _ σ _ _ (λ a, list.cases_on (f a) (g a) (λ b l, h a (b, l))) :=
list_cases' (primcodable.prim _)

theorem list_foldl
  {f : α → list β} {g : α → σ} {h : α → σ × β → σ} :
  primrec f → primrec g → primrec₂ h →
  primrec (λ a, (f a).foldl (λ s b, h a (s, b)) (g a)) :=
list_foldl' (primcodable.prim _)

theorem list_reverse : primrec (@list.reverse α) :=
list_reverse' (primcodable.prim _)

theorem list_foldr
  {f : α → list β} {g : α → σ} {h : α → β × σ → σ}
  (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
  primrec (λ a, (f a).foldr (λ b s, h a (b, s)) (g a)) :=
(list_foldl (list_reverse.comp hf) hg $ to₂ $
  hh.comp fst $ (pair snd fst).comp snd).of_eq $
λ a, by simp [list.foldl_reverse]

theorem list_head' : primrec (@list.head' α) :=
(list_cases primrec.id (const none)
  (option_some_iff.2 $ (fst.comp snd)).to₂).of_eq $
λ l, by cases l; refl

theorem list_head [inhabited α] : primrec (@list.head α _) :=
(option_iget.comp list_head').of_eq $
λ l, l.head_eq_head'.symm

theorem list_tail : primrec (@list.tail α) :=
(list_cases primrec.id (const []) (snd.comp snd).to₂).of_eq $
λ l, by cases l; refl

theorem list_rec
  {f : α → list β} {g : α → σ} {h : α → β × list β × σ → σ}
  (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
  @primrec _ σ _ _ (λ a,
    list.rec_on (f a) (g a) (λ b l IH, h a (b, l, IH))) :=
let F (a : α) := (f a).foldr
  (λ (b : β) (s : list β × σ), (b :: s.1, h a (b, s))) ([], g a) in
have primrec F, from
list_foldr hf (pair (const []) hg) $ to₂ $
  pair ((list_cons.comp fst (fst.comp snd)).comp snd) hh,
(snd.comp this).of_eq $ λ a, begin
  suffices : F a = (f a,
    list.rec_on (f a) (g a) (λ b l IH, h a (b, l, IH))), {rw this},
  simp [F], induction f a with b l IH; simp *
end

theorem list_nth : primrec₂ (@list.nth α) :=
let F (l : list α) (n : ℕ) :=
l.foldl (λ (s : ℕ ⊕ α) (a : α),
  sum.cases_on s
    (@nat.cases (ℕ ⊕ α) (sum.inr a) sum.inl) sum.inr)
  (sum.inl n) in
have hF : primrec₂ F, from
list_foldl fst (sum_inl.comp snd) ((sum_cases fst
  (nat_cases snd
    (sum_inr.comp $ snd.comp fst)
    (sum_inl.comp snd).to₂).to₂
  (sum_inr.comp snd).to₂).comp snd).to₂,
have @primrec _ (option α) _ _ (λ p : list α × ℕ,
  sum.cases_on (F p.1 p.2) (λ _, none) some), from
sum_cases hF (const none).to₂ (option_some.comp snd).to₂,
this.to₂.of_eq $ λ l n, begin
  dsimp, symmetry,
  induction l with a l IH generalizing n, {refl},
  cases n with n,
  { rw [(_ : F (a :: l) 0 = sum.inr a)], {refl},
    clear IH, dsimp [F],
    induction l with b l IH; simp * },
  { apply IH }
end

theorem list_inth [inhabited α] : primrec₂ (@list.inth α _) :=
option_iget.comp₂ list_nth

theorem list_append : primrec₂ ((++) : list α → list α → list α) :=
(list_foldr fst snd $ to₂ $ comp (@list_cons α _) snd).to₂.of_eq $
λ l₁ l₂, by induction l₁; simp *

theorem list_concat : primrec₂ (λ l (a:α), l ++ [a]) :=
list_append.comp fst (list_cons.comp snd (const []))

theorem list_map
  {f : α → list β} {g : α → β → σ}
  (hf : primrec f) (hg : primrec₂ g) :
  primrec (λ a, (f a).map (g a)) :=
(list_foldr hf (const []) $ to₂ $ list_cons.comp
  (hg.comp fst (fst.comp snd)) (snd.comp snd)).of_eq $
λ a, by induction f a; simp *

theorem list_range : primrec list.range :=
(nat_elim' primrec.id (const [])
  ((list_concat.comp snd fst).comp snd).to₂).of_eq $
λ n, by simp; induction n; simp [*, list.range_concat]; refl

theorem list_join : primrec (@list.join α) :=
(list_foldr primrec.id (const []) $ to₂ $
  comp (@list_append α _) snd).of_eq $
λ l, by dsimp; induction l; simp *

theorem list_length : primrec (@list.length α) :=
(list_foldr (@primrec.id (list α) _) (const 0) $ to₂ $
  (succ.comp $ snd.comp snd).to₂).of_eq $
λ l, by dsimp; induction l; simp [*, -add_comm]

theorem list_find_index {f : α → list β} {p : α → β → Prop}
  [∀ a b, decidable (p a b)]
  (hf : primrec f) (hp : primrec_rel p) :
  primrec (λ a, (f a).find_index (p a)) :=
(list_foldr hf (const 0) $ to₂ $
  ite (hp.comp fst $ fst.comp snd) (const 0)
    (succ.comp $ snd.comp snd)).of_eq $
λ a, eq.symm $ by dsimp; induction f a with b l;
  [refl, { simp [*, list.find_index], congr }]

theorem list_index_of [decidable_eq α] : primrec₂ (@list.index_of α _) :=
to₂ $ list_find_index snd $ primrec.eq.comp₂ (fst.comp fst).to₂ snd.to₂

theorem nat_strong_rec
  (f : α → ℕ → σ) {g : α → list σ → option σ} (hg : primrec₂ g)
  (H : ∀ a n, g a ((list.range n).map (f a)) = some (f a n)) : primrec₂ f :=
suffices primrec₂ (λ a n, (list.range n).map (f a)), from
  primrec₂.option_some_iff.1 $
  (list_nth.comp (this.comp fst (succ.comp snd)) snd).to₂.of_eq $
  λ a n, by simp [list.nth_range (nat.lt_succ_self n)]; refl,
primrec₂.option_some_iff.1 $
(nat_elim (const (some [])) (to₂ $
  option_bind (snd.comp snd) $ to₂ $
  option_map
    (hg.comp (fst.comp fst) snd)
    (to₂ $ list_concat.comp (snd.comp fst) snd))).of_eq $
λ a n, begin
  simp, induction n with n IH, {refl},
  simp [IH, H, list.range_concat]
end

end primrec

namespace primcodable
variables {α : Type*} {β : Type*}
variables [primcodable α] [primcodable β]
open primrec

def subtype {p : α → Prop} [decidable_pred p]
  (hp : primrec_pred p) : primcodable (subtype p) :=
⟨have primrec (λ n, (decode α n).bind (λ a, option.guard p a)),
 from option_bind primrec.decode (option_guard (hp.comp snd) snd),
 nat_iff.1 $ (encode_iff.2 this).of_eq $ λ n,
 show _ = encode ((decode α n).bind (λ a, _)), begin
   cases decode α n with a, {refl},
   dsimp [option.guard],
   by_cases h : p a; simp [h]; refl
 end⟩

instance fin {n} : primcodable (fin n) :=
@of_equiv _ _
  (subtype $ nat_lt.comp primrec.id (const n))
  (equiv.fin_equiv_subtype _)

instance vector {n} : primcodable (vector α n) :=
subtype ((@primrec.eq _ _ nat.decidable_eq).comp list_length (const _))

instance fin_arrow {n} : primcodable (fin n → α) :=
of_equiv _ (equiv.vector_equiv_fin _ _).symm

instance array {n} : primcodable (array n α) :=
of_equiv _ (equiv.array_equiv_fin _ _)

end primcodable

namespace primrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

theorem subtype_val {p : α → Prop} [decidable_pred p]
  {hp : primrec_pred p} :
  by haveI := primcodable.subtype hp; exact
  primrec (@subtype.val α p) :=
begin
  letI := primcodable.subtype hp,
  refine (primcodable.prim (subtype p)).of_eq (λ n, _),
  rcases decode (subtype p) n with _|⟨a,h⟩; refl
end

theorem subtype_val_iff {p : β → Prop} [decidable_pred p]
  {hp : primrec_pred p} {f : α → subtype p} :
  by haveI := primcodable.subtype hp; exact
  primrec (λ a, (f a).1) ↔ primrec f :=
begin
  letI := primcodable.subtype hp,
  refine ⟨λ h, _, λ hf, subtype_val.comp hf⟩,
  refine nat.primrec.of_eq h (λ n, _),
  cases decode α n with a, {refl},
  simp, cases f a; refl
end

theorem fin_val_iff {n} {f : α → fin n} :
  primrec (λ a, (f a).1) ↔ primrec f :=
begin
  let : primcodable {a//id a<n}, swap,
  exactI (iff.trans (by refl) subtype_val_iff).trans (of_equiv_iff _)
end

theorem fin_val {n} : primrec (@fin.val n) := fin_val_iff.2 primrec.id

theorem fin_succ {n} : primrec (@fin.succ n) :=
fin_val_iff.1 $ by simp [succ.comp fin_val]

theorem vector_to_list {n} : primrec (@vector.to_list α n) := subtype_val

theorem vector_to_list_iff {n} {f : α → vector β n} :
  primrec (λ a, (f a).to_list) ↔ primrec f := subtype_val_iff

theorem vector_cons {n} : primrec₂ (@vector.cons α n) :=
vector_to_list_iff.1 $ by simp; exact
list_cons.comp fst (vector_to_list_iff.2 snd)

theorem vector_length {n} : primrec (@vector.length α n) := const _

theorem vector_head {n} : primrec (@vector.head α n) :=
option_some_iff.1 $
(list_head'.comp vector_to_list).of_eq $ λ ⟨a::l, h⟩, rfl

theorem vector_tail {n} : primrec (@vector.tail α n) :=
vector_to_list_iff.1 $ (list_tail.comp vector_to_list).of_eq $
λ ⟨l, h⟩, by cases l; refl

theorem vector_nth {n} : primrec₂ (@vector.nth α n) :=
option_some_iff.1 $
(list_nth.comp (vector_to_list.comp fst) (fin_val.comp snd)).of_eq $
λ a, by simp [vector.nth_eq_nth_le]; rw [← list.nth_le_nth]

theorem list_of_fn : ∀ {n} {f : fin n → α → σ},
  (∀ i, primrec (f i)) → primrec (λ a, list.of_fn (λ i, f i a))
| 0     f hf := const []
| (n+1) f hf := by simp [list.of_fn_succ]; exact
  list_cons.comp (hf 0) (list_of_fn (λ i, hf i.succ))

theorem vector_of_fn {n} {f : fin n → α → σ}
  (hf : ∀ i, primrec (f i)) : primrec (λ a, vector.of_fn (λ i, f i a)) :=
vector_to_list_iff.1 $ by simp [list_of_fn hf]

theorem vector_nth' {n} : primrec (@vector.nth α n) := of_equiv_symm

theorem vector_of_fn' {n} : primrec (@vector.of_fn α n) := of_equiv

theorem fin_app {n} : primrec₂ (@id (fin n → σ)) :=
(vector_nth.comp (vector_of_fn'.comp fst) snd).of_eq $
λ ⟨v, i⟩, by simp

theorem fin_curry₁ {n} {f : fin n → α → σ} : primrec₂ f ↔ ∀ i, primrec (f i) :=
⟨λ h i, h.comp (const i) primrec.id,
 λ h, (vector_nth.comp ((vector_of_fn h).comp snd) fst).of_eq $ λ a, by simp⟩

theorem fin_curry {n} {f : α → fin n → σ} : primrec f ↔ primrec₂ f :=
⟨λ h, fin_app.comp (h.comp fst) snd,
 λ h, (vector_nth'.comp (vector_of_fn (λ i,
    show primrec (λ a, f a i), from
    h.comp primrec.id (const i)))).of_eq $
  λ a, by funext i; simp⟩

end primrec

namespace nat
open vector

/-- An alternative inductive definition of `primrec` which
  does not use the pairing function on ℕ, and so has to
  work with n-ary functions on ℕ instead of unary functions.
  We prove that this is equivalent to the regular notion
  in `to_prim` and `of_prim`. -/
inductive primrec' : ∀ {n}, (vector ℕ n → ℕ) → Prop
| zero : @primrec' 0 (λ _, 0)
| succ : @primrec' 1 (λ v, succ v.head)
| nth {n} (i : fin n) : primrec' (λ v, v.nth i)
| comp {m n f} (g : fin n → vector ℕ m → ℕ) :
  primrec' f → (∀ i, primrec' (g i)) →
  primrec' (λ a, f (of_fn (λ i, g i a)))
| prec {n f g} : @primrec' n f → @primrec' (n+2) g →
  primrec' (λ v : vector ℕ (n+1),
    v.head.elim (f v.tail) (λ y IH, g (y :: IH :: v.tail)))

end nat

namespace nat.primrec'
open vector primrec nat (primrec') nat.primrec'
hide ite

theorem to_prim {n f} (pf : @primrec' n f) : primrec f :=
begin
  induction pf,
  case nat.primrec'.zero { exact const 0 },
  case nat.primrec'.succ { exact primrec.succ.comp vector_head },
  case nat.primrec'.nth : n i {
    exact vector_nth.comp primrec.id (const i) },
  case nat.primrec'.comp : m n f g _ _ hf hg {
    exact hf.comp (vector_of_fn (λ i, hg i)) },
  case nat.primrec'.prec : n f g _ _ hf hg {
    exact nat_elim' vector_head (hf.comp vector_tail) (hg.comp $
      vector_cons.comp (fst.comp snd) $
      vector_cons.comp (snd.comp snd) $
      (@vector_tail _ _ (n+1)).comp fst).to₂ },
end

theorem of_eq {n} {f g : vector ℕ n → ℕ}
  (hf : primrec' f) (H : ∀ i, f i = g i) : primrec' g :=
(funext H : f = g) ▸ hf

theorem const {n} : ∀ m, @primrec' n (λ v, m)
| 0     := zero.comp fin.elim0 (λ i, i.elim0)
| (m+1) := succ.comp _ (λ i, const m)

theorem head {n : ℕ} : @primrec' n.succ head :=
(nth 0).of_eq $ λ v, by simp [nth_zero]

theorem tail {n f} (hf : @primrec' n f) : @primrec' n.succ (λ v, f v.tail) :=
(hf.comp _ (λ i, @nth _ i.succ)).of_eq $
λ v, by rw [← of_fn_nth v.tail]; congr; funext i; simp

def vec {n m} (f : vector ℕ n → vector ℕ m) :=
∀ i, primrec' (λ v, (f v).nth i)

protected theorem nil {n} : @vec n 0 (λ _, nil) := λ i, i.elim0

protected theorem cons {n m f g}
  (hf : @primrec' n f) (hg : @vec n m g) :
  vec (λ v, f v :: g v) :=
λ i, fin.cases (by simp *) (λ i, by simp [hg i]) i

theorem idv {n} : @vec n n id := nth

theorem comp' {n m f g}
  (hf : @primrec' m f) (hg : @vec n m g) :
  primrec' (λ v, f (g v)) :=
(hf.comp _ hg).of_eq $ λ v, by simp

theorem comp₁ (f : ℕ → ℕ) (hf : @primrec' 1 (λ v, f v.head))
  {n g} (hg : @primrec' n g) : primrec' (λ v, f (g v)) :=
hf.comp _ (λ i, hg)

theorem comp₂ (f : ℕ → ℕ → ℕ)
  (hf : @primrec' 2 (λ v, f v.head v.tail.head))
  {n g h} (hg : @primrec' n g) (hh : @primrec' n h) :
  primrec' (λ v, f (g v) (h v)) :=
by simpa using hf.comp' (hg.cons $ hh.cons primrec'.nil)

theorem prec' {n f g h}
  (hf : @primrec' n f) (hg : @primrec' n g) (hh : @primrec' (n+2) h) :
  @primrec' n (λ v, (f v).elim (g v)
    (λ (y IH : ℕ), h (y :: IH :: v))) :=
by simpa using comp' (prec hg hh) (hf.cons idv)

theorem pred : @primrec' 1 (λ v, v.head.pred) :=
(prec' head (const 0) head).of_eq $
λ v, by simp; cases v.head; refl

theorem add : @primrec' 2 (λ v, v.head + v.tail.head) :=
(prec head (succ.comp₁ _ (tail head))).of_eq $
λ v, by simp; induction v.head; simp [*, nat.succ_add]

theorem sub : @primrec' 2 (λ v, v.head - v.tail.head) :=
begin
  suffices, simpa using comp₂ (λ a b, b - a) this (tail head) head,
  refine (prec head (pred.comp₁ _ (tail head))).of_eq (λ v, _),
  simp, induction v.head; simp [*, nat.sub_succ]
end

theorem mul : @primrec' 2 (λ v, v.head * v.tail.head) :=
(prec (const 0) (tail (add.comp₂ _ (tail head) (head)))).of_eq $
λ v, by simp; induction v.head; simp [*, nat.succ_mul]; rw add_comm

theorem if_lt {n a b f g}
  (ha : @primrec' n a) (hb : @primrec' n b)
  (hf : @primrec' n f) (hg : @primrec' n g) :
  @primrec' n (λ v, if a v < b v then f v else g v) :=
(prec' (sub.comp₂ _ hb ha) hg (tail $ tail hf)).of_eq $
λ v, begin
  cases e : b v - a v,
  { simp [not_lt.2 (nat.le_of_sub_eq_zero e)] },
  { simp [nat.lt_of_sub_eq_succ e] }
end

theorem mkpair : @primrec' 2 (λ v, v.head.mkpair v.tail.head) :=
if_lt head (tail head)
  (add.comp₂ _ (tail $ mul.comp₂ _ head head) head)
  (add.comp₂ _ (add.comp₂ _
    (mul.comp₂ _ head head) head) (tail head))

protected theorem encode : ∀ {n}, @primrec' n encode
| 0     := (const 0).of_eq (λ v, by rw v.eq_nil; refl)
| (n+1) := (succ.comp₁ _ (mkpair.comp₂ _ head (tail encode)))
  .of_eq $ λ ⟨a::l, e⟩, rfl

theorem sqrt : @primrec' 1 (λ v, v.head.sqrt) :=
begin
  suffices H : ∀ n : ℕ, n.sqrt = n.elim 0 (λ x y,
    if x.succ < y.succ*y.succ then y else y.succ),
  { simp [H],
    have := @prec' 1 _ _ (λ v,
      by have x := v.head; have y := v.tail.head; from
      if x.succ < y.succ*y.succ then y else y.succ) head (const 0) _,
    { convert this, funext, congr, funext x y, congr; simp },
    have x1 := succ.comp₁ _ head,
    have y1 := succ.comp₁ _ (tail head),
    exact if_lt x1 (mul.comp₂ _ y1 y1) (tail head) y1 },
  intro, symmetry,
  induction n with n IH, {refl},
  dsimp, rw IH, split_ifs,
  { exact le_antisymm (nat.sqrt_le_sqrt (nat.le_succ _))
      (nat.lt_succ_iff.1 $ nat.sqrt_lt.2 h) },
  { exact nat.eq_sqrt.2 ⟨not_lt.1 h, nat.sqrt_lt.1 $
      nat.lt_succ_iff.2 $ nat.sqrt_succ_le_succ_sqrt _⟩ },
end

theorem unpair₁ {n f} (hf : @primrec' n f) :
  @primrec' n (λ v, (f v).unpair.1) :=
begin
  have s := sqrt.comp₁ _ hf,
  have fss := sub.comp₂ _ hf (mul.comp₂ _ s s),
  refine (if_lt fss s fss s).of_eq (λ v, _),
  simp [nat.unpair], split_ifs; refl
end

theorem unpair₂ {n f} (hf : @primrec' n f) :
  @primrec' n (λ v, (f v).unpair.2) :=
begin
  have s := sqrt.comp₁ _ hf,
  have fss := sub.comp₂ _ hf (mul.comp₂ _ s s),
  refine (if_lt fss s s (sub.comp₂ _ fss s)).of_eq (λ v, _),
  simp [nat.unpair], split_ifs; refl
end

theorem of_prim : ∀ {n f}, primrec f → @primrec' n f :=
suffices ∀ f, nat.primrec f → @primrec' 1 (λ v, f v.head), from
λ n f hf, (pred.comp₁ _ $ (this _ hf).comp₁
  (λ m, encodable.encode $ (decode (vector ℕ n) m).map f)
    primrec'.encode).of_eq (λ i, by simp [encodek]),
λ f hf, begin
  induction hf,
  case nat.primrec.zero { exact const 0 },
  case nat.primrec.succ { exact succ },
  case nat.primrec.left { exact unpair₁ head },
  case nat.primrec.right { exact unpair₂ head },
  case nat.primrec.pair : f g _ _ hf hg {
    exact mkpair.comp₂ _ hf hg },
  case nat.primrec.comp : f g _ _ hf hg {
    exact hf.comp₁ _ hg },
  case nat.primrec.prec : f g _ _ hf hg {
    simpa using prec' (unpair₂ head)
      (hf.comp₁ _ (unpair₁ head))
      (hg.comp₁ _ $ mkpair.comp₂ _ (unpair₁ $ tail $ tail head)
        (mkpair.comp₂ _ head (tail head))) },
end

theorem prim_iff {n f} : @primrec' n f ↔ primrec f := ⟨to_prim, of_prim⟩

theorem prim_iff₁ {f : ℕ → ℕ} :
  @primrec' 1 (λ v, f v.head) ↔ primrec f :=
prim_iff.trans ⟨
  λ h, (h.comp $ vector_of_fn $ λ i, primrec.id).of_eq (λ v, by simp),
  λ h, h.comp vector_head⟩

theorem prim_iff₂ {f : ℕ → ℕ → ℕ} :
  @primrec' 2 (λ v, f v.head v.tail.head) ↔ primrec₂ f :=
prim_iff.trans ⟨
  λ h, (h.comp $ vector_cons.comp fst $
    vector_cons.comp snd (primrec.const nil)).of_eq (λ v, by simp),
  λ h, h.comp vector_head (vector_head.comp vector_tail)⟩

theorem vec_iff {m n f} :
  @vec m n f ↔ primrec f :=
⟨λ h, by simpa using vector_of_fn (λ i, to_prim (h i)),
 λ h i, of_prim $ vector_nth.comp h (primrec.const i)⟩

end nat.primrec'

theorem primrec.nat_sqrt : primrec nat.sqrt :=
nat.primrec'.prim_iff₁.1 nat.primrec'.sqrt