import quantum
import matrix_lemmas

open_locale big_operators
open matrix
open Matrix
open quantum

------------------------------------------------------------------------------
section measurement

variables {n : ℕ} {s : Vector n}

lemma measure_eq_mul_conj {m : fin n}
        : (measure s m : ℂ) = ((s m 0)†) * (s m 0)
:= begin
    unfold quantum.measure,
    rw <- complex.mul_conj, ring,
end

lemma measure_eq_proj {m : fin n} : (measure s m : ℂ) = proj s m m
:= begin
    unfold quantum.measure proj,
    unfold matrix.mul matrix.dot_product,
    unfold adjoint,
    rw finset.sum_fin_eq_sum_range,
    rw finset.sum_range_one,
    repeat { rw dif_pos }; simp,
end

lemma measure_eq_of_proj_eq {a b : Vector n} :
                   proj a = proj b
    → measure a = measure b
:= begin
    intros h,
    rw <- matrix.ext_iff at h,
    apply funext, intros i,
    have g: (measure a i : ℂ) = measure b i, {
        iterate 2 {rw measure_eq_proj},
        apply h,
    },
    apply_mod_cast g,
end

lemma nonzero_vector_has_nonzero_measure
        : s ≠ 0 → (∃ i, measure s i ≠ 0)
:= begin
    contrapose!,
    intros h,

    apply matrix.ext, intros i j,
    have j0: j = 0, by {simp},
    cases j0, clear j0, simp,

    rw <- complex.norm_sq_eq_zero,
    apply h,
end

end measurement

------------------------------------------------------------------------------
-- proj lemmas

section proj

variables {n : ℕ} {s t : Vector n}

-- `proj s` is self-adjoint (aka "Hermitian").
@[simp]
lemma proj_self_adjoint (s : Vector n) : ((proj s)†) = proj s
:= begin
    unfold proj,
    rw adjoint_mul, simp,
end

lemma proj_mul_adjoint_eq_self {n} {u : Vector n} : u.unit → (proj u)† ⬝ (proj u) = proj u
:= begin
    unfold proj, intros h,
    rw adjoint_mul, simp,
    rw matrix.mul_assoc, congr' 1,
    rw <- matrix.mul_assoc,
    rw unfold_unit h, simp,
end

lemma outer_product_diagnonal_apply {i : fin n}
        : (s ⬝ t†) i i = (s i 0) * (t i 0).conj
:= begin
    unfold matrix.mul adjoint matrix.dot_product,
    rw finset.sum_fin_eq_sum_range,
    rw finset.sum_eq_single 0,
    rw dif_pos; simp,
    simp,
    simp,
end

lemma outer_product_self_diagnonal_apply_eq_norm_sq {i : fin n}
        : (s ⬝ s†) i i = (s i 0).norm_sq
:= begin
    rw outer_product_diagnonal_apply, simp,
end

lemma proj_diagnonal_eq_mul_conj {i : fin n} : s.proj i i = (s i 0)† * s i 0
:= begin
    unfold proj,
    rw outer_product_diagnonal_apply,
    ring,
end

lemma proj_diagnonal_eq_norm_sq {i : fin n} : s.proj i i = (s i 0).norm_sq
:= begin
    rw proj_diagnonal_eq_mul_conj, simp,
end

end proj

section proj_kron

variables {n : ℕ} {s : Vector n}
variables {m : ℕ} {t : Vector m}

lemma proj_kron : proj (s ⊗ t) = proj s ⊗ proj t
:= begin
    unfold proj,
    rw adjoint_kron,
    rw kron_mixed_prod,
end

lemma proj_kron_apply {i : fin n} {j : fin m}
    : proj (s ⊗ t) (kron_loc i j) (kron_loc i j)
      = proj s i i * proj t j j
:= begin
    rw proj_kron,
    cases i with i ip,
    cases j with j jp,
    unfold kron kron_div kron_mod,
    have f1: (m * i + j) / m = i, {
        rw add_comm,
        rw nat.add_mul_div_left,
        rw nat.div_eq_zero jp, simp, linarith,
    },
    have f2: (m * i + j) % m = j, {
        rw add_comm,
        rw nat.add_mul_mod_self_left,
        rw nat.mod_eq_of_lt jp,
    },
    congr' 1, {
        congr; simp; assumption,
    }, {
        congr; simp; assumption,
    }
end

end proj_kron

------------------------------------------------------------------------------
-- proj + std_basis lemmas

section proj_std_basis

variables {n : ℕ} {m : fin n}

lemma proj_std_basis_eq_diagonal
        : proj (std_basis m) = matrix.diagonal (λ i, if i = m then 1 else 0)
:= begin
    unfold proj matrix.mul,
    unfold Matrix.adjoint,
    apply matrix.ext, intros i j,
    simp,
    unfold matrix.dot_product,
    simp,
    by_cases h: i = j, {
        cases h,
        simp,
        by_cases h2: i = m, {
            cases h2,
            simp,
        }, {
            rw if_neg; try {assumption},
            rw std_basis_eq_zero h2,
            simp,
        }
    }, {
        unfold matrix.diagonal,
        rw if_neg h,
        by_cases h2: i = m, {
            have f1: ¬ j = m, by cc,
            rw std_basis_eq_zero f1, simp,
        }, {
            have f1: ¬ i = m, by cc,
            rw std_basis_eq_zero f1, simp,
        }
    }
end

@[simp]
lemma proj_std_basis_eq_one : proj (std_basis m) m m = 1
:= begin
    rw proj_std_basis_eq_diagonal,
    unfold matrix.diagonal, simp,
end

lemma proj_std_basis_eq_zero1 {i j : fin n} : ¬ i = m → proj (std_basis m) i j = 0
:= begin
    rw proj_std_basis_eq_diagonal,
    unfold matrix.diagonal, intros e,
    rw if_neg e, simp,
end

lemma proj_std_basis_eq_zero2 {i j : fin n} : ¬ j = m → proj (std_basis m) i j = 0
:= begin
    rw proj_std_basis_eq_diagonal,
    unfold matrix.diagonal, intros e,
    by_cases h : i = j, {
        cases h, simp, cc,
    }, {
        rw if_neg h,
    }
end

lemma mul_proj_std_basis_left {n} {m : fin n} {U : Square n}
    : proj (std_basis m) ⬝ U = λ i j, ite (i = m) (U i j) 0
:= begin
    apply matrix.ext, intros i j,
    rw proj_std_basis_eq_diagonal,
    rw matrix.diagonal_mul,
    by_cases h: i = m, {
        cases h, clear h, simp,
    }, {
        iterate 2 { rw if_neg h }, simp,
    }
end

lemma mul_proj_std_basis_right {n} {m : fin n} {U : Square n}
    : U ⬝ proj (std_basis m) = λ i j, ite (j = m) (U i j) 0
:= begin
    apply matrix.ext, intros i j,
    rw proj_std_basis_eq_diagonal,
    rw matrix.mul_diagonal,
    by_cases h: j = m, {
        cases h, clear h, simp,
    }, {
        iterate 2 { rw if_neg h }, simp,
    }
end

lemma kron_proj_std_basis {m : fin 2} {U : Square 2}
    : proj (std_basis m) ⊗ U = λ i j, ite (kron_div i = m ∧ kron_div j = m) (U (kron_mod i) (kron_mod j)) 0
:= begin
    apply kron_ext_mul, intros r s v w, simp,
    by_cases h1: r = m, {
        cases h1, clear h1, simp,
        by_cases h2: s = m, {
            cases h2, clear h2, simp,
        }, {
            rw proj_std_basis_eq_zero2 h2,
            rw if_neg h2, simp,
        }
    }, {
        rw proj_std_basis_eq_zero1 h1,
        have : ¬ (r = m ∧ s = m), by cc,
        rw if_neg this, simp,
    }
end

end proj_std_basis

------------------------------------------------------------------------------
-- trace lemmas

section trace

variables {n : ℕ} (v w : Square n)

theorem trace_smul (s : ℂ) : Tr(s • v) = s * Tr(v)
:= begin
    unfold Matrix.trace,
    simp,
    rw finset.mul_sum,
end

lemma trace_adjoint : Tr((v†)) = Tr(v)†
:= begin
    unfold Matrix.trace,
    unfold adjoint,
    rw complex.conj_sum_dist,
end

lemma abs_trace_adjoint : |Tr(v†)| = |Tr(v)|
:= begin
    unfold Matrix.trace,
    unfold adjoint,
    rw complex.conj_sum_dist,
    rw is_R_or_C.abs_conj,
end

lemma trace_mul_comm : Tr(v ⬝ w) = Tr(w ⬝ v)
:= begin
    unfold Matrix.trace,
    unfold matrix.mul matrix.dot_product,
    rw finset.sum_comm,
    congr, apply funext, intros i,
    congr, apply funext, intros j,
    ring,
end

-- for easier match
lemma fin_sum_sum_mul (f : fin n → fin n → ℂ) (g : fin n → ℂ)
        : (∑ (i : fin n), ((∑ (j : fin n), f i j) * (g i)))
        = (∑ (i : fin n) (j : fin n), f i j * g i)
:= begin
    congr, apply funext, intros i,
    rw finset.sum_mul,
end

variables {m : ℕ}

lemma trace_mul_rotate_l (a : Matrix m n) (b : Matrix n m)
        : Tr(a ⬝ v ⬝ b) = Tr(v ⬝ b ⬝ a)
:= begin
    unfold Matrix.trace,
    unfold matrix.mul matrix.dot_product,
    symmetry,
    rw finset.sum_comm,
    congr, apply funext, intros k,
    iterate 2 { rw fin_sum_sum_mul },
    rw finset.sum_comm,
    congr, apply funext, intros i,
    congr, apply funext, intros j,
    ring,
end

theorem trace_kron {x : Square m}: Tr(v ⊗ x) = Tr(v) * Tr(x)
:= begin
    unfold Matrix.trace kron,
    rw kron_sum_mul_mul,
end

end trace

section trace_proj

variables {n : ℕ} (s t : Vector n)

theorem trace_outer_eq_inner : Tr(s ⬝ (t†)) = (t† ⬝ s) 0 0
:= begin
    unfold Matrix.trace,
    unfold matrix.mul,
    unfold matrix.dot_product,
    congr' 1, apply funext, intro x,
    rw finset.sum_fin_eq_sum_range,
    rw finset.sum_range_one,
    rw dif_pos; try { solve1 {simp} },
    simp,
    ring,
end

lemma trace_outer_eq_trace_inner : Tr(s ⬝ (t†)) = Tr((t†) ⬝ s)
:= begin
    rw trace_outer_eq_inner,
    unfold Matrix.trace,
    rw finset.sum_fin_eq_sum_range,
    rw finset.sum_eq_single 0; simp,
end

theorem trace_proj : Tr(proj s) = ((s†) ⬝ s) 0 0
:= begin
    unfold proj,
    rw trace_outer_eq_inner,
end

lemma trace_proj_eq_one_of_unit {s : Vector n} : s.unit → Tr(proj s) = 1
:= begin
    intros h,
    rw trace_proj,
    rw unfold_unit h, simp,
end

lemma trace_proj_eq_one_of_unit' {s : Vector n} : s.unit → Tr(s ⬝ (s†)) = 1
:= begin
    intros h,
    rw trace_outer_eq_inner,
    rw unfold_unit h, simp,
end

lemma unit_of_trace_proj_eq_one : Tr(proj s) = 1 → s.unit
:= begin
    rw trace_proj,
    intros h,
    unfold matrix.unit,
    apply matrix.ext, intros i j,
    have i0 : i = 0, {
        cases i, simp,
    },
    have j0 : j = 0, {
        cases j, simp,
    },
    cases i0,
    cases j0,
    simp, assumption,
end

lemma trace_proj_inner_prod : Tr(proj (s† ⬝ t)) = Tr(proj s ⬝ proj t)
:= begin
    unfold proj,
    rw adjoint_mul, simp,
    rw <- matrix.mul_assoc,
    rw matrix.mul_assoc (s†),
    rw trace_mul_rotate_l,
    rw matrix.mul_assoc,
    rw _root_.trace_mul_comm,
end

lemma conj_trace_outer_product : Tr(s ⬝ t†)† = Tr(s† ⬝ t)
:= begin
    have f1: (t ⬝ s†)† = (s ⬝ t†), {
        rw adjoint_mul, simp,
    },
    rw <- f1,
    rw trace_adjoint, simp,
    apply trace_outer_eq_trace_inner,
end

end trace_proj

------------------------------------------------------------------------------
-- partial_trace lemmas

section partial_trace_add

variables {n m : ℕ} {x y : Square n * m}

lemma partial_trace_add : partial_trace (x + y) = partial_trace x + partial_trace y
:= begin
    unfold partial_trace Matrix.trace,
    apply funext, intros k,
    apply funext, intros i,
    simp,
    rw finset.sum_add_distrib,
end

end partial_trace_add

section partial_trace_kron

variables {n m : ℕ} (v : Square n) (w : Square m)

lemma partial_trace_kron : partial_trace (v ⊗ w) = Tr(w) • v
:= begin
    unfold partial_trace Matrix.trace,
    apply funext, intros k,
    apply funext, intros i,
    simp,
    rw finset.sum_mul,
    congr' 1, apply funext, intros j,
    rw mul_comm,
    rw mul_to_kron,
end

@[simp]
theorem trace_partial_trace {v : Square n*m} : Tr(partial_trace v) = Tr(v)
:= begin
    unfold Matrix.trace partial_trace,
    rw <- finset.sum_preimage (λ x : fin n × fin m, (kron_loc x.fst x.snd : fin (n * m))), {
        rw <- finset.sum_product',
        simp,
    }, {
        simp,
        unfold set.inj_on,
        intros,
        rw prod.eq_iff_fst_eq_snd_eq,
        apply kron_loc_inj; assumption,
    }, {
        intros x _ h2,
        exfalso,
        apply h2, clear h2,
        use (⟨kron_div x, kron_mod x⟩),
        simp,
    }
end

lemma partial_trace_kron_eq {o} (x : Square o): Tr(v) = Tr(w)
        → partial_trace (x ⊗ v) = partial_trace (x ⊗ w)
:= begin
    intros t,
    iterate 2 { rw partial_trace_kron },
    rw t,
