/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import tactic.gptf
import finite_field
import circulant_matrix
import diagonal_matrix

/-!
# Hadamard matrices.

This file defines the Hadamard matrices `matrix.Hadamard_matrix` as a type class,
and implements Sylvester's constructions and Payley's constructions of Hadamard matrices and a Hadamard matrix of order 92.
In particular, this files implements at least one Hadamard matrix of oder `n` for every possible `n ≤ 100`.

## References

*  <https://en.wikipedia.org/wiki/Hadamard_matrix>
*  <https://en.wikipedia.org/wiki/Paley_construction>
* [F.J. MacWilliams, *2 Nonlinear codes, Hadamard matrices, designs and the Golay code*][macwilliams1977]
* [L. D. Baumert, *Discovery of an Hadamard matrix of order 92*][baumert1962]

## Tags

Hadamard matrix, Hadamard
-/

--attribute [to_additive] fintype.prod_dite
--local attribute [-instance] set.has_coe_to_sort
local attribute [-instance] set.fintype_univ
local attribute [instance] set_fintype

open_locale big_operators

----------------------------------------------------------------------------
section pre

variables {α β I J : Type*} (S T U : set α)
variables [fintype I] [fintype J]

attribute [simp]
private lemma set.union_to_finset
[decidable_eq α] [fintype ↥S] [fintype ↥T] :
S.to_finset ∪ T.to_finset = (S ∪ T).to_finset :=
(set.to_finset_union S T).symm

@[simp] lemma ite_nested (p : Prop) [decidable p] {a b c d : α}:
ite p (ite p a b) (ite p c d)= ite p a d :=
by by_cases p; simp* at *

@[simp] lemma ite_eq [decidable_eq α] (a x : α) {f : α → β}:
ite (x = a) (f a) (f x)= f x :=
by by_cases x=a; simp* at *

-- The original proof is due to Eric Wieser, given in <https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/card>.
private lemma pick_elements (h : fintype.card I ≥ 3) :
∃ i j k : I, i ≠ j ∧ i ≠ k ∧ j ≠ k :=
begin
  set n := fintype.card I with hn,
  have f := fintype.equiv_fin_of_card_eq hn,
  refine ⟨f.symm ⟨0, by linarith⟩, f.symm ⟨1, by linarith⟩, f.symm ⟨2, by linarith⟩,
    and.imp f.symm.injective.ne (and.imp f.symm.injective.ne f.symm.injective.ne) _⟩,
  dec_trivial,
end
end pre
----------------------------------------------------------------------------
namespace equiv

variable {I : Type*}

def sum_self_equiv_prod_unit_sum_unit : I ⊕ I ≃  I × (unit ⊕ unit) :=
(equiv.trans (equiv.prod_sum_distrib I unit unit)
             (equiv.sum_congr (equiv.prod_punit I) (equiv.prod_punit I))).symm

@[simp] lemma sum_self_equiv_prod_unit_sum_unit_symm_apply_left (a : unit) (i : I) :
sum_self_equiv_prod_unit_sum_unit.symm (i, sum.inl a) = sum.inl i := rfl

@[simp] lemma sum_self_equiv_prod_unit_sum_unit_symm_apply_right (a : unit) (i : I) :
sum_self_equiv_prod_unit_sum_unit.symm (i, sum.inr a) = sum.inr i := rfl

end equiv
----------------------------------------------------------------------------
namespace matrix

variables {α β γ I J K L M N: Type*}
variables {R : Type*}
variables {m n: ℕ}
variables [fintype I] [fintype J] [fintype K] [fintype L] [fintype M] [fintype N]
open_locale matrix

section matrix_pre

@[simp] private
lemma push_nag [add_group α] (A : matrix I J α) {i : I} {j : J} {a : α}:
- A i j = a ↔ A i j = -a :=
⟨λ h, eq_neg_of_eq_neg (eq.symm h), λ h, neg_eq_iff_neg_eq.mp (eq.symm h)⟩