end

lemma partial_trace_kron_neq {o} (x y : Square o): Tr(v) = Tr(w)
        → partial_trace (x ⊗ v) ≠ partial_trace (y ⊗ w)
        → x ≠ y
:= begin
    intros t h c, apply h, clear h,
    cases c, apply partial_trace_kron_eq, assumption,
end

end partial_trace_kron

section partial_trace_proj

variables {n : ℕ} {s t : Vector n}
variables {m : ℕ} {a b : Vector m}

lemma partial_proj_eq_of_kron_eq :
        a ⊗ s = b ⊗ t
        → Tr(proj s) = 1 → Tr(proj t) = 1
        → proj a = proj b
:= begin
    intros h vt wt,
    have f1: partial_trace (proj (a ⊗ s)) = partial_trace (proj (b ⊗ t)), {
        rw h,
    },
    iterate 2 { rw proj_kron at f1 },
    iterate 2 { rw partial_trace_kron at f1 },
    rw vt at f1,
    rw wt at f1,
    simp at f1, assumption,
end

lemma partial_proj_eq_of_kron_eq' :
        a ⊗ s = b ⊗ t
        → s.unit → t.unit
        → proj a = proj b
:= begin
    intros h su tu,
    apply partial_proj_eq_of_kron_eq; try {assumption},
    rw trace_proj, rw unfold_unit su, simp,
    rw trace_proj, rw unfold_unit tu, simp,
end

end partial_trace_proj

section partial_trace_add_kron

variables {n : ℕ} (v w x y : Square n)
variables {m : ℕ} (a b c d : Square m)

lemma partial_trace_add_kron : partial_trace (a ⊗ v + b ⊗ w) = Tr(v) • a + Tr(w) • b
:= begin
    unfold partial_trace Matrix.trace,
    apply funext, intros k,
    apply funext, intros i,
    simp,

    rw finset.sum_add_distrib,
    rw finset.sum_mul,
    rw finset.sum_mul,
    congr' 1, {
        congr' 1, apply funext, intros j,
        rw mul_comm (v j j),
        rw mul_to_kron,
    }, {
        congr' 1, apply funext, intros j,
        rw mul_comm (w j j),
        rw mul_to_kron,
    }
end

lemma partial_trace_add_kron2 : partial_trace (a ⊗ v + b ⊗ w + c ⊗ x + d ⊗ y)
                                = Tr(v) • a + Tr(w) • b + Tr(x) • c + Tr(y) • d
:= begin
    unfold partial_trace Matrix.trace,
    apply funext, intros k,
    apply funext, intros i,
    simp,

    repeat { rw finset.sum_add_distrib },
    repeat { rw finset.sum_mul },
    congr' 1, {
        congr' 1, {
            congr' 1, {
                congr' 1, apply funext, intros j,
                rw mul_comm (v j j),
                rw mul_to_kron,
            }, {
                congr' 1, apply funext, intros j,
                rw mul_comm (w j j),
                rw mul_to_kron,
            }
        }, {
            congr' 1, apply funext, intros j,
            rw mul_comm (x j j),
            rw mul_to_kron,
        }
    }, {
        congr' 1, apply funext, intros j,
        rw mul_comm (y j j),
        rw mul_to_kron,
    }
end

end partial_trace_add_kron

section partial_trace_proj_add_kron

variables {n: ℕ} (s t p: Vector n)
variables {m: ℕ} (v w q: Vector m)

lemma proj_add_kron : proj ((t ⊗ w) + (p ⊗ q))
            = t ⬝ (t†) ⊗ (w ⬝ (w†)) + t ⬝ (p†) ⊗ (w ⬝ (q†)) + p ⬝ (t†) ⊗ (q ⬝ (w†)) + p ⬝ (p†) ⊗ (q ⬝ (q†))
:= begin
    unfold proj, repeat { rw adjoint_add <|> rw adjoint_kron },
    repeat { rw matrix.add_mul <|> rw matrix.mul_add },
    repeat { rw kron_mixed_prod },
    rw <- add_assoc,
end

lemma partial_trace_proj_add_kron : w.unit → q.unit → (w†) ⬝ q = 1
            → partial_trace (proj ((t ⊗ w) + (p ⊗ q))) = proj (t + p)
:= begin
    intros wu qu h,
    rw proj_add_kron,
    rw partial_trace_add_kron2,
    rw trace_proj_eq_one_of_unit' wu,
    rw trace_proj_eq_one_of_unit' qu,

    have f1: Tr(q ⬝ (w†)) = 1, {
        rw trace_outer_eq_inner, rw h, simp,
    },
    have f2: Tr(w ⬝ (q†)) = 1, {
        have h': (q†) ⬝ w = 1, {
            apply adjoint_inj, rw adjoint_mul, simp *,
        },
        rw trace_outer_eq_inner, rw h', simp,
    },
    rw f1, rw f2, simp,

    unfold proj, rw adjoint_add,
    repeat { rw matrix.add_mul <|> rw matrix.mul_add },
    abel,
end

lemma partial_trace_proj_add_kron2 : w.unit → q.unit → (w†) ⬝ q = 0
            → partial_trace (proj ((t ⊗ w) + (p ⊗ q))) = proj t + proj p
:= begin
    intros wu qu h,
    rw proj_add_kron,
    rw partial_trace_add_kron2,
    rw trace_proj_eq_one_of_unit' wu,
    rw trace_proj_eq_one_of_unit' qu,
    have f1: Tr(q ⬝ (w†)) = 0, {
        rw trace_outer_eq_inner, rw h, simp,
    },
    have f2: Tr(w ⬝ (q†)) = 0, {
        have h': (q†) ⬝ w = 0, {
            apply adjoint_inj, rw adjoint_mul, simp *,
        },
        rw trace_outer_eq_inner, rw h', simp,
    },
    rw f1, rw f2, unfold proj, simp,
end

end partial_trace_proj_add_kron

------------------------------------------------------------------------------
-- state_after_measure lemmas

section state_after_measure_lemmas

variables {n : ℕ} {s : Vector n} {m : fin n}

lemma state_after_measure_eq_zero {i : fin n}
        : ¬ i = m → (state_after_measure s m) i 0 = 0
:= begin
    unfold quantum.measure state_after_measure,
    intros h,
    rw Matrix.real_smul_apply,
    rw matrix.mul_apply,
    rw finset.sum_eq_zero; try {solve1 {simp}},
    intros x xh,
    rw proj_std_basis_eq_zero1; simp [*],
end

lemma abs_state_after_measure_eq_one {i : fin n}
        : ⟦s⟧ m ≠ 0 → i = m → |state_after_measure s m i 0| = 1
:= begin
    intros sp h, cases h, clear h,
    unfold quantum.measure state_after_measure,
    rw Matrix.real_smul_apply,
    rw matrix.mul_apply,
    rw finset.sum_eq_single m, {
        simp, ring,
        rw <- is_R_or_C.norm_sq_to_complex,
        rw is_R_or_C.sqrt_norm_sq_eq_norm,
        simp,
        rw mul_inv_cancel, {
            intro c,
            apply sp, clear sp,
            unfold quantum.measure,
            rw complex.norm_sq_eq_abs,
            rw c, simp,
        }
    }, {
        intros x xp xh,
        rw proj_std_basis_eq_zero2; simp [*],
    }, {
        simp,
    }
end

lemma measure_state_after_measure_eq_one {i : fin n}
        : ⟦s⟧ m ≠ 0 → i = m → measure (state_after_measure s m) i = 1
:= begin
    intros sp h, cases h, clear h,
    unfold quantum.measure state_after_measure,
    rw Matrix.real_smul_apply,
    rw matrix.mul_apply,
    rw finset.sum_eq_single m, {
        simp, rw mul_comm,
        rw mul_inv_cancel, {
            intro c,
            apply sp, clear sp,
            apply c,
        }
    }, {
        intros x xp xh,
        rw proj_std_basis_eq_zero2; simp [*],
    }, {
        simp,
    }
end

lemma measure_state_after_measure_eq_measure_std_basis
        : ⟦s⟧ m ≠ 0 → measure (state_after_measure s m) = measure (std_basis m)
:= begin
    intros h,
    ext1 i,
    by_cases c: i = m, {
        cases c, clear c,
        rw measure_state_after_measure_eq_one h rfl,
        unfold quantum.measure, simp,
    }, {
        unfold quantum.measure,
        rw state_after_measure_eq_zero c,
        rw std_basis_eq_zero c,
    },
end

end state_after_measure_lemmas

------------------------------------------------------------------------------
-- partial measure lemmas

section partial_measure

variables {n : ℕ} {a b : Vector n}
variables {m : ℕ} {s t : Vector m}

lemma measure_eq_of_kron_eq :
        a ⊗ s = b ⊗ t
        → Tr(proj s) = 1 → Tr(proj t) = 1
        → measure a = measure b
:= begin
    intros h su tu,
    apply measure_eq_of_proj_eq,
    apply partial_proj_eq_of_kron_eq h; assumption,
end

-- not true
-- example: a ⊗ (s + t) = b ⊗ (v + w)
--         → Tr(proj (s + t)) = 1 → Tr(proj (v + w)) = 1
--         → proj a = proj b

lemma partial_measure_proj_kron
        : Tr(proj s) = 1
        → partial_measure (a ⊗ s) = measure a
:= begin
    intros vu,
    apply funext, intros i,
    unfold partial_measure quantum.measure,
    rw proj_kron,
    rw partial_trace_kron,
    rw vu, simp,
    rw proj_diagnonal_eq_norm_sq, simp,
end

lemma partial_measure_eq_of_kron_eq :
        a ⊗ s = b ⊗ t
        → Tr(proj s) = 1 → Tr(proj t) = 1
        → measure a = measure b
:= begin
    intros h stu vwu,
    have f1: partial_measure (a ⊗ s) = partial_measure (b ⊗ t), {
        rw h,
    },
    rw partial_measure_proj_kron stu at f1,
    rw partial_measure_proj_kron vwu at f1,
    assumption,
end

lemma unit_has_nonzero_measure
        : s.unit → (∃ i, measure s i ≠ 0)
:= begin
    intros h,
    apply nonzero_vector_has_nonzero_measure,
    apply unit_nonzero, assumption,
end

lemma measure_kron_apply {i : fin n} {j : fin m}
    : measure (a ⊗ s) (kron_loc i j)
      = measure a i * measure s j
:= begin
    have goal: (measure (a ⊗ s) (kron_loc i j) : ℂ)
                = measure a i * measure s j, {
          repeat { rw measure_eq_proj },
          apply proj_kron_apply,
    },
    apply_mod_cast goal,
end

lemma measure_kron_cancel_right:
            measure (a ⊗ s) = measure (b ⊗ s)
            → s.unit
            → measure a = measure b
:= begin
    intros h su,
    apply funext, intro i,
    rw function.funext_iff at h,
    rcases (unit_has_nonzero_measure su) with ⟨j, jp⟩,
    specialize (h (kron_loc i j)),
    iterate 2 {rw measure_kron_apply at h},
    apply mul_right_cancel' _ h; assumption,
end

lemma measure_kron_cancel_left:
            measure (s ⊗ a) = measure (s ⊗ b)
            → s.unit
            → measure a = measure b
:= begin
    intros h su,
    apply funext, intro i,
    rw function.funext_iff at h,
    rcases (unit_has_nonzero_measure su) with ⟨j, jp⟩,
    specialize (h (kron_loc j i)),
    iterate 2 {rw measure_kron_apply at h},
    apply mul_left_cancel' _ h; assumption,
end

end partial_measure

------------------------------------------------------------------------------
-- partial_measure_add_kron

section partial_measure_add_kron

variables {n : ℕ} {a b : Vector n}
variables {m : ℕ} {s t : Vector m}

lemma partial_measure_add_kron_rhs {a b k : ℂ}
        : ((a + b).norm_sq : ℂ) - (2 * ((1 - k) * (a * b†)).re : ℝ)
            = (a.norm_sq + b.norm_sq : ℂ) + (2 * (k * (a * b.conj)).re : ℝ)
:= begin
    have l1: ((a + b).norm_sq : ℂ)
                = (a.norm_sq + b.norm_sq)
                    + (2 * (a * b.conj).re : ℝ), {
        rw <- complex.conj_mul' (a + b),
        repeat { rw complex.conj.map_add },
        repeat { rw add_mul },
        repeat { rw mul_add },
        have l1_1: a * b.conj + b * a.conj
                = (2 * (a * b.conj).re : ℝ), {
            rw <- complex.add_conj,
            congr, simp, ring,
        },
        rw <- l1_1, clear l1_1,
        simp, ring,
    },
    rw l1, clear l1,

    rw add_sub_assoc (a.norm_sq + b.norm_sq : ℂ),
    congr' 1,
    repeat { rw sub_mul },
    repeat { rw two_mul },
    rw complex.sub_re,
    rw is_R_or_C.conj_to_complex,
    norm_cast, ring,
    rw <- sub_sub,
    rw <- sub_add,
    rw <- sub_add,
    repeat { rw <- mul_assoc },
    ring,
end

lemma partial_measure_add_kron : Tr(proj s) = 1 → Tr(proj t) = 1
        → ⦃ a ⊗ s + b ⊗ t ⦄
            = λ i, |(a i 0 + b i 0).norm_sq
                    - 2 * ((1 - Tr(s ⬝ t†)) * (a i 0 * (b i 0)†)).re|
:= begin
    intros su tu,
    ext i,

    have lhs: ⦃a ⊗ s + b ⊗ t⦄ i
                = |((a ⬝ a†) i i + (b ⬝ b†) i i) + (Tr(s ⬝ t†) • ((a ⬝ b†) i i) + Tr(t ⬝ s†) • ((b ⬝ a†) i i))|,
    {
        unfold partial_measure,
        rw proj_add_kron,
        repeat { rw partial_trace_add },
        repeat { rw partial_trace_kron },
        unfold proj at su,
        unfold proj at tu,
        rw su, rw tu,
        simp,
        congr' 1,
        ring,
    },
    rw lhs, clear lhs,
    iterate 2 { rw outer_product_self_diagnonal_apply_eq_norm_sq },
    iterate 2 { rw outer_product_diagnonal_apply },

    have rhs: (((a i 0 + b i 0).norm_sq - 2 * ((1 - Tr(s ⬝ t†)) * (a i 0 * (b i 0)†)).re : ℝ) : ℂ)
            = ((a i 0).norm_sq + (b i 0).norm_sq : ℂ)
                    + (2 * (Tr(s ⬝ t†) * (a i 0 * (b i 0).conj)).re : ℝ), {
        apply_mod_cast partial_measure_add_kron_rhs,
    },
    rw complex.abs_of_real',
    rw rhs,

    congr' 1,
    congr' 1,

    have f1: Tr(s ⬝ t†) * (a i 0 * (b i 0).conj) + Tr(t ⬝ s†) * (b i 0 * (a i 0).conj)
           = (2 * (Tr(s ⬝ t†) * (a i 0 * (b i 0).conj)).re : ℝ), {
        rw <- complex.add_conj,
        simp,
        congr' 1, {
            rw <- adjoint_involutive t,
            rw <- adjoint_mul,
            rw trace_adjoint,
            simp,
        }, {
            ring,
        }
    },
    apply f1,
end

lemma partial_measure_add_kron' : Tr(proj s) = 1 → Tr(proj t) = 1
        → ⦃ a ⊗ s + b ⊗ t ⦄
            = λ i, |(a i 0 + b i 0).norm_sq
                    - 2 * ((1 - Tr(s† ⬝ t)) * ((a i 0)† * b i 0)).re|
:= begin
    intros su tu,
    rw partial_measure_add_kron su tu,
    ext i,

    have f1: ((1 - Tr(s ⬝ t†)) * (a i 0 * (b i 0)†)).re
                = ((1 - Tr(s† ⬝ t)) * ((a i 0)† * b i 0)).re, {
        rw <- complex.re_conj_eq_re,
        congr' 1,
        simp,
        left,
        rw <- is_R_or_C.conj_to_complex,
        rw conj_trace_outer_product,
    },
    rw f1,
end

lemma partial_measure_add_kron_of_orthogonal : Tr(proj s) = 1 → Tr(proj t) = 1
        → (∀ i, (a i 0)† * b i 0 = 0)
        → ⦃ a ⊗ s + b ⊗ t ⦄ = ⟦ a + b ⟧
:= begin
    intros su tu h,
    rw partial_measure_add_kron' su tu,
    ext i,
    rw h, simp,
    unfold quantum.measure,
    apply _root_.abs_of_nonneg, simp,
end

end partial_measure_add_kron

------------------------------------------------------------------------------
-- std_basis lemmas for proof automation

meta def solve_std_basis_zero := `[rw std_basis_eq_zero, dec_trivial]

@[simp] lemma std_basis_0_2_1 : (std_basis 0 : Vector 2) 1 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_1_2_0 : (std_basis 1 : Vector 2) 0 0 = 0 := by solve_std_basis_zero

@[simp] lemma std_basis_0_4_1 : (std_basis 0 : Vector 4) 1 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_0_4_2 : (std_basis 0 : Vector 4) 2 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_0_4_3 : (std_basis 0 : Vector 4) 3 0 = 0 := by solve_std_basis_zero

@[simp] lemma std_basis_1_4_0 : (std_basis 1 : Vector 4) 0 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_1_4_2 : (std_basis 1 : Vector 4) 2 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_1_4_3 : (std_basis 1 : Vector 4) 3 0 = 0 := by solve_std_basis_zero

@[simp] lemma std_basis_2_4_0 : (std_basis 2 : Vector 4) 0 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_2_4_1 : (std_basis 2 : Vector 4) 1 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_2_4_3 : (std_basis 2 : Vector 4) 3 0 = 0 := by solve_std_basis_zero

@[simp] lemma std_basis_3_0_1 : (std_basis 3 : Vector 4) 0 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_3_4_1 : (std_basis 3 : Vector 4) 1 0 = 0 := by solve_std_basis_zero
@[simp] lemma std_basis_3_4_2 : (std_basis 3 : Vector 4) 2 0 = 0 := by solve_std_basis_zero

------------------------------------------------------------------------------
-- More proof automation lemmas related to "fin" type.

@[instance]
def fin_has_zero_one_by_one : has_zero (fin (1 * 1))
:= by {split, exact ⟨0, by dec_trivial⟩}

@[instance]
def fin_has_zero_two_by_two : has_zero (fin (2 * 2))
:= by {split, exact ⟨0, by dec_trivial⟩}

@[instance]
def fin_has_one_two_by_two : has_one (fin (2 * 2))
:= by {split, exact ⟨1, by dec_trivial⟩}

@[simp] lemma fin_one_succ : (⟨(1 : ℕ).succ, by dec_trivial⟩ : fin 4) = ⟨2, by dec_trivial⟩ := by norm_num
@[simp] lemma fin_one_succ_succ : (⟨(1 : ℕ).succ.succ, by dec_trivial⟩ : fin 4) = ⟨3, by dec_trivial⟩ := by norm_num

@[simp] lemma fin_0_div_1 : (⟨(0 : fin 1) / 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_num
@[simp] lemma fin_0_mod_1 : (⟨(0 : fin 1) % 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_num
@[simp] lemma fin_0_div_2' : (⟨(0 : fin (2*2)) / 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_0_mod_2' : (⟨(0 : fin (2*2)) % 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_1_div_2 : (⟨1 / 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_num
@[simp] lemma fin_1_div_2' : (⟨(1 : fin (2*2)) / 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_1_mod_2 : (⟨(1 : fin (2*2)) % 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_2_div_2' : (⟨(2 : fin (2*2)) / 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_2_mod_2' : (⟨(2 : fin (2*2)) % 2, by dec_trivial⟩ : fin 2) = ⟨0, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_3_div_2 : (⟨(3 : fin (3+1)) / 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_3_mod_2 : (⟨(3 : fin (3+1)) % 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_3_div_2' : (⟨(3 : fin (2*2)) / 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_3_mod_2' : (⟨(3 : fin (2*2)) % 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast

@[simp] lemma fin_one_succ_succ_div_2' : (⟨(1 : ℕ).succ.succ / 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast
@[simp] lemma fin_one_succ_succ_mod_2' : (⟨(1 : ℕ).succ.succ % 2, by dec_trivial⟩ : fin 2) = ⟨1, by dec_trivial⟩ := by norm_cast

------------------------------------------------------------------------------
-- dot_product proof automation

meta def finish_complex_arith :=
    `[ repeat { simp
            <|> rw_mod_cast complex.conj_of_real
            <|> rw_mod_cast real.sqr_sqrt
            <|> refl
            <|> dec_trivial
            <|> ring
            <|> linarith
        }]

meta def grind_dot_product :=
    `[
        try {unfold matrix.mul matrix.dot_product},
        try {unfold Matrix.adjoint},
        rw finset.sum_fin_eq_sum_range,
        repeat { rw finset.sum_range_succ },
        rw finset.sum_range_zero,
        repeat { rw dif_pos }]

------------------------------------------------------------------------------
-- matrix proof automation

meta def finish_fin_out_of_range_h (h : expr) : tactic unit
:= do
    t ← tactic.infer_type h,
    match t with
    | `(_ < _) :=
        tactic.solve1 (do
            `[exfalso],
            e ← tactic.to_expr ``(not_le_of_gt %%h),
            tactic.apply e,
            `[repeat {rw <- nat.add_one}; linarith])
    | _ := tactic.fail ()
    end

meta def finish_fin_out_of_range : tactic unit
:= do
    ctx ← tactic.local_context,
    ctx.mfirst (λ h, finish_fin_out_of_range_h h)

meta def maybe_numeral (h : expr) : tactic bool
:= do
    match h with
    | (expr.var _) := return false
    | (expr.app _ _) := return true -- maybe
    | _ := return false
    end

meta def find_local_const : expr → tactic expr
| h := do
    match h with
    | (expr.local_const _ _ _ _) := return h
    | `(nat.succ %%h') :=
        do {
            r ← find_local_const h',
            return r
        }
    | _ := tactic.fail ()
    end

meta def destruct_fin_one (h : expr) : tactic unit
:= do
    t ← tactic.infer_type h,
    match t with
    | `(fin has_one.one) := tactic.cases h list.nil >> return ()
    | `(%%x < has_one.one) :=
        do
            c ← find_local_const x,
            tactic.cases c list.nil >> return ()
    | _ := tactic.fail ()
    end

meta def destruct_fin_succ (h : expr) : tactic unit
:= do
    t ← tactic.infer_type h,
    match t with
    | `(fin (nat.succ %%n)) := tactic.cases h list.nil >> return ()
    | `(fin (bit0 %%n)) := tactic.cases h list.nil >> return ()
    | `(%%x < (nat.succ %%y)) :=
        do  c ← find_local_const x,
            tactic.cases c list.nil >> return ()
    | `(%%x < (bit0 %%y)) :=
        do  c ← find_local_const x,
            tactic.cases c list.nil >> return ()
    | _ := tactic.fail ()
    end

-- case-split on a concrete finite set (such as fin 2, n < 3)
meta def destruct_fin : tactic unit
:= do
    ctx ← tactic.local_context,
    finish_fin_out_of_range
    <|> ctx.mfirst (λ h, destruct_fin_one h)
    <|> ctx.mfirst (λ h, destruct_fin_succ h)

-- case split on all matrix coordinates
meta def grind_matrix : tactic unit
:= do
    `[apply matrix.ext, intros],
    `[repeat { destruct_fin }]

meta def unfold_qubits : tactic unit
:= do
    `[try {unfold ket0 ket1}],
    `[try {unfold ket00 ket01 ket10 ket11}],
    `[try {unfold ket_plus ket_minus}]

------------------------------------------------------------------------------
-- state lemmas

@[simp] lemma ket0_unit : |0⟩† ⬝ |0⟩ = 1 := by {unfold_qubits, simp}
@[simp] lemma ket1_unit : |1⟩† ⬝ |1⟩ = 1 := by {unfold_qubits, simp}