lemma dot_product_split_over_subtypes {R} [semiring R]
(v w : I → R) (p : I → Prop) [decidable_pred p] :
dot_product v w =
∑ j : {j : I // p j}, v j * w j + ∑ j : {j : I // ¬ (p j)}, v j * w j :=
by { simp [dot_product], rw fintype.sum_split p}

end matrix_pre

/- ## Hadamard_matrix  -/
section Hadamard_matrix
open fintype finset matrix

class Hadamard_matrix (H : matrix I I ℚ) : Prop :=
(one_or_neg_one []: ∀ i j, (H i j) = 1 ∨ (H i j) = -1)
(orthogonal_rows []: H.has_orthogonal_rows)

-- alternative def
private abbreviation S := {x : ℚ// x = 1 ∨ x = -1}
instance fun_S_to_ℚ: has_coe (β → S) (β → ℚ) := ⟨λ f x, f x⟩
class Hadamard_matrix' (H : matrix I I S):=
(orthogonal_rows []: ∀ i₁ i₂, i₁ ≠ i₂ → dot_product ((H i₁) : (I → ℚ)) (H i₂) = 0)

@[reducible, simp]
def matched (H : matrix I I ℚ) (i₁ i₂ : I) : set I :=
{j : I | H i₁ j = H i₂ j}

@[reducible, simp]
def mismatched (H : matrix I I ℚ) (i₁ i₂ : I) : set I :=
{j : I | H i₁ j ≠ H i₂ j}

section set

/-- `matched H i₁ i₂ ∪ mismatched H i₁ i₂ = I` as sets -/
@[simp] lemma match_union_mismatch (H : matrix I I ℚ) (i₁ i₂ : I) :
matched H i₁ i₂ ∪ mismatched H i₁ i₂ = @set.univ I :=
set.union_compl' _

/-- a variant of `match_union_mismatch` -/
@[simp] lemma match_union_mismatch' (H : matrix I I ℚ) (i₁ i₂ : I) :
{j : I | H i₁ j = H i₂ j} ∪ {j : I | ¬H i₁ j = H i₂ j} = @set.univ I :=
begin
  have h := match_union_mismatch H i₁ i₂,
  simp* at *,
end

/-- `matched H i₁ i₂ ∪ mismatched H i₁ i₂ = I` as finsets -/
lemma match_union_mismatch_finset [decidable_eq I] (H : matrix I I ℚ) (i₁ i₂ : I) :
(matched H i₁ i₂).to_finset ∪ (mismatched H i₁ i₂).to_finset = @univ I _:=
begin
  simp only [←set.to_finset_union, univ_eq_set_univ_to_finset],
  congr, simp
end

/-- `matched H i₁ i₂` and `mismatched H i₁ i₂` are disjoint as sets -/
@[simp] lemma disjoint_match_mismatch (H : matrix I I ℚ) (i₁ i₂ : I) :
disjoint (matched H i₁ i₂) (mismatched H i₁ i₂) :=
set.disjoint_of_compl' _

/-- `matched H i₁ i₂` and `mismatched H i₁ i₂` are disjoint as finsets -/
@[simp] lemma match_disjoint_mismatch_finset [decidable_eq I] (H : matrix I I ℚ) (i₁ i₂ : I) :
disjoint (matched H i₁ i₂).to_finset (mismatched H i₁ i₂).to_finset :=
by simp [set.to_finset_disjoint_iff]

/-- `|I| = |H.matched i₁ i₂| + |H.mismatched i₁ i₂|`
    for any rows `i₁` `i₂` of a matrix `H` with index type `I`-/
lemma card_match_add_card_mismatch [decidable_eq I] (H : matrix I I ℚ) (i₁ i₂ : I) :
set.card (@set.univ I) = set.card (matched H i₁ i₂) + set.card (mismatched H i₁ i₂) :=
set.card_disjoint_union' (disjoint_match_mismatch _ _ _) (match_union_mismatch _ _ _)

lemma dot_product_split [decidable_eq I] (H : matrix I I ℚ) (i₁ i₂ : I) :
∑ j in (@set.univ I).to_finset, H i₁ j * H i₂ j =
∑ j in (matched H i₁ i₂).to_finset, H i₁ j * H i₂ j +
∑ j in (mismatched H i₁ i₂).to_finset, H i₁ j * H i₂ j :=
set.sum_union' (disjoint_match_mismatch H i₁ i₂) (match_union_mismatch H i₁ i₂)

end set

open matrix Hadamard_matrix

/- ## basic properties  -/
section properties
namespace Hadamard_matrix

variables (H : matrix I I ℚ) [Hadamard_matrix H]

attribute [simp] one_or_neg_one

@[simp] lemma neg_one_or_one (i j : I) : (H i j) = -1 ∨ (H i j) = 1 :=
(one_or_neg_one H i j).swap

@[simp] lemma entry_mul_self (i j : I) :
(H i j) * (H i j) = 1 :=
by rcases one_or_neg_one H i j; simp* at *

variables {H}

lemma entry_eq_one_of_ne_neg_one {i j : I} (h : H i j ≠ -1) :
H i j = 1 := by {have := one_or_neg_one H i j, tauto}

lemma entry_eq_neg_one_of_ne_one {i j : I} (h : H i j ≠ 1) :
H i j = -1 := by {have := one_or_neg_one H i j, tauto}

lemma entry_eq_neg_one_of {i j k l : I} (h : H i j ≠ H k l) (h' : H i j = 1):
H k l = -1 := by rcases one_or_neg_one H k l; simp* at *

lemma entry_eq_one_of {i j k l : I} (h : H i j ≠ H k l) (h' : H i j = -1):
H k l = 1 := by rcases one_or_neg_one H k l; simp* at *

lemma entry_eq_entry_of {a b c d e f : I} (h₁: H a b ≠ H c d) (h₂: H a b ≠ H e f) :
H c d = H e f :=
begin
  by_cases g : H a b = 1,
  { have g₁ := entry_eq_neg_one_of h₁ g,
    have g₂ := entry_eq_neg_one_of h₂ g,
    linarith },
  { replace g:= entry_eq_neg_one_of_ne_one g,
    have g₁ := entry_eq_one_of h₁ g,
    have g₂ := entry_eq_one_of h₂ g,
    linarith }
end

variables (H)
@[simp] lemma entry_mul_of_ne {i j k l : I} (h : H i j ≠ H k l):
(H i j) * (H k l) = -1 :=
by {rcases one_or_neg_one H i j;
    simp [*, entry_eq_one_of h, entry_eq_neg_one_of h] at *,}

@[simp] lemma row_dot_product_self (i : I) :
dot_product (H i) (H i) = card I := by simp [dot_product, finset.card_univ]

@[simp] lemma col_dot_product_self (j : I) :
dot_product (λ i, H i j) (λ i, H i j) = card I := by simp [dot_product, finset.card_univ]

@[simp] lemma row_dot_product_other {i₁ i₂ : I} (h : i₁ ≠ i₂) :
dot_product (H i₁) (H i₂) = 0 := orthogonal_rows H h

@[simp] lemma row_dot_product_other' {i₁ i₂ : I} (h : i₂ ≠ i₁) :
dot_product (H i₁) (H i₂)= 0 := by simp [ne.symm h]

@[simp] lemma row_dot_product'_other {i₁ i₂ : I} (h : i₁ ≠ i₂) :
∑ j, (H i₁ j) * (H i₂ j) = 0 := orthogonal_rows H h

lemma mul_tanspose [decidable_eq I] :
H ⬝ Hᵀ = (card I : ℚ) • 1 :=
begin
  ext,
  simp [transpose, matrix.mul],
  by_cases i = j; simp [*, mul_one] at *,
end

lemma det_sq [decidable_eq I] :
(det H)^2 = (card I)^(card I) :=
calc (det H)^2 = (det H) * (det H) : by ring
           ... = det (H ⬝ Hᵀ) : by simp
           ... = det ((card I : ℚ) • (1 : matrix I I ℚ)) : by rw mul_tanspose
           ... = (card I : ℚ)^(card I) : by simp

lemma right_invertible [decidable_eq I] :
H ⬝ ((1 / (card I : ℚ)) • Hᵀ) = 1 :=
begin
  have h := mul_tanspose H,
  by_cases hI : card I = 0,
  {exact @eq_of_empty _ _ _ (card_eq_zero_iff.mp hI) _ _}, -- the trivial case
  have hI': (card I : ℚ) ≠ 0, {simp [hI]},
  simp [h, hI'],
end

def invertible [decidable_eq I] : invertible H :=
invertible_of_right_inverse (Hadamard_matrix.right_invertible _)

lemma nonsing_inv_eq [decidable_eq I] : H⁻¹ = (1 / (card I : ℚ)) • Hᵀ :=
inv_eq_right_inv (Hadamard_matrix.right_invertible _)

lemma tanspose_mul [decidable_eq I] :
Hᵀ ⬝ H = ((card I) : ℚ) • 1 :=
begin
  rw [←nonsing_inv_right_left (right_invertible H), smul_mul, ←smul_assoc],
  by_cases hI : card I = 0,
  {exact @eq_of_empty _ _ _ (card_eq_zero_iff.mp hI) _ _}, --trivial case
  simp* at *,
end

/-- The dot product of a column with another column equals `0`. -/
@[simp] lemma col_dot_product_other [decidable_eq I] {j₁ j₂ : I} (h : j₁ ≠ j₂) :
dot_product (λ i, H i j₁) (λ i, H i j₂) = 0 :=
begin
  have h':= congr_fun (congr_fun (tanspose_mul H) j₁) j₂,
  simp [matrix.mul, transpose, has_one.one, diagonal, h] at h',
  assumption,
end

/-- The dot product of a column with another column equals `0`. -/
@[simp] lemma col_dot_product_other' [decidable_eq I] {j₁ j₂ : I} (h : j₂ ≠ j₁) :
dot_product (λ i, H i j₁) (λ i, H i j₂)= 0 := by simp [ne.symm h]

/-- Hadamard matrix `H` has orthogonal rows-/
@[simp] lemma has_orthogonal_cols [decidable_eq I] :
H.has_orthogonal_cols:=
by intros i j h; simp [h]

/-- `Hᵀ` is a Hadamard matrix suppose `H` is. -/
instance transpose [decidable_eq I] : Hadamard_matrix Hᵀ :=
begin
  refine{..}, {intros, simp[transpose]},
  simp [transpose_has_orthogonal_rows_iff_has_orthogonal_cols]
end

/-- `Hᵀ` is a Hadamard matrix implies `H` is a Hadamard matrix.-/
lemma of_Hadamard_matrix_transpose [decidable_eq I]
{H : matrix I I ℚ} (h: Hadamard_matrix Hᵀ):
Hadamard_matrix H :=
by convert Hadamard_matrix.transpose Hᵀ; simp

lemma card_match_eq {i₁ i₂ : I} (h: i₁ ≠ i₂):
(set.card (matched H i₁ i₂) : ℚ) = ∑ j in (matched H i₁ i₂).to_finset, H i₁ j * H i₂ j :=
begin
  simp [matched],
  have h : ∑ (x : I) in {j : I | H i₁ j = H i₂ j}.to_finset, H i₁ x * H i₂ x
         = ∑ (x : I) in {j : I | H i₁ j = H i₂ j}.to_finset, 1,
  { apply finset.sum_congr rfl,
    rintros j hj,
    simp* at * },
  rw [h, ← finset.card_eq_sum_ones_ℚ],
  congr,
end

lemma neg_card_mismatch_eq {i₁ i₂ : I} (h: i₁ ≠ i₂):
- (set.card (mismatched H i₁ i₂) : ℚ) = ∑ j in (mismatched H i₁ i₂).to_finset, H i₁ j * H i₂ j :=
begin
  simp [mismatched],
  have h : ∑ (x : I) in {j : I | H i₁ j ≠ H i₂ j}.to_finset, H i₁ x * H i₂ x
         = ∑ (x : I) in {j : I | H i₁ j ≠ H i₂ j}.to_finset, -1,
  { apply finset.sum_congr rfl, rintros j hj, simp* at * },
  have h' : ∑ (x : I) in {j : I | H i₁ j ≠ H i₂ j}.to_finset, - (1 : ℚ)
          = - ∑ (x : I) in {j : I | H i₁ j ≠ H i₂ j}.to_finset, (1 : ℚ),
  { simp },
  rw [h, h', ← finset.card_eq_sum_ones_ℚ],
  congr,
end

lemma card_mismatch_eq {i₁ i₂ : I} (h: i₁ ≠ i₂):
(set.card (mismatched H i₁ i₂) : ℚ) = - ∑ j in (mismatched H i₁ i₂).to_finset, H i₁ j * H i₂ j :=
by {rw [←neg_card_mismatch_eq]; simp* at *}

/-- `|H.matched i₁ i₂| = |H.mismatched i₁ i₂|` as rational numbers if `H` is a Hadamard matrix.-/
lemma card_match_eq_card_mismatch_ℚ [decidable_eq I] {i₁ i₂ : I} (h: i₁ ≠ i₂):
(set.card (matched H i₁ i₂) : ℚ)= set.card (mismatched H i₁ i₂) :=
begin
  have eq := dot_product_split H i₁ i₂,
  rw [card_match_eq H h, card_mismatch_eq H h],
  simp only [set.to_finset_univ, row_dot_product'_other H h] at eq,
  linarith,
end

/-- `|H.matched i₁ i₂| = |H.mismatched i₁ i₂|` if `H` is a Hadamard matrix.-/
lemma card_match_eq_card_mismatch [decidable_eq I] {i₁ i₂ : I} (h: i₁ ≠ i₂):
set.card (matched H i₁ i₂) = set.card (mismatched H i₁ i₂) :=
by have h := card_match_eq_card_mismatch_ℚ H h; simp * at *

lemma reindex (f : I ≃ J) (g : I ≃ J): Hadamard_matrix (reindex f g H) :=
begin
  refine {..},
  { simp [minor_apply] },
  intros i₁ i₂ h,
  simp [dot_product, minor_apply],
  rw [fintype.sum_equiv (g.symm) _ (λ x, H (f.symm i₁) x * H (f.symm i₂) x) (λ x, rfl)],
  have h' : f.symm i₁ ≠ f.symm i₂, {simp [h]},
  simp [h']
end

end Hadamard_matrix
end properties
/- ## end basic properties  -/

open Hadamard_matrix

/- ## basic constructions-/
section basic_constr

def H_0 : matrix empty empty ℚ := 1

def H_1 : matrix unit unit ℚ := 1

def H_1' : matrix punit punit ℚ := λ i j, 1

def H_2 : matrix (unit ⊕ unit) (unit ⊕ unit) ℚ :=
(1 :matrix unit unit ℚ).from_blocks 1 1 (-1)

instance Hadamard_matrix.H_0 : Hadamard_matrix H_0 :=
⟨by tidy, by tidy⟩

instance Hadamard_matrix.H_1 : Hadamard_matrix H_1 :=
⟨by tidy, by tidy⟩

instance Hadamard_matrix.H_1' : Hadamard_matrix H_1' :=
⟨by tidy, by tidy⟩

instance Hadamard_matrix.H_2 : Hadamard_matrix H_2 :=
⟨ by tidy,
  λ i₁ i₂ h, by { cases i₁, any_goals {cases i₂},
                  any_goals {simp[*, H_2, dot_product, fintype.sum_sum_type] at *} }
⟩

end basic_constr
/- ## end basic constructions-/

/- ## "normalize" constructions-/
section normalize

open matrix Hadamard_matrix

/-- negate row `i` of matrix `A`; `[decidable_eq I]` is required for `update_row` -/
def neg_row [has_neg α] [decidable_eq I] (A : matrix I J α) (i : I) :=
update_row A i (- A i)

/-- negate column `j` of matrix `A`; `[decidable_eq J]` is required for `update_column` -/
def neg_col [has_neg α] [decidable_eq J] (A : matrix I J α) (j : J) :=
update_column A j (-λ i, A i j)

section neg

/-- Negating row `i` and then column `j` equals negating column `j` first and then row `i`. -/
lemma neg_row_neg_col_comm [has_neg α] [decidable_eq I] [decidable_eq J]
(A : matrix I J α) (i : I) (j : J) :
(A.neg_row i).neg_col j = (A.neg_col j).neg_row i :=
begin
  ext a b,
  simp [neg_row, neg_col, update_column_apply, update_row_apply],
  by_cases a = i,
  any_goals {by_cases b = j},
  any_goals {simp* at *},
end

lemma transpose_neg_row [has_neg α] [decidable_eq I] (A : matrix I J α) (i : I) :
(A.neg_row i)ᵀ = Aᵀ.neg_col i :=
by simp [← update_column_transpose, neg_row, neg_col]

lemma transpose_neg_col [has_neg α] [decidable_eq J] (A : matrix I J α) (j : J) :
(A.neg_col j)ᵀ = Aᵀ.neg_row j :=
by {simp [← update_row_transpose, neg_row, neg_col, trans_row_eq_col]}

lemma neg_row_add [add_comm_group α] [decidable_eq I]
(A B : matrix I J α) (i : I) :
(A.neg_row i) + (B.neg_row i) = (A + B).neg_row i :=
begin
  ext a b,
  simp [neg_row, neg_col, update_column_apply, update_row_apply],
  by_cases a = i,
  any_goals {simp* at *},
  abel
end

lemma neg_col_add [add_comm_group α] [decidable_eq J]
(A B : matrix I J α) (j : J) :
(A.neg_col j) + (B.neg_col j) = (A + B).neg_col j :=
begin
  ext a b,
  simp [neg_row, neg_col, update_column_apply, update_row_apply],
  by_cases b = j,
  any_goals {simp* at *},
  abel
end

/-- Negating the same row and column of diagonal matrix `A` equals `A` itself. -/
lemma neg_row_neg_col_eq_self_of_is_diag [add_group α] [decidable_eq I]
{A : matrix I I α} (h : A.is_diagonal) (i : I) :
(A.neg_row i).neg_col i = A :=
begin
  ext a b,
  simp [neg_row, neg_col, update_column_apply, update_row_apply],
  by_cases h₁ : a = i,
  any_goals {by_cases h₂ : b = i},
  any_goals {simp* at *},
  { simp [h.apply_ne' h₂] },
  { simp [h.apply_ne h₁] },
end

end neg

variables [decidable_eq I] (H : matrix I I ℚ) [Hadamard_matrix H]

/-- Negating any row `i` of a Hadamard matrix `H` produces another Hadamard matrix. -/
instance Hadamard_matrix.neg_row (i : I) :
Hadamard_matrix (H.neg_row i) :=
begin
  -- first goal
  refine {..},
  { intros j k,
    simp [neg_row,  update_row_apply],
    by_cases j = i; simp* at * },
  -- second goal
  { intros j k hjk,
    by_cases h1 : j = i, any_goals {by_cases h2 : k = i},
    any_goals {simp [*, neg_row, update_row_apply]},
    tidy }
end

/-- Negating any column `j` of a Hadamard matrix `H` produces another Hadamard matrix. -/
instance Hadamard_matrix.neg_col (j : I) :
Hadamard_matrix (H.neg_col j) :=
begin
  apply of_Hadamard_matrix_transpose, --changes the goal to `(H.neg_col j)ᵀ.Hadamard_matrix`
  simp [transpose_neg_col, Hadamard_matrix.neg_row]
  -- `(H.neg_col j)ᵀ = Hᵀ.neg_row j`, in which the RHS has been proved to be a Hadamard matrix.
end

end normalize
/- ## end "normalize" constructions -/

/- ## special cases -/
section special_cases

namespace Hadamard_matrix
variables (H : matrix I I ℚ) [Hadamard_matrix H]

/-- normalized Hadamard matrix -/
def is_normalized [inhabited I] : Prop :=
H (default I) = 1 ∧ (λ i, H i (default I)) = 1

/-- skew Hadamard matrix -/
def is_skew [decidable_eq I] : Prop :=
Hᵀ + H = 2

/-- regular Hadamard matrix -/
def is_regular : Prop :=
∀ i j, ∑ b, H i b = ∑ a, H a j

variable {H}

lemma is_skew.eq [decidable_eq I] (h : is_skew H) :
Hᵀ + H = 2 := h

@[simp] lemma is_skew.apply_eq
[decidable_eq I] (h : is_skew H) (i : I) :
H i i + H i i = 2 :=
by replace h:= congr_fun (congr_fun h i) i; simp * at *

@[simp] lemma is_skew.apply_ne
[decidable_eq I] (h : is_skew H) {i j : I} (hij : i ≠ j) :
H j i + H i j = 0 :=
by replace h:= congr_fun (congr_fun h i) j; simp * at *

lemma is_skew.of_neg_col_row_of_is_skew
[decidable_eq I] (i : I) (h : Hadamard_matrix.is_skew H) :
is_skew ((H.neg_row i).neg_col i) :=
begin
  simp [is_skew],
  -- to show ((H.neg_row i).neg_col i)ᵀ + (H.neg_row i).neg_col i = 2
  nth_rewrite 0 [neg_row_neg_col_comm],
  simp [transpose_neg_row, transpose_neg_col, neg_row_add, neg_col_add],
  rw [h.eq],
  convert neg_row_neg_col_eq_self_of_is_diag _ _,
  apply is_diagonal_add; by simp
end

end Hadamard_matrix

end special_cases
/- ## end special cases -/

/- ## Sylvester construction  -/
section Sylvester_constr

def Sylvester_constr₀ (H : matrix I I ℚ) [Hadamard_matrix H] : matrix (I ⊕ I) (I ⊕ I) ℚ :=
H.from_blocks H H (-H)

@[instance]
theorem Hadamard_matrix.Sylvester_constr₀ (H : matrix I I ℚ) [Hadamard_matrix H] :
Hadamard_matrix (matrix.Sylvester_constr₀ H) :=
begin
  refine{..},
  { rintros (i | i)  (j | j);
    simp [matrix.Sylvester_constr₀] },
  rintros (i | i) (j | j) h,
  all_goals {simp [matrix.Sylvester_constr₀, dot_product_block', *]},
  any_goals {rw [← dot_product], have h' : i ≠ j; simp* at *}
end

def Sylvester_constr₀' (H : matrix I I ℚ) [Hadamard_matrix H]:
matrix (I × (unit ⊕ unit)) (I × (unit ⊕ unit)) ℚ :=
H ⊗ H_2

local notation `reindex_map` := equiv.sum_self_equiv_prod_unit_sum_unit

lemma Sylvester_constr₀'_eq_reindex_Sylvester_constr₀
(H : matrix I I ℚ) [Hadamard_matrix H] :
H.Sylvester_constr₀' = reindex reindex_map reindex_map H.Sylvester_constr₀:=
begin
  ext ⟨i, a⟩ ⟨j, b⟩,
  simp [Sylvester_constr₀', Sylvester_constr₀, Kronecker, H_2, from_blocks],
  rcases a with (a | a),
  any_goals {rcases b with (b | b)},
  any_goals {simp [one_apply]},
end

@[instance]
theorem Hadamard_matrix.Sylvester_constr₀' (H : matrix I I ℚ) [Hadamard_matrix H] :
Hadamard_matrix (Sylvester_constr₀' H) :=
begin
  convert Hadamard_matrix.reindex H.Sylvester_constr₀ reindex_map reindex_map,
  exact H.Sylvester_constr₀'_eq_reindex_Sylvester_constr₀,
end

theorem Hadamard_matrix.order_conclusion_1:
∀ (n : ℕ),  ∃ {I : Type*} [inst : fintype I]
(H : @matrix I I inst inst ℚ) [@Hadamard_matrix I inst H],
@fintype.card I inst = 2^n :=
begin
  intro n,
  induction n with n ih,
  -- the case 0
  {exact ⟨punit, infer_instance, H_1', infer_instance, by simp⟩},
  -- the case n.succ
  rcases ih with ⟨I, inst, H, h, hI⟩, resetI, -- unfold the IH
  refine ⟨I ⊕ I, infer_instance, H.Sylvester_constr₀, infer_instance, _⟩,
  rw [fintype.card_sum, hI], ring_nf, -- this line proves `card (I ⊕ I) = 2 ^ n.succ`
end

end Sylvester_constr
/- ## end Sylvester construction  -/

/- ## general Sylvester construction  -/
section general_Sylvester_constr

def Sylvester_constr
(H₁ : matrix I I ℚ) [Hadamard_matrix H₁] (H₂ : matrix J J ℚ) [Hadamard_matrix H₂] :
matrix (I × J) (I × J) ℚ := H₁ ⊗ H₂

@[instance] theorem Hadamard_matrix.Sylvester_constr'
(H₁ : matrix I I ℚ) [Hadamard_matrix H₁] (H₂ : matrix J J ℚ) [Hadamard_matrix H₂] :
Hadamard_matrix (H₁ ⊗ H₂) :=
begin
  refine {..},
  -- first goal
  { rintros ⟨i₁, j₁⟩ ⟨i₂, j₂⟩,
    simp [Kronecker],
    -- the current goal : H₁ i₁ i₂ * H₂ j₁ j₂ = 1 ∨ H₁ i₁ i₂ * H₂ j₁ j₂ = -1
    obtain (h | h) := one_or_neg_one H₁ i₁ i₂; -- prove by cases : H₁ i₁ i₂ = 1 or -1
    simp [h] },
  -- second goal
  rintros ⟨i₁, j₁⟩ ⟨i₂, j₂⟩ h,
  simp [dot_product_Kronecker_row_split],
  -- by cases j₁ = j₂; simp* closes the case j₁ ≠ j₂
  by_cases hi: i₁ = i₂, any_goals {simp*},
  -- the left case: i₁ = i₂
  by_cases hi: j₁ = j₂, any_goals {simp* at *},
end

/-- wraps `Hadamard_matrix.Sylvester_constr'`-/
@[instance] theorem Hadamard_matrix.Sylvester_constr
(H₁ : matrix I I ℚ) [Hadamard_matrix H₁] (H₂ : matrix J J ℚ) [Hadamard_matrix H₂] :
Hadamard_matrix (Sylvester_constr H₁ H₂) :=
Hadamard_matrix.Sylvester_constr' H₁ H₂

theorem {u v} Hadamard_matrix.order_conclusion_2 {I : Type u} {J : Type v} [fintype I] [fintype J]
(H₁ : matrix I I ℚ) [Hadamard_matrix H₁] (H₂ : matrix J J ℚ) [Hadamard_matrix H₂] :
∃ {K : Type max u v} [inst : fintype K] (H : @matrix K K inst inst ℚ),
by exactI Hadamard_matrix H ∧ card K = card I * card J :=
⟨(I × J), _, Sylvester_constr H₁ H₂, ⟨infer_instance, card_prod I J⟩⟩

end general_Sylvester_constr
/- ## end general Sylvester construction  -/

/- ## Paley construction -/
section Paley_construction

variables {F : Type*} [field F] [fintype F] [decidable_eq F] {p : ℕ} [char_p F p]
local notation `q` := fintype.card F

open finite_field

/- ## Jacobsthal_matrix -/

variable (F) -- `F` is an explicit variable to `Jacobsthal_matrix`.

@[reducible] def Jacobsthal_matrix : matrix F F ℚ := λ a b, χ (a-b)
-- We will use `J` to denote `Jacobsthal_matrix F` in annotations.

namespace Jacobsthal_matrix

/-- `J` is the circulant matrix `cir χ`. -/
lemma eq_cir : (Jacobsthal_matrix F) = cir χ := rfl

variable {F} -- this line makes `F` an implicit variable to the following lemmas/defs

@[simp] lemma diag_entry_eq_zero (i : F) : (Jacobsthal_matrix F) i i = 0 :=
by simp [Jacobsthal_matrix]

@[simp] lemma non_diag_entry_eq {i j : F} (h : i ≠ j):
(Jacobsthal_matrix F) i j = 1 ∨ (Jacobsthal_matrix F) i j = -1 :=
by simp [*, Jacobsthal_matrix]

@[simp] lemma non_diag_entry_Euare_eq {i j : F} (h : i ≠ j):
(Jacobsthal_matrix F) i j * (Jacobsthal_matrix F) i j = 1 :=
by obtain (h₁ | h₂) := Jacobsthal_matrix.non_diag_entry_eq h; simp*

@[simp] lemma entry_Euare_eq (i j : F) :
(Jacobsthal_matrix F) i j * (Jacobsthal_matrix F) i j = ite (i=j) 0 1 :=
by by_cases i=j; simp * at *

-- JJᵀ = qI − 𝟙
lemma mul_transpose_self (hp : p ≠ 2) :
(Jacobsthal_matrix F) ⬝ (Jacobsthal_matrix F)ᵀ = (q : ℚ) • 1 - 𝟙 :=
begin
  ext i j,
  simp [mul_apply, all_one, Jacobsthal_matrix, one_apply],
  -- the current goal is
  -- ∑ (x : F), χ (i - x) * χ (j - x) = ite (i = j) q 0 - 1
  by_cases i = j,
  -- when i = j
  { simp[h, sum_ite, filter_ne, fintype.card],
    rw [@card_erase_of_mem' _ _ j (@finset.univ F _) _];
    simp },
  -- when i ≠ j
  simp [quad_char.sum_mul h hp, h],
end

-- J ⬝ 𝟙 = 0
@[simp] lemma mul_all_one (hp : p ≠ 2) :
(Jacobsthal_matrix F) ⬝ (𝟙 : matrix F F ℚ) = 0 :=
begin
  ext i j,
  simp [all_one, Jacobsthal_matrix, mul_apply],
  -- the current goal: ∑ (x : F), χ (i - x) = 0
  exact quad_char.sum_eq_zero_reindex_1 hp,
end

-- 𝟙 ⬝ J = 0
@[simp] lemma all_one_mul (hp : p ≠ 2) :
(𝟙 : matrix F F ℚ) ⬝ (Jacobsthal_matrix F) = 0 :=
begin
  ext i j,
  simp [all_one, Jacobsthal_matrix, mul_apply],
  exact quad_char.sum_eq_zero_reindex_2 hp,
end

-- J ⬝ col 1 = 0
@[simp] lemma mul_col_one (hp : p ≠ 2) :
Jacobsthal_matrix F ⬝ col 1 = 0 :=
begin
  ext,
  simp [Jacobsthal_matrix, mul_apply],
  -- the current goal: ∑ (x : F), χ (i - x) = 0
  exact quad_char.sum_eq_zero_reindex_1 hp,
end

-- row 1 ⬝ Jᵀ = 0
@[simp] lemma row_one_mul_transpose (hp : p ≠ 2) :
row 1 ⬝ (Jacobsthal_matrix F)ᵀ = 0 :=
begin
  apply eq_of_transpose_eq,
  simp,
  exact mul_col_one hp
end

variables {F}

lemma is_sym_of (h : q ≡ 1 [MOD 4]) :
(Jacobsthal_matrix F).is_sym :=
by ext; simp [Jacobsthal_matrix, quad_char_is_sym_of' h i j]

lemma is_skewsym_of (h : q ≡ 3 [MOD 4]) :
(Jacobsthal_matrix F).is_skewsym :=
by ext; simp [Jacobsthal_matrix, quad_char_is_skewsym_of' h i j]

lemma is_skesym_of' (h : q ≡ 3 [MOD 4]) :
(Jacobsthal_matrix F)ᵀ = - (Jacobsthal_matrix F) :=
begin
  have := Jacobsthal_matrix.is_skewsym_of h,
  unfold matrix.is_skewsym at this,
  nth_rewrite 1 [← this],
  simp,
end

end Jacobsthal_matrix
/- ## end Jacobsthal_matrix -/

open Jacobsthal_matrix

/- ## Paley_constr_1 -/

variable (F)
def Paley_constr_1 : matrix (unit ⊕ F) (unit ⊕ F) ℚ :=
(1 : matrix unit unit ℚ).from_blocks (- row 1) (col 1) (1 + (Jacobsthal_matrix F))

@[simp] def Paley_constr_1'_aux : matrix (unit ⊕ F) (unit ⊕ F) ℚ :=
(0 : matrix unit unit ℚ).from_blocks (- row 1) (col 1) (Jacobsthal_matrix F)

def Paley_constr_1' := 1 + (Paley_constr_1'_aux F)

lemma Paley_constr_1'_eq_Paley_constr_1 :
Paley_constr_1' F = Paley_constr_1 F :=
begin
  simp only [Paley_constr_1', Paley_constr_1'_aux, Paley_constr_1, ←from_blocks_one, from_blocks_add],
  simp,
end

variable {F}

/-- if `q ≡ 3 [MOD 4]`, `Paley_constr_1 F` is a Hadamard matrix. -/
@[instance]
theorem Hadamard_matrix.Paley_constr_1 (h : q ≡ 3 [MOD 4]):
Hadamard_matrix (Paley_constr_1 F) :=
begin
  obtain ⟨p, inst⟩ := char_p.exists F, -- derive the char p of F
  resetI, -- resets the instance cache
  obtain ⟨hp, h'⟩ := char_ne_two_of' p h, -- prove p ≠ 2
  refine {..},
  -- first goal
  {
    rintros (i | i)  (j | j),
    all_goals {simp [Paley_constr_1, one_apply, Jacobsthal_matrix]},
    {by_cases i = j; simp*}
  },
  -- second goal
  rw ←mul_tranpose_is_diagonal_iff_has_orthogonal_rows,   -- changes the goal to prove J ⬝ Jᵀ is diagonal
  simp [Paley_constr_1, from_blocks_transpose, from_blocks_multiply,
        matrix.add_mul, matrix.mul_add, col_one_mul_row_one],
  rw [mul_col_one hp, row_one_mul_transpose hp, mul_transpose_self hp],
  simp,
  convert is_diagnoal_of_block_conditions ⟨is_diagonal_of_unit _, _, rfl, rfl⟩,
  -- to show the lower right corner block is diagonal
  {rw [is_skesym_of' h, add_assoc, add_comm, add_assoc], simp},
  any_goals {assumption},
end

open Hadamard_matrix

/-- if `q ≡ 3 [MOD 4]`, `Paley_constr_1 F` is a skew Hadamard matrix. -/
theorem Hadamard_matrix.Paley_constr_1_is_skew (h : q ≡ 3 [MOD 4]):
@is_skew _ _ (Paley_constr_1 F) (Hadamard_matrix.Paley_constr_1 h) _ :=
begin
  simp [is_skew, Paley_constr_1, from_blocks_transpose,
        from_blocks_add, is_skesym_of' h],
  have : 1 + -Jacobsthal_matrix F + (1 + Jacobsthal_matrix F) = 1 + 1,
  {noncomm_ring},
  rw [this], clear this,
  ext (a | i) (b | j),
  swap 3, rintro (b | j),
  any_goals {simp [one_apply, from_blocks, bit0]},
end

/- ## end Paley_constr_1 -/

/- ## Paley_constr_2 -/

/- # Paley_constr_2_helper -/
namespace Paley_constr_2

variable (F)

def C : matrix (unit ⊕ unit) (unit ⊕ unit) ℚ :=
(1 : matrix unit unit ℚ).from_blocks (-1) (-1) (-1)

/-- C is symmetric. -/
@[simp] lemma C_is_sym : C.is_sym :=
is_sym_of_block_conditions ⟨by simp, by simp, by simp⟩

def D : matrix (unit ⊕ unit) (unit ⊕ unit) ℚ :=
(1 : matrix unit unit ℚ).from_blocks 1 1 (-1)

/-- D is symmetric. -/
@[simp] lemma D_is_sym : D.is_sym :=
is_sym_of_block_conditions ⟨by simp, by simp, by simp⟩

/-- C ⬝ D = - D ⬝ C -/
lemma C_mul_D_anticomm : C ⬝ D = - D ⬝ C :=
begin
  ext (i | i) (j | j),
  swap 3, rintros (j | j),
  any_goals {simp [from_blocks_multiply, C, D]}
end

def E : matrix (unit ⊕ unit) (unit ⊕ unit) ℚ :=
(2 : matrix unit unit ℚ).from_blocks 0 0 2

/-- E is diagonal. -/
@[simp] lemma E_is_diagonal : E.is_diagonal :=
is_diagnoal_of_block_conditions ⟨by simp, by simp, rfl, rfl⟩

/-- C ⬝ C = E -/
@[simp] lemma C_mul_self : C ⬝ C = E :=
by simp [from_blocks_transpose, from_blocks_multiply, E, C]; congr' 1

/-- C ⬝ Cᵀ = E -/
@[simp] lemma C_mul_transpose_self : C ⬝ Cᵀ = E :=
by simp [C_is_sym.eq]

/-- D ⬝ D = E -/
@[simp] lemma D_mul_self : D ⬝ D = E :=
by simp [from_blocks_transpose, from_blocks_multiply, E, D]; congr' 1

/-- D ⬝ Dᵀ = E -/
@[simp] lemma D_mul_transpose_self : D ⬝ Dᵀ = E :=
by simp [D_is_sym.eq]

def replace (A : matrix I J ℚ) :
matrix (I × (unit ⊕ unit)) (J × (unit ⊕ unit)) ℚ :=
λ ⟨i, a⟩ ⟨j, b⟩,
if (A i j = 0)
then C a b
else (A i j) • D a b

variable (F)

/-- `(replace A)ᵀ = replace (Aᵀ)` -/
lemma transpose_replace (A : matrix I J ℚ) :
(replace A)ᵀ = replace (Aᵀ) :=
begin
  ext ⟨i, a⟩ ⟨j, b⟩,
  simp [transpose_apply, replace],
  congr' 1,
  {rw [C_is_sym.apply']},
  {rw [D_is_sym.apply']},
end

variable (F)

/-- `replace A` is a symmetric matrix if `A` is. -/
lemma replace_is_sym_of {A : matrix I I ℚ} (h : A.is_sym) :
(replace A).is_sym:=
begin
  ext ⟨i, a⟩ ⟨j, b⟩,
  simp [transpose_replace, replace, h.apply', C_is_sym.apply', D_is_sym.apply']
end

/-- `replace 0 = I ⊗ C` -/
lemma replace_zero :
replace (0 : matrix unit unit ℚ) = 1 ⊗ C :=
begin
  ext ⟨a, b⟩ ⟨c, d⟩,
  simp [replace, Kronecker, one_apply]
end

/-- `replace A = A ⊗ D` for a matrix `A` with no `0` entries. -/
lemma replace_matrix_of_no_zero_entry
{A : matrix I J ℚ} (h : ∀ i j, A i j ≠ 0) : replace A = A ⊗ D :=
begin
  ext ⟨i, a⟩ ⟨j, b⟩,
  simp [replace, Kronecker],
  intro g,
  exact absurd g (h i j)
end

/-- In particular, we can apply `replace_matrix_of_no_zero_entry` to `- row 1`. -/
lemma replace_neg_row_one :
replace (-row 1 : matrix unit F ℚ) = (-row 1) ⊗ D :=
replace_matrix_of_no_zero_entry (λ a i, by simp [row])

/-- `replace J = J ⊗ D + I ⊗ C` -/
lemma replace_Jacobsthal :
replace (Jacobsthal_matrix F) =
(Jacobsthal_matrix F) ⊗ D + 1 ⊗ C:=
begin
  ext ⟨i, a⟩ ⟨j, b⟩,
  by_cases i = j, --inspect the diagonal and non-diagonal entries respectively
  any_goals {simp [h, Jacobsthal_matrix, replace, Kronecker]},
end

/-- `(replace 0) ⬝ (replace 0)ᵀ= I ⊗ E` -/
@[simp] lemma replace_zero_mul_transpose_self :
replace (0 : matrix unit unit ℚ) ⬝ (replace (0 : matrix unit unit ℚ))ᵀ = 1 ⊗ E :=
by simp [replace_zero, transpose_K, K_mul]

/-- `(replace A) ⬝ (replace A)ᵀ = (A ⬝ Aᵀ) ⊗ E` -/
@[simp] lemma replace_matrix_of_no_zero_entry_mul_transpose_self
{A : matrix I J ℚ} (h : ∀ i j, A i j ≠ 0) :
(replace A) ⬝ (replace A)ᵀ = (A ⬝ Aᵀ) ⊗ E :=
by simp [replace_matrix_of_no_zero_entry h, transpose_K, K_mul]

variable {F}

lemma replace_Jacobsthal_mul_transpose_self' (h : q ≡ 1 [MOD 4]) :
replace (Jacobsthal_matrix F) ⬝ (replace (Jacobsthal_matrix F))ᵀ =
((Jacobsthal_matrix F) ⬝ (Jacobsthal_matrix F)ᵀ + 1) ⊗ E :=
begin
  simp [transpose_replace, (is_sym_of h).eq],
  simp [replace_Jacobsthal, matrix.add_mul, matrix.mul_add,
        K_mul, C_mul_D_anticomm, add_K],
  noncomm_ring
end

/-- enclose `replace_Jacobsthal_mul_transpose_self'` by replacing `J ⬝ Jᵀ` with `qI − 𝟙` -/
@[simp]lemma replace_Jacobsthal_mul_transpose_self (h : q ≡ 1 [MOD 4]) :
replace (Jacobsthal_matrix F) ⬝ (replace (Jacobsthal_matrix F))ᵀ =
(((q : ℚ) + 1) • (1 : matrix F F ℚ) - 𝟙) ⊗ E :=
begin
  obtain ⟨p, inst⟩ := char_p.exists F, -- obtains the character p of F
  resetI, -- resets the instance cache
  obtain hp := char_ne_two_of p (or.inl h),  -- hp: p ≠ 2
  simp [replace_Jacobsthal_mul_transpose_self' h, add_smul],
  rw [mul_transpose_self hp],
  congr' 1, noncomm_ring,
  assumption
end

end Paley_constr_2
/- # end Paley_constr_2_helper -/

open Paley_constr_2

variable (F)
def Paley_constr_2 :=
(replace (0 : matrix unit unit ℚ)).from_blocks
(replace (- row 1))
(replace (- col 1))
(replace (Jacobsthal_matrix F))

variable {F}
/-- `Paley_constr_2 F` is a symmetric matrix when `card F ≡ 1 [MOD 4]`. -/
@[simp]
lemma Paley_constr_2_is_sym (h : q ≡ 1 [MOD 4]) :
(Paley_constr_2 F).is_sym :=
begin
  convert is_sym_of_block_conditions ⟨_, _, _⟩,
  { simp [replace_zero] }, -- `0` is symmetric
  { apply replace_is_sym_of (is_sym_of h) }, -- `J` is symmetric
  { simp [transpose_replace] } -- `(replace (-row 1))ᵀ = replace (-col 1)`
end

variable (F)
/-- Every entry of `Paley_constr_2 F` equals `1` or `-1`. -/
lemma Paley_constr_2.one_or_neg_one :
∀ (i j : unit × (unit ⊕ unit) ⊕ F × (unit ⊕ unit)),
Paley_constr_2 F i j = 1 ∨ Paley_constr_2 F i j = -1 :=
begin
  rintros (⟨a, (u₁|u₂)⟩ | ⟨i, (u₁ | u₂)⟩) (⟨b, (u₃|u₄)⟩ | ⟨j, (u₃ | u₄)⟩),
  all_goals {simp [Paley_constr_2, one_apply, Jacobsthal_matrix, replace, C, D]},
  all_goals {by_cases i = j},
  any_goals {simp [h]},
end

variable {F}

@[instance]
theorem Hadamard_matrix.Paley_constr_2 (h : q ≡ 1 [MOD 4]):
Hadamard_matrix (Paley_constr_2 F) :=
begin
  refine {..},
  -- the first goal
  { exact Paley_constr_2.one_or_neg_one F },
  -- the second goal
  -- turns the goal to `Paley_constr_2 F ⬝ (Paley_constr_2 F)ᵀ` is diagonal
  rw ←mul_tranpose_is_diagonal_iff_has_orthogonal_rows,
  -- sym : `Paley_constr_2 F ⬝ (Paley_constr_2 F)ᵀ` is symmetric
  have sym := mul_transpose_self_is_sym (Paley_constr_2 F),
  -- The next `simp` turns `Paley_constr_2 F ⬝ (Paley_constr_2 F)ᵀ` into a block form.
  simp [Paley_constr_2, from_blocks_transpose, from_blocks_multiply] at *,
  convert is_diagnoal_of_sym_block_conditions sym ⟨_, _, _⟩, -- splits into the three goals
  any_goals {clear sym},
  -- to prove the upper left corner block is diagonal.
  { simp [row_one_mul_col_one, ← add_K],
    apply K_is_diagonal_of; simp },
  -- to prove the lower right corner block is diagonal.
  { simp [h, col_one_mul_row_one, ← add_K],
    apply smul_is_diagonal_of,
    apply K_is_diagonal_of; simp },
  -- to prove the upper right corner block is `0`.
  { obtain ⟨p, inst⟩ := char_p.exists F, -- obtains the character p of F
    resetI, -- resets the instance cache
    obtain hp := char_ne_two_of p (or.inl h), -- hp: p ≠ 2
    simp [transpose_replace, (is_sym_of h).eq],
    simp [replace_zero, replace_neg_row_one, replace_Jacobsthal,
          matrix.mul_add, K_mul, C_mul_D_anticomm],
    rw [←(is_sym_of h).eq, row_one_mul_transpose hp],
    simp, assumption }
end

/- ## end Paley_constr_2 -/
end Paley_construction
/- ## end Paley construction -/

/- ## order 92-/
section order_92
/-
namespace H_92

def a : fin 23 → ℚ :=
![ 1,  1, -1, -1, -1,  1, -1, -1, -1,  1, -1,  1,  1, -1,  1, -1, -1, -1,  1, -1, -1, -1,  1]
def b : fin 23 → ℚ :=
![ 1, -1,  1,  1, -1,  1,  1, -1, -1,  1,  1,  1,  1,  1,  1, -1, -1,  1,  1, -1,  1,  1, -1]
def c : fin 23 → ℚ :=
![ 1,  1,  1, -1, -1, -1,  1,  1, -1,  1, -1,  1,  1, -1,  1, -1,  1,  1, -1, -1, -1,  1,  1]
def d : fin 23 → ℚ :=
![ 1,  1,  1, -1,  1,  1,  1, -1,  1, -1, -1, -1, -1, -1, -1,  1, -1,  1,  1,  1, -1,  1,  1]

abbreviation A := cir a
abbreviation B := cir b
abbreviation C := cir c
abbreviation D := cir d

@[simp] lemma a.one_or_neg_one : ∀ i, a i ∈ ({1, -1} : set ℚ) :=
λ i, begin simp, dec_trivial! end -- `dec_trivial!` inspects every entry
@[simp] lemma b.one_or_neg_one : ∀ i, b i ∈ ({1, -1} : set ℚ) :=
λ i, begin simp, dec_trivial! end
@[simp] lemma c.one_or_neg_one : ∀ i, c i ∈ ({1, -1} : set ℚ) :=
λ i, begin simp, dec_trivial! end
@[simp] lemma d.one_or_neg_one : ∀ i, d i ∈ ({1, -1} : set ℚ) :=
λ i, begin simp, dec_trivial! end

@[simp] lemma A.one_or_neg_one : ∀ i j, A i j = 1 ∨ A i j = -1 :=
by convert cir_entry_in_of_vec_entry_in a.one_or_neg_one
@[simp] lemma A.neg_one_or_one : ∀ i j, A i j = -1 ∨ A i j = 1 :=
λ i j, (A.one_or_neg_one i j).swap
@[simp] lemma B.one_or_neg_one : ∀ i j, B i j = 1 ∨ B i j = -1 :=
by convert cir_entry_in_of_vec_entry_in b.one_or_neg_one
@[simp] lemma B.neg_one_or_one : ∀ i j, B i j = -1 ∨ B i j = 1 :=
λ i j, (B.one_or_neg_one i j).swap
@[simp] lemma C.one_or_neg_one : ∀ i j, C i j = 1 ∨ C i j = -1 :=
by convert cir_entry_in_of_vec_entry_in c.one_or_neg_one
@[simp] lemma C.neg_one_or_one : ∀ i j, C i j = -1 ∨ C i j = 1 :=
λ i j, (C.one_or_neg_one i j).swap
@[simp] lemma D.one_or_neg_one : ∀ i j, D i j = 1 ∨ D i j = -1 :=
by convert cir_entry_in_of_vec_entry_in d.one_or_neg_one
@[simp] lemma D.neg_one_or_one : ∀ i j, D i j = -1 ∨ D i j = 1 :=
λ i j, (D.one_or_neg_one i j).swap

@[simp] lemma a_is_sym : ∀ (i : fin 23), a (-i) = a i := by dec_trivial

@[simp] lemma a_is_sym' : ∀ (i : fin 23),
![(1 : ℚ), 1, -1, -1, -1,  1, -1, -1, -1,  1, -1,  1,  1, -1,  1, -1, -1, -1,  1, -1, -1, -1,  1] (-i) =
![(1 : ℚ), 1, -1, -1, -1,  1, -1, -1, -1,  1, -1,  1,  1, -1,  1, -1, -1, -1,  1, -1, -1, -1,  1]   i :=
by convert a_is_sym

@[simp] lemma b_is_sym : ∀ (i : fin 23), b (-i) = b i := by dec_trivial

@[simp] lemma b_is_sym' : ∀ (i : fin 23),
![(1 : ℚ), -1,  1,  1, -1,  1,  1, -1, -1,  1,  1,  1,  1,  1,  1, -1, -1,  1,  1, -1,  1,  1, -1] (-i) =
![(1 : ℚ), -1,  1,  1, -1,  1,  1, -1, -1,  1,  1,  1,  1,  1,  1, -1, -1,  1,  1, -1,  1,  1, -1]   i :=
by convert b_is_sym

@[simp] lemma c_is_sym : ∀ (i : fin 23), c (-i) = c i := by dec_trivial

@[simp] lemma c_is_sym' : ∀ (i : fin 23),
![ (1 : ℚ), 1,  1, -1, -1, -1,  1,  1, -1,  1, -1,  1,  1, -1,  1, -1,  1,  1, -1, -1, -1,  1,  1] (-i) =
![ (1 : ℚ), 1,  1, -1, -1, -1,  1,  1, -1,  1, -1,  1,  1, -1,  1, -1,  1,  1, -1, -1, -1,  1,  1]   i :=
by convert c_is_sym

@[simp] lemma d_is_sym : ∀ (i : fin 23), d (-i) = d i := by dec_trivial

@[simp] lemma d_is_sym' : ∀ (i : fin 23),
![ (1 : ℚ), 1,  1, -1,  1,  1,  1, -1,  1, -1, -1, -1, -1, -1, -1,  1, -1,  1,  1,  1, -1,  1,  1] (-i) =
![ (1 : ℚ), 1,  1, -1,  1,  1,  1, -1,  1, -1, -1, -1, -1, -1, -1,  1, -1,  1,  1,  1, -1,  1,  1]   i :=
by convert d_is_sym

@[simp] lemma A_is_sym : Aᵀ = A :=
by rw [←is_sym, cir_is_sym_ext_iff]; exact a_is_sym
@[simp] lemma B_is_sym : Bᵀ = B :=
by rw [←is_sym, cir_is_sym_ext_iff]; exact b_is_sym
@[simp] lemma C_is_sym : Cᵀ = C :=
by rw [←is_sym, cir_is_sym_ext_iff]; exact c_is_sym
@[simp] lemma D_is_sym : Dᵀ = D :=
by rw [←is_sym, cir_is_sym_ext_iff]; exact d_is_sym

def i : matrix (fin 4) (fin 4) ℚ :=
![![0, 1, 0, 0],
  ![-1, 0, 0, 0],
  ![0, 0, 0, -1],
  ![0, 0, 1, 0]]

def j : matrix (fin 4) (fin 4) ℚ :=
![![0, 0, 1, 0],
  ![0, 0, 0, 1],
  ![-1, 0, 0, 0],
  ![0, -1, 0, 0]]

def k: matrix (fin 4) (fin 4) ℚ :=
![![0, 0, 0, 1],
  ![0, 0, -1, 0],
  ![0, 1, 0, 0],
  ![-1, 0, 0, 0]]

@[simp] lemma i_is_skewsym : iᵀ = - i := by dec_trivial
@[simp] lemma j_is_skewsym : jᵀ = - j := by dec_trivial
@[simp] lemma k_is_skewsym : kᵀ = - k := by dec_trivial

@[simp] lemma i_mul_i : (i ⬝ i) = -1 := by simp [i]; dec_trivial
@[simp] lemma j_mul_j : (j ⬝ j) = -1 := by simp [j]; dec_trivial
@[simp] lemma k_mul_k : (k ⬝ k) = -1 := by simp [k]; dec_trivial
@[simp] lemma i_mul_j : (i ⬝ j) = k := by simp [i, j, k]; dec_trivial
@[simp] lemma i_mul_k : (i ⬝ k) = -j := by simp [i, j, k]; dec_trivial
@[simp] lemma j_mul_i : (j ⬝ i) = -k := by simp [i, j, k]; dec_trivial
@[simp] lemma k_mul_i : (k ⬝ i) = j := by simp [i, j, k]; dec_trivial
@[simp] lemma j_mul_k : (j ⬝ k) = i := by simp [i, j, k]; dec_trivial
@[simp] lemma k_mul_j : (k ⬝ j) = -i := by simp [i, j, k]; dec_trivial

/-- `fin_23_shift` normalizes `λ (j : fin 23), f (s j)` in `![]` form,
    where `s : fin 23 → fin 23` is a function shifting indices. -/
lemma fin_23_shift (f : fin 23 → ℚ) (s : fin 23 → fin 23) :
(λ (j : fin 23), f (s j)) =
![f (s 0), f (s 1), f (s 2), f (s 3), f (s 4), f (s 5), f (s 6), f (s 7),
  f (s 8), f (s 9), f (s 10), f (s 11), f (s 12), f (s 13), f (s 14), f (s 15),
  f (s 16), f (s 17), f (s 18), f (s 19), f (s 20), f (s 21), f (s 22)] :=
by {ext i, fin_cases i, any_goals {simp},}

@[simp] lemma eq_aux₀:
dot_product (λ (j : fin 23), a (0 - j)) a +
dot_product (λ (j : fin 23), b (0 - j)) b +
dot_product (λ (j : fin 23), c (0 - j)) c +
dot_product (λ (j : fin 23), d (0 - j)) d = 92 :=
by {unfold a b c d, norm_num}

@[simp] lemma eq_aux₁:
dot_product (λ (j : fin 23), a (1 - j)) a +
dot_product (λ (j : fin 23), b (1 - j)) b +
dot_product (λ (j : fin 23), c (1 - j)) c +
dot_product (λ (j : fin 23), d (1 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₂:
dot_product (λ (j : fin 23), a (2 - j)) a +
dot_product (λ (j : fin 23), b (2 - j)) b +
dot_product (λ (j : fin 23), c (2 - j)) c +
dot_product (λ (j : fin 23), d (2 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₃:
dot_product (λ (j : fin 23), a (3 - j)) a +
dot_product (λ (j : fin 23), b (3 - j)) b +
dot_product (λ (j : fin 23), c (3 - j)) c +
dot_product (λ (j : fin 23), d (3 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₄:
dot_product (λ (j : fin 23), a (4 - j)) a +
dot_product (λ (j : fin 23), b (4 - j)) b +
dot_product (λ (j : fin 23), c (4 - j)) c +
dot_product (λ (j : fin 23), d (4 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₅:
dot_product (λ (j : fin 23), a (5 - j)) a +
dot_product (λ (j : fin 23), b (5 - j)) b +
dot_product (λ (j : fin 23), c (5 - j)) c +
dot_product (λ (j : fin 23), d (5 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₆:
dot_product (λ (j : fin 23), a (6 - j)) a +
dot_product (λ (j : fin 23), b (6 - j)) b +
dot_product (λ (j : fin 23), c (6 - j)) c +
dot_product (λ (j : fin 23), d (6 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₇:
dot_product (λ (j : fin 23), a (7 - j)) a +
dot_product (λ (j : fin 23), b (7 - j)) b +
dot_product (λ (j : fin 23), c (7 - j)) c +
dot_product (λ (j : fin 23), d (7 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₈:
dot_product (λ (j : fin 23), a (8 - j)) a +
dot_product (λ (j : fin 23), b (8 - j)) b +
dot_product (λ (j : fin 23), c (8 - j)) c +
dot_product (λ (j : fin 23), d (8 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₉:
dot_product (λ (j : fin 23), a (9 - j)) a +
dot_product (λ (j : fin 23), b (9 - j)) b +
dot_product (λ (j : fin 23), c (9 - j)) c +
dot_product (λ (j : fin 23), d (9 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₀:
dot_product (λ (j : fin 23), a (10 - j)) a +
dot_product (λ (j : fin 23), b (10 - j)) b +
dot_product (λ (j : fin 23), c (10 - j)) c +
dot_product (λ (j : fin 23), d (10 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₁:
dot_product (λ (j : fin 23), a (11 - j)) a +
dot_product (λ (j : fin 23), b (11 - j)) b +
dot_product (λ (j : fin 23), c (11 - j)) c +
dot_product (λ (j : fin 23), d (11 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₂:
dot_product (λ (j : fin 23), a (12 - j)) a +
dot_product (λ (j : fin 23), b (12 - j)) b +
dot_product (λ (j : fin 23), c (12 - j)) c +
dot_product (λ (j : fin 23), d (12 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₃:
dot_product (λ (j : fin 23), a (13 - j)) a +
dot_product (λ (j : fin 23), b (13 - j)) b +
dot_product (λ (j : fin 23), c (13 - j)) c +
dot_product (λ (j : fin 23), d (13 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₄:
dot_product (λ (j : fin 23), a (14 - j)) a +
dot_product (λ (j : fin 23), b (14 - j)) b +
dot_product (λ (j : fin 23), c (14 - j)) c +
dot_product (λ (j : fin 23), d (14 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₅:
dot_product (λ (j : fin 23), a (15 - j)) a +
dot_product (λ (j : fin 23), b (15 - j)) b +
dot_product (λ (j : fin 23), c (15 - j)) c +
dot_product (λ (j : fin 23), d (15 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₆:
dot_product (λ (j : fin 23), a (16 - j)) a +
dot_product (λ (j : fin 23), b (16 - j)) b +
dot_product (λ (j : fin 23), c (16 - j)) c +
dot_product (λ (j : fin 23), d (16 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₇:
dot_product (λ (j : fin 23), a (17 - j)) a +
dot_product (λ (j : fin 23), b (17 - j)) b +
dot_product (λ (j : fin 23), c (17 - j)) c +
dot_product (λ (j : fin 23), d (17 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₈:
dot_product (λ (j : fin 23), a (18 - j)) a +
dot_product (λ (j : fin 23), b (18 - j)) b +
dot_product (λ (j : fin 23), c (18 - j)) c +
dot_product (λ (j : fin 23), d (18 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₁₉:
dot_product (λ (j : fin 23), a (19 - j)) a +
dot_product (λ (j : fin 23), b (19 - j)) b +
dot_product (λ (j : fin 23), c (19 - j)) c +
dot_product (λ (j : fin 23), d (19 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₂₀:
dot_product (λ (j : fin 23), a (20 - j)) a +
dot_product (λ (j : fin 23), b (20 - j)) b +
dot_product (λ (j : fin 23), c (20 - j)) c +
dot_product (λ (j : fin 23), d (20 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₂₁:
dot_product (λ (j : fin 23), a (21 - j)) a +
dot_product (λ (j : fin 23), b (21 - j)) b +
dot_product (λ (j : fin 23), c (21 - j)) c +
dot_product (λ (j : fin 23), d (21 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

@[simp] lemma eq_aux₂₂:
dot_product (λ (j : fin 23), a (22 - j)) a +
dot_product (λ (j : fin 23), b (22 - j)) b +
dot_product (λ (j : fin 23), c (22 - j)) c +
dot_product (λ (j : fin 23), d (22 - j)) d = 0 :=
by {simp only [fin_23_shift, a, b ,c ,d], norm_num}

lemma equality :
A ⬝ A + B ⬝ B + C ⬝ C + D ⬝ D = (92 : ℚ) • (1 : matrix (fin 23) (fin 23) ℚ) :=
begin
  -- the first `simp` transfers the equation to the form `cir .. = cir ..`
  simp [cir_mul, cir_add, one_eq_cir, smul_cir],
  -- we then show the two `cir`s consume equal arguments
  congr' 1,
  -- to show the two vectors are equal
  ext i,
  simp [mul_vec, cir],
  -- ask lean to inspect the 23 pairs entries one by one
  fin_cases i,
  exact eq_aux₀,
  exact eq_aux₁,
  exact eq_aux₂,
  exact eq_aux₃,
  exact eq_aux₄,
  exact eq_aux₅,
  exact eq_aux₆,
  exact eq_aux₇,
  exact eq_aux₈,
  exact eq_aux₉,
  exact eq_aux₁₀,
  exact eq_aux₁₁,
  exact eq_aux₁₂,
  exact eq_aux₁₃,
  exact eq_aux₁₄,
  exact eq_aux₁₅,
  exact eq_aux₁₆,
  exact eq_aux₁₇,
  exact eq_aux₁₈,
  exact eq_aux₁₉,
  exact eq_aux₂₀,
  exact eq_aux₂₁,
  exact eq_aux₂₂,
end
end H_92

open H_92

def H_92 := A ⊗ 1 + B ⊗ i + C ⊗ j + D ⊗ k

/-- Poves every entry of `H_92` is `1` or `-1`. -/
lemma H_92.one_or_neg_one : ∀ i j, (H_92 i j) = 1 ∨ (H_92 i j) = -1 :=
begin
  rintros ⟨c, a⟩ ⟨d, b⟩,
  simp [H_92, Kronecker],
  fin_cases a,
  any_goals {fin_cases b},
  any_goals {norm_num [one_apply, i, j, k]},
end

/-- Proves `H_92 ⬝ H_92ᵀ` is a diagonal matrix. -/
lemma H_92_mul_transpose_self_is_diagonal : (H_92 ⬝ H_92ᵀ).is_diagonal :=
begin
  simp [H_92, transpose_K, matrix.mul_add, matrix.add_mul, K_mul,
  cir_mul_comm _ a, cir_mul_comm c b, cir_mul_comm d b, cir_mul_comm d c],
  have :
  (cir a ⬝ cir a)⊗1 + -(cir a ⬝ cir b)⊗i + -(cir a ⬝ cir c)⊗j + -(cir a ⬝ cir d)⊗k +
  ((cir a ⬝ cir b)⊗i + (cir b ⬝ cir b)⊗1 + -(cir b ⬝ cir c)⊗k + (cir b ⬝ cir d)⊗j) +
  ((cir a ⬝ cir c)⊗j + (cir b ⬝ cir c)⊗k + (cir c ⬝ cir c)⊗1 + -(cir c ⬝ cir d)⊗i) +
  ((cir a ⬝ cir d)⊗k + -(cir b ⬝ cir d)⊗j + (cir c ⬝ cir d)⊗i + (cir d ⬝ cir d)⊗1) =
  (cir a ⬝ cir a)⊗1 + (cir b ⬝ cir b)⊗1 + (cir c ⬝ cir c)⊗1 + (cir d ⬝ cir d)⊗1 :=
  by abel,
  rw this, clear this,
  simp [←add_K, equality], -- uses `equality`
end

@[instance]
theorem Hadamard_matrix.H_92 : Hadamard_matrix H_92 :=
⟨H_92.one_or_neg_one, mul_tranpose_is_diagonal_iff_has_orthogonal_rows.1 H_92_mul_transpose_self_is_diagonal⟩
-/
end order_92
/- ## end order 92-/

/- ## order -/
section order
open matrix Hadamard_matrix

theorem Hadamard_matrix.order_constraint
[decidable_eq I] (H : matrix I I ℚ) [Hadamard_matrix H]
: card I ≥ 3 →  4 ∣ card I :=
begin
  intros h, -- h: card I ≥ 3
  -- pick three distinct rows i₁, i₂, i₃
  obtain ⟨i₁, i₂, i₃, ⟨h₁₂, h₁₃, h₂₃⟩⟩:= pick_elements h,
  -- the cardinalities of J₁, J₂, J₃, J₄ are denoted as i, j, k, l in the proof in words
  set J₁ := {j : I | H i₁ j = H i₂ j ∧ H i₂ j = H i₃ j},
  set J₂ := {j : I | H i₁ j = H i₂ j ∧ H i₂ j ≠ H i₃ j},
  set J₃ := {j : I | H i₁ j ≠ H i₂ j ∧ H i₁ j = H i₃ j},
  set J₄ := {j : I | H i₁ j ≠ H i₂ j ∧ H i₂ j = H i₃ j},
  -- dₘₙ proves Jₘ Jₙ are disjoint
  have d₁₂: disjoint J₁ J₂,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros, linarith},
  have d₁₃: disjoint J₁ J₃,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros a b c d, exact c a},
  have d₁₄: disjoint J₁ J₄,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros a b c d, exact c a},
  have d₂₃: disjoint J₂ J₃,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros a b c d, exact c a},
  have d₂₄: disjoint J₂ J₄,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros a b c d, exact c a},
  have d₃₄: disjoint J₃ J₄,
  {simp [set.disjoint_iff_inter_eq_empty], ext, simp, intros a b c d,
  have : H i₁ x = H i₂ x, {linarith}, exact c this},
  -- u₁₂ proves J₁ ∪ J₂ = matched H i₁ i₂
  have u₁₂: J₁.union J₂ = matched H i₁ i₂,
  {ext, simp [J₁, J₂, matched, set.union], tauto},
  -- u₁₃ proves J₁ ∪ J₃ = matched H i₁ i₃
  have u₁₃: J₁.union J₃ = matched H i₁ i₃,
  {ext, simp [J₁, J₃, matched, set.union], by_cases g : H i₁ x = H i₂ x; simp [g]},
  -- u₁₄ proves J₁ ∪ J₄ = matched H i₂ i₃
  have u₁₄: J₁.union J₄ = matched H i₂ i₃,
  {ext, simp [J₁, J₄, matched, set.union], tauto},
  -- u₂₃ proves J₂ ∪ J₃ = mismatched H i₂ i₃
  have u₂₃: J₂.union J₃ = mismatched H i₂ i₃,
  { ext, simp [J₂, J₃, mismatched, set.union],
    by_cases g₁ : H i₂ x = H i₃ x; simp [g₁],
    by_cases g₂ : H i₁ x = H i₂ x; simp [g₁, g₂],
    exact entry_eq_entry_of (ne.symm g₂) g₁ },
  -- u₂₄ proves J₂ ∪ J₄ = mismatched H i₂ i₄
  have u₂₄: J₂.union J₄ = mismatched H i₁ i₃,
  { ext, simp [J₂, J₄, mismatched, set.union],
    by_cases g₁ : H i₁ x = H i₂ x; simp [g₁],
    split, {rintros g₂ g₃, exact g₁ (g₃.trans g₂.symm)},
    intros g₂,
    exact entry_eq_entry_of g₁ g₂ },
 -- u₃₄ proves J₃ ∪ J₄ = mismatched H i₁ i₂
  have u₃₄: J₃.union J₄ = mismatched H i₁ i₂,
  { ext, simp [J₃, J₄, matched, set.union],
    split; try {tauto},
    intros g₁,
    by_cases g₂ : H i₁ x = H i₃ x,
    { left, exact ⟨g₁, g₂⟩ },
    { right, exact ⟨g₁, entry_eq_entry_of g₁ g₂⟩ } },
  -- eq₁: |H.matched i₁ i₂| = |H.mismatched i₁ i₂|
  have eq₁ := card_match_eq_card_mismatch H h₁₂,
  -- eq₂: |H.matched i₁ i₃| = |H.mismatched i₁ i₃|
  have eq₂ := card_match_eq_card_mismatch H h₁₃,
  -- eq₃: |H.matched i₂ i₃| = |H.mismatched i₂ i₃|
  have eq₃ := card_match_eq_card_mismatch H h₂₃,
  -- eq : |I| = |H.matched i₁ i₂| + |H.mismatched i₁ i₂|
  have eq := card_match_add_card_mismatch H i₁ i₂,
  -- rewrite eq to |I| = |J₁| + |J₂| + |J₃| + |J₄|, and
  -- rewrite eq₁ to |J₁| + |J₂| = |J₃| + |J₄|
  rw [set.card_disjoint_union' d₁₂ u₁₂, set.card_disjoint_union' d₃₄ u₃₄] at eq₁ eq,
  -- rewrite eq₂ to |J₁| + |J₃| = |J₂| + |J₄|
  rw [set.card_disjoint_union' d₁₃ u₁₃, set.card_disjoint_union' d₂₄ u₂₄] at eq₂,
  -- rewrite eq₃ to |J₁| + |J₄| = |J₂| + |J₄|
  rw [set.card_disjoint_union' d₁₄ u₁₄, set.card_disjoint_union' d₂₃ u₂₃] at eq₃,
  -- g₂₁, g₃₁, g₄₁ prove that |J₁| = |J₂| = |J₃| = |J₄|
  have g₂₁ : J₂.card = J₁.card, {linarith},
  have g₃₁ : J₃.card = J₁.card, {linarith},
  have g₄₁ : J₄.card = J₁.card, {linarith},
  -- rewrite eq to |I| = |J₁| + |J₁| + |J₁| + |J₁|
  rw [g₂₁, g₃₁, g₄₁, set.univ_card_eq_fintype_card] at eq,
  use J₁.card,
  simp [eq], noncomm_ring,
end

theorem Hadamard_matrix.Hadamard_conjecture:
∀ k : ℕ, ∃ (I : Type*) [fintype I],
by exactI ∃ (H : matrix I I ℚ) [Hadamard_matrix H],
card I = 4 * k :=
sorry -- Here, `sorry` means if you ask me to prove this conjecture,
      -- then I have to apologize.

end order
/- ## end order -/

end Hadamard_matrix
/- ## end Hadamard_matrix  -/

end matrix
----------------------------------------------- end of file


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

/-!
# Equivariant homomorphisms

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

## Main definitions

* `mul_action_hom M X Y`, the type of equivariant functions from `X` to `Y`, where `M` is a monoid
  that acts on the types `X` and `Y`.
* `distrib_mul_action_hom M A B`, the type of equivariant additive monoid homomorphisms
  from `A` to `B`, where `M` is a monoid that acts on the additive monoids `A` and `B`.
* `mul_semiring_action_hom M R S`, the type of equivariant ring homomorphisms
  from `R` to `S`, where `M` is a monoid that acts on the rings `R` and `S`.

The above types have corresponding classes:
* `smul_hom_class F M X Y` states that `F` is a type of bundled `X → Y` homs
  preserving scalar multiplication by `M`
* `distrib_mul_action_hom_class F M A B` states that `F` is a type of bundled `A → B` homs
  preserving the additive monoid structure and scalar multiplication by `M`
* `mul_semiring_action_hom_class F M R S` states that `F` is a type of bundled `R → S` homs
  preserving the ring structure and scalar multiplication by `M`

## Notations

* `X →[M] Y` is `mul_action_hom M X Y`.
* `A →+[M] B` is `distrib_mul_action_hom M A B`.
* `R →+*[M] S` is `mul_semiring_action_hom M R S`.

-/

assert_not_exists submonoid

variables (M' : Type*)
variables (X : Type*) [has_smul M' X]
variables (Y : Type*) [has_smul M' Y]
variables (Z : Type*) [has_smul M' Z]
variables (M : Type*) [monoid M]
variables (A : Type*) [add_monoid A] [distrib_mul_action M A]
variables (A' : Type*) [add_group A'] [distrib_mul_action M A']
variables (B : Type*) [add_monoid B] [distrib_mul_action M B]
variables (B' : Type*) [add_group B'] [distrib_mul_action M B']
variables (C : Type*) [add_monoid C] [distrib_mul_action M C]
variables (R : Type*) [semiring R] [mul_semiring_action M R]
variables (R' : Type*) [ring R'] [mul_semiring_action M R']
variables (S : Type*) [semiring S] [mul_semiring_action M S]
variables (S' : Type*) [ring S'] [mul_semiring_action M S']
variables (T : Type*) [semiring T] [mul_semiring_action M T]

set_option old_structure_cmd true

/-- Equivariant functions. -/
@[nolint has_nonempty_instance]
structure mul_action_hom :=
(to_fun : X → Y)
(map_smul' : ∀ (m : M') (x : X), to_fun (m • x) = m • to_fun x)

notation (name := mul_action_hom) X ` →[`:25 M:25 `] `:0 Y:0 := mul_action_hom M X Y

/-- `smul_hom_class F M X Y` states that `F` is a type of morphisms preserving
scalar multiplication by `M`.

You should extend this class when you extend `mul_action_hom`. -/
class smul_hom_class (F : Type*) (M X Y : out_param $ Type*) [has_smul M X] [has_smul M Y]
  extends fun_like F X (λ _, Y) :=
(map_smul : ∀ (f : F) (c : M) (x : X), f (c • x) = c • f x)

-- `M` becomes a metavariable but it's an `out_param` so it's not a problem.
attribute [nolint dangerous_instance] smul_hom_class.to_fun_like

export smul_hom_class (map_smul)
attribute [simp] map_smul

namespace mul_action_hom

instance : has_coe_to_fun (X →[M'] Y) (λ _, X → Y) := ⟨mul_action_hom.to_fun⟩

instance : smul_hom_class (X →[M'] Y) M' X Y :=
{ coe := mul_action_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_smul := mul_action_hom.map_smul' }

variables {M M' X Y}

protected lemma map_smul (f : X →[M'] Y) (m : M') (x : X) : f (m • x) = m • f x := map_smul _ _ _
@[ext] theorem ext : ∀ {f g : X →[M'] Y}, (∀ x, f x = g x) → f = g := fun_like.ext
theorem ext_iff {f g : X →[M'] Y} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
protected lemma congr_fun {f g : X →[M'] Y} (h : f = g) (x : X) : f x = g x :=
fun_like.congr_fun h _

variables (M M') {X}

/-- The identity map as an equivariant map. -/
protected def id : X →[M'] X :=
⟨id, λ _ _, rfl⟩

@[simp] lemma id_apply (x : X) : mul_action_hom.id M' x = x := rfl

variables {M M' X Y Z}

/-- Composition of two equivariant maps. -/
def comp (g : Y →[M'] Z) (f : X →[M'] Y) : X →[M'] Z :=
⟨g ∘ f, λ m x, calc
g (f (m • x)) = g (m • f x) : by rw f.map_smul
          ... = m • g (f x) : g.map_smul _ _⟩

@[simp] lemma comp_apply (g : Y →[M'] Z) (f : X →[M'] Y) (x : X) : g.comp f x = g (f x) := rfl

@[simp] lemma id_comp (f : X →[M'] Y) : (mul_action_hom.id M').comp f = f :=
ext $ λ x, by rw [comp_apply, id_apply]

@[simp] lemma comp_id (f : X →[M'] Y) : f.comp (mul_action_hom.id M') = f :=
ext $ λ x, by rw [comp_apply, id_apply]

variables {A B}

/-- The inverse of a bijective equivariant map is equivariant. -/
@[simps] def inverse (f : A →[M] B) (g : B → A)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) :
  B →[M] A :=
{ to_fun    := g,
  map_smul' := λ m x,
    calc g (m • x) = g (m • (f (g x))) : by rw h₂
               ... = g (f (m • (g x))) : by rw f.map_smul
               ... = m • g x : by rw h₁, }

end mul_action_hom

/-- Equivariant additive monoid homomorphisms. -/
structure distrib_mul_action_hom extends A →[M] B, A →+ B.

/-- Reinterpret an equivariant additive monoid homomorphism as an additive monoid homomorphism. -/
add_decl_doc distrib_mul_action_hom.to_add_monoid_hom

/-- Reinterpret an equivariant additive monoid homomorphism as an equivariant function. -/
add_decl_doc distrib_mul_action_hom.to_mul_action_hom

notation A ` →+[`:25 M:25 `] `:0 B:0 := distrib_mul_action_hom M A B

/-- `distrib_mul_action_hom_class F M A B` states that `F` is a type of morphisms preserving
the additive monoid structure and scalar multiplication by `M`.

You should extend this class when you extend `distrib_mul_action_hom`. -/
class distrib_mul_action_hom_class (F : Type*) (M A B : out_param $ Type*)
  [monoid M] [add_monoid A] [add_monoid B] [distrib_mul_action M A] [distrib_mul_action M B]
  extends smul_hom_class F M A B, add_monoid_hom_class F A B

-- `M` becomes a metavariable but it's an `out_param` so it's not a problem.
attribute [nolint dangerous_instance] distrib_mul_action_hom_class.to_add_monoid_hom_class

namespace distrib_mul_action_hom

instance has_coe : has_coe (A →+[M] B) (A →+ B) :=
⟨to_add_monoid_hom⟩

instance has_coe' : has_coe (A →+[M] B) (A →[M] B) :=
⟨to_mul_action_hom⟩

instance : has_coe_to_fun (A →+[M] B) (λ _, A → B) := ⟨to_fun⟩

instance : distrib_mul_action_hom_class (A →+[M] B) M A B :=
{ coe := distrib_mul_action_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_smul := distrib_mul_action_hom.map_smul',
  map_zero := distrib_mul_action_hom.map_zero',
  map_add := distrib_mul_action_hom.map_add' }

variables {M A B}

@[simp] lemma to_fun_eq_coe (f : A →+[M] B) : f.to_fun = ⇑f := rfl

@[norm_cast] lemma coe_fn_coe (f : A →+[M] B) : ((f : A →+ B) : A → B) = f := rfl
@[norm_cast] lemma coe_fn_coe' (f : A →+[M] B) : ((f : A →[M] B) : A → B) = f := rfl

@[ext] theorem ext : ∀ {f g : A →+[M] B}, (∀ x, f x = g x) → f = g := fun_like.ext
theorem ext_iff {f g : A →+[M] B} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
protected lemma congr_fun {f g : A →+[M] B} (h : f = g) (x : A) : f x = g x :=
fun_like.congr_fun h _

lemma to_mul_action_hom_injective {f g : A →+[M] B}
  (h : (f : A →[M] B) = (g : A →[M] B)) : f = g :=
by { ext a, exact mul_action_hom.congr_fun h a, }

lemma to_add_monoid_hom_injective {f g : A →+[M] B}
  (h : (f : A →+ B) = (g : A →+ B)) : f = g :=
by { ext a, exact add_monoid_hom.congr_fun h a, }

protected lemma map_zero (f : A →+[M] B) : f 0 = 0 := map_zero _
protected lemma map_add (f : A →+[M] B) (x y : A) : f (x + y) = f x + f y := map_add _ _ _
protected lemma map_neg (f : A' →+[M] B') (x : A') : f (-x) = -f x := map_neg _ _
protected lemma map_sub (f : A' →+[M] B') (x y : A') : f (x - y) = f x - f y := map_sub _ _ _
protected lemma map_smul (f : A →+[M] B) (m : M) (x : A) : f (m • x) = m • f x := map_smul _ _ _

variables (M) {A}

/-- The identity map as an equivariant additive monoid homomorphism. -/
protected def id : A →+[M] A :=
⟨id, λ _ _, rfl, rfl, λ _ _, rfl⟩

@[simp] lemma id_apply (x : A) : distrib_mul_action_hom.id M x = x := rfl

variables {M A B C}

instance : has_zero (A →+[M] B) :=
⟨{ map_smul' := by simp,
   .. (0 : A →+ B) }⟩

instance : has_one (A →+[M] A) := ⟨distrib_mul_action_hom.id M⟩

@[simp] lemma coe_zero : ((0 : A →+[M] B) : A → B) = 0 := rfl

@[simp] lemma coe_one : ((1 : A →+[M] A) : A → A) = id := rfl

lemma zero_apply (a : A) : (0 : A →+[M] B) a = 0 := rfl

lemma one_apply (a : A) : (1 : A →+[M] A) a = a := rfl

instance : inhabited (A →+[M] B) := ⟨0⟩

/-- Composition of two equivariant additive monoid homomorphisms. -/
def comp (g : B →+[M] C) (f : A →+[M] B) : A →+[M] C :=
{ .. mul_action_hom.comp (g : B →[M] C) (f : A →[M] B),
  .. add_monoid_hom.comp (g : B →+ C) (f : A →+ B), }

@[simp] lemma comp_apply (g : B →+[M] C) (f : A →+[M] B) (x : A) : g.comp f x = g (f x) := rfl

@[simp] lemma id_comp (f : A →+[M] B) : (distrib_mul_action_hom.id M).comp f = f :=
ext $ λ x, by rw [comp_apply, id_apply]

@[simp] lemma comp_id (f : A →+[M] B) : f.comp (distrib_mul_action_hom.id M) = f :=
ext $ λ x, by rw [comp_apply, id_apply]

/-- The inverse of a bijective `distrib_mul_action_hom` is a `distrib_mul_action_hom`. -/
@[simps] def inverse (f : A →+[M] B) (g : B → A)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) :
  B →+[M] A :=
{ to_fun := g,
  .. (f : A →+ B).inverse g h₁ h₂,
  .. (f : A →[M] B).inverse g h₁ h₂ }

section semiring

variables {R M'} [add_monoid M'] [distrib_mul_action R M']

@[ext] lemma ext_ring
  {f g : R →+[R] M'} (h : f 1 = g 1) : f = g :=
by { ext x, rw [← mul_one x, ← smul_eq_mul R, f.map_smul, g.map_smul, h], }

lemma ext_ring_iff {f g : R →+[R] M'} : f = g ↔ f 1 = g 1 :=
⟨λ h, h ▸ rfl, ext_ring⟩

end semiring

end distrib_mul_action_hom

/-- Equivariant ring homomorphisms. -/
@[nolint has_nonempty_instance]
structure mul_semiring_action_hom extends R →+[M] S, R →+* S.

/-- Reinterpret an equivariant ring homomorphism as a ring homomorphism. -/
add_decl_doc mul_semiring_action_hom.to_ring_hom

/-- Reinterpret an equivariant ring homomorphism as an equivariant additive monoid homomorphism. -/
add_decl_doc mul_semiring_action_hom.to_distrib_mul_action_hom

notation R ` →+*[`:25 M:25 `] `:0 S:0 := mul_semiring_action_hom M R S

/-- `mul_semiring_action_hom_class F M R S` states that `F` is a type of morphisms preserving
the ring structure and scalar multiplication by `M`.

You should extend this class when you extend `mul_semiring_action_hom`. -/
class mul_semiring_action_hom_class (F : Type*) (M R S : out_param $ Type*)
  [monoid M] [semiring R] [semiring S] [distrib_mul_action M R] [distrib_mul_action M S]
  extends distrib_mul_action_hom_class F M R S, ring_hom_class F R S

-- `M` becomes a metavariable but it's an `out_param` so it's not a problem.
attribute [nolint dangerous_instance] mul_semiring_action_hom_class.to_ring_hom_class

namespace mul_semiring_action_hom

instance has_coe : has_coe (R →+*[M] S) (R →+* S) :=
⟨to_ring_hom⟩

instance has_coe' : has_coe (R →+*[M] S) (R →+[M] S) :=
⟨to_distrib_mul_action_hom⟩

instance : has_coe_to_fun (R →+*[M] S) (λ _, R → S) := ⟨λ c, c.to_fun⟩

instance : mul_semiring_action_hom_class (R →+*[M] S) M R S :=
{ coe := mul_semiring_action_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_smul := mul_semiring_action_hom.map_smul',
  map_zero := mul_semiring_action_hom.map_zero',
  map_add := mul_semiring_action_hom.map_add',
  map_one := mul_semiring_action_hom.map_one',
  map_mul := mul_semiring_action_hom.map_mul' }

variables {M R S}

@[norm_cast] lemma coe_fn_coe (f : R →+*[M] S) : ((f : R →+* S) : R → S) = f := rfl
@[norm_cast] lemma coe_fn_coe' (f : R →+*[M] S) : ((f : R →+[M] S) : R → S) = f := rfl

@[ext] theorem ext : ∀ {f g : R →+*[M] S}, (∀ x, f x = g x) → f = g := fun_like.ext
theorem ext_iff {f g : R →+*[M] S} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff

protected lemma map_zero (f : R →+*[M] S) : f 0 = 0 := map_zero _
protected lemma map_add (f : R →+*[M] S) (x y : R) : f (x + y) = f x + f y := map_add _ _ _
protected lemma map_neg (f : R' →+*[M] S') (x : R') : f (-x) = -f x := map_neg _ _
protected lemma map_sub (f : R' →+*[M] S') (x y : R') : f (x - y) = f x - f y := map_sub _ _ _
protected lemma map_one (f : R →+*[M] S) : f 1 = 1 := map_one _
protected

variables (M) {R}

/-- The identity map as an equivariant ring homomorphism. -/
protected def id : R →+*[M] R :=
⟨id, λ _ _, rfl, rfl, λ _ _, rfl, rfl, λ _ _, rfl⟩

@[simp] lemma id_apply (x : R) : mul_semiring_action_hom.id M x = x := rfl

variables {M R S T}

/-- Composition of two equivariant additive monoid homomorphisms. -/
def comp (g : S →+*[M] T) (f : R →+*[M] S) : R →+*[M] T :=
{ .. distrib_mul_action_hom.comp (g : S →+[M] T) (f : R →+[M] S),
  .. ring_hom.comp (g : S →+* T) (f : R →+* S), }

@[simp] lemma comp_apply (g : S →+*[M] T) (f : R →+*[M] S) (x : R) : g.comp f x = g (f x) := rfl

@[simp] lemma id_comp (f : R →+*[M] S) : (mul_semiring_action_hom.id M).comp f = f :=
ext $ λ x, by rw [comp_apply, id_apply]

@[simp] lemma comp_id (f : R →+*[M] S) : f.comp (mul_semiring_action_hom.id M) = f :=
ext $ λ x, by rw [comp_apply, id_apply]

end mul_semiring_action_hom


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
--import data.option.defs
import mathlib4_experiments.Logic.Basic
import mathlib4_experiments.CoreExt
import mathlib4_experiments.Commands.print_prefix
--import tactic.cache
/-!
## Definitions on lists

This file contains various definitions on lists. It does not contain
proofs about these definitions, those are contained in other files in `data/list`
-/

namespace List

open Function Nat
-- open native (rb_map mk_rb_map rb_map.of_list)

variable (R : α → α → Prop)

/-- `pairwise R l` means that all the elements with earlier indexes are
  `R`-related to all the elements with later indexes.

     pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3

  For example if `R = (≠)` then it asserts `l` has no duplicates,
  and if `R = (<)` then it asserts that `l` is (strictly) sorted. -/
inductive pairwise : List α → Prop
| nil : pairwise []
| cons : ∀ {a : α} {l : List α}, (∀ a', a' ∈ l → R a a') → pairwise l → pairwise (a::l)

/-- `nodup l` means that `l` has no duplicates, that is, any element appears at most
  once in the list. It is defined as `pairwise (≠)`. -/
def nodup : List α → Prop := pairwise (· ≠ ·)

end List

/-

TO BE PORTED

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

instance [decidable_eq α] : has_sdiff (list α) :=
⟨ list.diff ⟩

/-- Split a list at an index.

     split_at 2 [a, b, c] = ([a, b], [c]) -/
def split_at : ℕ → list α → list α × list α
| 0        a         := ([], a)
| (succ n) []        := ([], [])
| (succ n) (x :: xs) := let (l, r) := split_at n xs in (x :: l, r)

/-- An auxiliary function for `split_on_p`. -/
def split_on_p_aux {α : Type u} (P : α → Prop) [decidable_pred P] :
  list α → (list α → list α) → list (list α)
| [] f       := [f []]
| (h :: t) f :=
  if P h then f [] :: split_on_p_aux t id
  else split_on_p_aux t (λ l, f (h :: l))

/-- Split a list at every element satisfying a predicate. -/
def split_on_p {α : Type u} (P : α → Prop) [decidable_pred P] (l : list α) : list (list α) :=
split_on_p_aux P l id

/-- Split a list at every occurrence of an element.

    [1,1,2,3,2,4,4].split_on 2 = [[1,1],[3],[4,4]] -/
def split_on {α : Type u} [decidable_eq α] (a : α) (as : list α) : list (list α) :=
as.split_on_p (=a)

/-- Concatenate an element at the end of a list.

     concat [a, b] c = [a, b, c] -/
@[simp] def concat : list α → α → list α
| []     a := [a]
| (b::l) a := b :: concat l a

/-- `head' xs` returns the first element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def head' : list α → option α
| []       := none
| (a :: l) := some a

/-- Convert a list into an array (whose length is the length of `l`). -/
def to_array (l : list α) : array l.length α :=
{data := λ v, l.nth_le v.1 v.2}

/-- "inhabited" `nth` function: returns `default` instead of `none` in the case
  that the index is out of bounds. -/
@[simp] def inth [h : inhabited α] (l : list α) (n : nat) : α := (nth l n).iget

/-- Apply a function to the nth tail of `l`. Returns the input without
  using `f` if the index is larger than the length of the list.

     modify_nth_tail f 2 [a, b, c] = [a, b] ++ f [c] -/
@[simp] def modify_nth_tail (f : list α → list α) : ℕ → list α → list α
| 0     l      := f l
| (n+1) []     := []
| (n+1) (a::l) := a :: modify_nth_tail n l

/-- Apply `f` to the head of the list, if it exists. -/
@[simp] def modify_head (f : α → α) : list α → list α
| []     := []
| (a::l) := f a :: l

/-- Apply `f` to the nth element of the list, if it exists. -/
def modify_nth (f : α → α) : ℕ → list α → list α :=
modify_nth_tail (modify_head f)

/-- Apply `f` to the last element of `l`, if it exists. -/
@[simp] def modify_last (f : α → α) : list α → list α
| [] := []
| [x] := [f x]
| (x :: xs) := x :: modify_last xs

/-- `insert_nth n a l` inserts `a` into the list `l` after the first `n` elements of `l`
 `insert_nth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4]`-/
def insert_nth (n : ℕ) (a : α) : list α → list α := modify_nth_tail (list.cons a) n

section take'
variable [inhabited α]

/-- Take `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l`
elements `default α`. -/
def take' : ∀ n, list α → list α
| 0     l := []
| (n+1) l := l.head :: take' n l.tail

end take'

/-- Get the longest initial segment of the list whose members all satisfy `p`.

     take_while (λ x, x < 3) [0, 2, 5, 1] = [0, 2] -/
def take_while (p : α → Prop) [decidable_pred p] : list α → list α
| []     := []
| (a::l) := if p a then a :: take_while l else []

/-- Fold a function `f` over the list from the left, returning the list
  of partial results.

     scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6] -/
def scanl (f : α → β → α) : α → list β → list α
| a []     := [a]
| a (b::l) := a :: scanl (f a b) l

/-- Auxiliary definition used to define `scanr`. If `scanr_aux f b l = (b', l')`
then `scanr f b l = b' :: l'` -/
def scanr_aux (f : α → β → β) (b : β) : list α → β × list β
| []     := (b, [])
| (a::l) := let (b', l') := scanr_aux l in (f a b', b' :: l')

/-- Fold a function `f` over the list from the right, returning the list
  of partial results.

     scanr (+) 0 [1, 2, 3] = [6, 5, 3, 0] -/
def scanr (f : α → β → β) (b : β) (l : list α) : list β :=
let (b', l') := scanr_aux f b l in b' :: l'

/-- Product of a list.

     prod [a, b, c] = ((1 * a) * b) * c -/
def prod [has_mul α] [has_one α] : list α → α := foldl (*) 1

/-- Sum of a list.

     sum [a, b, c] = ((0 + a) + b) + c -/
-- Later this will be tagged with `to_additive`, but this can't be done yet because of import
-- dependencies.
def sum [has_add α] [has_zero α] : list α → α := foldl (+) 0

/-- The alternating sum of a list. -/
def alternating_sum {G : Type*} [has_zero G] [has_add G] [has_neg G] : list G → G
| [] := 0
| (g :: []) := g
| (g :: h :: t) := g + -h + alternating_sum t

/-- The alternating product of a list. -/
def alternating_prod {G : Type*} [has_one G] [has_mul G] [has_inv G] : list G → G
| [] := 1
| (g :: []) := g
| (g :: h :: t) := g * h⁻¹ * alternating_prod t

/-- Given a function `f : α → β ⊕ γ`, `partition_map f l` maps the list by `f`
  whilst partitioning the result it into a pair of lists, `list β × list γ`,
  partitioning the `sum.inl _` into the left list, and the `sum.inr _` into the right list.
  `partition_map (id : ℕ ⊕ ℕ → ℕ ⊕ ℕ) [inl 0, inr 1, inl 2] = ([0,2], [1])`    -/
def partition_map (f : α → β ⊕ γ) : list α → list β × list γ
| [] := ([],[])
| (x::xs) :=
match f x with
| (sum.inr r) := prod.map id (cons r) $ partition_map xs
| (sum.inl l) := prod.map (cons l) id $ partition_map xs
end

/-- `find p l` is the first element of `l` satisfying `p`, or `none` if no such
  element exists. -/
def find (p : α → Prop) [decidable_pred p] : list α → option α
| []     := none
| (a::l) := if p a then some a else find l

/-- `mfind tac l` returns the first element of `l` on which `tac` succeeds, and
fails otherwise. -/
def mfind {α} {m : Type u → Type v} [monad m] [alternative m] (tac : α → m punit) : list α → m α :=
list.mfirst $ λ a, tac a $> a

/-- `mbfind' p l` returns the first element `a` of `l` for which `p a` returns
true. `mbfind'` short-circuits, so `p` is not necessarily run on every `a` in
`l`. This is a monadic version of `list.find`. -/
def mbfind' {m : Type u → Type v} [monad m] {α : Type u} (p : α → m (ulift bool)) :
  list α → m (option α)
| [] := pure none
| (x :: xs) := do
  ⟨px⟩ ← p x,
  if px then pure (some x) else mbfind' xs

section

variables {m : Type → Type v} [monad m]

/-- A variant of `mbfind'` with more restrictive universe levels. -/
def mbfind {α} (p : α → m bool) (xs : list α) : m (option α) :=
xs.mbfind' (functor.map ulift.up ∘ p)

/-- `many p as` returns true iff `p` returns true for any element of `l`.
`many` short-circuits, so if `p` returns true for any element of `l`, later
elements are not checked. This is a monadic version of `list.any`. -/
-- Implementing this via `mbfind` would give us less universe polymorphism.
def many {α : Type u} (p : α → m bool) : list α → m bool
| [] := pure false
| (x :: xs) := do px ← p x, if px then pure tt else many xs

/-- `mall p as` returns true iff `p` returns true for all elements of `l`.
`mall` short-circuits, so if `p` returns false for any element of `l`, later
elements are not checked. This is a monadic version of `list.all`. -/
def mall {α : Type u} (p : α → m bool) (as : list α) : m bool :=
bnot <$> many (λ a, bnot <$> p a) as

/-- `mbor xs` runs the actions in `xs`, returning true if any of them returns
true. `mbor` short-circuits, so if an action returns true, later actions are
not run. This is a monadic version of `list.bor`. -/
def mbor : list (m bool) → m bool :=
many id

/-- `mband xs` runs the actions in `xs`, returning true if all of them return
true. `mband` short-circuits, so if an action returns false, later actions are
not run. This is a monadic version of `list.band`. -/
def mband : list (m bool) → m bool :=
mall id

end

/-- Auxiliary definition for `foldl_with_index`. -/
def foldl_with_index_aux (f : ℕ → α → β → α) : ℕ → α → list β → α
| _ a [] := a
| i a (b :: l) := foldl_with_index_aux (i + 1) (f i a b) l

/-- Fold a list from left to right as with `foldl`, but the combining function
also receives each element's index. -/
def foldl_with_index (f : ℕ → α → β → α) (a : α) (l : list β) : α :=
foldl_with_index_aux f 0 a l

/-- Auxiliary definition for `foldr_with_index`. -/
def foldr_with_index_aux (f : ℕ → α → β → β) : ℕ → β → list α → β
| _ b [] := b
| i b (a :: l) := f i a (foldr_with_index_aux (i + 1) b l)

/-- Fold a list from right to left as with `foldr`, but the combining function
also receives each element's index. -/
def foldr_with_index (f : ℕ → α → β → β) (b : β) (l : list α) : β :=
foldr_with_index_aux f 0 b l

/-- `find_indexes p l` is the list of indexes of elements of `l` that satisfy `p`. -/
def find_indexes (p : α → Prop) [decidable_pred p] (l : list α) : list nat :=
foldr_with_index (λ i a is, if p a then i :: is else is) [] l

/-- Returns the elements of `l` that satisfy `p` together with their indexes in
`l`. The returned list is ordered by index. -/
def indexes_values (p : α → Prop) [decidable_pred p] (l : list α) : list (ℕ × α) :=
foldr_with_index (λ i a l, if p a then (i , a) :: l else l) [] l

/-- `indexes_of a l` is the list of all indexes of `a` in `l`. For example:
```
indexes_of a [a, b, a, a] = [0, 2, 3]
```
-/
def indexes_of [decidable_eq α] (a : α) : list α → list nat := find_indexes (eq a)

section mfold_with_index

variables {m : Type v → Type w} [monad m]

/-- Monadic variant of `foldl_with_index`. -/
def mfoldl_with_index {α β} (f : ℕ → β → α → m β) (b : β) (as : list α) : m β :=
as.foldl_with_index (λ i ma b, do a ← ma, f i a b) (pure b)

/-- Monadic variant of `foldr_with_index`. -/
def mfoldr_with_index {α β} (f : ℕ → α → β → m β) (b : β) (as : list α) : m β :=
as.foldr_with_index (λ i a mb, do b ← mb, f i a b) (pure b)

end mfold_with_index

section mmap_with_index

variables {m : Type v → Type w} [applicative m]

/-- Auxiliary definition for `mmap_with_index`. -/
def mmap_with_index_aux {α β} (f : ℕ → α → m β) : ℕ → list α → m (list β)
| _ [] := pure []
| i (a :: as) := list.cons <$> f i a <*> mmap_with_index_aux (i + 1) as

/-- Applicative variant of `map_with_index`. -/
def mmap_with_index {α β} (f : ℕ → α → m β) (as : list α) : m (list β) :=
mmap_with_index_aux f 0 as

/-- Auxiliary definition for `mmap_with_index'`. -/
def mmap_with_index'_aux {α} (f : ℕ → α → m punit) : ℕ → list α → m punit
| _ [] := pure ⟨⟩
| i (a :: as) := f i a *> mmap_with_index'_aux (i + 1) as

/-- A variant of `mmap_with_index` specialised to applicative actions which
return `unit`. -/
def mmap_with_index' {α} (f : ℕ → α → m punit) (as : list α) : m punit :=
mmap_with_index'_aux f 0 as

end mmap_with_index

/-- `lookmap` is a combination of `lookup` and `filter_map`.
  `lookmap f l` will apply `f : α → option α` to each element of the list,
  replacing `a → b` at the first value `a` in the list such that `f a = some b`. -/
def lookmap (f : α → option α) : list α → list α
| []     := []
| (a::l) :=
  match f a with
  | some b := b :: l
  | none   := a :: lookmap l
  end

/-- `countp p l` is the number of elements of `l` that satisfy `p`. -/
def countp (p : α → Prop) [decidable_pred p] : list α → nat
| []      := 0
| (x::xs) := if p x then succ (countp xs) else countp xs

/-- `count a l` is the number of occurrences of `a` in `l`. -/
def count [decidable_eq α] (a : α) : list α → nat := countp (eq a)

/-- `is_prefix l₁ l₂`, or `l₁ <+: l₂`, means that `l₁` is a prefix of `l₂`,
  that is, `l₂` has the form `l₁ ++ t` for some `t`. -/
def is_prefix (l₁ : list α) (l₂ : list α) : Prop := ∃ t, l₁ ++ t = l₂

/-- `is_suffix l₁ l₂`, or `l₁ <:+ l₂`, means that `l₁` is a suffix of `l₂`,
  that is, `l₂` has the form `t ++ l₁` for some `t`. -/
def is_suffix (l₁ : list α) (l₂ : list α) : Prop := ∃ t, t ++ l₁ = l₂

/-- `is_infix l₁ l₂`, or `l₁ <:+: l₂`, means that `l₁` is a contiguous
  substring of `l₂`, that is, `l₂` has the form `s ++ l₁ ++ t` for some `s, t`. -/
def is_infix (l₁ : list α) (l₂ : list α) : Prop := ∃ s t, s ++ l₁ ++ t = l₂

infix ` <+: `:50 := is_prefix
infix ` <:+ `:50 := is_suffix
infix ` <:+: `:50 := is_infix

/-- `inits l` is the list of initial segments of `l`.

     inits [1, 2, 3] = [[], [1], [1, 2], [1, 2, 3]] -/
@[simp] def inits : list α → list (list α)
| []     := [[]]
| (a::l) := [] :: map (λt, a::t) (inits l)

/-- `tails l` is the list of terminal segments of `l`.

     tails [1, 2, 3] = [[1, 2, 3], [2, 3], [3], []] -/
@[simp] def tails : list α → list (list α)
| []     := [[]]
| (a::l) := (a::l) :: tails l

def sublists'_aux : list α → (list α → list β) → list (list β) → list (list β)
| []     f r := f [] :: r
| (a::l) f r := sublists'_aux l f (sublists'_aux l (f ∘ cons a) r)

/-- `sublists' l` is the list of all (non-contiguous) sublists of `l`.
  It differs from `sublists` only in the order of appearance of the sublists;
  `sublists'` uses the first element of the list as the MSB,
  `sublists` uses the first element of the list as the LSB.

     sublists' [1, 2, 3] = [[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]] -/
def sublists' (l : list α) : list (list α) :=
sublists'_aux l id []

def sublists_aux : list α → (list α → list β → list β) → list β
| []     f := []
| (a::l) f := f [a] (sublists_aux l (λys r, f ys (f (a :: ys) r)))

/-- `sublists l` is the list of all (non-contiguous) sublists of `l`; cf. `sublists'`
  for a different ordering.

     sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]] -/
def sublists (l : list α) : list (list α) :=
[] :: sublists_aux l cons

def sublists_aux₁ : list α → (list α → list β) → list β
| []     f := []
| (a::l) f := f [a] ++ sublists_aux₁ l (λys, f ys ++ f (a :: ys))

section forall₂
variables {r : α → β → Prop} {p : γ → δ → Prop}

/-- `forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length,
  and whenever `a` is the nth element of `l₁`, and `b` is the nth element of `l₂`,
  then `R a b` is satisfied. -/
inductive forall₂ (R : α → β → Prop) : list α → list β → Prop
| nil : forall₂ [] []
| cons {a b l₁ l₂} : R a b → forall₂ l₁ l₂ → forall₂ (a::l₁) (b::l₂)

attribute [simp] forall₂.nil

end forall₂

/-- Auxiliary definition used to define `transpose`.
  `transpose_aux l L` takes each element of `l` and appends it to the start of
  each element of `L`.

  `transpose_aux [a, b, c] [l₁, l₂, l₃] = [a::l₁, b::l₂, c::l₃]` -/
def transpose_aux : list α → list (list α) → list (list α)
| []     ls      := ls
| (a::i) []      := [a] :: transpose_aux i []
| (a::i) (l::ls) := (a::l) :: transpose_aux i ls

/-- transpose of a list of lists, treated as a matrix.

     transpose [[1, 2], [3, 4], [5, 6]] = [[1, 3, 5], [2, 4, 6]] -/
def transpose : list (list α) → list (list α)
| []      := []
| (l::ls) := transpose_aux l (transpose ls)

/-- List of all sections through a list of lists. A section
  of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from
  `L₁`, whose second element comes from `L₂`, and so on. -/
def sections : list (list α) → list (list α)
| []     := [[]]
| (l::L) := bind (sections L) $ λ s, map (λ a, a::s) l

section permutations

def permutations_aux2 (t : α) (ts : list α) (r : list β) : list α → (list α → β) → list α × list β
| []      f := (ts, r)
| (y::ys) f := let (us, zs) := permutations_aux2 ys (λx : list α, f (y::x)) in
               (y :: us, f (t :: y :: us) :: zs)

private def meas : (Σ'_:list α, list α) → ℕ × ℕ | ⟨l, i⟩ := (length l + length i, length l)

local infix ` ≺ `:50 := inv_image (prod.lex (<) (<)) meas

@[elab_as_eliminator] def permutations_aux.rec {C : list α → list α → Sort v}
  (H0 : ∀ is, C [] is)
  (H1 : ∀ t ts is, C ts (t::is) → C is [] → C (t::ts) is) : ∀ l₁ l₂, C l₁ l₂
| []      is := H0 is
| (t::ts) is :=
  have h1 : ⟨ts, t :: is⟩ ≺ ⟨t :: ts, is⟩, from
    show prod.lex _ _ (succ (length ts + length is), length ts) (succ (length ts) + length is,
      length (t :: ts)),
    by rw nat.succ_add; exact prod.lex.right _ (lt_succ_self _),
  have h2 : ⟨is, []⟩ ≺ ⟨t :: ts, is⟩, from prod.lex.left _ _ (nat.lt_add_of_pos_left (succ_pos _)),
  H1 t ts is (permutations_aux.rec ts (t::is)) (permutations_aux.rec is [])
using_well_founded {
  dec_tac := tactic.assumption,
  rel_tac := λ _ _, `[exact ⟨(≺), @inv_image.wf _ _ _ meas (prod.lex_wf lt_wf lt_wf)⟩] }

def permutations_aux : list α → list α → list (list α) :=
@@permutations_aux.rec (λ _ _, list (list α)) (λ is, [])
  (λ t ts is IH1 IH2, foldr (λy r, (permutations_aux2 t ts r y id).2) IH1 (is :: IH2))

/-- List of all permutations of `l`.

     permutations [1, 2, 3] =
       [[1, 2, 3], [2, 1, 3], [3, 2, 1],
        [2, 3, 1], [3, 1, 2], [1, 3, 2]] -/
def permutations (l : list α) : list (list α) :=
l :: permutations_aux l []

end permutations

/-- `erasep p l` removes the first element of `l` satisfying the predicate `p`. -/
def erasep (p : α → Prop) [decidable_pred p] : list α → list α
| []     := []
| (a::l) := if p a then l else a :: erasep l

/-- `extractp p l` returns a pair of an element `a` of `l` satisfying the predicate
  `p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`. -/
def extractp (p : α → Prop) [decidable_pred p] : list α → option α × list α
| []     := (none, [])
| (a::l) := if p a then (some a, l) else
  let (a', l') := extractp l in (a', a :: l')

/-- `revzip l` returns a list of pairs of the elements of `l` paired
  with the elements of `l` in reverse order.

`revzip [1,2,3,4,5] = [(1, 5), (2, 4), (3, 3), (4, 2), (5, 1)]`
 -/
def revzip (l : list α) : list (α × α) := zip l l.reverse

/-- `product l₁ l₂` is the list of pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂`.

     product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
def product (l₁ : list α) (l₂ : list β) : list (α × β) :=
l₁.bind $ λ a, l₂.map $ prod.mk a

/-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`.

     sigma [1, 2] (λ_, [(5 : ℕ), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
protected def sigma {σ : α → Type*} (l₁ : list α) (l₂ : Π a, list (σ a)) : list (Σ a, σ a) :=
l₁.bind $ λ a, (l₂ a).map $ sigma.mk a

/-- Auxliary definition used to define `of_fn`.

  `of_fn_aux f m h l` returns the first `m` elements of `of_fn f`
  appended to `l` -/
def of_fn_aux {n} (f : fin n → α) : ∀ m, m ≤ n → list α → list α
| 0        h l := l
| (succ m) h l := of_fn_aux m (le_of_lt h) (f ⟨m, h⟩ :: l)

/-- `of_fn f` with `f : fin n → α` returns the list whose ith element is `f i`
  `of_fun f = [f 0, f 1, ... , f(n - 1)]` -/
def of_fn {n} (f : fin n → α) : list α :=
of_fn_aux f n (le_refl _) []

/-- `of_fn_nth_val f i` returns `some (f i)` if `i < n` and `none` otherwise. -/
def of_fn_nth_val {n} (f : fin n → α) (i : ℕ) : option α :=
if h : i < n then some (f ⟨i, h⟩) else none

/-- `disjoint l₁ l₂` means that `l₁` and `l₂` have no elements in common. -/
def disjoint (l₁ l₂ : list α) : Prop := ∀ ⦃a⦄, a ∈ l₁ → a ∈ l₂ → false

section pairwise
-- kmb ported the definition

variables (R : α → α → Prop)

variables {R}
@[simp] theorem pairwise_cons {a : α} {l : list α} :
  pairwise R (a::l) ↔ (∀ a' ∈ l, R a a') ∧ pairwise R l :=
⟨λ p, by cases p with a l n p; exact ⟨n, p⟩, λ ⟨n, p⟩, p.cons n⟩

attribute [simp] pairwise.nil

instance decidable_pairwise [decidable_rel R] (l : list α) : decidable (pairwise R l) :=
by induction l with hd tl ih; [exact is_true pairwise.nil,
  exactI decidable_of_iff' _ pairwise_cons]

end pairwise

/-- `pw_filter R l` is a maximal sublist of `l` which is `pairwise R`.
  `pw_filter (≠)` is the erase duplicates function (cf. `erase_dup`), and `pw_filter (<)` finds
  a maximal increasing subsequence in `l`. For example,

     pw_filter (<) [0, 1, 5, 2, 6, 3, 4] = [0, 1, 2, 3, 4] -/
def pw_filter (R : α → α → Prop) [decidable_rel R] : list α → list α
| []        := []
| (x :: xs) := let IH := pw_filter xs in if ∀ y ∈ IH, R x y then x :: IH else IH

section chain
variable (R : α → α → Prop)

/-- `chain R a l` means that `R` holds between adjacent elements of `a::l`.

     chain R a [b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
inductive chain : α → list α → Prop
| nil {a : α} : chain a []
| cons : ∀ {a b : α} {l : list α}, R a b → chain b l → chain a (b::l)

/-- `chain' R l` means that `R` holds between adjacent elements of `l`.

     chain' R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
def chain' : list α → Prop
| [] := true
| (a :: l) := chain R a l

variable {R}
@[simp] theorem chain_cons {a b : α} {l : list α} :
  chain R a (b::l) ↔ R a b ∧ chain R b l :=
⟨λ p, by cases p with _ a b l n p; exact ⟨n, p⟩, λ ⟨n, p⟩, p.cons n⟩

attribute [simp] chain.nil

instance decidable_chain [decidable_rel R] (a : α) (l : list α) : decidable (chain R a l) :=
by induction l generalizing a; simp only [chain.nil, chain_cons]; resetI; apply_instance

instance decidable_chain' [decidable_rel R] (l : list α) : decidable (chain' R l) :=
by cases l; dunfold chain'; apply_instance

end chain

-- kmb : I ported def of `nodup`

instance nodup_decidable [decidable_eq α] : ∀ l : list α, decidable (nodup l) :=
list.decidable_pairwise

/-- `erase_dup l` removes duplicates from `l` (taking only the first occurrence).
  Defined as `pw_filter (≠)`.

     erase_dup [1, 0, 2, 2, 1] = [0, 2, 1] -/
def erase_dup [decidable_eq α] : list α → list α := pw_filter (≠)

/-- `range' s n` is the list of numbers `[s, s+1, ..., s+n-1]`.
  It is intended mainly for proving properties of `range` and `iota`. -/
@[simp] def range' : ℕ → ℕ → list ℕ
| s 0     := []
| s (n+1) := s :: range' (s+1) n

/-- Drop `none`s from a list, and replace each remaining `some a` with `a`. -/
def reduce_option {α} : list (option α) → list α :=
list.filter_map id

/-- `ilast' x xs` returns the last element of `xs` if `xs` is non-empty;
it returns `x` otherwise -/
@[simp] def ilast' {α} : α → list α → α
| a []     := a
| a (b::l) := ilast' b l

/-- `last' xs` returns the last element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def last' {α} : list α → option α
| []     := none
| [a]    := some a
| (b::l) := last' l

/-- `rotate l n` rotates the elements of `l` to the left by `n`

     rotate [0, 1, 2, 3, 4, 5] 2 = [2, 3, 4, 5, 0, 1] -/
def rotate (l : list α) (n : ℕ) : list α :=
let (l₁, l₂) := list.split_at (n % l.length) l in l₂ ++ l₁

/-- rotate' is the same as `rotate`, but slower. Used for proofs about `rotate`-/
def rotate' : list α → ℕ → list α
| []     n     := []
| l      0     := l
| (a::l) (n+1) := rotate' (l ++ [a]) n

section choose
variables (p : α → Prop) [decidable_pred p] (l : list α)

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns both `a` and proofs
of `a ∈ l` and `p a`. -/
def choose_x : Π l : list α, Π hp : (∃ a, a ∈ l ∧ p a), { a // a ∈ l ∧ p a }
| [] hp := false.elim (exists.elim hp (assume a h, not_mem_nil a h.left))
| (l :: ls) hp := if pl : p l then ⟨l, ⟨or.inl rfl, pl⟩⟩ else
let ⟨a, ⟨a_mem_ls, pa⟩⟩ := choose_x ls (hp.imp
  (λ b ⟨o, h₂⟩, ⟨o.resolve_left (λ e, pl $ e ▸ h₂), h₂⟩)) in
⟨a, ⟨or.inr a_mem_ls, pa⟩⟩

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns `a : α`, and properties
are given by `choose_mem` and `choose_property`. -/
def choose (hp : ∃ a, a ∈ l ∧ p a) : α := choose_x p l hp

end choose

/-- Filters and maps elements of a list -/
def mmap_filter {m : Type → Type v} [monad m] {α β} (f : α → m (option β)) :
  list α → m (list β)
| []       := return []
| (h :: t) := do b ← f h, t' ← t.mmap_filter, return $
  match b with none := t' | (some x) := x::t' end

/--
`mmap_upper_triangle f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap_upper_triangle f l` will produce the list
`[f 1 1, f 1 2, f 1 3, f 2 2, f 2 3, f 3 3]`.
-/
def mmap_upper_triangle {m} [monad m] {α β : Type u} (f : α → α → m β) : list α → m (list β)
| [] := return []
| (h::t) := do v ← f h h, l ← t.mmap (f h), t ← t.mmap_upper_triangle, return $ (v::l) ++ t

/--
`mmap'_diag f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap'_diag f l` will evaluate, in this order,
`f 1 1`, `f 1 2`, `f 1 3`, `f 2 2`, `f 2 3`, `f 3 3`.
-/
def mmap'_diag {m} [monad m] {α} (f : α → α → m unit) : list α → m unit
| [] := return ()
| (h::t) := f h h >> t.mmap' (f h) >> t.mmap'_diag

protected def traverse {F : Type u → Type v} [applicative F] {α β : Type*} (f : α → F β) :
  list α → F (list β)
| [] := pure []
| (x :: xs) := list.cons <$> f x <*> traverse xs

/-- `get_rest l l₁` returns `some l₂` if `l = l₁ ++ l₂`.
  If `l₁` is not a prefix of `l`, returns `none` -/
def get_rest [decidable_eq α] : list α → list α → option (list α)
| l      []      := some l
| []     _       := none
| (x::l) (y::l₁) := if x = y then get_rest l l₁ else none

/--
`list.slice n m xs` removes a slice of length `m` at index `n` in list `xs`.
-/
def slice {α} : ℕ → ℕ → list α → list α
| 0 n xs := xs.drop n
| (succ n) m [] := []
| (succ n) m (x :: xs) := x :: slice n m xs

/--
Left-biased version of `list.map₂`. `map₂_left' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is
applied to `none` for the remaining `aᵢ`. Returns the results of the `f`
applications and the remaining `bs`.

```
map₂_left' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

map₂_left' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
```
-/
@[simp] def map₂_left' (f : α → option β → γ) : list α → list β → (list γ × list β)
| [] bs := ([], bs)
| (a :: as) [] :=
  ((a :: as).map (λ a, f a none), [])
| (a :: as) (b :: bs) :=
  let rec := map₂_left' as bs in
  (f a (some b) :: rec.fst, rec.snd)

/--
Right-biased version of `list.map₂`. `map₂_right' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is
applied to `none` for the remaining `bᵢ`. Returns the results of the `f`
applications and the remaining `as`.

```
map₂_right' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

map₂_right' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])
```
-/
def map₂_right' (f : option α → β → γ) (as : list α) (bs : list β) : (list γ × list α) :=
map₂_left' (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`. Also returns the remaining `bs`.

```
zip_left' [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

zip_left' [1] ['a', 'b'] = ([(1, some 'a')], ['b'])

zip_left' = map₂_left' prod.mk

```
-/
def zip_left' : list α → list β → list (α × option β) × list β :=
map₂_left' prod.mk

/--
Right-biased version of `list.zip`. `zip_right' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`. Also returns the remaining `as`.

```
zip_right' [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

zip_right' [1, 2] ['a'] = ([(some 1, 'a')], [2])

zip_right' = map₂_right' prod.mk
```
-/
def zip_right' : list α → list β → list (option α × β) × list α :=
map₂_right' prod.mk

/--
Left-biased version of `list.map₂`. `map₂_left f as bs` applies `f` to each pair
`aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`
for the remaining `aᵢ`.

```
map₂_left prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]

map₂_left prod.mk [1] ['a', 'b'] = [(1, some 'a')]

map₂_left f as bs = (map₂_left' f as bs).fst
```
-/
@[simp] def map₂_left (f : α → option β → γ) : list α → list β → list γ
| [] _ := []
| (a :: as) [] := (a :: as).map (λ a, f a none)
| (a :: as) (b :: bs) := f a (some b) :: map₂_left as bs

/--
Right-biased version of `list.map₂`. `map₂_right f as bs` applies `f` to each
pair `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is applied to
`none` for the remaining `bᵢ`.

```
map₂_right prod.mk [1, 2] ['a'] = [(some 1, 'a')]

map₂_right prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

map₂_right f as bs = (map₂_right' f as bs).fst
```
-/
def map₂_right (f : option α → β → γ) (as : list α) (bs : list β) :
  list γ :=
map₂_left (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`.

```
zip_left [1, 2] ['a'] = [(1, some 'a'), (2, none)]

zip_left [1] ['a', 'b'] = [(1, some 'a')]

zip_left = map₂_left prod.mk
```
-/
def zip_left : list α → list β → list (α × option β) :=
map₂_left prod.mk

/--
Right-biased version of `list.zip`. `zip_right as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`.

```
zip_right [1, 2] ['a'] = [(some 1, 'a')]

zip_right [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

zip_right = map₂_right prod.mk
```
-/
def zip_right : list α → list β → list (option α × β) :=
map₂_right prod.mk

/--
If all elements of `xs` are `some xᵢ`, `all_some xs` returns the `xᵢ`. Otherwise
it returns `none`.

```
all_some [some 1, some 2] = some [1, 2]
all_some [some 1, none  ] = none
```
-/
def all_some : list (option α) → option (list α)
| [] := some []
| (some a :: as) := cons a <$> all_some as
| (none :: as) := none

/--
`fill_nones xs ys` replaces the `none`s in `xs` with elements of `ys`. If there
are not enough `ys` to replace all the `none`s, the remaining `none`s are
dropped from `xs`.

```
fill_nones [none, some 1, none, none] [2, 3] = [2, 1, 3]
```
-/
def fill_nones {α} : list (option α) → list α → list α
| [] _ := []
| (some a :: as) as' := a :: fill_nones as as'
| (none :: as) [] := as.reduce_option
| (none :: as) (a :: as') := a :: fill_nones as as'

/--
`take_list as ns` extracts successive sublists from `as`. For `ns = n₁ ... nₘ`,
it first takes the `n₁` initial elements from `as`, then the next `n₂` ones,
etc. It returns the sublists of `as` -- one for each `nᵢ` -- and the remaining
elements of `as`. If `as` does not have at least as many elements as the sum of
the `nᵢ`, the corresponding sublists will have less than `nᵢ` elements.

```
take_list ['a', 'b', 'c', 'd', 'e'] [2, 1, 1] = ([['a', 'b'], ['c'], ['d']], ['e'])
take_list ['a', 'b'] [3, 1] = ([['a', 'b'], []], [])
```
-/
def take_list {α} : list α → list ℕ → list (list α) × list α
| xs [] := ([], xs)
| xs (n :: ns) :=
  let ⟨xs₁, xs₂⟩ := xs.split_at n in
  let ⟨xss, rest⟩ := take_list xs₂ ns in
  (xs₁ :: xss, rest)

/--
`to_rbmap as` is the map that associates each index `i` of `as` with the
corresponding element of `as`.

```
to_rbmap ['a', 'b', 'c'] = rbmap_of [(0, 'a'), (1, 'b'), (2, 'c')]
```
-/
def to_rbmap : list α → rbmap ℕ α :=
foldl_with_index (λ i mapp a, mapp.insert i a) (mk_rbmap ℕ α)

/--
`to_rb_map as` is the map that associates each index `i` of `as` with the
corresponding element of `as`.

```
to_rb_map ['a', 'b', 'c'] = rb_map.of_list [(0, 'a'), (1, 'b'), (2, 'c')]
```
-/
meta def to_rb_map {α : Type} : list α → rb_map ℕ α :=
foldl_with_index (λ i mapp a, mapp.insert i a) mk_rb_map

/--
`xs.to_chunks n` splits the list into sublists of size at most `n`,
such that `(xs.to_chunks n).join = xs`.

TODO: make non-meta; currently doesn't terminate, e.g.
```
#eval [0].to_chunks 0
```
-/
meta def to_chunks {α} (n : ℕ) : list α → list (list α)
| [] := []
| xs :=
  xs.take n :: (xs.drop n).to_chunks

/--
Asynchronous version of `list.map`.
-/
meta def map_async_chunked {α β} (f : α → β) (xs : list α) (chunk_size := 1024) : list β :=
((xs.to_chunks chunk_size).map (λ xs, task.delay (λ _, list.map f xs))).bind task.get

end list
-/