meta def unit_vector : tactic unit
:= `[apply matrix.ext; intros; unfold_qubits; grind_dot_product; finish_complex_arith]

@[simp] lemma ket_plus_unit : (|+⟩†) ⬝ |+⟩ = 1 := by unit_vector
@[simp] lemma ket_minus_unit : (|-⟩†) ⬝ |-⟩ = 1 := by unit_vector

meta def solve_vector_eq := `[unfold_qubits; grind_matrix; `[simp]]

lemma ket_plus_alt_def : |+⟩ = (/√2 • |0⟩) + (/√2 • |1⟩) := by solve_vector_eq
lemma ket_minus_alt_def : |-⟩ = (/√2 • |0⟩) + (-/√2 • |1⟩) := by solve_vector_eq

@[simp] lemma ket_zeros_unit {n : ℕ} : (((ket_zeros n)†) ⬝ (ket_zeros n) = 1)
:= by {unfold ket_zeros, simp}

@[simp] lemma ket_phi_plus_unit : ket_phi_plus† ⬝ ket_phi_plus = 1
:= by {unfold ket_phi_plus, unit_vector}

@[simp]
lemma vec_head_fin_one (f : fin 1 → ℂ) : vec_head (λ x : fin 1, f x) = f 0
:= by refl

lemma ket_phi_plus_alt_def : ket_phi_plus = /√2 • (|00⟩) + /√2 • (|11⟩)
:= begin
    unfold ket_phi_plus,
    solve_vector_eq,
end

lemma ket_phi_plus_alt_def' : ket_phi_plus = /√2 • (|0⟩ ⊗ |0⟩) + /√2 • (|1⟩ ⊗ |1⟩)
:= begin
    rw ket_phi_plus_alt_def,
    unfold ket0 ket1 ket00 ket11,
    repeat { rw kron_std_basis },
    congr,
end

-- The "unit" flavor (`s.unit`), instead of `s† ⬝ s`.
@[simp] lemma ket0_unit': |0⟩.unit := by {unfold ket0, simp}
@[simp] lemma ket1_unit': |1⟩.unit := by {unfold ket1, simp}
@[simp] lemma ket_plus_unit': |+⟩.unit := by {unfold matrix.unit, simp}
@[simp] lemma ket_minus_unit': |-⟩.unit := by {unfold matrix.unit, simp}

------------------------------------------------------------------------------------------------
-- Inner product values

-- This could be read as `⟨0|+⟩` on books.
@[simp] lemma inner_ket0_ket_plus :  ⟪ |0⟩, |+⟩ ⟫ = (/√2 : ℂ)
:= begin
    unfold has_inner.inner Matrix.inner_product,
    unfold_qubits; grind_dot_product; finish_complex_arith,
end

------------------------------------------------------------------------------------------------
-- gate lemmas

meta def unfold_gates := `[try {unfold X Z H CNOT CZ SWAP}]
meta def solve_matrix_mul := `[unfold_gates; unfold_qubits; grind_matrix; grind_dot_product; finish_complex_arith]

@[simp] lemma X_unitary : X† ⬝ X = 1 := by solve_matrix_mul
@[simp] lemma Z_unitary : Z† ⬝ Z = 1 := by solve_matrix_mul
@[simp] lemma H_unitary : H† ⬝ H = 1 := by solve_matrix_mul

meta def solve_matrix_apply_eq := `[unfold_gates; grind_dot_product; finish_complex_arith]

@[simp] lemma CNOT_self_inner_0_0 : (CNOT† ⬝ CNOT) 0 0 = 1 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_0_1 : (CNOT† ⬝ CNOT) 0 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_0_2 : (CNOT† ⬝ CNOT) 0 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_0_3 : (CNOT† ⬝ CNOT) 0 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CNOT_self_inner_1_0 : (CNOT† ⬝ CNOT) 1 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_1_1 : (CNOT† ⬝ CNOT) 1 1 = 1 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_1_2 : (CNOT† ⬝ CNOT) 1 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_1_3 : (CNOT† ⬝ CNOT) 1 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CNOT_self_inner_2_0 : (CNOT† ⬝ CNOT) 2 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_2_1 : (CNOT† ⬝ CNOT) 2 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_2_2 : (CNOT† ⬝ CNOT) 2 2 = 1 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_2_3 : (CNOT† ⬝ CNOT) 2 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CNOT_self_inner_3_0 : (CNOT† ⬝ CNOT) 3 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_3_1 : (CNOT† ⬝ CNOT) 3 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_3_2 : (CNOT† ⬝ CNOT) 3 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CNOT_self_inner_3_3 : (CNOT† ⬝ CNOT) 3 3 = 1 := by solve_matrix_apply_eq

@[simp] lemma CNOT_unitary : CNOT† ⬝ CNOT = 1 := by {grind_matrix; finish_complex_arith}

@[simp] lemma CZ_inner_self_0_0 : (CZ† ⬝ CZ) 0 0 = 1 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_0_1 : (CZ† ⬝ CZ) 0 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_0_2 : (CZ† ⬝ CZ) 0 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_0_3 : (CZ† ⬝ CZ) 0 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CZ_inner_self_1_0 : (CZ† ⬝ CZ) 1 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_1_1 : (CZ† ⬝ CZ) 1 1 = 1 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_1_2 : (CZ† ⬝ CZ) 1 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_1_3 : (CZ† ⬝ CZ) 1 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CZ_inner_self_2_0 : (CZ† ⬝ CZ) 2 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_2_1 : (CZ† ⬝ CZ) 2 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_2_2 : (CZ† ⬝ CZ) 2 2 = 1 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_2_3 : (CZ† ⬝ CZ) 2 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma CZ_inner_self_3_0 : (CZ† ⬝ CZ) 3 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_3_1 : (CZ† ⬝ CZ) 3 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_3_2 : (CZ† ⬝ CZ) 3 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma CZ_inner_self_3_3 : (CZ† ⬝ CZ) 3 3 = 1 := by solve_matrix_apply_eq

lemma CZ_unitary : CZ† ⬝ CZ = 1 := by {grind_matrix; finish_complex_arith}

@[simp] lemma SWAP_inner_self_0_0 : (SWAP† ⬝ SWAP) 0 0 = 1 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_0_1 : (SWAP† ⬝ SWAP) 0 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_0_2 : (SWAP† ⬝ SWAP) 0 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_0_3 : (SWAP† ⬝ SWAP) 0 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma SWAP_inner_self_1_0 : (SWAP† ⬝ SWAP) 1 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_1_1 : (SWAP† ⬝ SWAP) 1 1 = 1 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_1_2 : (SWAP† ⬝ SWAP) 1 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_1_3 : (SWAP† ⬝ SWAP) 1 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma SWAP_inner_self_2_0 : (SWAP† ⬝ SWAP) 2 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_2_1 : (SWAP† ⬝ SWAP) 2 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_2_2 : (SWAP† ⬝ SWAP) 2 2 = 1 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_2_3 : (SWAP† ⬝ SWAP) 2 3 = 0 := by solve_matrix_apply_eq

@[simp] lemma SWAP_inner_self_3_0 : (SWAP† ⬝ SWAP) 3 0 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_3_1 : (SWAP† ⬝ SWAP) 3 1 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_3_2 : (SWAP† ⬝ SWAP) 3 2 = 0 := by solve_matrix_apply_eq
@[simp] lemma SWAP_inner_self_3_3 : (SWAP† ⬝ SWAP) 3 3 = 1 := by solve_matrix_apply_eq

lemma SWAP_unitary : SWAP† ⬝ SWAP = 1 := by {grind_matrix; finish_complex_arith}

------------------------------------------------------------------------------
-- gate and state lemmas

@[simp] lemma X_ket0_eq_ket1 : X ⬝ |0⟩ = |1⟩ := by solve_matrix_mul
@[simp] lemma X_ket1_eq_ket0 : X ⬝ |1⟩ = |0⟩ := by solve_matrix_mul

@[simp] lemma H_ket0_eq_ket_plus  : H ⬝ |0⟩ = |+⟩ := by solve_matrix_mul
@[simp] lemma H_ket1_eq_ket_minus : H ⬝ |1⟩ = |-⟩ := by solve_matrix_mul
@[simp] lemma H_ket_plus_eq_ket0  : H ⬝ |+⟩ = |0⟩ := by solve_matrix_mul
@[simp] lemma H_ket_minus_eq_ket1 : H ⬝ |-⟩ = |1⟩ := by solve_matrix_mul

@[simp] lemma CNOT_ket00_eq_ket00 : CNOT ⬝ |00⟩ = |00⟩ := by solve_matrix_mul
@[simp] lemma CNOT_ket01_eq_ket01 : CNOT ⬝ |01⟩ = |01⟩ := by solve_matrix_mul
@[simp] lemma CNOT_ket10_eq_ket11 : CNOT ⬝ |10⟩ = |11⟩ := by solve_matrix_mul
@[simp] lemma CNOT_ket11_eq_ket10 : CNOT ⬝ |11⟩ = |10⟩ := by solve_matrix_mul

------------------------------------------------------------------------------
-- SWAP gate lemmas

section SWAP_lemmas

variables {a b : Vector 2}

meta def unfold_swap_app := `[unfold SWAP; simp; unfold matrix.vec_head matrix.vec_tail]
meta def solve_swap_kron := unfold_swap_app; `[unfold kron kron_div kron_mod; repeat {simp <|> ring}]

lemma SWAP_kron_0 : (SWAP ⬝ (a ⊗ b)) ⟨0, by dec_trivial⟩ ⟨0, by dec_trivial⟩ = (b ⊗ a) 0 0
:= by solve_swap_kron
lemma SWAP_kron_1 : (SWAP ⬝ (a ⊗ b)) ⟨1, by dec_trivial⟩ ⟨0, by dec_trivial⟩ = (b ⊗ a) 1 0
:= by solve_swap_kron
lemma SWAP_kron_2 : (SWAP ⬝ (a ⊗ b)) ⟨2, by dec_trivial⟩ ⟨0, by dec_trivial⟩ = (b ⊗ a) 2 0
:= by solve_swap_kron
lemma SWAP_kron_3 : (SWAP ⬝ (a ⊗ b)) ⟨3, by dec_trivial⟩ ⟨0, by dec_trivial⟩ = (b ⊗ a) 3 0
:= by solve_swap_kron

@[simp] lemma SWAP_kron_0' : (SWAP ⬝ (a ⊗ b)) (⟨0, by dec_trivial⟩ : fin (2*2)) ⟨0, by dec_trivial⟩
                             = (b ⊗ a) 0 0
:= by apply SWAP_kron_0

@[simp] lemma SWAP_kron_1' : (SWAP ⬝ (a ⊗ b)) (⟨1, by dec_trivial⟩ : fin (2*2)) ⟨0, by dec_trivial⟩
                             = (b ⊗ a) 1 0
:= by apply SWAP_kron_1

@[simp] lemma SWAP_kron_2' : (SWAP ⬝ (a ⊗ b)) (bit0 (⟨1, by dec_trivial⟩ : fin (2*2))) ⟨0, by dec_trivial⟩
                             = (b ⊗ a) 2 0
:= by apply SWAP_kron_2

@[simp] lemma SWAP_kron_3' : (SWAP ⬝ (a ⊗ b)) (⟨2 + 1, by dec_trivial⟩ : fin (2*2)) ⟨0, by dec_trivial⟩
                             = (b ⊗ a) 3 0
:= by apply SWAP_kron_3

lemma SWAP_kron : SWAP ⬝ (a ⊗ b) = b ⊗ a
:= begin
    symmetry,
    apply kron_ext_mul, intros r s v w,
    unfold kron_loc,
    repeat { destruct_fin }; {
        simp, unfold kron kron_div kron_mod, simp,
    },
end

end SWAP_lemmas

------------------------------------------------------------------------------
-- Numeric constants lemmas for proof automation

@[simp] lemma sqrt_2_nonneg : 0 ≤ √2 := by {apply real.sqrt_nonneg}

@[simp] lemma one_lt_sqrt_2 : 1 < √2
:= begin
    apply real.lt_of_lt_pow_two; try {solve1 {simp <|> linarith}},
    {
        repeat {rw pow_two}, simp,
        rw <- real.sqrt_mul,
        rw real.sqrt_mul_self; linarith,
        linarith,
    },
end

@[simp] lemma sqrt_2_nonzero : √2 ≠ 0
:= by linarith [one_lt_sqrt_2]

@[simp] lemma sqrt_two_mul_self : √2 * √2 = 2
:= by {rw real.mul_self_sqrt, linarith}

@[simp] lemma one_over_sqrt_two_mul_self : /√2 * /√2 = 1/2
:= begin
    rw div_mul_div,
    congr' 1,
    simp,
    rw_mod_cast real.mul_self_sqrt; simp,
end

@[simp] lemma sqrt_two_inv_mul_self : (√2)⁻¹ * (√2)⁻¹ = 1/2
:= by {rw <- mul_inv'; simp}

------------------------------------------------------------------------------
-- Gate decompositions

lemma P0_eq_proj_ket0 : P0 = proj |0⟩
:= begin
    unfold ket0 P0,
    rw proj_std_basis_eq_diagonal,
    grind_matrix; `[simp],
end

lemma P1_eq_proj_ket1 : P1 = proj |1⟩
:= begin
    unfold ket1 P1,
    rw proj_std_basis_eq_diagonal,
    grind_matrix; `[simp],
end

lemma I_eq_add_P0_P1 : (I 2) = P0 + P1
:= begin
    unfold P0 P1,
    grind_matrix; `[simp],
end

lemma I_eq_add_P_plus_P_minus : (I 2) = P_plus + P_minus
:= begin
    unfold X P_plus P_minus,
    grind_matrix; `[simp; ring],
end

lemma X_eq_sub_P_plus_P_minus : X = P_plus - P_minus
:= begin
    unfold X P_plus P_minus,
    grind_matrix; `[simp; ring],
end

lemma Z_eq_sub_P0_P1 : Z = P0 - P1
:= begin
    unfold Z P0 P1,
    grind_matrix; `[simp],
end

lemma CNOT_decompose : CNOT = P0 ⊗ (I 2) + P1 ⊗ X
:= begin
    have r1 : P0 ⊗ (I 2) = λ (i j : fin (2*2)), ite (kron_div i = 0 ∧ kron_div j = 0) ((I 2) (kron_mod i) (kron_mod j)) 0,
    {
        rw P0_eq_proj_ket0, unfold ket0,
        apply kron_proj_std_basis,
    },
    have r2 : P1 ⊗ X = λ (i j : fin (2*2)), ite (kron_div i = 1 ∧ kron_div j = 1) (X (kron_mod i) (kron_mod j)) 0,
    {
        rw P1_eq_proj_ket1, unfold ket1,
        apply kron_proj_std_basis,
    },
    unfold CNOT,
    rw r1, rw r2,
    unfold X kron_div kron_mod,
    grind_matrix; `[simp],
end

lemma CZ_decompose : CZ = P0 ⊗ (I 2) + P1 ⊗ Z
:= begin
    have r1 : P0 ⊗ (I 2) = λ (i j : fin (2*2)), ite (kron_div i = 0 ∧ kron_div j = 0) ((I 2) (kron_mod i) (kron_mod j)) 0,
    {
        rw P0_eq_proj_ket0, unfold ket0,
        apply kron_proj_std_basis,
    },
    have r2 : P1 ⊗ Z = λ (i j : fin (2*2)), ite (kron_div i = 1 ∧ kron_div j = 1) (Z (kron_mod i) (kron_mod j)) 0,
    {
        rw P1_eq_proj_ket1, unfold ket1,
        apply kron_proj_std_basis,
    },
    unfold CZ,
    rw r1, rw r2,
    unfold Z kron_div kron_mod,
    grind_matrix; `[simp],
end

lemma CZ_decompose_alt : CZ = (I 2) ⊗ P0 + Z ⊗ P1
:= begin
    rw CZ_decompose,

    rw Z_eq_sub_P0_P1,
    rw kron_dist_over_sub_left,
    rw kron_dist_over_sub_right,
    rw add_sub,
    rw add_sub,
    congr' 1,

    rw <- matrix.diagonal_one,
    rw P0_eq_proj_ket0,
    unfold ket0,
    rw proj_std_basis_eq_diagonal,
    rw kron_diagonal,
    rw P1_eq_proj_ket1,
    unfold ket1,
    rw proj_std_basis_eq_diagonal,
    iterate 3 { rw kron_diagonal },
    iterate 2 { rw matrix.diagonal_add },
    congr,
    apply funext, intros i,
    cases i with i ip,
    unfold kron_div kron_mod,
    iterate 4 { cases i, by simp },
    destruct_fin,
end

lemma mul_P0_H : P0 ⬝ H = ![ ![ /√2, /√2 ],
                             ![ 0, 0 ] ]
:= begin
    rw P0_eq_proj_ket0,
    unfold ket0,
    rw mul_proj_std_basis_left,
    unfold H,
    grind_matrix; `[simp],
end

lemma mul_P1_H : P1 ⬝ H = ![ ![ 0, 0 ],
                            ![ /√2, -/√2 ] ]
:= begin
    rw P1_eq_proj_ket1, unfold ket1,
    rw mul_proj_std_basis_left,
    unfold H,
    grind_matrix; `[simp],
end

lemma H_P0_H_eq_P_plus : H ⬝ P0 ⬝ H = P_plus
:= begin
    rw matrix.mul_assoc,
    rw mul_P0_H,
    unfold H P_plus,
    grind_matrix; `[ simp, norm_cast, simp ],
end

lemma H_P1_H_eq_P_minus : H ⬝ P1 ⬝ H = P_minus
:= begin
    rw matrix.mul_assoc,
    rw mul_P1_H,
    unfold H P_minus,
    grind_matrix; `[ simp, norm_cast, simp ],
end

theorem CNOT_eq_H_CZ_H : CNOT = ((I 2) ⊗ H) ⬝ CZ ⬝ ((I 2) ⊗ H)
:= begin
    rw CNOT_decompose,
    rw I_eq_add_P_plus_P_minus,
    rw X_eq_sub_P_plus_P_minus,
    have : P0 ⊗ (P_plus + P_minus) + P1 ⊗ (P_plus - P_minus)
        = (P0 + P1) ⊗ P_plus + (P0 - P1) ⊗ P_minus,
    {
        rw kron_dist_over_add_right,
        rw kron_dist_over_sub_right,
        rw kron_dist_over_add_left,
        rw kron_dist_over_sub_left,
        abel,
    },
    rw this, clear this,
    rw <- I_eq_add_P0_P1,
    rw <- Z_eq_sub_P0_P1,
    have l1: (I 2) ⊗ P_plus = ((I 2) ⊗ H) ⬝ ((I 2) ⊗ P0) ⬝ ((I 2) ⊗ H),
    {
        rw <- H_P0_H_eq_P_plus,
        rw kron_mixed_prod_I_left,
        rw kron_mixed_prod_I_left,
    },
    have l2: Z ⊗ P_minus = ((I 2) ⊗ H) ⬝ (Z ⊗ P1) ⬝ ((I 2) ⊗ H),
    {
        rw <- H_P1_H_eq_P_minus,
        rw kron_mixed_prod_I_left,
        rw kron_mixed_prod_I_right,
    },
    rw l1, clear l1,
    rw l2, clear l2,
    rw <- I_eq_add_P_plus_P_minus,
    rw <- matrix.add_mul,
    congr' 1,
    rw <- matrix.mul_add,
    congr' 1,
    rw CZ_decompose_alt,
end

------------------------------------------------------------------------------
-- Controlled-U gates definitions

lemma CNOT_def : CNOT = controlled_gate X
:= begin
    rw CNOT_decompose,
    unfold controlled_gate,
    rw P0_eq_proj_ket0,
    rw P1_eq_proj_ket1,
end

lemma CZ_def : CZ = controlled_gate Z
:= begin
    rw CZ_decompose,
    unfold controlled_gate,
    rw P0_eq_proj_ket0,
    rw P1_eq_proj_ket1,
end

-- CZ gate's control and target can be swapped and the operater is still the same.
lemma CZ_symmetry : CZ = SWAP ⬝ CZ ⬝ SWAP
:= begin
    unfold CZ SWAP,
    grind_matrix; `[simp],
end

lemma CZ_def' : CZ = gate_controlled Z
:= begin
    unfold gate_controlled,
    rw <- CZ_def,
    apply CZ_symmetry,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury G. Kudryashov, Scott Morrison
-/
import algebra.algebra.basic
import linear_algebra.finsupp

/-!
# Monoid algebras

When the domain of a `finsupp` has a multiplicative or additive structure, we can define
a convolution product. To mathematicians this structure is known as the "monoid algebra",
i.e. the finite formal linear combinations over a given semiring of elements of the monoid.
The "group ring" ℤ[G] or the "group algebra" k[G] are typical uses.

In this file we define `monoid_algebra k G := G →₀ k`, and `add_monoid_algebra k G`
in the same way, and then define the convolution product on these.

When the domain is additive, this is used to define polynomials:
```
polynomial α := add_monoid_algebra ℕ α
mv_polynomial σ α := add_monoid_algebra (σ →₀ ℕ) α
```

When the domain is multiplicative, e.g. a group, this will be used to define the group ring.

## Implementation note
Unfortunately because additive and multiplicative structures both appear in both cases,
it doesn't appear to be possible to make much use of `to_additive`, and we just settle for
saying everything twice.

Similarly, I attempted to just define
`add_monoid_algebra k G := monoid_algebra k (multiplicative G)`, but the definitional equality
`multiplicative G = G` leaks through everywhere, and seems impossible to use.
-/

noncomputable theory
open_locale classical big_operators

open finset finsupp

universes u₁ u₂ u₃
variables (k : Type u₁) (G : Type u₂)

/-! ### Multiplicative monoids -/
section
variables [semiring k]

/--
The monoid algebra over a semiring `k` generated by the monoid `G`.
It is the type of finite formal `k`-linear combinations of terms of `G`,
endowed with the convolution product.
-/
@[derive [inhabited, add_comm_monoid, has_coe_to_fun]]
def monoid_algebra : Type (max u₁ u₂) := G →₀ k

end

namespace monoid_algebra

variables {k G}

section has_mul

variables [semiring k] [has_mul G]

/-- The product of `f g : monoid_algebra k G` is the finitely supported function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x * y = a`. (Think of the group ring of a group.) -/
instance : has_mul (monoid_algebra k G) :=
⟨λf g, f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ * a₂) (b₁ * b₂)⟩

lemma mul_def {f g : monoid_algebra k G} :
  f * g = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ * a₂) (b₁ * b₂)) :=
rfl

instance : distrib (monoid_algebra k G) :=
{ mul           := (*),
  add           := (+),
  left_distrib  := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add],
  right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, mul_zero, zero_mul,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero,
    sum_add],
  .. finsupp.add_comm_monoid }

instance : mul_zero_class (monoid_algebra k G) :=
{ zero      := 0,
  mul       := (*),
  zero_mul  := assume f, by simp only [mul_def, sum_zero_index],
  mul_zero  := assume f, by simp only [mul_def, sum_zero_index, sum_zero] }

end has_mul

section semigroup

variables [semiring k] [semigroup G]

instance : semigroup_with_zero (monoid_algebra k G) :=
{ mul       := (*),
  mul_assoc := assume f g h, by simp only [mul_def, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff,
    add_mul, mul_add, add_assoc, mul_assoc, zero_mul, mul_zero, sum_zero, sum_add],
  .. monoid_algebra.mul_zero_class }

end semigroup

section has_one

variables [semiring k] [has_one G]

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `1` and zero elsewhere. -/
instance : has_one (monoid_algebra k G) :=
⟨single 1 1⟩

lemma one_def : (1 : monoid_algebra k G) = single 1 1 :=
rfl

end has_one

section mul_one_class

variables [semiring k] [mul_one_class G]

instance : mul_zero_one_class (monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  one_mul   := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul,
    single_zero, sum_zero, zero_add, one_mul, sum_single],
  mul_one   := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero,
    single_zero, sum_zero, add_zero, mul_one, sum_single],
  ..monoid_algebra.mul_zero_class }

variables {R : Type*} [semiring R]

/-- A non-commutative version of `monoid_algebra.lift`: given a additive homomorphism `f : k →+ R`
and a multiplicative monoid homomorphism `g : G →* R`, returns the additive homomorphism from
`monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f` is a ring homomorphism
and the range of either `f` or `g` is in center of `R`, then the result is a ring homomorphism.  If
`R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra homomorphism called
`monoid_algebra.lift`. -/
def lift_nc (f : k →+ R) (g : G →* R) : monoid_algebra k G →+ R :=
lift_add_hom (λ x : G, (add_monoid_hom.mul_right (g x)).comp f)

@[simp] lemma lift_nc_single (f : k →+ R) (g : G →* R) (a : G) (b : k) :
  lift_nc f g (single a b) = f b * g a :=
lift_add_hom_apply_single _ _ _

@[simp] lemma lift_nc_one (f : k →+* R) (g : G →* R) : lift_nc (f : k →+ R) g 1 = 1 :=
by simp [one_def]

lemma lift_nc_mul (f : k →+* R) (g : G →* R)
  (a b : monoid_algebra k G) (h_comm : ∀ {x y}, y ∈ a.support → commute (f (b x)) (g y)) :
  lift_nc (f : k →+ R) g (a * b) = lift_nc (f : k →+ R) g a * lift_nc (f : k →+ R) g b :=
begin
  conv_rhs { rw [← sum_single a, ← sum_single b] },
  simp_rw [mul_def, (lift_nc _ g).map_finsupp_sum, lift_nc_single, finsupp.sum_mul,
    finsupp.mul_sum],
  refine finset.sum_congr rfl (λ y hy, finset.sum_congr rfl (λ x hx, _)),
  simp [mul_assoc, (h_comm hy).left_comm]
end

end mul_one_class

/-! #### Semiring structure -/
section semiring

variables [semiring k] [monoid G]

instance : semiring (monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  .. monoid_algebra.mul_zero_one_class,
  .. monoid_algebra.semigroup_with_zero,
  .. monoid_algebra.distrib,
  .. finsupp.add_comm_monoid }

variables {R : Type*} [semiring R]

/-- `lift_nc` as a `ring_hom`, for when `f x` and `g y` commute -/
def lift_nc_ring_hom (f : k →+* R) (g : G →* R) (h_comm : ∀ x y, commute (f x) (g y)) :
  monoid_algebra k G →+* R :=
{ to_fun := lift_nc (f : k →+ R) g,
  map_one' := lift_nc_one _ _,
  map_mul' := λ a b, lift_nc_mul _ _ _ _ $ λ _ _ _, h_comm _ _,
  ..(lift_nc (f : k →+ R) g)}

end semiring

instance [comm_semiring k] [comm_monoid G] : comm_semiring (monoid_algebra k G) :=
{ mul_comm := assume f g,
  begin
    simp only [mul_def, finsupp.sum, mul_comm],
    rw [finset.sum_comm],
    simp only [mul_comm]
  end,
  .. monoid_algebra.semiring }

instance [semiring k] [nontrivial k] [nonempty G]: nontrivial (monoid_algebra k G) :=
finsupp.nontrivial

/-! #### Derived instances -/
section derived_instances

instance [semiring k] [subsingleton k] : unique (monoid_algebra k G) :=
finsupp.unique_of_right

instance [ring k] : add_group (monoid_algebra k G) :=
finsupp.add_group

instance [ring k] [monoid G] : ring (monoid_algebra k G) :=
{ neg := has_neg.neg,
  add_left_neg := add_left_neg,
  .. monoid_algebra.semiring }

instance [comm_ring k] [comm_monoid G] : comm_ring (monoid_algebra k G) :=
{ mul_comm := mul_comm, .. monoid_algebra.ring}

variables {R S : Type*}

instance [semiring R] [semiring k] [module R k] :
  has_scalar R (monoid_algebra k G) :=
finsupp.has_scalar

instance [semiring R] [semiring k] [module R k] :
  module R (monoid_algebra k G) :=
finsupp.module G k

instance [semiring R] [semiring S] [semiring k] [module R k] [module S k]
  [has_scalar R S] [is_scalar_tower R S k] :
  is_scalar_tower R S (monoid_algebra k G) :=
finsupp.is_scalar_tower G k

instance [semiring R] [semiring S] [semiring k] [module R k] [module S k]
  [smul_comm_class R S k] :
  smul_comm_class R S (monoid_algebra k G) :=
finsupp.smul_comm_class G k

instance [group G] [semiring k] : distrib_mul_action G (monoid_algebra k G) :=
finsupp.comap_distrib_mul_action_self

end derived_instances

section misc_theorems

variables [semiring k]
local attribute [reducible] monoid_algebra

lemma mul_apply [has_mul G] (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ * a₂ = x then b₁ * b₂ else 0) :=
begin
  rw [mul_def],
  simp only [finsupp.sum_apply, single_apply],
end

lemma mul_apply_antidiagonal [has_mul G] (f g : monoid_algebra k G) (x : G) (s : finset (G × G))
  (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 * p.2 = x) :
  (f * g) x = ∑ p in s, (f p.1 * g p.2) :=
let F : G × G → k := λ p, if p.1 * p.2 = x then f p.1 * g p.2 else 0 in
calc (f * g) x = (∑ a₁ in f.support, ∑ a₂ in g.support, F (a₁, a₂)) :
  mul_apply f g x
... = ∑ p in f.support.product g.support, F p : finset.sum_product.symm
... = ∑ p in (f.support.product g.support).filter (λ p : G × G, p.1 * p.2 = x), f p.1 * g p.2 :
  (finset.sum_filter _ _).symm
... = ∑ p in s.filter (λ p : G × G, p.1 ∈ f.support ∧ p.2 ∈ g.support), f p.1 * g p.2 :
  sum_congr (by { ext, simp only [mem_filter, mem_product, hs, and_comm] }) (λ _ _, rfl)
... = ∑ p in s, f p.1 * g p.2 : sum_subset (filter_subset _ _) $ λ p hps hp,
  begin
    simp only [mem_filter, mem_support_iff, not_and, not_not] at hp ⊢,
    by_cases h1 : f p.1 = 0,
    { rw [h1, zero_mul] },
    { rw [hp hps h1, mul_zero] }
  end

lemma support_mul [has_mul G] (a b : monoid_algebra k G) :
  (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ * a₂}) :=
subset.trans support_sum $ bUnion_mono $ assume a₁ _,
  subset.trans support_sum $ bUnion_mono $ assume a₂ _, support_single_subset

@[simp] lemma single_mul_single [has_mul G] {a₁ a₂ : G} {b₁ b₂ : k} :
  (single a₁ b₁ : monoid_algebra k G) * single a₂ b₂ = single (a₁ * a₂) (b₁ * b₂) :=
(sum_single_index (by simp only [zero_mul, single_zero, sum_zero])).trans
  (sum_single_index (by rw [mul_zero, single_zero]))

@[simp] lemma single_pow [monoid G] {a : G} {b : k} :
  ∀ n : ℕ, (single a b : monoid_algebra k G)^n = single (a^n) (b ^ n)
| 0 := by { simp only [pow_zero], refl }
| (n+1) := by simp only [pow_succ, single_pow n, single_mul_single]

section

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
lemma map_domain_mul {α : Type*} {β : Type*} {α₂ : Type*} [semiring β] [has_mul α] [has_mul α₂]
  {x y : monoid_algebra β α} (f : mul_hom α α₂) :
  (map_domain f (x * y : monoid_algebra β α) : monoid_algebra β α₂) =
    (map_domain f x * map_domain f y : monoid_algebra β α₂) :=
begin
  simp_rw [mul_def, map_domain_sum, map_domain_single, f.map_mul],
  rw finsupp.sum_map_domain_index,
  { congr,
    ext a b,
    rw finsupp.sum_map_domain_index,
    { simp },
    { simp [mul_add] } },
  { simp },
  { simp [add_mul] }
end

variables (k G) [mul_one_class G]

/-- Embedding of a monoid into its monoid algebra. -/
def of : G →* monoid_algebra k G :=
{ to_fun := λ a, single a 1,
  map_one' := rfl,
  map_mul' := λ a b, by rw [single_mul_single, one_mul] }

end

@[simp] lemma of_apply [mul_one_class G] (a : G) : of k G a = single a 1 := rfl

lemma of_injective [mul_one_class G] [nontrivial k] : function.injective (of k G) :=
λ a b h, by simpa using (single_eq_single_iff _ _ _ _).mp h

lemma mul_single_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k}
  {x y z : G} (H : ∀ a, a * x = z ↔ a = y) :
  (f * single x r) z = f y * r :=
have A : ∀ a₁ b₁, (single x r).sum (λ a₂ b₂, ite (a₁ * a₂ = z) (b₁ * b₂) 0) =
  ite (a₁ * x = z) (b₁ * r) 0,
from λ a₁ b₁, sum_single_index $ by simp,
calc (f * single x r) z = sum f (λ a b, if (a = y) then (b * r) else 0) :
  -- different `decidable` instances make it not trivial
  by { simp only [mul_apply, A, H], congr, funext, split_ifs; refl }
... = if y ∈ f.support then f y * r else 0 : f.support.sum_ite_eq' _ _
... = f y * r : by split_ifs with h; simp at h; simp [h]

lemma mul_single_one_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x : G) :
  (f * single 1 r) x = f x * r :=
f.mul_single_apply_aux $ λ a, by rw [mul_one]

lemma single_mul_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k} {x y z : G}
  (H : ∀ a, x * a = y ↔ a = z) :
  (single x r * f) y = r * f z :=
have f.sum (λ a b, ite (x * a = y) (0 * b) 0) = 0, by simp,
calc (single x r * f) y = sum f (λ a b, ite (x * a = y) (r * b) 0) :
  (mul_apply _ _ _).trans $ sum_single_index this
... = f.sum (λ a b, ite (a = z) (r * b) 0) :
  by { simp only [H], congr' with g s, split_ifs; refl  }
... = if z ∈ f.support then (r * f z) else 0 : f.support.sum_ite_eq' _ _
... = _ : by split_ifs with h; simp at h; simp [h]

lemma single_one_mul_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x : G) :
  (single 1 r * f) x = r * f x :=
f.single_mul_apply_aux $ λ a, by rw [one_mul]

lemma lift_nc_smul [mul_one_class G] {R : Type*} [semiring R] (f : k →+* R) (g : G →* R) (c : k)
  (φ : monoid_algebra k G) :
  lift_nc (f : k →+ R) g (c • φ) = f c * lift_nc (f : k →+ R) g φ :=
begin
  suffices : (lift_nc ↑f g).comp (smul_add_hom k (monoid_algebra k G) c) =
    (add_monoid_hom.mul_left (f c)).comp (lift_nc ↑f g),
    from add_monoid_hom.congr_fun this φ,
  ext a b, simp [mul_assoc]
end

end misc_theorems

/-! #### Algebra structure -/
section algebra

local attribute [reducible] monoid_algebra

lemma single_one_comm [comm_semiring k] [mul_one_class G] (r : k) (f : monoid_algebra k G) :
  single 1 r * f = f * single 1 r :=
by { ext, rw [single_one_mul_apply, mul_single_one_apply, mul_comm] }

/-- `finsupp.single 1` as a `ring_hom` -/
@[simps] def single_one_ring_hom [semiring k] [monoid G] : k →+* monoid_algebra k G :=
{ map_one' := rfl,
  map_mul' := λ x y, by rw [single_add_hom, single_mul_single, one_mul],
  ..finsupp.single_add_hom 1}

/-- If two ring homomorphisms from `monoid_algebra k G` are equal on all `single a 1`
and `single 1 b`, then they are equal. -/
lemma ring_hom_ext {R} [semiring k] [monoid G] [semiring R]
  {f g : monoid_algebra k G →+* R} (h₁ : ∀ b, f (single 1 b) = g (single 1 b))
  (h_of : ∀ a, f (single a 1) = g (single a 1)) : f = g :=
ring_hom.coe_add_monoid_hom_injective $ add_hom_ext $ λ a b,
  by rw [← one_mul a, ← mul_one b, ← single_mul_single, f.coe_add_monoid_hom,
    g.coe_add_monoid_hom, f.map_mul, g.map_mul, h₁, h_of]

/-- If two ring homomorphisms from `monoid_algebra k G` are equal on all `single a 1`
and `single 1 b`, then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext] lemma ring_hom_ext' {R} [semiring k] [monoid G] [semiring R]
  {f g : monoid_algebra k G →+* R} (h₁ : f.comp single_one_ring_hom = g.comp single_one_ring_hom)
  (h_of : (f : monoid_algebra k G →* R).comp (of k G) =
    (g : monoid_algebra k G →* R).comp (of k G)) :
  f = g :=
ring_hom_ext (ring_hom.congr_fun h₁) (monoid_hom.congr_fun h_of)

/--
The instance `algebra k (monoid_algebra A G)` whenever we have `algebra k A`.

In particular this provides the instance `algebra k (monoid_algebra k G)`.
-/
instance {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  algebra k (monoid_algebra A G) :=
{ smul_def' := λ r a, by { ext, simp [single_one_mul_apply, algebra.smul_def'', pi.smul_apply], },
  commutes' := λ r f, by { ext, simp [single_one_mul_apply, mul_single_one_apply,
    algebra.commutes], },
  ..single_one_ring_hom.comp (algebra_map k A) }

/-- `finsupp.single 1` as a `alg_hom` -/
@[simps]
def single_one_alg_hom {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  A →ₐ[k] monoid_algebra A G :=
{ commutes' := λ r, by { ext, simp, refl, }, ..single_one_ring_hom}

@[simp] lemma coe_algebra_map {A : Type*} [comm_semiring k] [semiring A] [algebra k A] [monoid G] :
  ⇑(algebra_map k (monoid_algebra A G)) = single 1 ∘ (algebra_map k A) :=
rfl

lemma single_eq_algebra_map_mul_of [comm_semiring k] [monoid G] (a : G) (b : k) :
  single a b = algebra_map k (monoid_algebra k G) b * of k G a :=
by simp

lemma single_algebra_map_eq_algebra_map_mul_of {A : Type*} [comm_semiring k] [semiring A]
  [algebra k A] [monoid G] (a : G) (b : k) :
  single a (algebra_map k A b) = algebra_map k (monoid_algebra A G) b * of A G a :=
by simp

lemma induction_on [semiring k] [monoid G] {p : monoid_algebra k G → Prop} (f : monoid_algebra k G)
  (hM : ∀ g, p (of k G g)) (hadd : ∀ f g : monoid_algebra k G, p f → p g → p (f + g))
  (hsmul : ∀ (r : k) f, p f → p (r • f)) : p f :=
begin
  refine finsupp.induction_linear f _ (λ f g hf hg, hadd f g hf hg) (λ g r, _),
  { simpa using hsmul 0 (of k G 1) (hM 1) },
  { convert hsmul r (of k G g) (hM g),
    simp only [mul_one, smul_single', of_apply] },
end

end algebra

section lift

variables {k G} [comm_semiring k] [monoid G]
variables {A : Type u₃} [semiring A] [algebra k A] {B : Type*} [semiring B] [algebra k B]

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom (f : A →ₐ[k] B) (g : G →* B) (h_comm : ∀ x y, commute (f x) (g y)) :
  monoid_algebra A G →ₐ[k] B :=
{ to_fun := lift_nc_ring_hom (f : A →+* B) g h_comm,
  commutes' := by simp [lift_nc_ring_hom],
  ..(lift_nc_ring_hom (f : A →+* B) g h_comm)}

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma alg_hom_ext ⦃φ₁ φ₂ : monoid_algebra k G →ₐ[k] A⦄
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
alg_hom.to_linear_map_inj $ finsupp.lhom_ext' $ λ a, linear_map.ext_ring (h a)

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma alg_hom_ext' ⦃φ₁ φ₂ : monoid_algebra k G →ₐ[k] A⦄
  (h : (φ₁ : monoid_algebra k G →* A).comp (of k G) =
    (φ₂ : monoid_algebra k G →* A).comp (of k G)) : φ₁ = φ₂ :=
alg_hom_ext $ monoid_hom.congr_fun h

variables (k G A)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift : (G →* A) ≃ (monoid_algebra k G →ₐ[k] A) :=
{ inv_fun := λ f, (f : monoid_algebra k G →* A).comp (of k G),
  to_fun := λ F, lift_nc_alg_hom (algebra.of_id k A) F $ λ _ _, algebra.commutes _ _,
  left_inv := λ f, by { ext, simp [lift_nc_alg_hom, lift_nc_ring_hom] },
  right_inv := λ F, by { ext, simp [lift_nc_alg_hom, lift_nc_ring_hom] } }

variables {k G A}

lemma lift_apply' (F : G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, (algebra_map k A b) * F a) := rfl

lemma lift_apply (F : G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, b • F a) :=
by simp only [lift_apply', algebra.smul_def]

lemma lift_def (F : G →* A) :
  ⇑(lift k G A F) = lift_nc ((algebra_map k A : k →+* A) : k →+ A) F :=
rfl

@[simp] lemma lift_symm_apply (F : monoid_algebra k G →ₐ[k] A) (x : G) :
  (lift k G A).symm F x = F (single x 1) := rfl

lemma lift_of (F : G →* A) (x) :
  lift k G A F (of k G x) = F x :=
by rw [of_apply, ← lift_symm_apply, equiv.symm_apply_apply]

@[simp] lemma lift_single (F : G →* A) (a b) :
  lift k G A F (single a b) = b • F a :=
by rw [lift_def, lift_nc_single, algebra.smul_def, ring_hom.coe_add_monoid_hom]

lemma lift_unique' (F : monoid_algebra k G →ₐ[k] A) :
  F = lift k G A ((F : monoid_algebra k G →* A).comp (of k G)) :=
((lift k G A).apply_symm_apply F).symm

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
lemma lift_unique (F : monoid_algebra k G →ₐ[k] A) (f : monoid_algebra k G) :
  F f = f.sum (λ a b, b • F (single a 1)) :=
by conv_lhs { rw lift_unique' F, simp [lift_apply] }

end lift

section
local attribute [reducible] monoid_algebra

variables (k)
/-- When `V` is a `k[G]`-module, multiplication by a group element `g` is a `k`-linear map. -/
def group_smul.linear_map [monoid G] [comm_semiring k]
  (V : Type u₃) [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V] (g : G) :
  V →ₗ[k] V :=
{ to_fun    := λ v, (single g (1 : k) • v : V),
  map_add'  := λ x y, smul_add (single g (1 : k)) x y,
  map_smul' := λ c x, smul_algebra_smul_comm _ _ _ }

@[simp]
lemma group_smul.linear_map_apply [monoid G] [comm_semiring k]
  (V : Type u₃) [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V] (g : G) (v : V) :
  (group_smul.linear_map k V g) v = (single g (1 : k) • v : V) :=
rfl

section
variables {k}
variables [monoid G] [comm_semiring k] {V W : Type u₃}
  [add_comm_monoid V] [module k V] [module (monoid_algebra k G) V]
  [is_scalar_tower k (monoid_algebra k G) V]
  [add_comm_monoid W] [module k W] [module (monoid_algebra k G) W]
  [is_scalar_tower k (monoid_algebra k G) W]
  (f : V →ₗ[k] W)
  (h : ∀ (g : G) (v : V), f (single g (1 : k) • v : V) = (single g (1 : k) • (f v) : W))
include h

/-- Build a `k[G]`-linear map from a `k`-linear map and evidence that it is `G`-equivariant. -/
def equivariant_of_linear_of_comm : V →ₗ[monoid_algebra k G] W :=
{ to_fun := f,
  map_add' := λ v v', by simp,
  map_smul' := λ c v,
  begin
  apply finsupp.induction c,
  { simp, },
  { intros g r c' nm nz w,
    simp only [add_smul, f.map_add, w, add_left_inj, single_eq_algebra_map_mul_of, ← smul_smul],
    erw [algebra_map_smul (monoid_algebra k G) r, algebra_map_smul (monoid_algebra k G) r,
      f.map_smul, h g v, of_apply],
    all_goals { apply_instance } }
  end, }

@[simp]
lemma equivariant_of_linear_of_comm_apply (v : V) : (equivariant_of_linear_of_comm f h) v = f v :=
rfl

end
end

section
universe ui
variable {ι : Type ui}
local attribute [reducible] monoid_algebra

lemma prod_single [comm_semiring k] [comm_monoid G]
  {s : finset ι} {a : ι → G} {b : ι → k} :
  (∏ i in s, single (a i) (b i)) = single (∏ i in s, a i) (∏ i in s, b i) :=
finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih,
  single_mul_single, prod_insert has, prod_insert has]

end

section -- We now prove some additional statements that hold for group algebras.
variables [semiring k] [group G]
local attribute [reducible] monoid_algebra

@[simp]
lemma mul_single_apply (f : monoid_algebra k G) (r : k) (x y : G) :
  (f * single x r) y = f (y * x⁻¹) * r :=
f.mul_single_apply_aux $ λ a, eq_mul_inv_iff_mul_eq.symm

@[simp]
lemma single_mul_apply (r : k) (x : G) (f : monoid_algebra k G) (y : G) :
  (single x r * f) y = r * f (x⁻¹ * y) :=
f.single_mul_apply_aux $ λ z, eq_inv_mul_iff_mul_eq.symm

lemma mul_apply_left (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λ a b, b * (g (a⁻¹ * x))) :=
calc (f * g) x = sum f (λ a b, (single a b * g) x) :
  by rw [← finsupp.sum_apply, ← finsupp.sum_mul, f.sum_single]
... = _ : by simp only [single_mul_apply, finsupp.sum]

-- If we'd assumed `comm_semiring`, we could deduce this from `mul_apply_left`.
lemma mul_apply_right (f g : monoid_algebra k G) (x : G) :
  (f * g) x = (g.sum $ λa b, (f (x * a⁻¹)) * b) :=
calc (f * g) x = sum g (λ a b, (f * single a b) x) :
  by rw [← finsupp.sum_apply, ← finsupp.mul_sum, g.sum_single]
... = _ : by simp only [mul_single_apply, finsupp.sum]

end

section span

variables [semiring k] [mul_one_class G]

lemma mem_span_support (f : monoid_algebra k G) :
  f ∈ submodule.span k (of k G '' (f.support : set G)) :=
by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported]

end span

end monoid_algebra

/-! ### Additive monoids -/
section
variables [semiring k]

/--
The monoid algebra over a semiring `k` generated by the additive monoid `G`.
It is the type of finite formal `k`-linear combinations of terms of `G`,
endowed with the convolution product.
-/
@[derive [inhabited, add_comm_monoid, has_coe_to_fun]]
def add_monoid_algebra := G →₀ k

end

namespace add_monoid_algebra

variables {k G}

section has_mul

variables [semiring k] [has_add G]

/-- The product of `f g : add_monoid_algebra k G` is the finitely supported function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x + y = a`. (Think of the product of multivariate
  polynomials where `α` is the additive monoid of monomial exponents.) -/
instance : has_mul (add_monoid_algebra k G) :=
⟨λf g, f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)⟩

lemma mul_def {f g : add_monoid_algebra k G} :
  f * g = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)) :=
rfl

instance : distrib (add_monoid_algebra k G) :=
{ mul           := (*),
  add           := (+),
  left_distrib  := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add],
  right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, mul_zero, zero_mul,
    single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero,
    sum_add], }

instance : mul_zero_class (add_monoid_algebra k G) :=
{ zero      := 0,
  mul       := (*),
  zero_mul  := assume f, by simp only [mul_def, sum_zero_index],
  mul_zero  := assume f, by simp only [mul_def, sum_zero_index, sum_zero] }

end has_mul

section has_one

variables [semiring k] [has_zero G]

/-- The unit of the multiplication is `single 1 1`, i.e. the function
  that is `1` at `0` and zero elsewhere. -/
instance : has_one (add_monoid_algebra k G) :=
⟨single 0 1⟩

lemma one_def : (1 : add_monoid_algebra k G) = single 0 1 :=
rfl

end has_one

section semigroup

variables [semiring k] [add_semigroup G]

instance : semigroup_with_zero (add_monoid_algebra k G) :=
{ mul       := (*),
  mul_assoc := assume f g h, by simp only [mul_def, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff,
    add_mul, mul_add, add_assoc, mul_assoc, zero_mul, mul_zero, sum_zero, sum_add],
  .. add_monoid_algebra.mul_zero_class }

end semigroup

section mul_one_class

variables [semiring k] [add_zero_class G]

instance : mul_zero_one_class (add_monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  one_mul   := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul,
    single_zero, sum_zero, zero_add, one_mul, sum_single],
  mul_one   := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero,
    single_zero, sum_zero, add_zero, mul_one, sum_single],
  .. add_monoid_algebra.mul_zero_class }

variables {R : Type*} [semiring R]

/-- A non-commutative version of `add_monoid_algebra.lift`: given a additive homomorphism `f : k →+
R` and a multiplicative monoid homomorphism `g : multiplicative G →* R`, returns the additive
homomorphism from `add_monoid_algebra k G` such that `lift_nc f g (single a b) = f b * g a`. If `f`
is a ring homomorphism and the range of either `f` or `g` is in center of `R`, then the result is a
ring homomorphism.  If `R` is a `k`-algebra and `f = algebra_map k R`, then the result is an algebra
homomorphism called `add_monoid_algebra.lift`. -/
def lift_nc (f : k →+ R) (g : multiplicative G →* R) : add_monoid_algebra k G →+ R :=
lift_add_hom (λ x : G, (add_monoid_hom.mul_right (g $ multiplicative.of_add x)).comp f)

@[simp] lemma lift_nc_single (f : k →+ R) (g : multiplicative G →* R) (a : G) (b : k) :
  lift_nc f g (single a b) = f b * g (multiplicative.of_add a) :=
lift_add_hom_apply_single _ _ _

@[simp] lemma lift_nc_one (f : k →+* R) (g : multiplicative G →* R) :
  lift_nc (f : k →+ R) g 1 = 1 :=
@monoid_algebra.lift_nc_one k (multiplicative G) _ _ _ _ f g

lemma lift_nc_mul (f : k →+* R) (g : multiplicative G →* R) (a b : add_monoid_algebra k G)
  (h_comm : ∀ {x y}, y ∈ a.support → commute (f (b x)) (g $ multiplicative.of_add y)) :
  lift_nc (f : k →+ R) g (a * b) = lift_nc (f : k →+ R) g a * lift_nc (f : k →+ R) g b :=
@monoid_algebra.lift_nc_mul k (multiplicative G) _ _ _ _ f g a b @h_comm

end mul_one_class

/-! #### Semiring structure -/
section semiring

instance {R : Type*} [semiring R] [semiring k] [module R k] :
  has_scalar R (add_monoid_algebra k G) :=
finsupp.has_scalar

variables [semiring k] [add_monoid G]

instance : semiring (add_monoid_algebra k G) :=
{ one       := 1,
  mul       := (*),
  zero      := 0,
  add       := (+),
  nsmul     := λ n f, n • f,
  nsmul_zero' := by { intros, ext, simp [-nsmul_eq_mul, add_smul] },
  nsmul_succ' := by { intros, ext, simp [-nsmul_eq_mul, nat.succ_eq_one_add, add_smul] },
  .. add_monoid_algebra.mul_zero_one_class,
  .. add_monoid_algebra.semigroup_with_zero,
  .. add_monoid_algebra.distrib,
  .. finsupp.add_comm_monoid }

variables {R : Type*} [semiring R]

/-- `lift_nc` as a `ring_hom`, for when `f` and `g` commute -/
def lift_nc_ring_hom (f : k →+* R) (g : multiplicative G →* R)
  (h_comm : ∀ x y, commute (f x) (g y)) :
  add_monoid_algebra k G →+* R :=
{ to_fun := lift_nc (f : k →+ R) g,
  map_one' := lift_nc_one _ _,
  map_mul' := λ a b, lift_nc_mul _ _ _ _ $ λ _ _ _, h_comm _ _,
  ..(lift_nc (f : k →+ R) g)}

end semiring

instance [comm_semiring k] [add_comm_monoid G] : comm_semiring (add_monoid_algebra k G) :=
{ mul_comm := @mul_comm (monoid_algebra k $ multiplicative G) _,
  .. add_monoid_algebra.semiring }

instance [semiring k] [nontrivial k] [nonempty G] : nontrivial (add_monoid_algebra k G) :=
finsupp.nontrivial

/-! #### Derived instances -/
section derived_instances

instance [semiring k] [subsingleton k] : unique (add_monoid_algebra k G) :=
finsupp.unique_of_right

instance [ring k] : add_group (add_monoid_algebra k G) :=
finsupp.add_group

instance [ring k] [add_monoid G] : ring (add_monoid_algebra k G) :=
{ neg := has_neg.neg,
  add_left_neg := add_left_neg,
  sub := has_sub.sub,
  sub_eq_add_neg := finsupp.add_group.sub_eq_add_neg,
  .. add_monoid_algebra.semiring }

instance [comm_ring k] [add_comm_monoid G] : comm_ring (add_monoid_algebra k G) :=
{ mul_comm := mul_comm, .. add_monoid_algebra.ring}

variables {R S : Type*}

instance [semiring R] [semiring k] [module R k] : module R (add_monoid_algebra k G) :=
finsupp.module G k

instance [semiring R] [semiring S] [semiring k] [module R k] [module S k]
  [has_scalar R S] [is_scalar_tower R S k] :
  is_scalar_tower R S (add_monoid_algebra k G) :=
finsupp.is_scalar_tower G k

instance [semiring R] [semiring S] [semiring k] [module R k] [module S k]
  [smul_comm_class R S k] :
  smul_comm_class R S (add_monoid_algebra k G) :=
finsupp.smul_comm_class G k

/-! It is hard to state the equivalent of `distrib_mul_action G (add_monoid_algebra k G)`
because we've never discussed actions of additive groups. -/

end derived_instances

section misc_theorems

variables [semiring k]

lemma mul_apply [has_add G] (f g : add_monoid_algebra k G) (x : G) :
  (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ + a₂ = x then b₁ * b₂ else 0) :=
@monoid_algebra.mul_apply k (multiplicative G) _ _ _ _ _

lemma mul_apply_antidiagonal [has_add G] (f g : add_monoid_algebra k G) (x : G) (s : finset (G × G))
  (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 + p.2 = x) :
  (f * g) x = ∑ p in s, (f p.1 * g p.2) :=
@monoid_algebra.mul_apply_antidiagonal k (multiplicative G) _ _ _ _ _ s @hs

lemma support_mul [has_add G] (a b : add_monoid_algebra k G) :
  (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ + a₂}) :=
@monoid_algebra.support_mul k (multiplicative G) _ _ _ _

lemma single_mul_single [has_add G] {a₁ a₂ : G} {b₁ b₂ : k} :
  (single a₁ b₁ * single a₂ b₂ : add_monoid_algebra k G) = single (a₁ + a₂) (b₁ * b₂) :=
@monoid_algebra.single_mul_single k (multiplicative G) _ _ _ _ _ _

-- This should be a `@[simp]` lemma, but the simp_nf linter times out if we add this.
-- Probably the correct fix is to make a `[add_]monoid_algebra.single` with the correct type,
-- instead of relying on `finsupp.single`.
lemma single_pow [add_monoid G] {a : G} {b : k} :
  ∀ n : ℕ, ((single a b)^n : add_monoid_algebra k G) = single (n • a) (b ^ n)
| 0 := by { simp only [pow_zero, zero_nsmul], refl }
| (n+1) :=
by rw [pow_succ, pow_succ, single_pow n, single_mul_single, add_comm, add_nsmul, one_nsmul]

/-- Like `finsupp.map_domain_add`, but for the convolutive multiplication we define in this file -/
lemma map_domain_mul {α : Type*} {β : Type*} {α₂ : Type*}
  [semiring β] [has_add α] [has_add α₂]
  {x y : add_monoid_algebra β α} (f : add_hom α α₂) :
  (map_domain f (x * y : add_monoid_algebra β α) : add_monoid_algebra β α₂) =
    (map_domain f x * map_domain f y : add_monoid_algebra β α₂) :=
begin
  simp_rw [mul_def, map_domain_sum, map_domain_single, f.map_add],
  rw finsupp.sum_map_domain_index,
  { congr,
    ext a b,
    rw finsupp.sum_map_domain_index,
    { simp },
    { simp [mul_add] } },
  { simp },
  { simp [add_mul] }
end

section

variables (k G)

/-- Embedding of a monoid into its monoid algebra. -/
def of [add_zero_class G] : multiplicative G →* add_monoid_algebra k G :=
{ to_fun := λ a, single a 1,
  map_one' := rfl,
  map_mul' := λ a b, by { rw [single_mul_single, one_mul], refl } }

/-- Embedding of a monoid into its monoid algebra, having `G` as source. -/
def of' : G → add_monoid_algebra k G := λ a, single a 1

end

@[simp] lemma of_apply [add_zero_class G] (a : multiplicative G) : of k G a = single a.to_add 1 :=
rfl

@[simp] lemma of'_apply (a : G) : of' k G a = single a 1 := rfl

lemma of_injective [nontrivial k] [add_zero_class G] : function.injective (of k G) :=
λ a b h, by simpa using (single_eq_single_iff _ _ _ _).mp h

lemma mul_single_apply_aux [has_add G] (f : add_monoid_algebra k G) (r : k)
  (x y z : G) (H : ∀ a, a + x = z ↔ a = y) :
  (f * single x r) z = f y * r :=
@monoid_algebra.mul_single_apply_aux k (multiplicative G) _ _ _ _ _ _ _ H

lemma mul_single_zero_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : k) (x : G) :
  (f * single 0 r) x = f x * r :=
f.mul_single_apply_aux r _ _ _ $ λ a, by rw [add_zero]

lemma single_mul_apply_aux [has_add G] (f : add_monoid_algebra k G) (r : k) (x y z : G)
  (H : ∀ a, x + a = y ↔ a = z) :
  (single x r * f : add_monoid_algebra k G) y = r * f z :=
@monoid_algebra.single_mul_apply_aux k (multiplicative G) _ _ _ _ _ _ _ H

lemma single_zero_mul_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : k) (x : G) :
  (single 0 r * f : add_monoid_algebra k G) x = r * f x :=
f.single_mul_apply_aux r _ _ _ $ λ a, by rw [zero_add]

lemma lift_nc_smul {R : Type*} [add_zero_class G] [semiring R] (f : k →+* R)
  (g : multiplicative G →* R) (c : k) (φ : monoid_algebra k G) :
  lift_nc (f : k →+ R) g (c • φ) = f c * lift_nc (f : k →+ R) g φ :=
@monoid_algebra.lift_nc_smul k (multiplicative G) _ _ _ _ f g c φ

variables {k G}

lemma induction_on [add_monoid G] {p : add_monoid_algebra k G → Prop} (f : add_monoid_algebra k G)
  (hM : ∀ g, p (of k G (multiplicative.of_add g)))
  (hadd : ∀ f g : add_monoid_algebra k G, p f → p g → p (f + g))
  (hsmul : ∀ (r : k) f, p f → p (r • f)) : p f :=
begin
  refine finsupp.induction_linear f _ (λ f g hf hg, hadd f g hf hg) (λ g r, _),
  { simpa using hsmul 0 (of k G (multiplicative.of_add 0)) (hM 0) },
  { convert hsmul r (of k G (multiplicative.of_add g)) (hM g),
    simp only [mul_one, to_add_of_add, smul_single', of_apply] },
end

end misc_theorems

section span

variables [semiring k]

lemma mem_span_support [add_zero_class G] (f : add_monoid_algebra k G) :
  f ∈ submodule.span k (of k G '' (f.support : set G)) :=
by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported]

lemma mem_span_support' (f : add_monoid_algebra k G) :
  f ∈ submodule.span k (of' k G '' (f.support : set G)) :=
by rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported]

end span

end add_monoid_algebra

/-!
#### Conversions between `add_monoid_algebra` and `monoid_algebra`

While we were not able to define `add_monoid_algebra k G = monoid_algebra k (multiplicative G)` due
to definitional inconveniences, we can still show the types are isomorphic.

TODO: with the new definitional `nsmul`, there is a direct equality here, so this paragraph could be
improved.
-/

/-- The equivalence between `add_monoid_algebra` and `monoid_algebra` in terms of
`multiplicative` -/
protected def add_monoid_algebra.to_multiplicative [semiring k] [has_add G] :
  add_monoid_algebra k G ≃+* monoid_algebra k (multiplicative G) :=
{ map_mul' := λ x y, by convert add_monoid_algebra.map_domain_mul (add_hom.id G),
  ..finsupp.dom_congr multiplicative.of_add }

/-- The equivalence between `monoid_algebra` and `add_monoid_algebra` in terms of `additive` -/
protected def monoid_algebra.to_additive [semiring k] [has_mul G] :
  monoid_algebra k G ≃+* add_monoid_algebra k (additive G) :=
{ map_mul' := λ x y, by convert monoid_algebra.map_domain_mul (mul_hom.id G),
  ..finsupp.dom_congr additive.of_mul }

namespace add_monoid_algebra

variables {k G}

/-! #### Algebra structure -/
section algebra

variables {R : Type*}
local attribute [reducible] add_monoid_algebra

/-- `finsupp.single 0` as a `ring_hom` -/
@[simps] def single_zero_ring_hom [semiring k] [add_monoid G] : k →+* add_monoid_algebra k G :=
{ map_one' := rfl,
  map_mul' := λ x y, by rw [single_add_hom, single_mul_single, zero_add],
  ..finsupp.single_add_hom 0}

/-- If two ring homomorphisms from `add_monoid_algebra k G` are equal on all `single a 1`
and `single 0 b`, then they are equal. -/
lemma ring_hom_ext {R} [semiring k] [add_monoid G] [semiring R]
  {f g : add_monoid_algebra k G →+* R} (h₀ : ∀ b, f (single 0 b) = g (single 0 b))
  (h_of : ∀ a, f (single a 1) = g (single a 1)) : f = g :=
@monoid_algebra.ring_hom_ext k (multiplicative G) R _ _ _ _ _ h₀ h_of

/-- If two ring homomorphisms from `add_monoid_algebra k G` are equal on all `single a 1`
and `single 0 b`, then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext] lemma ring_hom_ext' {R} [semiring k] [add_monoid G] [semiring R]
  {f g : add_monoid_algebra k G →+* R}
  (h₁ : f.comp single_zero_ring_hom = g.comp single_zero_ring_hom)
  (h_of : (f : add_monoid_algebra k G →* R).comp (of k G) =
    (g : add_monoid_algebra k G →* R).comp (of k G)) :
  f = g :=
ring_hom_ext (ring_hom.congr_fun h₁) (monoid_hom.congr_fun h_of)

/--
The instance `algebra R (add_monoid_algebra k G)` whenever we have `algebra R k`.

In particular this provides the instance `algebra k (add_monoid_algebra k G)`.
-/
instance [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  algebra R (add_monoid_algebra k G) :=
{ smul_def' := λ r a, by { ext, simp [single_zero_mul_apply, algebra.smul_def'', pi.smul_apply], },
  commutes' := λ r f, by { ext, simp [single_zero_mul_apply, mul_single_zero_apply,
                                      algebra.commutes], },
  ..single_zero_ring_hom.comp (algebra_map R k) }

/-- `finsupp.single 0` as a `alg_hom` -/
@[simps] def single_zero_alg_hom [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  k →ₐ[R] add_monoid_algebra k G :=
{ commutes' := λ r, by { ext, simp, refl, }, ..single_zero_ring_hom}

@[simp] lemma coe_algebra_map [comm_semiring R] [semiring k] [algebra R k] [add_monoid G] :
  (algebra_map R (add_monoid_algebra k G) : R → add_monoid_algebra k G) =
    single 0 ∘ (algebra_map R k) :=
rfl

end algebra

section lift

variables {k G} [comm_semiring k] [add_monoid G]
variables {A : Type u₃} [semiring A] [algebra k A] {B : Type*} [semiring B] [algebra k B]

/-- `lift_nc_ring_hom` as a `alg_hom`, for when `f` is an `alg_hom` -/
def lift_nc_alg_hom (f : A →ₐ[k] B) (g : multiplicative G →* B)
  (h_comm : ∀ x y, commute (f x) (g y)) :
  add_monoid_algebra A G →ₐ[k] B :=
{ to_fun := lift_nc_ring_hom (f : A →+* B) g h_comm,
  commutes' := by simp [lift_nc_ring_hom],
  ..(lift_nc_ring_hom (f : A →+* B) g h_comm)}

/-- A `k`-algebra homomorphism from `monoid_algebra k G` is uniquely defined by its
values on the functions `single a 1`. -/
lemma alg_hom_ext ⦃φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A⦄
  (h : ∀ x, φ₁ (single x 1) = φ₂ (single x 1)) : φ₁ = φ₂ :=
@monoid_algebra.alg_hom_ext k (multiplicative G) _ _ _ _ _ _ _ h

/-- See note [partially-applied ext lemmas]. -/
@[ext] lemma alg_hom_ext' ⦃φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A⦄
  (h : (φ₁ : add_monoid_algebra k G →* A).comp (of k G) =
    (φ₂ : add_monoid_algebra k G →* A).comp (of k G)) : φ₁ = φ₂ :=
alg_hom_ext $ monoid_hom.congr_fun h

variables (k G A)

/-- Any monoid homomorphism `G →* A` can be lifted to an algebra homomorphism
`monoid_algebra k G →ₐ[k] A`. -/
def lift : (multiplicative G →* A) ≃ (add_monoid_algebra k G →ₐ[k] A) :=
{ inv_fun := λ f, (f : add_monoid_algebra k G →* A).comp (of k G),
  to_fun := λ F, {
    to_fun := lift_nc_alg_hom (algebra.of_id k A) F $ λ _ _, algebra.commutes _ _,
    .. @monoid_algebra.lift k (multiplicative G) _ _ A _ _ F},
  .. @monoid_algebra.lift k (multiplicative G) _ _ A _ _ }

variables {k G A}

lemma lift_apply' (F : multiplicative G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, (algebra_map k A b) * F (multiplicative.of_add a)) := rfl

lemma lift_apply (F : multiplicative G →* A) (f : monoid_algebra k G) :
  lift k G A F f = f.sum (λ a b, b • F (multiplicative.of_add a)) :=
by simp only [lift_apply', algebra.smul_def]

lemma lift_def (F : multiplicative G →* A) :
  ⇑(lift k G A F) = lift_nc ((algebra_map k A : k →+* A) : k →+ A) F :=
rfl

@[simp] lemma lift_symm_apply (F : add_monoid_algebra k G →ₐ[k] A) (x : multiplicative G) :
  (lift k G A).symm F x = F (single x.to_add 1) := rfl

lemma lift_of (F : multiplicative G →* A) (x : multiplicative G) :
  lift k G A F (of k G x) = F x :=
by rw [of_apply, ← lift_symm_apply, equiv.symm_apply_apply]

@[simp] lemma lift_single (F : multiplicative G →* A) (a b) :
  lift k G A F (single a b) = b • F (multiplicative.of_add a) :=
by rw [lift_def, lift_nc_single, algebra.smul_def, ring_hom.coe_add_monoid_hom]

lemma lift_unique' (F : add_monoid_algebra k G →ₐ[k] A) :
  F = lift k G A ((F : add_monoid_algebra k G →* A).comp (of k G)) :=
((lift k G A).apply_symm_apply F).symm

/-- Decomposition of a `k`-algebra homomorphism from `monoid_algebra k G` by
its values on `F (single a 1)`. -/
lemma lift_unique (F : add_monoid_algebra k G →ₐ[k] A) (f : monoid_algebra k G) :
  F f = f.sum (λ a b, b • F (single a 1)) :=
by conv_lhs { rw lift_unique' F, simp [lift_apply] }

lemma alg_hom_ext_iff {φ₁ φ₂ : add_monoid_algebra k G →ₐ[k] A} :
  (∀ x, φ₁ (finsupp.single x 1) = φ₂ (finsupp.single x 1)) ↔ φ₁ = φ₂ :=
⟨λ h, alg_hom_ext h, by rintro rfl _; refl⟩

end lift

section
local attribute [reducible] add_monoid_algebra

universe ui
variable {ι : Type ui}

lemma prod_single [comm_semiring k] [add_comm_monoid G]
  {s : finset ι} {a : ι → G} {b : ι → k} :
  (∏ i in s, single (a i) (b i)) = single (∑ i in s, a i) (∏ i in s, b i) :=
finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih,
  single_mul_single, sum_insert has, prod_insert has]

end

end add_monoid_algebra

variables {R : Type*} [comm_semiring R] (k G)

/-- The algebra equivalence between `add_monoid_algebra` and `monoid_algebra` in terms of
`multiplicative`. -/
def add_monoid_algebra.to_multiplicative_alg_equiv [semiring k] [algebra R k] [add_monoid G] :
  add_monoid_algebra k G ≃ₐ[R] monoid_algebra k (multiplicative G) :=
{ commutes' := λ r, by simp [add_monoid_algebra.to_multiplicative],
  ..add_monoid_algebra.to_multiplicative k G }

/-- The algebra equivalence between `monoid_algebra` and `add_monoid_algebra` in terms of
`additive`. -/
def monoid_algebra.to_additive_alg_equiv [semiring k] [algebra R k] [monoid G] :
  monoid_algebra k G ≃ₐ[R] add_monoid_algebra k (additive G) :=
{ commutes' := λ r, by simp [monoid_algebra.to_additive],
  ..monoid_algebra.to_additive k G }


import inner_product_spaces.complex_ip.basic

-- Ask Scott how to fix this
set_option class.instance_max_depth 100

noncomputable theory

open complex

variables {α : Type*} {β : Type*}
variables [decidable_eq α] [add_comm_group α] [vector_space ℂ α] [ℂ_inner_product_space α]
variables [decidable_eq β] [add_comm_group β] [vector_space ℂ β] [ℂ_inner_product_space β]

instance prod_vector_space : vector_space ℂ (α×β) := by apply_instance

section cartesian_prod

def prod_inner_product (x y : α×β) : ℂ := x.1†y.1 + x.2†y.2

instance prod_has_inner_product : has_ℂ_inner_product (α×β) := ⟨prod_inner_product⟩

lemma prod_conj_symm : ∀ (x y : α × β), x†y = conj (y†x) :=
begin
    intros x y,
    dsimp [(†), prod_inner_product],
    rw [conj_add, ←conj_symm x.fst y.fst, ←conj_symm x.snd y.snd],
end

lemma prod_linearity (x y z : α × β) (a : ℂ) : (a • x + y) † z = a * (x † z) + y † z :=
begin
    dsimp [(†), prod_inner_product],
    simp [-add_comm],
    simp,
    rw [left_distrib],
end

lemma comp_neq_zero_of_neq_zero (x : α × β) : x ≠ 0 → x.1 ≠ 0 ∨ x.2 ≠ 0 :=
begin
    intros h,
    by_contradiction,
    rw [not_or_distrib] at a,
    simp only [not_not] at a,
    cases a,
    have w : x = (x.1, x.2) := by simp only [prod.mk.eta, eq_self_iff_true],
    rw [a_left, a_right] at w,
    have k : (0, 0) = (0 : α × β) := by refl,
    rw [←w] at k,
    contradiction,
end

lemma prod_pos_def : ∀ (x : α × β), x ≠ 0 → (x†x).re > 0 :=
begin
    intros x h,
    dsimp [(†), prod_inner_product],
    have w := comp_neq_zero_of_neq_zero _ h,
    cases w,

    have k := pos_def _ w,
    have k' := ip_self_nonneg x.2,
    dsimp [ip_self] at k',
    exact lt_add_of_pos_of_le k k',

    have k := pos_def _ w,
    have k' := ip_self_nonneg x.1,
    dsimp [ip_self] at k',
    exact lt_add_of_le_of_pos k' k,
end

instance prod_inner_product_space : ℂ_inner_product_space (α×β) :=
{conj_symm := prod_conj_symm, linearity := prod_linearity, pos_def := prod_pos_def}

end cartesian_prod


universe u

namespace hidden

definition min {α : Type u} [decidable_linear_order α] (a b : α) : α := if a ≤ b then a else b
definition max {α : Type u} [decidable_linear_order α] (a b : α) : α := if a ≤ b then b else a
definition abs {α : Type u} [decidable_linear_ordered_add_comm_group α] (a : α) : α := max a (-a)

section
open decidable tactic
variables {α : Type u} [decidable_linear_order α]

private meta def min_tac_step : tactic unit :=
solve1 $ intros
>> `[unfold min max]
>> try `[simp [*, if_pos, if_neg]]
>> try `[apply le_refl]
>> try `[apply le_of_not_le, assumption]

meta def tactic.interactive.min_tac (a b : interactive.parse lean.parser.pexpr) : tactic unit :=
interactive.by_cases (none, ``(%%a ≤ %%b)); min_tac_step

lemma min_le_left (a b : α) : min a b ≤ a :=
by min_tac a b

#print min_le_left -- very long proof

set_option trace.simplify.rewrite true

lemma min_le_left' (a b : α) : min a b ≤ a :=
begin
  -- unfold min max,
  rw min.equations._eqn_1,
  by_cases (a ≤ b),

  type_check @if_pos,
  type_check @if_neg,
  rw if_pos h,
  rw if_neg h,
  apply le_of_not_le,
  exact h,
end

#print min_le_left'

lemma min_le_right (a b : α) : min a b ≤ b :=
by min_tac a b

lemma le_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) : c ≤ min a b :=
by min_tac a b

lemma le_max_left (a b : α) : a ≤ max a b :=
by min_tac a b

lemma le_max_right (a b : α) : b ≤ max a b :=
by min_tac a b

lemma max_le {a b c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) : max a b ≤ c :=
by min_tac a b

lemma eq_min {a b c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) (h₃ : ∀{d}, d ≤ a → d ≤ b → d ≤ c) :  c = min a b :=
le_antisymm (le_min h₁ h₂) (h₃ (min_le_left a b) (min_le_right a b))

lemma min_comm (a b : α) : min a b = min b a :=
eq_min (min_le_right a b) (min_le_left a b) (λ c h₁ h₂, le_min h₂ h₁)

lemma min_assoc (a b c : α) : min (min a b) c = min a (min b c) :=
begin
  apply eq_min,
  { apply le_trans, apply min_le_left, apply min_le_left },
  { apply le_min, apply le_trans, apply min_le_left, apply min_le_right, apply min_le_right },
  { intros d h₁ h₂, apply le_min, apply le_min h₁, apply le_trans h₂, apply min_le_left,
    apply le_trans h₂, apply min_le_right }
end

end hidden