import rank_one_valuation
import normed_space
import power_mult_seminorm
import analysis.normed_space.operator_norm
import data.list.min_max
import field_theory.fixed
import field_theory.normal
import topology.algebra.valuation
import ring_theory.polynomial.vieta
import normal_closure
import pow_mult_faithful

noncomputable theory

open polynomial

open_locale polynomial nnreal

variables {R : Type*} [normed_ring R]

def polynomial.coeffs (p : R[X])  : list R := list.map p.coeff (list.range p.nat_degree)

lemma list.le_max_of_exists_le {α : Type*} [linear_order α] [order_bot α] {l : list α} {a x : α}
  (hx : x ∈ l) (h : a ≤ x) : a ≤ l.foldr max ⊥ :=
begin
  induction l with y l IH,
  { exact absurd hx (list.not_mem_nil _), },
  { obtain rfl | hl := hx,
    simp only [list.foldr, list.foldr_cons],
    { exact le_max_of_le_left h, },
    { exact le_max_of_le_right (IH hl) }}
end

def spectral_value_terms {p : R[X]} (hp : p.monic) : ℕ → ℝ≥0 :=
λ (n : ℕ), if n < p.nat_degree then ∥ p.coeff n ∥₊^(1/(p.nat_degree - n : ℝ)) else 0

lemma spectral_value_terms_of_lt_nat_degree {p : R[X]} (hp : p.monic) {n : ℕ}
  (hn : n < p.nat_degree) : spectral_value_terms hp n = ∥ p.coeff n ∥₊^(1/(p.nat_degree - n : ℝ)) :=
by simp only [spectral_value_terms, if_pos hn]

lemma spectral_value_terms_of_nat_degree_le {p : R[X]} (hp : p.monic) {n : ℕ}
  (hn : p.nat_degree ≤ n) : spectral_value_terms hp n = 0 :=
by simp only [spectral_value_terms, if_neg (not_lt.mpr hn)]

def spectral_value {p : R[X]} (hp : p.monic) : nnreal := supr (spectral_value_terms hp)

lemma spectral_value_terms_bdd_above {p : R[X]} (hp : p.monic) :
  bdd_above (set.range (spectral_value_terms hp)) :=
begin
  use list.foldr max 0
  (list.map (λ n, ∥ p.coeff n ∥₊^(1/(p.nat_degree - n : ℝ))) (list.range p.nat_degree)),
  { rw mem_upper_bounds,
    intros r hr,
    obtain ⟨n, hn⟩ := set.mem_range.mpr hr,
    simp only [spectral_value_terms] at hn,
    rw ← nnreal.bot_eq_zero,
    split_ifs at hn with hd hd,
    { have h : ∥p.coeff n∥₊ ^ (1 / (p.nat_degree - n : ℝ)) ∈ list.map
        (λ (n : ℕ), ∥p.coeff n∥₊ ^ (1 / (p.nat_degree - n : ℝ))) (list.range p.nat_degree),
      { simp only [list.mem_map, list.mem_range],
        exact ⟨n, hd, rfl⟩, },
    exact list.le_max_of_exists_le h (ge_of_eq hn), },
    { rw ← hn, exact zero_le _, }},
end

lemma spectral_value_terms_finite_range {p : R[X]} (hp : p.monic) :
  (set.range (spectral_value_terms hp)).finite :=
begin
  have h_ss : set.range (spectral_value_terms hp) ⊆ set.range (λ (n : fin p.nat_degree),
    ∥ p.coeff n ∥₊^(1/(p.nat_degree - n : ℝ))) ∪ {(0 : ℝ≥0)},
  { intros x hx,
    obtain ⟨m, hm⟩ := set.mem_range.mpr hx,
    by_cases hm_lt : m < p.nat_degree,
    { simp only [spectral_value_terms_of_lt_nat_degree hp hm_lt] at hm,
      rw ← hm,
      exact set.mem_union_left _ ⟨⟨m, hm_lt⟩, rfl⟩, },
    { simp only [spectral_value_terms_of_nat_degree_le hp (le_of_not_lt hm_lt)] at hm,
      rw hm,
      exact set.mem_union_right _ (set.mem_singleton _), }},
  exact set.finite.subset (set.finite.union (set.finite_range _) (set.finite_singleton _)) h_ss,
end

variable [nontrivial R]

lemma list.max_repeat {α : Type*} {n : ℕ} (a : α) [linear_order α] :
  list.foldr max a (list.repeat a n) = a :=
begin
  induction n with n hn,
  { simp only [list.repeat, list.foldr_nil] },
  { simp only [list.foldr, list.repeat, list.repeat_succ, list.foldr_cons, max_eq_left_iff],
    exact le_of_eq hn, }
end

lemma spectral_value_X_pow (n : ℕ) :
  spectral_value (@polynomial.monic_X_pow R _ n) = 0 :=
begin
  rw spectral_value, rw spectral_value_terms,
  simp_rw [polynomial.coeff_X_pow n, polynomial.nat_degree_X_pow],
  convert csupr_const,
  ext m,
  by_cases hmn : m < n,
  { rw [if_pos hmn, nnreal.coe_eq, nnreal.rpow_eq_zero_iff, if_neg (ne_of_lt hmn), nnnorm_zero,
      one_div, ne.def, inv_eq_zero, ← nat.cast_sub (le_of_lt hmn), nat.cast_eq_zero,
      nat.sub_eq_zero_iff_le],
    exact ⟨eq.refl _, not_le_of_lt hmn⟩, },
  { rw if_neg hmn },
  apply_instance,
end

lemma spectral_value_eq_zero_iff [nontrivial R] {p : R[X]} (hp : p.monic) :
  spectral_value hp = 0 ↔ p = polynomial.X^p.nat_degree :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw spectral_value at h,
    ext,
    rw polynomial.coeff_X_pow,
    by_cases hn : n = p.nat_degree,
    { rw [if_pos hn, hn, polynomial.coeff_nat_degree], exact hp, },
    { rw if_neg hn,
      { by_cases hn' : n < p.nat_degree,
        { have h_le : supr (spectral_value_terms hp) ≤ 0 := le_of_eq h,
          have h_exp : 0 < 1 / ((p.nat_degree : ℝ) - n),
          { rw [one_div_pos, ← nat.cast_sub (le_of_lt hn'), nat.cast_pos],
            exact nat.sub_pos_of_lt hn', },
          have h0 : (0 : nnreal) = 0^(1 / ((p.nat_degree : ℝ) - n)),
          { rw nnreal.zero_rpow (ne_of_gt h_exp), },
          rw [supr, cSup_le_iff (spectral_value_terms_bdd_above hp)
            (set.range_nonempty _)] at h_le,
          specialize h_le (spectral_value_terms hp n) ⟨n, rfl⟩,
          simp only [spectral_value_terms, if_pos hn'] at h_le,
          rw [h0, nnreal.rpow_le_rpow_iff h_exp] at h_le,
          exact norm_eq_zero.mp (le_antisymm h_le (norm_nonneg _)), },
        { exact polynomial.coeff_eq_zero_of_nat_degree_lt
            (lt_of_le_of_ne (le_of_not_lt hn') (ne_comm.mpr hn)) }}}},
  { convert spectral_value_X_pow p.nat_degree,
    apply_instance }
end

lemma spectral_value_X_sub_C (r : R) :
  spectral_value (@polynomial.monic_X_sub_C _ _ r) = ∥r∥₊ :=
begin
  rw spectral_value, rw spectral_value_terms,
  simp only [polynomial.nat_degree_X_sub_C, nat.lt_one_iff, polynomial.coeff_sub,
    nat.cast_one, one_div],
  suffices : (⨆ (n : ℕ), ite (n = 0) ∥r∥₊ 0) = ∥r∥₊,
  { rw ← this,
    apply congr_arg,
    ext n,
    by_cases hn : n = 0,
    { rw [if_pos hn, if_pos hn, hn, nat.cast_zero, sub_zero, polynomial.coeff_X_zero,
        polynomial.coeff_C_zero, zero_sub, nnnorm_neg, inv_one, nnreal.rpow_one] },
    { rw [if_neg hn, if_neg hn],}},
  { apply csupr_eq_of_forall_le_of_forall_lt_exists_gt,
    { intro n,
      split_ifs,
      exact le_refl _,
      exact zero_le _ },
    { intros x hx, use 0,
      simp only [eq_self_iff_true, if_true, hx], }}
end

/- In this section we prove Proposition 3.1.2/1 from BGR. -/
section bdd_by_spectral_value
variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L] {f : L → ℝ≥0}

lemma polynomial.nat_degree_pos_of_monic_of_root {p : K[X]} (hp : p.monic) {x : L}
  (hx : polynomial.aeval x p = 0) : 0 < p.nat_degree :=
polynomial.nat_degree_pos_of_aeval_root (polynomial.ne_zero_of_ne_zero_of_monic one_ne_zero hp) hx
  ((injective_iff_map_eq_zero (algebra_map K L)).mp (algebra_map K L).injective)

-- Part (1): the norm of any root of p is bounded by the spectral value of p.
lemma root_norm_le_spectral_value (hf_pm : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) (hf1 : is_norm_le_one_class f)
  {p : K[X]} (hp : p.monic) {x : L} (hx : polynomial.aeval x p = 0) : f x ≤ spectral_value hp :=
begin
  by_cases hx0 : f x = 0,
  { rw hx0, exact zero_le _ },
  { by_contra' h_ge,
    have hn_lt : ∀ (n : ℕ) (hn : n < p.nat_degree), ∥ p.coeff n ∥₊ < (f x)^ (p.nat_degree - n),
    { intros n hn,
      have hexp : (∥p.coeff n∥₊^(1/(p.nat_degree - n : ℝ)))^(p.nat_degree - n) = ∥p.coeff n∥₊,
      { rw [← nnreal.rpow_nat_cast, ← nnreal.rpow_mul, mul_comm, nnreal.rpow_mul,
          nnreal.rpow_nat_cast, ← nat.cast_sub (le_of_lt hn), one_div,
          nnreal.pow_nat_rpow_nat_inv _ (ne_of_gt (tsub_pos_of_lt hn))] },
      have h_base : ∥p.coeff n∥₊^(1/(p.nat_degree - n : ℝ)) < f x,
      { rw [spectral_value, supr, set.finite.cSup_lt_iff (spectral_value_terms_finite_range hp)
          (set.range_nonempty (spectral_value_terms hp))] at h_ge,
        have h_rg: ∥p.coeff n∥₊ ^ (1 / (p.nat_degree - n : ℝ)) ∈ set.range (spectral_value_terms hp),
        { use n, simp only [spectral_value_terms, if_pos hn] },
        exact h_ge (∥p.coeff n∥₊ ^ (1 / (↑(p.nat_degree) - ↑n))) h_rg },
      rw [← hexp, ← nnreal.rpow_nat_cast, ← nnreal.rpow_nat_cast],
      exact nnreal.rpow_lt_rpow h_base (nat.cast_pos.mpr (tsub_pos_of_lt hn)), },
    have h_deg : 0 < p.nat_degree := polynomial.nat_degree_pos_of_monic_of_root hp hx,
    have : ∥(1 : K)∥ = 1 := norm_one,
    have h_lt : f ((finset.range (p.nat_degree)).sum (λ (i : ℕ), p.coeff i • x ^ i)) <
      f (x^(p.nat_degree)),
    { have hn' : ∀ (n : ℕ) (hn : n < p.nat_degree), f (p.coeff n • x ^ n) < f (x^(p.nat_degree)),
      { intros n hn,
        by_cases hn0 : n = 0,
        { rw [hn0, pow_zero, hf_alg_norm.smul, hf_pm _ (nat.succ_le_iff.mpr h_deg),
            ← nat.sub_zero p.nat_degree, ← hn0],
          exact mul_lt_of_lt_of_le_one (hn_lt n hn) hf1 },
        { have : p.nat_degree = (p.nat_degree - n) + n,
          { rw nat.sub_add_cancel (le_of_lt hn), },
          rw [hf_alg_norm.smul, hf_pm _ (nat.succ_le_iff.mp (pos_iff_ne_zero.mpr hn0)),
            hf_pm _ (nat.succ_le_iff.mpr h_deg), this, pow_add],
          rw mul_lt_mul_right (pow_pos (pos_iff_ne_zero.mpr hx0) _),
          exact hn_lt n hn }},
      have hf0 : f 0 = 0 := hf_alg_norm.to_is_norm.to_is_seminorm.zero,
      obtain ⟨m, hm_in, hm⟩ := is_nonarchimedean_finset_range_add_le hf0 hf_na p.nat_degree
        (λ (i : ℕ), p.coeff i • x ^ i),
      exact lt_of_le_of_lt hm (hn' m (hm_in h_deg)) },
    have h0 : f 0 ≠ 0,
    { have h_eq : f 0 = f (x^(p.nat_degree)),
      { rw [← hx, polynomial.aeval_eq_sum_range, finset.sum_range_succ, add_comm, hp.coeff_nat_degree,
        one_smul, ← max_eq_left_of_lt h_lt],
        exact is_nonarchimedean_add_eq_max_of_ne hf_alg_norm.to_is_norm.to_is_seminorm
        hf_na (ne_of_lt h_lt), },
      rw h_eq,
      exact ne_of_gt (lt_of_le_of_lt (zero_le _) h_lt) },
    exact h0 hf_alg_norm.to_is_norm.to_is_seminorm.zero, }
end

lemma polynomial.monic_of_prod (p : K[X]) {n : ℕ} (b : fin n → L) (hp : polynomial.map_alg K L p =
  finprod (λ (k : fin n), polynomial.X - (polynomial.C (b k)))) : p.monic :=
begin
  have hprod : (finprod (λ (k : fin n), polynomial.X - polynomial.C (b k))).monic,
  { rw finprod_eq_prod_of_fintype,
    exact polynomial.monic_prod_of_monic _ _ (λ m hm, polynomial.monic_X_sub_C (b m)) },
  rw [← hp, polynomial.map_alg_eq_map] at hprod,
  exact polynomial.monic_of_injective (algebra_map K L).injective hprod,
end

lemma polynomial.monic_of_prod' (p : K[X]) (s : multiset L) (hp : polynomial.map_alg K L p =
  (multiset.map (λ (a : L), polynomial.X - polynomial.C a) s).prod) : p.monic :=
begin
  have hprod : ((multiset.map (λ (a : L), polynomial.X - polynomial.C a) s).prod).monic,
  { exact polynomial.monic_multiset_prod_of_monic _ _ (λ m hm, polynomial.monic_X_sub_C m) },
  rw [← hp, polynomial.map_alg_eq_map] at hprod,
  exact polynomial.monic_of_injective (algebra_map K L).injective hprod,
end

lemma polynomial.C_finset_add {α : Type*} (s : finset α) (b : α → K) :
  s.sum (λ (x : α), polynomial.C (b x)) = polynomial.C (s.sum b) :=
begin
  classical,
  apply s.induction_on,
  { simp only [finset.sum_empty, map_zero] },
  { intros a s ha hs,
    rw [finset.sum_insert ha, finset.sum_insert ha, hs, polynomial.C_add], }
end

lemma polynomial.C_finset_prod {α : Type*} (s : finset α) (b : α → K) :
  s.prod (λ (x : α), polynomial.C (b x)) = polynomial.C (s.prod  b) :=
begin
  classical,
  apply s.induction_on,
  { simp only [finset.prod_empty, map_one] },
  { intros a s ha hs,
    rw [finset.prod_insert ha, finset.prod_insert ha, hs, polynomial.C_mul], }
end

lemma prod_X_add_C_nat_degree {n : ℕ} (b : fin n → L) :
  (finset.univ.prod (λ (i : fin n), polynomial.X - polynomial.C (b i))).nat_degree = n :=
begin
  rw polynomial.nat_degree_prod _ _ (λ m hm, polynomial.X_sub_C_ne_zero (b m)),
  simp only [polynomial.nat_degree_X_sub_C, finset.sum_const, finset.card_fin,
    algebra.id.smul_eq_mul, mul_one],
end

lemma finset.powerset_len_nonempty' {α : Type*} {n : ℕ} {s : finset α} (h : n ≤ s.card) :
  (finset.powerset_len n s).nonempty :=
begin
  classical,
  induction s using finset.induction_on with x s hx IH generalizing n,
  { rw [finset.card_empty, le_zero_iff] at h,
    rw [h, finset.powerset_len_zero],
    exact finset.singleton_nonempty _, },
  { cases n,
    { simp },
    { rw [finset.card_insert_of_not_mem hx, nat.succ_le_succ_iff] at h,
      rw finset.powerset_len_succ_insert hx,
      refine finset.nonempty.mono _ ((IH h).image (insert x)),
      convert (finset.subset_union_right _ _) }}
end

lemma is_nonarchimedean_finset_powerset_image_add (hf_pm : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) {n : ℕ} (hn : 0 < n) (b : fin n → L)
  {m : ℕ} (hm : m < n) :
∃ (s : (finset.powerset_len (fintype.card (fin n) - m) (@finset.univ (fin n) _))),
 f ((finset.powerset_len (fintype.card (fin n) - m) finset.univ).sum
  (λ (t : finset (fin n)), t.prod (λ (i : fin n), -b i))) ≤  f (s.val.prod (λ (i : fin n), -b i)) :=
begin
  have hf0 : f 0 = 0 := hf_alg_norm.zero,
  set g := (λ (t : finset (fin n)), t.prod (λ (i : fin n), -b i)) with hg,
  obtain ⟨b, hb_in, hb⟩ := is_nonarchimedean_finset_image_add hf0 hf_na g
    (finset.powerset_len (fintype.card (fin n) - m) finset.univ),
  have hb_ne : (finset.powerset_len (fintype.card (fin n) - m)
    (finset.univ : finset(fin n))).nonempty,
  { rw [fintype.card_fin],
    have hmn : n - m ≤ (finset.univ : finset (fin n)).card,
    { rw [finset.card_fin],
      exact nat.sub_le n m },
    exact finset.powerset_len_nonempty' hmn, },
  use [⟨b, hb_in hb_ne⟩, hb]
end

lemma is_nonarchimedean_multiset_powerset_image_add (hf_pm : is_pow_mult f)
  (hf_na : is_nonarchimedean f) (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f)
  (s : multiset L) {m : ℕ} (hm : m < s.card) :
  ∃ t : multiset L, t.card = s.card - m ∧ (∀ x : L, x ∈ t → x ∈ s) ∧
    f (multiset.map multiset.prod (multiset.powerset_len (s.card - m) s)).sum ≤ f (t.prod) :=
begin
  have hf0 : f 0 = 0 := hf_alg_norm.zero,
  set g := (λ (t : multiset L), t.prod) with hg,
  obtain ⟨b, hb_in, hb_le⟩ := is_nonarchimedean_multiset_image_add hf0 hf_na g
    (multiset.powerset_len (s.card - m) s),
  have hb : b ≤ s ∧ b.card = s.card - m,
  { rw [← multiset.mem_powerset_len],
    apply hb_in,
    rw [multiset.card_powerset_len],
    exact nat.choose_pos ((s.card).sub_le m), },
  refine ⟨b, hb.2, (λ x hx, multiset.mem_of_le hb.left hx), hb_le⟩,
end

lemma finset.esymm_map_val {σ R} [comm_semiring R] (f : σ → R) (s : finset σ) (n : ℕ) :
  (s.val.map f).esymm n = (s.powerset_len n).sum (λ t, t.prod f) :=
begin
  rw [multiset.esymm, multiset.powerset_len_map, ← finset.map_val_val_powerset_len],
  simpa only [multiset.map_map],
end

-- (multiset.map (λ (a : L), X - ⇑C a) s).prod
open_locale classical

/-- Part (2): if p splits into linear factors over B, then its spectral value equals the maximum
  of the norms of its roots. -/
lemma max_root_norm_eq_spectral_value (hf_pm : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) (hf1 : is_norm_one_class f)
  (p : K[X]) {n : ℕ} (hn : 0 < n) (b : fin n → L)
  (hp : polynomial.map_alg K L p = finprod (λ (k : fin n), polynomial.X - (polynomial.C (b k))))
  (h_isom : ∀ x y : K, f ((algebra_map K L y) - algebra_map K L x) = nndist x y) :
  supr (f ∘ b) = spectral_value (p.monic_of_prod b hp) :=
begin
  apply le_antisymm,
  { haveI : nonempty (fin n) := fin.pos_iff_nonempty.mp hn,
    apply csupr_le,
    rintros m,
    have hm : polynomial.aeval (b m) p = 0,
    { have hm' : polynomial.aeval (b m) ((polynomial.map_alg K L) p) = 0,
      { have hd1 : (polynomial.aeval (b m)) (polynomial.X - polynomial.C (b m)) = 0,
        { rw [polynomial.coe_aeval_eq_eval, polynomial.eval_sub, polynomial.eval_X,
            polynomial.eval_C, sub_self] },
        rw [hp, finprod_eq_prod_of_fintype, polynomial.aeval_def, polynomial.eval₂_finset_prod],
        exact finset.prod_eq_zero (finset.mem_univ m) hd1, },
      rw [polynomial.map_alg_eq_map, polynomial.aeval_map] at hm',
      exact hm', },
    rw function.comp_apply,
    exact root_norm_le_spectral_value hf_pm hf_na hf_alg_norm (le_of_eq hf1) _ hm, },
  { apply csupr_le,
    intros m,
    by_cases hm : m < p.nat_degree,
    { rw spectral_value_terms_of_lt_nat_degree _ hm,
      have h : 0 < (p.nat_degree - m : ℝ),
      { rw [sub_pos, nat.cast_lt], exact hm },
      rw [← nnreal.rpow_le_rpow_iff h, ← nnreal.rpow_mul, one_div_mul_cancel (ne_of_gt h),
        nnreal.rpow_one, ← nat.cast_sub (le_of_lt hm), nnreal.rpow_nat_cast],
      have hpn : n = p.nat_degree,
      { rw [← polynomial.nat_degree_map (algebra_map K L), ← polynomial.map_alg_eq_map, hp,
          finprod_eq_prod_of_fintype, prod_X_add_C_nat_degree] },
      have hc : ∥p.coeff m∥₊ = f (((polynomial.map_alg K L) p).coeff m),
      { have : ∥p.coeff m∥₊ = (λ (r : K), ∥r∥₊) (p.coeff m) := rfl,
        rw [this, ← is_algebra_norm_extends (normed_ring.to_is_norm K) hf_alg_norm hf1,
          polynomial.map_alg_eq_map, polynomial.coeff_map] },
        rw [hc, hp, finprod_eq_prod_of_fintype],
        simp_rw [sub_eq_add_neg, ← polynomial.C_neg, finset.prod_eq_multiset_prod, ← pi.neg_apply,
          ← multiset.map_map (λ x : L, X + C x) (-b)],
        have hm_le' : m ≤ multiset.card (multiset.map (-b) finset.univ.val),
        { have : multiset.card finset.univ.val = finset.card finset.univ := rfl,
          rw [multiset.card_map, this, finset.card_fin n, hpn],
           exact (le_of_lt hm), },
        rw multiset.prod_X_add_C_coeff _ hm_le',
      have : m < n,
      { rw hpn, exact hm },
      obtain ⟨s, hs⟩ := is_nonarchimedean_finset_powerset_image_add hf_pm hf_na hf_alg_norm hn b
        this,
      rw finset.esymm_map_val,
      have h_card : multiset.card (multiset.map (-b) finset.univ.val) = fintype.card (fin n),
      { rw [multiset.card_map], refl, },
      rw h_card,
      apply le_trans hs,
      have  h_pr: f (s.val.prod (λ (i : fin n), -b i)) ≤ s.val.prod (λ (i : fin n), f(-b i)),
      { exact finset.le_prod_of_submultiplicative _ hf1 hf_alg_norm.mul _ _,},
      apply le_trans h_pr,
      have : s.val.prod (λ (i : fin n), f (-b i)) ≤ s.val.prod (λ (i : fin n), supr (f ∘ b)),
      { apply finset.prod_le_prod,
        { intros i hi, exact zero_le _, },
        { intros i hi,
          rw hf_na.neg hf_alg_norm.zero _,
          exact le_csupr (set.finite.bdd_above (set.range (f ∘ b)).to_finite) _, }},
      apply le_trans this,
      apply le_of_eq,
      simp only [subtype.val_eq_coe, finset.prod_const],
      suffices h_card : (s : finset (fin n)).card = p.nat_degree - m,
      { rw h_card },
      have hs' := s.property,
      simp only [subtype.val_eq_coe, fintype.card_fin, finset.mem_powerset_len] at hs',
      rw [hs'.right, hpn],  },
    rw spectral_value_terms_of_nat_degree_le _ (le_of_not_lt hm),
    exact zero_le _, },
end

lemma multiset.max {s : multiset L} (hs : s.to_finset.nonempty) :
  ∃ y : L, y ∈ s ∧ ∀ z : L, z ∈ s → f z ≤ f y :=
begin
  have hsf : (multiset.map f s).to_finset.nonempty,
  { obtain ⟨x, hx⟩ := hs.bex,
    exact ⟨f x, multiset.mem_to_finset.mpr (multiset.mem_map.mpr
      ⟨x, (multiset.mem_to_finset.mp hx), rfl⟩)⟩ },
  have h := (s.map f).to_finset.max'_mem hsf,
  rw [multiset.mem_to_finset, multiset.mem_map] at h,
  obtain ⟨y, hys, hymax⟩ := h,
  use [y, hys],
  intros z hz,
  rw hymax,
  exact finset.le_max' _ _ (multiset.mem_to_finset.mpr (multiset.mem_map.mpr ⟨z, hz, rfl⟩)),
end

lemma multiset.card_to_finset_pos {α : Type u_1} {m : multiset α} (hm : 0 < m.card) :
  0 < m.to_finset.card :=
begin
  obtain ⟨x, hx⟩ := multiset.card_pos_iff_exists_mem.mp hm,
  exact finset.card_pos.mpr ⟨x, multiset.mem_to_finset.mpr hx⟩,
end

lemma polynomial.aeval_root (s : multiset L) {x : L} (hx : x ∈ s) {p : K[X]}
  (hp : polynomial.map_alg K L p =
    (multiset.map (λ (a : L), polynomial.X - polynomial.C a) s).prod) : polynomial.aeval x p = 0 :=
begin
  have : polynomial.aeval x (polynomial.map_alg K L p) = polynomial.aeval x p,
  { rw [map_alg_eq_map, aeval_map] },
  rw [← this, hp, coe_aeval_eq_eval],
  have hy : (X - C x) ∣ (multiset.map (λ (a : L), X - C a) s).prod,
  { apply multiset.dvd_prod,
    simp only [multiset.mem_map, sub_right_inj, C_inj, exists_eq_right],
    exact hx },
  rw eval_eq_zero_of_dvd_of_eval_eq_zero hy,
  simp only [eval_sub, eval_X, eval_C, sub_self],
end

lemma max_root_norm_eq_spectral_value' (hf_pm : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) (hf1 : is_norm_one_class f)
  (p : K[X]) (s : multiset L)
  (hp : polynomial.map_alg K L p = (multiset.map (λ (a : L), polynomial.X - polynomial.C a) s).prod)
  (h_isom : ∀ x y : K, f ((algebra_map K L y) - algebra_map K L x) = nndist x y) :
  supr (λ x : L, if x ∈ s then f x else 0 ) = spectral_value (p.monic_of_prod' s hp) :=
begin
   apply le_antisymm,
  { apply csupr_le,
    rintros x,
    by_cases hx : x ∈ s,
    { have hx0 : polynomial.aeval x p = 0 := polynomial.aeval_root s hx hp,
      rw if_pos hx,
      exact root_norm_le_spectral_value hf_pm hf_na hf_alg_norm (le_of_eq hf1) _ hx0, },
    { rw if_neg hx,
      exact zero_le', }},
  { apply csupr_le,
    intros m,
    by_cases hm : m < p.nat_degree,
    { rw spectral_value_terms_of_lt_nat_degree _ hm,
      have h : 0 < (p.nat_degree - m : ℝ),
      { rw [sub_pos, nat.cast_lt], exact hm },
      rw [← nnreal.rpow_le_rpow_iff h, ← nnreal.rpow_mul, one_div_mul_cancel (ne_of_gt h),
        nnreal.rpow_one, ← nat.cast_sub (le_of_lt hm), nnreal.rpow_nat_cast],
      have hps : s.card = p.nat_degree,
      { rw [← polynomial.nat_degree_map (algebra_map K L), ← polynomial.map_alg_eq_map, hp,
          nat_degree_multiset_prod_X_sub_C_eq_card], },
      have hc : ∥p.coeff m∥₊ = f (((polynomial.map_alg K L) p).coeff m),
      { have : ∥p.coeff m∥₊ = (λ (r : K), ∥r∥₊) (p.coeff m) := rfl,
        rw [this, ← is_algebra_norm_extends (normed_ring.to_is_norm K) hf_alg_norm hf1,
          polynomial.map_alg_eq_map, polynomial.coeff_map] },
        rw [hc, hp],
        have hm_le' : m ≤ s.card,
        { rw hps, exact le_of_lt hm, },
        rw multiset.prod_X_sub_C_coeff s hm_le',

        have h : f ((-1) ^ (s.card - m) * s.esymm (s.card - m)) = f (s.esymm (s.card - m)),
        { cases (neg_one_pow_eq_or L (s.card - m)) with h1 hn1,
          { rw [h1, one_mul] },
          { rw [hn1, neg_mul, one_mul, hf_na.neg hf_alg_norm.zero], } },
        rw h,
        rw [multiset.esymm],
        --set n := s.card with hn,

        have ht : ∃ t : multiset L, t.card = s.card - m ∧ (∀ x : L, x ∈ t → x ∈ s) ∧
        f (multiset.map multiset.prod (multiset.powerset_len (s.card - m) s)).sum ≤ f (t.prod),
        { have hm' : m < multiset.card s,
          { rw hps, exact hm, },
          exact is_nonarchimedean_multiset_powerset_image_add hf_pm hf_na hf_alg_norm s hm', },

        obtain ⟨t, ht_card, hts, ht_ge⟩ := ht,
        apply le_trans ht_ge,

        have  h_pr: f (t.prod) ≤ (t.map f).prod,
        { exact multiset.le_prod_of_submultiplicative _ hf1 hf_alg_norm.mul _ },
        apply le_trans h_pr,
        have hs_ne : s.to_finset.nonempty,
        { rw [← finset.card_pos],
          apply multiset.card_to_finset_pos,
          rw hps,
          exact lt_of_le_of_lt (zero_le _) hm, },
        have hy : ∃ y : L, y ∈ s ∧ ∀ z : L, z ∈ s → f z ≤ f y := multiset.max hs_ne,
        obtain ⟨y, hyx, hy_max⟩ := hy,
        have : (multiset.map f t).prod ≤ (f y) ^ (p.nat_degree - m),
        { have h_card : (p.nat_degree - m) = (t.map f).card,
          { rw [multiset.card_map, ht_card, ← hps] },
          have h_le : ∀ (x : ℝ≥0), x ∈ multiset.map f t → x ≤ f y,
          { intros r hr,
            obtain ⟨z, hzt, hzr⟩ := multiset.mem_map.mp hr,
            rw ← hzr,
            exact hy_max _ (hts _ hzt) },
          rw h_card,
          exact multiset.prod_le_pow_card (t.map f) _ h_le, },

        have h_bdd : bdd_above (set.range (λ (x : L), ite (x ∈ s) (f x) 0)),
        { use f y,
          rw mem_upper_bounds,
          intros r hr,
          obtain ⟨z, hz⟩ := set.mem_range.mpr hr,
          simp only at hz,
          rw ← hz,
          split_ifs with h,
          { exact hy_max _ h },
          { exact zero_le' }},
        apply le_trans this,
        apply pow_le_pow_of_le,
        apply le_trans _ (le_csupr h_bdd y),
        rw if_pos hyx },
      { simp only [spectral_value_terms],
        rw if_neg hm,
        exact zero_le' }},
end

end bdd_by_spectral_value

section alg_equiv

variables {S A B C: Type*} [comm_semiring S] [semiring A] [semiring B] [semiring C] [algebra S A]
  [algebra S B] [algebra S C]

def alg_equiv.comp (f : A ≃ₐ[S] B) (g : B ≃ₐ[S] C) : A ≃ₐ[S] C :=
{ to_fun    := g.to_fun ∘ f.to_fun,
  inv_fun   := f.inv_fun ∘ g.inv_fun,
  left_inv  :=  λ x, by simp only [alg_equiv.inv_fun_eq_symm, alg_equiv.to_fun_eq_coe,
    function.comp_app, alg_equiv.symm_apply_apply],
  right_inv := λ x, by simp only [alg_equiv.to_fun_eq_coe, alg_equiv.inv_fun_eq_symm,
    function.comp_app, alg_equiv.apply_symm_apply],
  map_mul'  := λ x y, by simp only [alg_equiv.to_fun_eq_coe, function.comp_app, map_mul],
  map_add'  := λ x y, by simp only [alg_equiv.to_fun_eq_coe, function.comp_app, map_add],
  commutes' := λ x, by simp only [alg_equiv.to_fun_eq_coe, function.comp_app, alg_equiv.commutes] }

lemma alg_equiv.comp_apply (f : A ≃ₐ[S] B) (g : B ≃ₐ[S] C) (x : A) : f.comp g x = g (f x) := rfl

end alg_equiv

section minpoly

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]
(h_alg : algebra.is_algebraic K L)

def adjoin_root.id_alg_equiv {p q : K[X]} (hp : p ≠ 0) (hq : q ≠ 0) (h_eq : p = q) :
  adjoin_root p ≃ₐ[K] adjoin_root q :=
alg_equiv.of_alg_hom (adjoin_root.lift_hom p (adjoin_root.root q) (by
  rw [h_eq, adjoin_root.aeval_eq, adjoin_root.mk_self]))
  (adjoin_root.lift_hom q (adjoin_root.root p) (by
  rw [h_eq, adjoin_root.aeval_eq, adjoin_root.mk_self]))
  (power_basis.alg_hom_ext (adjoin_root.power_basis hq) (by
    rw [adjoin_root.power_basis_gen hq, alg_hom.coe_comp, function.comp_app,
      adjoin_root.lift_hom_root, adjoin_root.lift_hom_root, alg_hom.coe_id, id.def]))
  (power_basis.alg_hom_ext (adjoin_root.power_basis hp) (by
    rw [adjoin_root.power_basis_gen hp, alg_hom.coe_comp, function.comp_app,
      adjoin_root.lift_hom_root, adjoin_root.lift_hom_root, alg_hom.coe_id, id.def]))

lemma adjoin_root.id_alg_equiv_apply_root {p q : K[X]} (hp : p ≠ 0) (hq : q ≠ 0) (h_eq : p = q) :
  adjoin_root.id_alg_equiv hp hq h_eq (adjoin_root.root p) = adjoin_root.root q :=
by rw [adjoin_root.id_alg_equiv, alg_equiv.of_alg_hom, alg_equiv.coe_mk, adjoin_root.lift_hom_root]

@[simp] lemma minpoly.aeval_conj (h_alg : algebra.is_algebraic K L) (σ : L ≃ₐ[K] L) (x : L) :
  (polynomial.aeval (σ x)) (minpoly K x) = 0 :=
by rw [polynomial.aeval_alg_equiv, alg_hom.coe_comp, function.comp_app, minpoly.aeval, map_zero]

@[simp] lemma minpoly.eq_of_conj (h_alg : algebra.is_algebraic K L) (σ : L ≃ₐ[K] L) (x : L) :
  minpoly K (σ x) = minpoly K x :=
begin
  have h_dvd : minpoly K x ∣ minpoly K (σ x),
  { apply minpoly.dvd,
    have hx : σ.symm (σ x) = x := σ.left_inv x,
    nth_rewrite 0 ← hx,
    rw [polynomial.aeval_alg_equiv, alg_hom.coe_comp, function.comp_app, minpoly.aeval, map_zero] },
  have h_deg : (minpoly K (σ x)).nat_degree ≤ (minpoly K x).nat_degree,
  { apply polynomial.nat_degree_le_nat_degree (minpoly.degree_le_of_ne_zero K _ (minpoly.ne_zero
    (is_algebraic_iff_is_integral.mp (h_alg _))) (minpoly.aeval_conj h_alg σ x)) },
  exact polynomial.eq_of_monic_of_dvd_of_nat_degree_le
    (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg _)))
    (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg _))) h_dvd h_deg,
end

def minpoly.alg_equiv {x y : L} (h_mp : minpoly K x = minpoly K y) : K⟮x⟯ ≃ₐ[K] K⟮y⟯ :=
alg_equiv.comp ((intermediate_field.adjoin_root_equiv_adjoin K
  (is_algebraic_iff_is_integral.mp (h_alg _))).symm)
  (alg_equiv.comp (adjoin_root.id_alg_equiv
    (minpoly.ne_zero (is_algebraic_iff_is_integral.mp (h_alg _)))
    (minpoly.ne_zero (is_algebraic_iff_is_integral.mp (h_alg _))) h_mp)
    (intermediate_field.adjoin_root_equiv_adjoin K(is_algebraic_iff_is_integral.mp (h_alg _))))

lemma minpoly.alg_equiv_apply {x y : L} (h_mp : minpoly K x = minpoly K y) :
  minpoly.alg_equiv h_alg h_mp ((intermediate_field.adjoin_simple.gen K x)) =
    (intermediate_field.adjoin_simple.gen K y) :=
begin
  simp only [minpoly.alg_equiv],
  rw [alg_equiv.comp_apply, ← intermediate_field.adjoin_root_equiv_adjoin_apply_root K
    (is_algebraic_iff_is_integral.mp (h_alg _)), alg_equiv.symm_apply_apply,
    alg_equiv.comp_apply, adjoin_root.id_alg_equiv_apply_root,
    intermediate_field.adjoin_root_equiv_adjoin_apply_root K
    (is_algebraic_iff_is_integral.mp (h_alg _))],
end

lemma minpoly.eq_of_root (h_alg : algebra.is_algebraic K L) {x y : L}
 (h_ev : (polynomial.aeval y) (minpoly K x) = 0) : minpoly K y = minpoly K x  :=
polynomial.eq_of_monic_of_associated
   (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg _)))
   (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg _)))
   (irreducible.associated_of_dvd
    (minpoly.irreducible (is_algebraic_iff_is_integral.mp (h_alg _)))
    (minpoly.irreducible (is_algebraic_iff_is_integral.mp (h_alg _)))
    (minpoly.dvd K y h_ev))

lemma minpoly.conj_of_root (h_alg : algebra.is_algebraic K L) (hn : normal K L) {x y : L}
 (h_ev : (polynomial.aeval x) (minpoly K y) = 0) : ∃ (σ : L ≃ₐ[K] L), σ x = y  :=
begin
  set f : K⟮x⟯ ≃ₐ[K] K⟮y⟯ := minpoly.alg_equiv h_alg (minpoly.eq_of_root h_alg h_ev),
  set h : L ≃ₐ[K] L := alg_equiv.lift_normal f L,
  use alg_equiv.lift_normal f L,
  simp_rw ← intermediate_field.adjoin_simple.algebra_map_gen K x,
  rw [alg_equiv.lift_normal_commutes f L, minpoly.alg_equiv_apply,
    intermediate_field.adjoin_simple.algebra_map_gen K y],
end

lemma minpoly.conj_of_root' (h_alg : algebra.is_algebraic K L) (hn : normal K L) {x y : L}
 (h_ev : (polynomial.aeval x) (minpoly K y) = 0) : ∃ (σ : L ≃ₐ[K] L), σ y = x  :=
begin
  obtain ⟨σ, hσ⟩ := minpoly.conj_of_root  h_alg hn h_ev,
  use σ.symm,
  rw [← hσ, alg_equiv.symm_apply_apply],
end

end minpoly

/- In this section we prove Theorem 3.2.1/2 from BGR. -/

section spectral_norm

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]
(h_alg : algebra.is_algebraic K L)

-- The spectral norm |y|_sp is the spectral value of the minimal polynomial of y over K.
def spectral_norm (y : L) : nnreal :=
spectral_value (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg y)))

lemma spectral_value.eq_of_tower {E : Type*} [field E] [algebra K E] [algebra E L]
  [is_scalar_tower K E L] (h_alg_E : algebra.is_algebraic K E) (h_alg_L : algebra.is_algebraic K L)
  (x : E) : spectral_norm h_alg_E x = spectral_norm h_alg_L (algebra_map E L x) :=
begin
  have hx : minpoly K x = minpoly K  (algebra_map E L x),
  { exact minpoly.eq_of_algebra_map_eq (algebra_map E L).injective
      (is_algebraic_iff_is_integral.mp (h_alg_E x)) rfl, },
  simp only [spectral_norm, hx],
end

lemma intermediate_field.is_algebraic (h_alg_L : algebra.is_algebraic K L)
  (E : intermediate_field K L) :
  algebra.is_algebraic K E := λ y,
begin
  obtain ⟨p, hp0, hp⟩ := h_alg_L ↑y,
  rw [subalgebra.aeval_coe, add_submonoid_class.coe_eq_zero] at hp,
  exact ⟨p, hp0, hp⟩,
end

lemma spectral_value.eq_normal (h_alg_L : algebra.is_algebraic K L)
  (E : intermediate_field K L) (x : E) :
  spectral_norm (normal_closure.is_algebraic K E (intermediate_field.is_algebraic h_alg_L E))
    (algebra_map E (normal_closure K E) x) = spectral_norm h_alg_L (algebra_map E L x) :=
begin
  simp only [spectral_norm, spectral_value],
  have h_min : minpoly K (algebra_map ↥E ↥(normal_closure K ↥E) x) = minpoly K (algebra_map ↥E L x),
  { have hx : is_integral K x :=
    is_algebraic_iff_is_integral.mp (intermediate_field.is_algebraic_iff.mpr (h_alg_L ↑x)),
    rw [← minpoly.eq_of_algebra_map_eq (algebra_map ↥E ↥(normal_closure K ↥E)).injective hx rfl,
      minpoly.eq_of_algebra_map_eq (algebra_map ↥E L).injective hx rfl] },
  simp_rw h_min,
end

variable (y : L)

lemma spectral_norm.zero : spectral_norm h_alg (0 : L) = 0 :=
begin
  have h_lr: list.range 1 = [0] := rfl,
  rw [spectral_norm, spectral_value, spectral_value_terms, minpoly.zero, polynomial.nat_degree_X],
  convert csupr_const,
  ext m,
  by_cases hm : m < 1,
  { rw [if_pos hm, nnreal.coe_eq, nat.lt_one_iff.mp hm, nat.cast_one, nat.cast_zero, sub_zero,
      div_one, nnreal.rpow_one, polynomial.coeff_X_zero, nnnorm_zero] },
  { rw if_neg hm },
  apply_instance,
end

lemma spectral_norm.zero_lt {y : L} (hy : y ≠ 0) : 0 < spectral_norm h_alg y :=
begin
  rw lt_iff_le_and_ne,
  refine ⟨zero_le _, _⟩,
  rw [spectral_norm, ne.def, eq_comm, spectral_value_eq_zero_iff],
  have h0 : polynomial.coeff (minpoly K y) 0 ≠ 0  :=
  minpoly.coeff_zero_ne_zero (is_algebraic_iff_is_integral.mp (h_alg y)) hy,
  intro h,
  have h0' : (minpoly K y).coeff 0 = 0,
  { rw [h, polynomial.coeff_X_pow,
      if_neg (ne_of_lt ( minpoly.nat_degree_pos (is_algebraic_iff_is_integral.mp (h_alg y))))] },
  exact h0 h0',
end

lemma spectral_norm.ge_norm {f : L → nnreal} (hf_pm : is_pow_mult f)
  (hf_na : is_nonarchimedean f) (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f)
  (hf1 : is_norm_le_one_class f) (x : L) : f x ≤ spectral_norm h_alg x :=
begin
  apply root_norm_le_spectral_value hf_pm hf_na hf_alg_norm hf1,
  rw [minpoly.aeval],
end

lemma spectral_norm.aut_isom (σ : L ≃ₐ[K] L) (x : L) :
  spectral_norm h_alg x = spectral_norm h_alg (σ x) :=
by simp only [spectral_norm, minpoly.eq_of_conj h_alg]

-- We first assume that the extension is finite and normal
section finite

variable (h_fin : finite_dimensional K L)

def seminorm_of_auto (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) : L → ℝ≥0 :=
λ x, classical.some (finite_extension_pow_mul_seminorm h_fin hna) (σ x)

lemma seminorm_of_auto.is_pow_mult (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_pow_mult (seminorm_of_auto h_fin σ hna) :=
begin
  intros x n hn,
  simp only [seminorm_of_auto, map_pow σ x n],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.1 _ hn,
end

lemma seminorm_of_auto.is_nonarchimedean (σ : L ≃ₐ[K] L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_nonarchimedean (seminorm_of_auto h_fin σ hna) :=
begin
  intros x y,
  simp only [seminorm_of_auto, map_sub σ],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2.2 _ _,
end

lemma seminorm_of_auto.is_algebra_norm (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_algebra_norm (normed_ring.to_is_norm K) (seminorm_of_auto h_fin σ hna) :=
{ zero    := begin
    simp only [seminorm_of_auto, map_zero σ],
    exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1.zero,
  end,
  add     := begin
    simp only [seminorm_of_auto, map_add σ],
    intros x y,
    exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1.add _ _,
  end,
  mul     := begin
    simp only [seminorm_of_auto, map_mul σ],
    intros x y,
    exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1.mul _ _,
  end,
  ne_zero := λ a ha, begin
    apply (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1.ne_zero _
      ((add_equiv_class.map_ne_zero_iff σ).mpr ha),
  end,
  smul    := begin
    simp only [seminorm_of_auto, map_smul σ],
    intros r x,
    exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1.smul _ _,
  end }

lemma seminorm_of_auto.extends (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  function_extends (λ x : K, ∥x∥₊) (seminorm_of_auto h_fin σ hna) :=
begin
  intro r, simp only [seminorm_of_auto,  alg_equiv.commutes],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2.1 _,
end

def seminorm_of_galois (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) : L → ℝ≥0 :=
λ x, (supr (λ (σ : L ≃ₐ[K] L), seminorm_of_auto h_fin σ hna x))

lemma csupr_univ {α : Type u_1} {β : Type u_2} [fintype β] [conditionally_complete_lattice α]
  {f : β → α} :
(⨆ (x : β) (H : x ∈ (finset.univ : finset β)), f x) = ⨆ (x : β), f x := by simp

theorem finset.sup_eq_csupr {α : Type u_1} [nonempty α] (s : finset α) [nonempty s]
  (f : α → ℝ≥0) : s.sup f = ⨆ (a : α) (H : a ∈ s), f a :=
begin
  apply le_antisymm,
  { apply finset.sup_le,
    intros a ha, apply le_csupr_of_le _ a,
    { exact le_csupr_of_le (set.finite.bdd_above (set.finite_range (λ (ha : a ∈ s), f a)))
        ha (le_refl _) },
    { apply set.finite.bdd_above,
      have hrange: set.range (λ (a : α), ⨆ (H : a ∈ s), f a) ⊆
        set.range (λ (a : s), f a) ∪ {⊥},
      { rintros y ⟨x, hxy⟩,
        simp only [set.mem_range, bot_eq_zero', set.union_singleton, set.mem_insert_iff] at y ⊢,
        by_cases hx : x ∈ s,
        { right, simp only [hx, csupr_pos] at hxy, exact ⟨⟨x, hx⟩, hxy⟩, },
        { left, simp only [hx, csupr_false, bot_eq_zero'] at hxy, exact hxy.symm }},
      exact set.finite.subset (set.range (λ (a : ↥s), f ↑a) ∪ {⊥}).to_finite hrange, }},
  { apply csupr_le,
    intro x,
    by_cases hx : x ∈ s,
    { haveI : nonempty (x ∈ s) := ⟨hx⟩,
      apply csupr_le, intro hx', exact finset.le_sup hx, },
    { simp only [(iff_false _).mpr hx, csupr_false, bot_eq_zero', zero_le'], }}
end

lemma nnreal.supr_pow {ι : Type*} [nonempty ι] [fintype ι] (f : ι → nnreal) (n : ℕ) :
(⨆ (i : ι), f i)^n = ⨆ (i : ι), (f i)^n :=
begin
  induction n with n hn,
  { simp only [pow_zero, csupr_const], },
  { rw [pow_succ, hn],
    apply le_antisymm,
    { apply nnreal.csupr_mul_csupr_le,
      intros i j,
      by_cases hij : f i < f j,
      { have hj : f i * f j ^ n ≤ f j ^ n.succ,
        { rw pow_succ, apply mul_le_mul' (le_of_lt hij) (le_refl _) },
        exact le_trans hj (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) j
          (le_refl _)), },
      { have hi : f i * f j ^ n ≤ f i ^ n.succ,
        { rw pow_succ, exact mul_le_mul' (le_refl _) (pow_le_pow_of_le (not_lt.mp hij)) },
        exact le_trans hi (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) i
          (le_refl _)), }},
    { haveI : nonempty (finset.univ : finset ι),
     { exact finset.nonempty_coe_sort.mpr finset.univ_nonempty },
       simp only [← csupr_univ, ← finset.sup_eq_csupr, pow_succ],
      apply finset.sup_mul_le_mul_sup_of_nonneg;
      rintros i -; exact zero_le _ }},
end

lemma seminorm_of_galois.is_pow_mult (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_pow_mult (seminorm_of_galois h_fin hna) :=
begin
  intros x n hn,
  simp only [seminorm_of_galois],
  rw nnreal.supr_pow,
  exact supr_congr (λ σ, seminorm_of_auto.is_pow_mult h_fin σ hna _ hn),
end

lemma lt_csupr_of_lt {α : Type*} {ι : Sort*} [conditionally_complete_lattice α] {a : α} {f : ι → α}
  (H : bdd_above (set.range f)) (c : ι) (h : a < f c) : a < supr f :=
lt_of_lt_of_le h (le_csupr H c)

lemma seminorm_of_galois.is_algebra_norm (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_algebra_norm (normed_ring.to_is_norm K) (seminorm_of_galois h_fin hna) :=
{ zero    := by simp only [seminorm_of_galois, (seminorm_of_auto.is_algebra_norm h_fin _ hna).zero,
    csupr_const],
  add     := λ x y, csupr_le (λ σ, le_trans ((seminorm_of_auto.is_algebra_norm h_fin σ hna).add x y)
     (add_le_add (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
       (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)))),
  mul     := λ x y, csupr_le (λ σ, le_trans ((seminorm_of_auto.is_algebra_norm h_fin σ hna).mul x y)
   ( mul_le_mul'  (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
  (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)))),
  ne_zero := λ x hx, lt_csupr_of_lt (set.finite.bdd_above
    (set.range (λ (σ : L ≃ₐ[K] L), seminorm_of_auto h_fin σ hna x)).to_finite) (alg_equiv.refl)
    ((seminorm_of_auto.is_algebra_norm h_fin _ hna).ne_zero _ hx),
  smul    := λ r x, by simp only [seminorm_of_galois,
    (seminorm_of_auto.is_algebra_norm h_fin _ hna).smul, nnreal.mul_csupr (set.finite.bdd_above
      (set.finite_range (λ (i : L ≃ₐ[K] L), seminorm_of_auto h_fin i hna x)))] }

lemma seminorm_of_galois.is_nonarchimedean (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_nonarchimedean (seminorm_of_galois h_fin hna)  :=
λ x y, csupr_le (λ σ, le_trans ((seminorm_of_auto.is_nonarchimedean h_fin σ hna) x y)
  (max_le_max (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
    (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))))

lemma seminorm_of_galois.extends (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  function_extends (λ x : K, ∥x∥₊) (seminorm_of_galois h_fin hna) :=
λ r, by simp only [seminorm_of_galois, seminorm_of_auto.extends h_fin _ hna r, csupr_const]

section normal

lemma extends_is_norm_le_one_class {f : L → nnreal}
  (hf_ext : function_extends (λ x : K, ∥x∥₊) f) : is_norm_le_one_class f :=
begin
  rw [is_norm_le_one_class, ← (algebra_map K L).map_one, hf_ext],
  simp only [nnnorm_one],
end

lemma extends_is_norm_one_class {f : L → nnreal}
  (hf_ext : function_extends (λ x : K, ∥x∥₊) f) : is_norm_one_class f :=
begin
  rw [is_norm_one_class, ← (algebra_map K L).map_one, hf_ext],
  simp only [nnnorm_one],
end

lemma spectral_norm.max_of_fd_normal (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) {f : L → nnreal} (hf_pow : is_pow_mult f)
  (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f)
  (hf_ext : function_extends (λ x : K, ∥x∥₊) f) (x : L) :
  spectral_norm h_alg x = supr (λ (σ : L ≃ₐ[K] L), f (σ x)) :=
begin
  refine le_antisymm _ (csupr_le (λ σ, root_norm_le_spectral_value hf_pow hf_na hf_alg_norm
      (extends_is_norm_le_one_class hf_ext) _ (minpoly.aeval_conj h_alg _ _))),
{ set p := minpoly K x with hp_def,
  have hp_sp : polynomial.splits (algebra_map K L) (minpoly K x) := hn.splits x,
  obtain ⟨s, hs⟩ := (polynomial.splits_iff_exists_multiset _).mp hp_sp,
  have : polynomial.map_alg K L p = map (algebra_map K L) p := rfl,
  have h_lc : (algebra_map K L) (minpoly K x).leading_coeff = 1,
  { have h1 : (minpoly K x).leading_coeff = 1,
    { rw ← monic, exact minpoly.monic (normal.is_integral hn x),},
    rw [h1, map_one] },
  rw [h_lc, map_one, one_mul] at hs,
  simp only [spectral_norm],
  rw ← max_root_norm_eq_spectral_value' hf_pow hf_na hf_alg_norm (extends_is_norm_one_class hf_ext)
    _ _ hs (λ x y, by rw [← map_sub, hf_ext, nndist_comm, nndist_eq_nnnorm]),
  apply csupr_le,
  intros y,
  split_ifs,
  { have hy : ∃ σ : L ≃ₐ[K] L, σ x = y,
    { exact minpoly.conj_of_root' h_alg hn (polynomial.aeval_root s h hs), },
    obtain ⟨σ, hσ⟩ := hy,
    rw ← hσ,
    have h_bdd : bdd_above (set.range (λ (σ : L ≃ₐ[K] L), f (σ x))),
    { exact set.finite.bdd_above (set.finite_range _), },
    exact le_csupr h_bdd σ, },
  { exact zero_le' }},
end

lemma spectral_norm.eq_seminorm_of_galois (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  spectral_norm h_alg = seminorm_of_galois h_fin hna :=
begin
  ext x,
  set f := classical.some (finite_extension_pow_mul_seminorm h_fin hna) with hf,
  have hf_alg_norm : is_algebra_norm _ f :=
  (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1,
  have hf_pow : is_pow_mult f :=
  (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.1,
  have hf_ext : function_extends _ f :=
  (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2.1,
  have hf_na : is_nonarchimedean f :=
  (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2.2,
  rw spectral_norm.max_of_fd_normal h_alg h_fin hn hna hf_pow hf_na hf_alg_norm hf_ext,
  refl,
end

lemma spectral_norm.is_pow_mult_of_fd_normal (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) : is_pow_mult (spectral_norm h_alg) :=
begin
  rw spectral_norm.eq_seminorm_of_galois _ h_fin hn hna,
  exact seminorm_of_galois.is_pow_mult h_fin hna,
end

lemma spectral_norm.is_algebra_norm_of_fd_normal (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_algebra_norm (normed_ring.to_is_norm K) (spectral_norm h_alg) :=
begin
  rw spectral_norm.eq_seminorm_of_galois _ h_fin hn hna,
  exact seminorm_of_galois.is_algebra_norm h_fin hna,
end

lemma spectral_norm.is_nonarchimedean_of_fd_normal (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0))  :
  is_nonarchimedean (spectral_norm h_alg) :=
begin
  rw spectral_norm.eq_seminorm_of_galois _ h_fin hn hna,
  exact seminorm_of_galois.is_nonarchimedean h_fin hna,
end

lemma spectral_norm.extends_norm_of_fd (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  function_extends (λ x : K, ∥x∥₊) (spectral_norm h_alg) :=
begin
  rw spectral_norm.eq_seminorm_of_galois _ h_fin hn hna,
  exact seminorm_of_galois.extends h_fin hna,
end

/- lemma max_root_norm_eq_spectral_value (hf_pm : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) (hf1 : is_norm_one_class f)
  (p : K[X]) {n : ℕ} (hn : 0 < n) (b : fin n → L)
  (hp : polynomial.map_alg K L p = finprod (λ (k : fin n), polynomial.X - (polynomial.C (b k))))
  (h_isom : ∀ x y : K, f ((algebra_map K L y) - algebra_map K L x) = nndist x y) :
  supr (f ∘ b) = spectral_value (p.monic_of_prod b hp) := -/

lemma spectral_norm.unique_of_fd_normal (h_fin : finite_dimensional K L) (hn : normal K L)
  (hna : is_nonarchimedean (nnnorm : K → ℝ≥0))
  {f : L → nnreal} (hf_pow : is_pow_mult f) (hf_na : is_nonarchimedean f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f)
  (hf_ext : function_extends (λ x : K, ∥x∥₊) f)
  (hf_iso : ∀ (σ : L ≃ₐ[K] L) (x : L), f x = f (σ x))
  (x : L) : f x = spectral_norm h_alg x :=
begin
  have h_sup : supr (λ (σ : L ≃ₐ[K] L), f (σ x)) = f x,
  { rw ← @csupr_const _ (L ≃ₐ[K] L) _ _ (f x),
    exact supr_congr (λ σ, by rw hf_iso σ x), },
  rw [spectral_norm.max_of_fd_normal h_alg h_fin hn hna hf_pow  hf_na hf_alg_norm hf_ext, h_sup]
end

end normal

end finite

-- Now we let L/K be any algebraic extension

-- The spectral norm is a power-multiplicative K-algebra norm on L extending the norm on K.

lemma spectral_value.eq_normal' (h_alg_L : algebra.is_algebraic K L)
  {E : intermediate_field K L} {x : L} (g : E) (h_map : algebra_map E L g = x) :
  spectral_norm (normal_closure.is_algebraic K E (intermediate_field.is_algebraic h_alg_L E))
    (algebra_map E (normal_closure K E) g) = spectral_norm h_alg_L x :=
begin
  rw ← h_map,
  exact spectral_value.eq_normal h_alg_L E g,
end

lemma spectral_norm.is_pow_mult (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  is_pow_mult (spectral_norm h_alg) :=
begin
  intros x n hn,
  set E := K⟮x⟯ with hE,
  haveI h_fd_E : finite_dimensional K E :=
  intermediate_field.adjoin.finite_dimensional (is_algebraic_iff_is_integral.mp (h_alg x)),
  have h_alg_E : algebra.is_algebraic K E := intermediate_field.is_algebraic h_alg E,
  set g := intermediate_field.adjoin_simple.gen K x with hg,
  have h_map : algebra_map E L g^n = x^n := rfl,
  rw [← spectral_value.eq_normal' h_alg  _ (intermediate_field.adjoin_simple.algebra_map_gen K x),
    ← spectral_value.eq_normal' h_alg (g^n) h_map, map_pow],
  exact spectral_norm.is_pow_mult_of_fd_normal (normal_closure.is_algebraic K E h_alg_E)
    (normal_closure.is_finite_dimensional K E) (normal_closure.is_normal K E h_alg_E) hna _ hn,
end

lemma spectral_norm.smul (k : K) (y : L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  spectral_norm h_alg (k • y) = ∥ k ∥₊ * spectral_norm h_alg y :=
begin
  set E := K⟮y⟯ with hE,
  haveI h_fd_E : finite_dimensional K E :=
  intermediate_field.adjoin.finite_dimensional (is_algebraic_iff_is_integral.mp (h_alg y)),
  have h_alg_E : algebra.is_algebraic K E := intermediate_field.is_algebraic h_alg E,
  set g := intermediate_field.adjoin_simple.gen K y with hg,
  have hgy : k • y = (algebra_map ↥K⟮y⟯ L) (k • g) := rfl,
  have h : algebra_map K⟮y⟯ (normal_closure K K⟮y⟯) (k • g) =
    k • algebra_map K⟮y⟯ (normal_closure K K⟮y⟯) g,
  { rw [algebra.algebra_map_eq_smul_one, algebra.algebra_map_eq_smul_one, smul_assoc] },
    rw [← spectral_value.eq_normal' h_alg g (intermediate_field.adjoin_simple.algebra_map_gen K y),
      hgy, ← spectral_value.eq_normal' h_alg (k • g) rfl, h],
  exact (spectral_norm.is_algebra_norm_of_fd_normal (normal_closure.is_algebraic K E h_alg_E)
    (normal_closure.is_finite_dimensional K E) (normal_closure.is_normal K E h_alg_E) hna).smul _ _,
end

lemma intermediate_field.adjoin_adjoin.finite_dimensional {x y : L} (hx : is_integral K x)
  (hy : is_integral K y) : finite_dimensional K K⟮x, y⟯ :=
begin
  haveI hx_fd : finite_dimensional K K⟮x⟯ := intermediate_field.adjoin.finite_dimensional hx,
  have hy' : is_integral K⟮x⟯ y := is_integral_of_is_scalar_tower  y hy,
  haveI hy_fd : finite_dimensional K⟮x⟯ K⟮x⟯⟮y⟯ := intermediate_field.adjoin.finite_dimensional hy',
  rw ← intermediate_field.adjoin_simple_adjoin_simple,
  apply finite_dimensional.trans K K⟮x⟯ K⟮x⟯⟮y⟯,
end

lemma intermediate_field.mem_adjoin_adjoin_left (F : Type u_1) [field F] {E : Type u_2} [field E]
  [algebra F E] (x y : E) : x ∈ F⟮x, y⟯ :=
begin
  rw [← intermediate_field.adjoin_simple_adjoin_simple, intermediate_field.adjoin_simple_comm],
  exact intermediate_field.subset_adjoin F⟮y⟯ {x} (set.mem_singleton x),
end

lemma intermediate_field.mem_adjoin_adjoin_right (F : Type u_1) [field F] {E : Type u_2} [field E]
  [algebra F E] (x y : E) : y ∈ F⟮x, y⟯ :=
begin
  rw ← intermediate_field.adjoin_simple_adjoin_simple,
  exact intermediate_field.subset_adjoin F⟮x⟯ {y} (set.mem_singleton y),
end

def intermediate_field.adjoin_adjoin.gen_1 (F : Type u_1) [field F] {E : Type u_2} [field E]
  [algebra F E] (x y : E) : F⟮x, y⟯ :=
⟨x, intermediate_field.mem_adjoin_adjoin_left F x y⟩

def intermediate_field.adjoin_adjoin.gen_2 (F : Type u_1) [field F] {E : Type u_2} [field E]
  [algebra F E] (x y : E) : F⟮x, y⟯ :=
⟨y, intermediate_field.mem_adjoin_adjoin_right F x y⟩

@[simp]
theorem intermediate_field.adjoin_adjoin.algebra_map_gen_1 (F : Type u_1) [field F] {E : Type u_2}
  [field E] [algebra F E] (x y : E) :
  (algebra_map ↥F⟮x, y⟯ E) (intermediate_field.adjoin_adjoin.gen_1 F x y) = x := rfl

@[simp]
theorem intermediate_field.adjoin_adjoin.algebra_map_gen_2 (F : Type u_1) [field F] {E : Type u_2}
  [field E] [algebra F E] (x y : E) :
  (algebra_map ↥F⟮x, y⟯ E) (intermediate_field.adjoin_adjoin.gen_2 F x y) = y := rfl

lemma spectral_norm.mul (x y : L) (hna : is_nonarchimedean (nnnorm : K → ℝ≥0)) :
  spectral_norm h_alg (x * y) ≤ spectral_norm h_alg x * spectral_norm h_alg y :=
begin
  set E := K⟮x, y⟯ with hE,
  haveI h_fd_E : finite_dimensional K E :=
  intermediate_field.adjoin_adjoin.finite_dimensional (is_algebraic_iff_is_integral.mp (h_alg x))
    (is_algebraic_iff_is_integral.mp (h_alg y)),
  have h_alg_E : algebra.is_algebraic K E := intermediate_field.is_algebraic h_alg E,
  set gx := intermediate_field.adjoin_adjoin.gen_1 K x y with hgx,
  set gy := intermediate_field.adjoin_adjoin.gen_2 K x y with hgy,
  have hxy : x * y = (algebra_map K⟮x, y⟯ L) (gx * gy) := rfl,
  rw [hxy, ← spectral_value.eq_normal' h_alg (gx*gy) hxy,
    ← spectral_value.eq_normal' h_alg gx (intermediate_field.adjoin_adjoin.algebra_map_gen_1
    K x y), ← spectral_value.eq_normal' h_alg gy (intermediate_field.adjoin_adjoin.algebra_map_gen_2
    K x y), map_mul],
  exact (spectral_norm.is_algebra_norm_of_fd_normal (normal_closure.is_algebraic K E h_alg_E)
    (normal_closure.is_finite_dimensional K E) (normal_closure.is_normal K E h_alg_E) hna).mul _ _,
end

lemma spectral_norm.is_nonarchimedean (h : is_nonarchimedean (λ k : K, ∥k∥₊)) :
  is_nonarchimedean (spectral_norm h_alg) :=
begin
  intros x y,
  set E := K⟮x, y⟯ with hE,
  haveI h_fd_E : finite_dimensional K E :=
  intermediate_field.adjoin_adjoin.finite_dimensional (is_algebraic_iff_is_integral.mp (h_alg x))
    (is_algebraic_iff_is_integral.mp (h_alg y)),
  have h_alg_E : algebra.is_algebraic K E := intermediate_field.is_algebraic h_alg E,
  set gx := intermediate_field.adjoin_adjoin.gen_1 K x y with hgx,
  set gy := intermediate_field.adjoin_adjoin.gen_2 K x y with hgy,
  have hxy : x - y = (algebra_map K⟮x, y⟯ L) (gx - gy) := rfl,
  rw [hxy, ← spectral_value.eq_normal' h_alg (gx - gy) hxy,
    ← spectral_value.eq_normal' h_alg gx (intermediate_field.adjoin_adjoin.algebra_map_gen_1
    K x y), ← spectral_value.eq_normal' h_alg gy (intermediate_field.adjoin_adjoin.algebra_map_gen_2
    K x y), map_sub],
  exact spectral_norm.is_nonarchimedean_of_fd_normal (normal_closure.is_algebraic K E h_alg_E)
    (normal_closure.is_finite_dimensional K E)  (normal_closure.is_normal K E h_alg_E) h _ _,
end

lemma spectral_norm.is_algebra_norm (hna : is_nonarchimedean (λ k : K, ∥k∥₊)) :
  is_algebra_norm (normed_ring.to_is_norm K) (spectral_norm h_alg) :=
{ zero    := spectral_norm.zero h_alg,
  add     := add_le_of_is_nonarchimedean (spectral_norm.zero h_alg)
    (spectral_norm.is_nonarchimedean h_alg hna),
  mul     := λ x y, spectral_norm.mul h_alg _ _ hna,
  ne_zero := λ x hx, spectral_norm.zero_lt h_alg hx,
  smul    := λ x y, spectral_norm.smul h_alg _ _ hna, }

lemma spectral_norm.neg (h : is_nonarchimedean (λ k : K, ∥k∥₊)) (y : L)  :
  spectral_norm h_alg (-y) = spectral_norm h_alg y :=
is_nonarchimedean.neg (spectral_norm.is_nonarchimedean h_alg h) (spectral_norm.zero h_alg) _

lemma spectral_norm.extends (k : K) : spectral_norm h_alg (algebra_map K L k) = ∥ k ∥₊ :=
begin
  simp_rw [spectral_norm, minpoly.eq_X_sub_C_of_algebra_map_inj _ (algebra_map K L).injective],
  exact spectral_value_X_sub_C k,
end

lemma spectral_norm.is_norm_le_one_class : is_norm_le_one_class (spectral_norm h_alg) :=
begin
  rw is_norm_le_one_class,
  have h1 : (1 : L) = (algebra_map K L 1) := by rw map_one,
  rw [h1, spectral_norm.extends, nnnorm_one],
end

lemma adjoin.algebra_norm {f : L → nnreal} (hf_alg_norm : is_algebra_norm
  (normed_ring.to_is_norm K) f) (x : L) :
  is_algebra_norm (normed_ring.to_is_norm K) (f ∘ (algebra_map ↥K⟮x⟯ L)) :=
{ zero    := by rw [function.comp_app, map_zero, hf_alg_norm.zero],
  add     := λ a b, by {rw [function.comp_app, map_add], exact hf_alg_norm.add _ _ },
  mul     := λ a b, by {rw [function.comp_app, map_mul], exact hf_alg_norm.mul _ _ },
  ne_zero := λ a ha, by { rw [function.comp_app],
    exact hf_alg_norm.ne_zero _ ((ring_hom.map_ne_zero _).mpr ha) },
  smul    := λ r a, by { rw [function.comp_app, function.comp_app], exact hf_alg_norm.smul _ _ }}

end spectral_norm

section spectral_valuation

variables {K : Type*} [normed_field K] [complete_space K] {L : Type*} [hL : field L] [algebra K L]
(h_alg : algebra.is_algebraic K L)

include hL
/- variables {K : Type*} [hK : field K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
[val : valued K Γ₀] [hv : is_rank_one val.v] [complete_space K] {L : Type*} [field L] [algebra K L]
(h_alg : algebra.is_algebraic K L)

include hK

--@[priority 10]
instance valued_field.to_normed_field : normed_field K :=
{ norm               := sorry,
  dist               := sorry,
  dist_self          := sorry,
  dist_comm          := sorry,
  dist_triangle      := sorry,
  eq_of_dist_eq_zero := sorry,
  dist_eq            := sorry,
  norm_mul'          := sorry,
  ..hK }

instance spectral_valued : valued L (multiplicative (order_dual (with_top  ℝ))) := sorry -/

-- Theorem 3.2.4/2

section

omit hL

def norm_to_normed_ring {A : Type*} [hA : ring A] {f : A → nnreal} (hf : is_norm f)
  (hf_neg : ∀ x, f (-x) = f x) :
  normed_ring A :=
{ norm          := λ x, f x,
  dist          := λ x y, f (x - y),
  dist_self     := λ x, by simp only [sub_self, hf.zero, nnreal.coe_zero],
  dist_comm     := λ x y, by simp only [nnreal.coe_eq, ← neg_sub x y, hf_neg],
  dist_triangle := λ x y z, begin
    have hxyz : x - z = x - y + (y - z) := by abel,
    rw [← nnreal.coe_add, nnreal.coe_le_coe, hxyz],
    exact hf.add _ _,
  end,
  eq_of_dist_eq_zero := λ x y hxy,
    eq_of_sub_eq_zero (hf.zero_of_norm_zero ((nnreal.coe_eq_zero _).mp hxy)),
  dist_eq := λ x y, rfl,
  norm_mul := λ x y, by simp only [norm, ← nnreal.coe_mul, nnreal.coe_le_coe, hf.mul],
  ..hA }

end

def mul_norm_to_normed_field {f : L → nnreal} (hf : is_mul_norm f) (hf_neg : ∀ x, f (-x) = f x) :
  normed_field L :=
{ norm          := λ x, f x,
  dist          := λ x y, f (x - y),
  dist_self     := λ x, by simp only [sub_self, hf.zero, nnreal.coe_zero],
  dist_comm     := λ x y, by simp only [nnreal.coe_eq, ← neg_sub x y, hf_neg],
  dist_triangle := λ x y z, begin
    have hxyz : x - z = x - y + (y - z) := by ring,
    rw [← nnreal.coe_add, nnreal.coe_le_coe, hxyz],
    exact hf.add _ _,
  end,
  eq_of_dist_eq_zero := λ x y hxy,
    eq_of_sub_eq_zero (hf.to_is_norm.zero_of_norm_zero ((nnreal.coe_eq_zero _).mp hxy)),
  dist_eq := λ x y, rfl,
  norm_mul' := λ x y, by simp only [norm, ← nnreal.coe_mul, nnreal.coe_eq, hf.mul_eq],
  ..hL }

lemma mul_norm_to_normed_field.norm  {f : L → nnreal} (hf : is_mul_norm f)
  (hf_neg : ∀ x, f (-x) = f x):
  (mul_norm_to_normed_field hf hf_neg).norm = λ x, (f x : ℝ) := rfl

end spectral_valuation

--#lint


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.nat.form
import Mathlib.PostPort

namespace Mathlib

/-
Subtraction elimination for linear natural number arithmetic.
Works by repeatedly rewriting goals of the preform `P[t-s]` into
`P[x] ∧ (t = s + x ∨ (t ≤ s ∧ x = 0))`, where `x` is fresh.
-/

namespace omega

namespace nat

namespace preterm

/-- Find subtraction inside preterm and return its operands -/
def sub_terms : preterm → Option (preterm × preterm) :=
  sorry

/-- Find (t - s) inside a preterm and replace it with variable k -/
def sub_subst (t : preterm) (s : preterm) (k : ℕ) : preterm → preterm :=
  sorry

theorem val_sub_subst {k : ℕ} {x : preterm} {y : preterm} {v : ℕ → ℕ} {t : preterm} : fresh_index t ≤ k → val (update k (val v x - val v y) v) (sub_subst x y k t) = val v t := sorry

end preterm

namespace preform

/-- Find subtraction inside preform and return its operands -/
def sub_terms : preform → Option (preterm × preterm) :=
  sorry

/-- Find (t - s) inside a preform and replace it with variable k -/
@[simp] def sub_subst (x : preterm) (y : preterm) (k : ℕ) : preform → preform :=
  sorry

end preform

/-- Preform which asserts that the value of variable k is
    the truncated difference between preterms t and s -/
def is_diff (t : preterm) (s : preterm) (k : ℕ) : preform :=
  preform.or (preform.eq t (preterm.add s (preterm.var 1 k)))
    (preform.and (preform.le t s) (preform.eq (preterm.var 1 k) (preterm.cst 0)))

theorem holds_is_diff {t : preterm} {s : preterm} {k : ℕ} {v : ℕ → ℕ} : v k = preterm.val v t - preterm.val v s → preform.holds v (is_diff t s k) := sorry

/-- Helper function for sub_elim -/
def sub_elim_core (t : preterm) (s : preterm) (k : ℕ) (p : preform) : preform :=
  preform.and (preform.sub_subst t s k p) (is_diff t s k)

/-- Return de Brujin index of fresh variable that does not occur
    in any of the arguments -/
def sub_fresh_index (t : preterm) (s : preterm) (p : preform) : ℕ :=
  max (preform.fresh_index p) (max (preterm.fresh_index t) (preterm.fresh_index s))

/-- Return a new preform with all subtractions eliminated -/
def sub_elim (t : preterm) (s : preterm) (p : preform) : preform :=
  sub_elim_core t s (sub_fresh_index t s p) p

theorem sub_subst_equiv {k : ℕ} {x : preterm} {y : preterm} {v : ℕ → ℕ} (p : preform) : preform.fresh_index p ≤ k →
  (preform.holds (update k (preterm.val v x - preterm.val v y) v) (preform.sub_subst x y k p) ↔ preform.holds v p) := sorry

theorem sat_sub_elim {t : preterm} {s : preterm} {p : preform} : preform.sat p → preform.sat (sub_elim t s p) := sorry

theorem unsat_of_unsat_sub_elim (t : preterm) (s : preterm) (p : preform) : preform.unsat (sub_elim t s p) → preform.unsat p :=
  mt sat_sub_elim


import mathlib_someday
import Zalpha

local notation `α` := Zalpha.units.α
local notation `β` := Zalpha.units.β

def Fib (n : ℤ) : ℤ := (↑(α^n) : ℤα).r
@[simp] lemma Fib_zero : Fib 0 = 0 := rfl
@[simp] lemma Fib_one : Fib 1 = 1 := rfl
@[simp] lemma Fib_add_two (n : ℤ) : Fib (n+2) = Fib n + Fib (n+1) :=
calc  (↑(α^(n+2)) : ℤα).r
    = (↑(α^n)*(1+α) : ℤα).r : by rw [gpow_add, units.coe_mul]; refl
... = (↑(α^n) : ℤα).r + (↑(α^(n+1)) : ℤα).r :
  by rw [gpow_add, units.coe_mul, mul_add, mul_one]; refl
@[simp] lemma Fib_add_one_add_one (n : ℤ) : Fib (n+1+1) = Fib n + Fib (n+1) :=
by rw [← Fib_add_two, add_assoc]; refl

def Luc (n : ℤ) : ℤ := (↑(α^n) + ↑(β^n) : ℤα).i
@[simp] lemma Luc_zero : Luc 0 = 2 := rfl
@[simp] lemma Luc_one : Luc 1 = 1 := rfl
@[simp] lemma Luc_add_two (n : ℤ) : Luc (n+2) = Luc n + Luc (n+1) :=
calc  (↑(α^(n+2)) + ↑(β^(n+2)) : ℤα).i
    = (↑(α^n)*(1+α) + ↑(β^n)*(1+β) : ℤα).i : by rw [gpow_add, gpow_add, units.coe_mul, units.coe_mul]; refl
... = (↑(α^n) + ↑(β^n) : ℤα).i + (↑(α^(n+1)) + ↑(β^(n+1)) : ℤα).i :
  by rw [gpow_add, units.coe_mul, mul_add, mul_one];
     rw [gpow_add, units.coe_mul, mul_add, mul_one];
     rw [← Zalpha.add_i, gpow_one, gpow_one]; ac_refl

def fib : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n+2) := fib n + fib (n+1)

def luc : ℕ → ℕ
| 0 := 2
| 1 := 1
| (n+2) := luc n + luc (n+1)

@[elab_as_eliminator]
protected def nat.rec_on_two {C : ℕ → Sort*} (n : ℕ)
  (H0 : C 0) (H1 : C 1)
  (ih : Π (n : ℕ), C n → C (nat.succ n) → C (nat.succ (nat.succ n))) :
  C n :=
nat.strong_induction_on n $ λ n, nat.cases_on n (λ _, H0) $
λ n, nat.cases_on n (λ _, H1) $ λ n ih2, ih n (ih2 n $ nat.lt_succ_of_lt $ nat.le_refl _) $
ih2 (n+1) $ nat.le_refl _

lemma fib_down (n : ℕ) : Fib ↑n = ↑(fib n) :=
nat.rec_on_two n rfl rfl $ λ n ih1 (ih2 : Fib (n+1) = _),
show Fib (n+2) = _,
by rw [Fib_add_two, ih1, ih2, fib, int.coe_nat_add]

lemma luc_down (n : ℕ) : Luc ↑n = ↑(luc n) :=
nat.rec_on_two n rfl rfl $ λ n ih1 (ih2 : Luc (n+1) = _),
show Luc (n+2) = _,
by rw [Luc_add_two, ih1, ih2, luc, int.coe_nat_add]

theorem int.mod_add (a b m: ℤ) : (a % m + b % m) % m = (a + b) % m :=
begin
rw [int.mod_add_mod,add_comm,int.mod_add_mod,add_comm]
end

theorem nat.mod_add_mod : ∀ (m n k : ℕ), (m % n + k) % n = (m + k) % n :=
begin
intros m n k,
apply int.of_nat_inj,
exact int.mod_add_mod ↑m ↑n ↑k,
end


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Kevin Buzzard, Jujian Zhang
-/

import algebra.algebra.operations
import algebra.algebra.subalgebra.basic
import algebra.direct_sum.algebra

/-!
# Internally graded rings and algebras

This module provides `gsemiring` and `gcomm_semiring` instances for a collection of subobjects `A`
when a `set_like.graded_monoid` instance is available:

* `set_like.gnon_unital_non_assoc_semiring`
* `set_like.gsemiring`
* `set_like.gcomm_semiring`

With these instances in place, it provides the bundled canonical maps out of a direct sum of
subobjects into their carrier type:

* `direct_sum.coe_ring_hom` (a `ring_hom` version of `direct_sum.coe_add_monoid_hom`)
* `direct_sum.coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`)

Strictly the definitions in this file are not sufficient to fully define an "internal" direct sum;
to represent this case, `(h : direct_sum.is_internal A) [set_like.graded_monoid A]` is
needed. In the future there will likely be a data-carrying, constructive, typeclass version of
`direct_sum.is_internal` for providing an explicit decomposition function.

When `complete_lattice.independent (set.range A)` (a weaker condition than
`direct_sum.is_internal A`), these provide a grading of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

internally graded ring
-/

open_locale direct_sum big_operators

variables {ι : Type*} {σ S R : Type*}

instance add_comm_monoid.of_submonoid_on_semiring [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) : ∀ i, add_comm_monoid (A i) :=
λ i, by apply_instance

instance add_comm_group.of_subgroup_on_semiring [ring R] [set_like σ R]
  [add_subgroup_class σ R] (A : ι → σ) : ∀ i, add_comm_group (A i) :=
λ i, by apply_instance

lemma set_like.has_graded_one.algebra_map_mem [has_zero ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.has_graded_one A] (s : S) : algebra_map S R s ∈ A 0 :=
begin
  rw algebra.algebra_map_eq_smul_one,
  exact ((A 0).smul_mem s set_like.has_graded_one.one_mem),
end

lemma set_like.has_graded_one.nat_cast_mem [has_zero ι] [add_monoid_with_one R]
  [set_like σ R] [add_submonoid_class σ R] (A : ι → σ) [set_like.has_graded_one A] (n : ℕ) :
  (n : R) ∈ A 0:=
begin
  induction n,
  { rw nat.cast_zero,
    exact zero_mem (A 0), },
  { rw nat.cast_succ,
    exact add_mem n_ih set_like.has_graded_one.one_mem, },
end

lemma set_like.has_graded_one.int_cast_mem [has_zero ι] [add_group_with_one R]
  [set_like σ R] [add_subgroup_class σ R] (A : ι → σ) [set_like.has_graded_one A] (z : ℤ) :
  (z : R) ∈ A 0:=
begin
  induction z,
  { rw int.cast_of_nat,
    exact set_like.has_graded_one.nat_cast_mem _ _, },
  { rw int.cast_neg_succ_of_nat,
    exact neg_mem (set_like.has_graded_one.nat_cast_mem _ _), },
end

section direct_sum
variables [decidable_eq ι]

/-! #### From `add_submonoid`s and `add_subgroup`s -/

namespace set_like

/-- Build a `gnon_unital_non_assoc_semiring` instance for a collection of additive submonoids. -/
instance gnon_unital_non_assoc_semiring [has_add ι] [non_unital_non_assoc_semiring R]
  [set_like σ R] [add_submonoid_class σ R]
  (A : ι → σ) [set_like.has_graded_mul A] :
  direct_sum.gnon_unital_non_assoc_semiring (λ i, A i) :=
{ mul_zero := λ i j _, subtype.ext (mul_zero _),
  zero_mul := λ i j _, subtype.ext (zero_mul _),
  mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _),
  add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _),
  ..set_like.ghas_mul A }

/-- Build a `gsemiring` instance for a collection of additive submonoids. -/
instance gsemiring [add_monoid ι] [semiring R] [set_like σ R] [add_submonoid_class σ R]
  (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
{ mul_zero := λ i j _, subtype.ext (mul_zero _),
  zero_mul := λ i j _, subtype.ext (zero_mul _),
  mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _),
  add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _),
  nat_cast := λ n, ⟨n, set_like.has_graded_one.nat_cast_mem _ _⟩,
  nat_cast_zero := subtype.ext nat.cast_zero,
  nat_cast_succ := λ n, subtype.ext (nat.cast_succ n),
  ..set_like.gmonoid A }

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcomm_semiring [add_comm_monoid ι] [comm_semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gcomm_semiring (λ i, A i) :=
{ ..set_like.gcomm_monoid A,
  ..set_like.gsemiring A, }

/-- Build a `gring` instance for a collection of additive subgroups. -/
instance gring [add_monoid ι] [ring R] [set_like σ R] [add_subgroup_class σ R]
  (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gring (λ i, A i) :=
{ int_cast := λ z, ⟨z, set_like.has_graded_one.int_cast_mem _ _⟩,
  int_cast_of_nat := λ n, subtype.ext $ int.cast_of_nat _,
  int_cast_neg_succ_of_nat := λ n, subtype.ext $ int.cast_neg_succ_of_nat n,
  ..set_like.gsemiring A }

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcomm_ring [add_comm_monoid ι] [comm_ring R] [set_like σ R]
  [add_subgroup_class σ R] (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gcomm_ring (λ i, A i) :=
{ ..set_like.gcomm_monoid A,
  ..set_like.gring A, }

end set_like

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
def direct_sum.coe_ring_hom [add_monoid ι] [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] : (⨁ i, A i) →+* R :=
direct_sum.to_semiring (λ i, add_submonoid_class.subtype (A i)) rfl (λ _ _ _ _, rfl)

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
@[simp] lemma direct_sum.coe_ring_hom_of [add_monoid ι] [semiring R]
  (A : ι → add_submonoid R) [set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ _ _ _ _

lemma direct_sum.coe_mul_apply [add_monoid ι] [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A]
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (i : ι) :
  ((r * r') i : R) =
    ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support),
      r ij.1 * r' ij.2 :=
begin
  rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply,
    add_submonoid_class.coe_finset_sum],
  simp_rw [direct_sum.coe_of_apply, ←finset.sum_filter, set_like.coe_ghas_mul],
end

/-! #### From `submodule`s -/

namespace submodule

/-- Build a `galgebra` instance for a collection of `submodule`s. -/
instance galgebra [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] :
  direct_sum.galgebra S (λ i, A i) :=
{ to_fun := ((algebra.linear_map S R).cod_restrict (A 0) $
    set_like.has_graded_one.algebra_map_mem A).to_add_monoid_hom,
  map_one := subtype.ext $ by exact (algebra_map S R).map_one,
  map_mul := λ x y, sigma.subtype_ext (add_zero 0).symm $ (algebra_map S R).map_mul _ _,
  commutes := λ r ⟨i, xi⟩,
    sigma.subtype_ext ((zero_add i).trans (add_zero i).symm) $ algebra.commutes _ _,
  smul_def := λ r ⟨i, xi⟩, sigma.subtype_ext (zero_add i).symm $ algebra.smul_def _ _ }

@[simp] lemma set_like.coe_galgebra_to_fun [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] (s : S) :
    ↑(@direct_sum.galgebra.to_fun _ S (λ i, A i) _ _ _ _ _ _ _ s) = (algebra_map S R s : R) := rfl

/-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/
instance nat_power_graded_monoid
  [comm_semiring S] [semiring R] [algebra S R] (p : submodule S R) :
  set_like.graded_monoid (λ i : ℕ, p ^ i) :=
{ one_mem := by { rw [←one_le, pow_zero], exact le_rfl },
  mul_mem := λ i j p q hp hq, by { rw pow_add, exact submodule.mul_mem_mul hp hq } }

end submodule

/-- The canonical algebra isomorphism between `⨁ i, A i` and `R`. -/
def direct_sum.coe_alg_hom [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] : (⨁ i, A i) →ₐ[S] R :=
direct_sum.to_algebra S _ (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) (λ _, rfl)

/-- The supremum of submodules that form a graded monoid is a subalgebra, and equal to the range of
`direct_sum.coe_alg_hom`. -/
lemma submodule.supr_eq_to_submodule_range [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R] (A : ι → submodule S R) [set_like.graded_monoid A] :
  (⨆ i, A i) = (direct_sum.coe_alg_hom A).range.to_submodule :=
(submodule.supr_eq_range_dfinsupp_lsum A).trans $ set_like.coe_injective rfl

@[simp] lemma direct_sum.coe_alg_hom_of [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.coe_alg_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ rfl (λ _ _ _ _, rfl) _ _

end direct_sum

section homogeneous_element

lemma set_like.is_homogeneous_zero_submodule [has_zero ι]
  [semiring S] [add_comm_monoid R] [module S R]
  (A : ι → submodule S R) : set_like.is_homogeneous A (0 : R) :=
⟨0, submodule.zero_mem _⟩

lemma set_like.is_homogeneous.smul [comm_semiring S] [semiring R] [algebra S R]
  {A : ι → submodule S R} {s : S}
  {r : R} (hr : set_like.is_homogeneous A r) : set_like.is_homogeneous A (s • r) :=
let ⟨i, hi⟩ := hr in ⟨i, submodule.smul_mem _ _ hi⟩

end homogeneous_element


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import data.list.basic data.pnat data.array.lemmas

universes u v w

/-- `bucket_array α β` is the underlying data type for `hash_map α β`,
  an array of linked lists of key-value pairs. -/
def bucket_array (α : Type u) (β : α → Type v) (n : ℕ+) :=
array n.1 (list Σ a, β a)

/-- Make a hash_map index from a `nat` hash value and a (positive) buffer size -/
def hash_map.mk_idx (n : ℕ+) (i : nat) : fin n.1 :=
⟨i % n.1, nat.mod_lt _ n.2⟩

namespace bucket_array
section
parameters {α : Type u} {β : α → Type v} (hash_fn : α → nat)
variables {n : ℕ+} (data : bucket_array α β n)

/-- Read the bucket corresponding to an element -/
def read (a : α) : list Σ a, β a :=
let bidx := hash_map.mk_idx n (hash_fn a) in
data.read bidx

/-- Write the bucket corresponding to an element -/
def write (a : α) (l : list Σ a, β a) : bucket_array α β n :=
let bidx := hash_map.mk_idx n (hash_fn a) in
data.write bidx l

/-- Modify (read, apply `f`, and write) the bucket corresponding to an element -/
def modify (a : α) (f : list (Σ a, β a) → list (Σ a, β a)) : bucket_array α β n :=
let bidx := hash_map.mk_idx n (hash_fn a) in
array.write data bidx (f (array.read data bidx))

/-- The list of all key-value pairs in the bucket list -/
def as_list : list Σ a, β a := data.to_list.join

theorem mem_as_list {a : Σ a, β a} : a ∈ data.as_list ↔ ∃i, a ∈ array.read data i :=
have (∃ (l : list (Σ (a : α), β a)) (i : fin (n.val)), a ∈ l ∧ array.read data i = l) ↔
  ∃ (i : fin (n.val)), a ∈ array.read data i,
by rw exists_swap; exact exists_congr (λ i, by simp),
by simp [as_list]; simpa [array.mem.def, and_comm]

/-- Fold a function `f` over the key-value pairs in the bucket list -/
def foldl {δ : Type w} (d : δ) (f : δ → Π a, β a → δ) : δ :=
data.foldl d (λ b d, b.foldl (λ r a, f r a.1 a.2) d)

theorem foldl_eq {δ : Type w} (d : δ) (f : δ → Π a, β a → δ) :
  data.foldl d f = data.as_list.foldl (λ r a, f r a.1 a.2) d :=
by rw [foldl, as_list, list.foldl_join, ← array.to_list_foldl]

end
end bucket_array

namespace hash_map
section
parameters {α : Type u} {β : α → Type v} (hash_fn : α → nat)

/-- Insert the pair `⟨a, b⟩` into the correct location in the bucket array
  (without checking for duplication) -/
def reinsert_aux {n} (data : bucket_array α β n) (a : α) (b : β a) : bucket_array α β n :=
data.modify hash_fn a (λl, ⟨a, b⟩ :: l)

parameter [decidable_eq α]

/-- Search a bucket for a key `a` and return the value -/
def find_aux (a : α) : list (Σ a, β a) → option (β a)
| []          := none
| (⟨a',b⟩::t) := if h : a' = a then some (eq.rec_on h b) else find_aux t

theorem find_aux_iff {a : α} {b : β a} : Π {l : list Σ a, β a}, (l.map sigma.fst).nodup → (find_aux a l = some b ↔ sigma.mk a b ∈ l)
| []          nd := ⟨λn, by injection n, false.elim⟩
| (⟨a',b'⟩::t) nd := begin
  by_cases a' = a,
  { clear find_aux_iff, subst h,
    suffices : b' = b ↔ b' = b ∨ sigma.mk a' b ∈ t, {simpa [find_aux, eq_comm]},
    refine (or_iff_left_of_imp (λ m, _)).symm,
    have : a' ∉ t.map sigma.fst, from list.not_mem_of_nodup_cons nd,
    exact this.elim (list.mem_map_of_mem sigma.fst m) },
  { have : sigma.mk a b ≠ ⟨a', b'⟩,
    { intro e, injection e with e, exact h e.symm },
    simp at nd, simp [find_aux, h, ne.symm h, find_aux_iff, nd] }
end

/-- Returns `tt` if the bucket `l` contains the key `a` -/
def contains_aux (a : α) (l : list Σ a, β a) : bool :=
(find_aux a l).is_some

theorem contains_aux_iff {a : α} {l : list Σ a, β a} (nd : (l.map sigma.fst).nodup) : contains_aux a l ↔ a ∈ l.map sigma.fst :=
begin
  unfold contains_aux,
  cases h : find_aux a l with b; simp,
  { assume (b : β a) (m : sigma.mk a b ∈ l),
    rw (find_aux_iff nd).2 m at h,
    contradiction },
  { show ∃ (b : β a), sigma.mk a b ∈ l,
    exact ⟨_, (find_aux_iff nd).1 h⟩ },
end

/-- Modify a bucket to replace a value in the list. Leaves the list
 unchanged if the key is not found. -/
def replace_aux (a : α) (b : β a) : list (Σ a, β a) → list (Σ a, β a)
| []            := []
| (⟨a', b'⟩::t) := if a' = a then ⟨a, b⟩::t else ⟨a', b'⟩ :: replace_aux t

/-- Modify a bucket to remove a key, if it exists. -/
def erase_aux (a : α) : list (Σ a, β a) → list (Σ a, β a)
| []            := []
| (⟨a', b'⟩::t) := if a' = a then t else ⟨a', b'⟩ :: erase_aux t

/-- The predicate `valid bkts sz` means that `bkts` satisfies the `hash_map`
  invariants: There are exactly `sz` elements in it, every pair is in the
  bucket determined by its key and the hash function, and no key appears
  multiple times in the list. -/
structure valid {n} (bkts : bucket_array α β n) (sz : nat) : Prop :=
(len : bkts.as_list.length = sz)
(idx : ∀ {i} {a : Σ a, β a}, a ∈ array.read bkts i →
  mk_idx n (hash_fn a.1) = i)
(nodup : ∀i, ((array.read bkts i).map sigma.fst).nodup)

theorem valid.idx_enum {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz)
  {i l} (he : (i, l) ∈ bkts.to_list.enum) {a} {b : β a} (hl : sigma.mk a b ∈ l) :
  ∃ h, mk_idx n (hash_fn a) = ⟨i, h⟩ :=
(array.mem_to_list_enum.mp he).imp (λ h e, by subst e; exact v.idx hl)

theorem valid.idx_enum_1 {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz)
  {i l} (he : (i, l) ∈ bkts.to_list.enum) {a} {b : β a} (hl : sigma.mk a b ∈ l) :
  (mk_idx n (hash_fn a)).1 = i :=
let ⟨h, e⟩ := v.idx_enum _ he hl in by rw e; refl

theorem valid.as_list_nodup {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz) : (bkts.as_list.map sigma.fst).nodup :=
begin
  suffices : (bkts.to_list.map (list.map sigma.fst)).pairwise list.disjoint,
  { simp [bucket_array.as_list, list.nodup_join, this],
    change ∀ l s, array.mem s bkts → list.map sigma.fst s = l → l.nodup,
    introv m e, subst e, cases m with i e, subst e,
    apply v.nodup },
  rw [← list.enum_map_snd bkts.to_list, list.pairwise_map, list.pairwise_map],
  have : (bkts.to_list.enum.map prod.fst).nodup := by simp [list.nodup_range],
  refine list.pairwise.imp_of_mem _ ((list.pairwise_map _).1 this),
  rw prod.forall, intros i l₁,
  rw prod.forall, intros j l₂ me₁ me₂ ij,
  simp [list.disjoint], intros a b ml₁ b' ml₂,
  apply ij, rwa [← v.idx_enum_1 _ me₁ ml₁, ← v.idx_enum_1 _ me₂ ml₂]
end

theorem mk_as_list (n : ℕ+) : bucket_array.as_list (mk_array n.1 [] : bucket_array α β n) = [] :=
list.eq_nil_of_forall_not_mem $ λ x m,
let ⟨i, h⟩ := (bucket_array.mem_as_list _).1 m in h

theorem mk_valid (n : ℕ+) : @valid n (mk_array n.1 []) 0 :=
⟨by simp [mk_as_list], λ i a h, by cases h, λ i, list.nodup_nil⟩

theorem valid.find_aux_iff {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz) {a : α} {b : β a} :
  find_aux a (bkts.read hash_fn a) = some b ↔ sigma.mk a b ∈ bkts.as_list :=
(find_aux_iff (v.nodup _)).trans $
by rw bkts.mem_as_list; exact ⟨λ h, ⟨_, h⟩, λ ⟨i, h⟩, (v.idx h).symm ▸ h⟩

theorem valid.contains_aux_iff {n} {bkts : bucket_array α β n} {sz : nat} (v : valid bkts sz) (a : α) :
  contains_aux a (bkts.read hash_fn a) ↔ a ∈ bkts.as_list.map sigma.fst :=
by simp [contains_aux, option.is_some_iff_exists, v.find_aux_iff hash_fn]

section
  parameters {n : ℕ+} {bkts : bucket_array α β n}
             {bidx : fin n.1} {f : list (Σ a, β a) → list (Σ a, β a)}
             (u v1 v2 w : list Σ a, β a)

  local notation `L` := array.read bkts bidx
  private def bkts' : bucket_array α β n := array.write bkts bidx (f L)

  variables (hl : L = u ++ v1 ++ w)
            (hfl : f L = u ++ v2 ++ w)
  include hl hfl

  theorem append_of_modify : ∃ u' w', bkts.as_list = u' ++ v1 ++ w' ∧ bkts'.as_list = u' ++ v2 ++ w' :=
  begin
    unfold bucket_array.as_list,
    have h : bidx.1 < bkts.to_list.length, {simp [bidx.2]},
    refine ⟨(bkts.to_list.take bidx.1).join ++ u, w ++ (bkts.to_list.drop (bidx.1+1)).join, _, _⟩,
    { conv { to_lhs,
        rw [← list.take_append_drop bidx.1 bkts.to_list, list.drop_eq_nth_le_cons h],
        simp [hl] }, simp },
    { conv { to_lhs,
        rw [bkts', array.write_to_list, list.update_nth_eq_take_cons_drop _ h],
        simp [hfl] }, simp }
  end

  variables (hvnd : (v2.map sigma.fst).nodup)
            (hal : ∀ (a : Σ a, β a), a ∈ v2 → mk_idx n (hash_fn a.1) = bidx)
            (djuv : (u.map sigma.fst).disjoint (v2.map sigma.fst))
            (djwv : (w.map sigma.fst).disjoint (v2.map sigma.fst))
  include hvnd hal djuv djwv

  theorem valid.modify {sz : ℕ} (v : valid bkts sz) : sz + v2.length ≥ v1.length ∧ valid bkts' (sz + v2.length - v1.length) :=
  begin
    rcases append_of_modify u v1 v2 w hl hfl with ⟨u', w', e₁, e₂⟩,
    rw [← v.len, e₁],
    suffices : valid bkts' (u' ++ v2 ++ w').length,
    { simpa [ge, nat.le_add_right, nat.add_sub_cancel_left] },
    refine ⟨congr_arg _ e₂, λ i a, _, λ i, _⟩,
    { by_cases bidx = i,
      { subst i, rw [bkts', array.read_write, hfl],
        have := @valid.idx _ _ _ v bidx a,
        simp only [hl, list.mem_append, or_imp_distrib, forall_and_distrib] at this ⊢,
        exact ⟨⟨this.1.1, hal _⟩, this.2⟩ },
      { rw [bkts', array.read_write_of_ne _ _ h], apply v.idx } },
    { by_cases bidx = i,
      { subst i, rw [bkts', array.read_write, hfl],
        have := @valid.nodup _ _ _ v bidx,
        simp [hl, list.nodup_append] at this,
        simp [list.nodup_append, this, hvnd, djuv, djwv.symm] },
      { rw [bkts', array.read_write_of_ne _ _ h], apply v.nodup } }
  end
end

theorem valid.replace_aux (a : α) (b : β a) : Π (l : list (Σ a, β a)), a ∈ l.map sigma.fst →
  ∃ (u w : list Σ a, β a) b', l = u ++ [⟨a, b'⟩] ++ w ∧ replace_aux a b l = u ++ [⟨a, b⟩] ++ w
| []            := false.elim
| (⟨a', b'⟩::t) := begin
  by_cases e : a' = a,
  { subst a',
    suffices : ∃ u w (b'' : β a),
      sigma.mk a b' :: t = u ++ ⟨a, b''⟩ :: w ∧
      replace_aux a b (⟨a, b'⟩ :: t) = u ++ ⟨a, b⟩ :: w, {simpa},
    refine ⟨[], t, b', _⟩, simp [replace_aux] },
  { suffices : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (b'' : β a),
      sigma.mk a' b' :: t = u ++ ⟨a, b''⟩ :: w ∧
      sigma.mk a' b' :: replace_aux a b t = u ++ ⟨a, b⟩ :: w,
    { simpa [replace_aux, ne.symm e, e] },
    intros x m,
    have IH : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (b'' : β a),
      t = u ++ ⟨a, b''⟩ :: w ∧ replace_aux a b t = u ++ ⟨a, b⟩ :: w,
    { simpa using valid.replace_aux t },
    rcases IH x m with ⟨u, w, b'', hl, hfl⟩,
    exact ⟨⟨a', b'⟩ :: u, w, b'', by simp [hl, hfl.symm, ne.symm e]⟩ }
end

theorem valid.replace {n : ℕ+}
  {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
  (Hc : contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (bkts.modify hash_fn a (replace_aux a b)) sz :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  rcases hash_map.valid.replace_aux a b (array.read bkts (mk_idx n (hash_fn a)))
    ((contains_aux_iff nd).1 Hc) with ⟨u, w, b', hl, hfl⟩,
  simp [hl, list.nodup_append] at nd,
  refine (v.modify hash_fn
    u [⟨a, b'⟩] [⟨a, b⟩] w hl hfl (list.nodup_singleton _)
    (λa' e, by simp at e; rw e)
    (λa' e1 e2, _)
    (λa' e1 e2, _)).2;
  { revert e1, simp [-sigma.exists] at e2, subst a', simp [nd] }
end

theorem valid.insert {n : ℕ+}
  {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
  (Hnc : ¬ contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (reinsert_aux bkts a b) (sz+1) :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  refine (v.modify hash_fn
    [] [] [⟨a, b⟩] (bkts.read hash_fn a) rfl rfl (list.nodup_singleton _)
    (λa' e, by simp at e; rw e)
    (λa', false.elim)
    (λa' e1 e2, _)).2,
  simp [-sigma.exists] at e2, subst a',
  exact Hnc ((contains_aux_iff nd).2 e1)
end

theorem valid.erase_aux (a : α) : Π (l : list (Σ a, β a)), a ∈ l.map sigma.fst →
  ∃ (u w : list Σ a, β a) b, l = u ++ [⟨a, b⟩] ++ w ∧ erase_aux a l = u ++ [] ++ w
| []            := false.elim
| (⟨a', b'⟩::t) := begin
  by_cases e : a' = a,
  { subst a',
    simpa [erase_aux, and_comm] using show ∃ u w (x : β a),
      t = u ++ w ∧ sigma.mk a b' :: t = u ++ ⟨a, x⟩ :: w, from ⟨[], t, b', by simp⟩ },
  { simp [erase_aux, e, ne.symm e],
    suffices : ∀ (b : β a) (_ : sigma.mk a b ∈ t), ∃ u w (x : β a),
      sigma.mk a' b' :: t = u ++ ⟨a, x⟩ :: w ∧
      sigma.mk a' b' :: erase_aux a t = u ++ w,
    { simpa [replace_aux, ne.symm e, e] },
    intros b m,
    have IH : ∀ (x : β a) (_ : sigma.mk a x ∈ t), ∃ u w (x : β a),
      t = u ++ ⟨a, x⟩ :: w ∧ erase_aux a t = u ++ w,
    { simpa using valid.erase_aux t },
    rcases IH b m with ⟨u, w, b'', hl, hfl⟩,
    exact ⟨⟨a', b'⟩ :: u, w, b'', by simp [hl, hfl.symm]⟩ }
end

theorem valid.erase {n} {bkts : bucket_array α β n} {sz}
  (a : α) (Hc : contains_aux a (bkts.read hash_fn a))
  (v : valid bkts sz) : valid (bkts.modify hash_fn a (erase_aux a)) (sz-1) :=
begin
  have nd := v.nodup (mk_idx n (hash_fn a)),
  rcases hash_map.valid.erase_aux a (array.read bkts (mk_idx n (hash_fn a)))
    ((contains_aux_iff nd).1 Hc) with ⟨u, w, b, hl, hfl⟩,
  refine (v.modify hash_fn u [⟨a, b⟩] [] w hl hfl list.nodup_nil _ _ _).2;
  { intros, simp at *; contradiction }
end

end
end hash_map

/-- A hash map data structure, representing a finite key-value map
  with key type `α` and value type `β` (which may depend on `α`). -/
structure hash_map (α : Type u) [decidable_eq α] (β : α → Type v) :=
(hash_fn : α → nat)
(size : ℕ)
(nbuckets : ℕ+)
(buckets : bucket_array α β nbuckets)
(is_valid : hash_map.valid hash_fn buckets size)

/-- Construct an empty hash map with buffer size `nbuckets` (default 8). -/
def mk_hash_map {α : Type u} [decidable_eq α] {β : α → Type v} (hash_fn : α → nat) (nbuckets := 8) : hash_map α β :=
let n := if nbuckets = 0 then 8 else nbuckets in
let nz : n > 0 := by abstract { cases nbuckets, {simp, tactic.comp_val}, simp [if_pos, nat.succ_ne_zero], apply nat.zero_lt_succ} in
{ hash_fn  := hash_fn,
  size     := 0,
  nbuckets := ⟨n, nz⟩,
  buckets  := mk_array n [],
  is_valid := hash_map.mk_valid _ _ }

namespace hash_map
variables {α : Type u} {β : α → Type v} [decidable_eq α]

/-- Return the value corresponding to a key, or `none` if not found -/
def find (m : hash_map α β) (a : α) : option (β a) :=
find_aux a (m.buckets.read m.hash_fn a)

/-- Return `tt` if the key exists in the map -/
def contains (m : hash_map α β) (a : α) : bool :=
(m.find a).is_some

instance : has_mem α (hash_map α β) := ⟨λa m, m.contains a⟩

/-- Fold a function over the key-value pairs in the map -/
def fold {δ : Type w} (m : hash_map α β) (d : δ) (f : δ → Π a, β a → δ) : δ :=
m.buckets.foldl d f

/-- The list of key-value pairs in the map -/
def entries (m : hash_map α β) : list Σ a, β a :=
m.buckets.as_list

/-- The list of keys in the map -/
def keys (m : hash_map α β) : list α :=
m.entries.map sigma.fst

theorem find_iff (m : hash_map α β) (a : α) (b : β a) :
  m.find a = some b ↔ sigma.mk a b ∈ m.entries :=
m.is_valid.find_aux_iff _

theorem contains_iff (m : hash_map α β) (a : α) :
  m.contains a ↔ a ∈ m.keys :=
m.is_valid.contains_aux_iff _ _

theorem entries_empty (hash_fn : α → nat) (n) :
  (@mk_hash_map α _ β hash_fn n).entries = [] :=
by dsimp [entries, mk_hash_map]; rw mk_as_list

theorem keys_empty (hash_fn : α → nat) (n) :
  (@mk_hash_map α _ β hash_fn n).keys = [] :=
by dsimp [keys]; rw entries_empty; refl

theorem find_empty (hash_fn : α → nat) (n a) :
  (@mk_hash_map α _ β hash_fn n).find a = none :=
by induction h : (@mk_hash_map α _ β hash_fn n).find a; [refl,
   { have := (find_iff _ _ _).1 h, rw entries_empty at this, contradiction }]

theorem not_contains_empty (hash_fn : α → nat) (n a) :
  ¬ (@mk_hash_map α _ β hash_fn n).contains a :=
by apply bool_iff_false.2; dsimp [contains]; rw [find_empty]; refl

theorem insert_lemma (hash_fn : α → nat) {n n'}
  {bkts : bucket_array α β n} {sz} (v : valid hash_fn bkts sz) :
  valid hash_fn (bkts.foldl (mk_array _ [] : bucket_array α β n') (reinsert_aux hash_fn)) sz :=
begin
  suffices : ∀ (l : list Σ a, β a) (t : bucket_array α β n') sz,
    valid hash_fn t sz → ((l ++ t.as_list).map sigma.fst).nodup →
    valid hash_fn (l.foldl (λr (a : Σ a, β a), reinsert_aux hash_fn r a.1 a.2) t) (sz + l.length),
  { have p := this bkts.as_list _ _ (mk_valid _ _),
    rw [mk_as_list, list.append_nil, zero_add, v.len] at p,
    rw bucket_array.foldl_eq,
    exact p (v.as_list_nodup _) },
  intro l, induction l with c l IH; intros t sz v nd, {exact v},
  rw show sz + (c :: l).length = sz + 1 + l.length, by simp,
  rcases (show (l.map sigma.fst).nodup ∧
      ((bucket_array.as_list t).map sigma.fst).nodup ∧
      c.fst ∉ l.map sigma.fst ∧
      c.fst ∉ (bucket_array.as_list t).map sigma.fst ∧
      (l.map sigma.fst).disjoint ((bucket_array.as_list t).map sigma.fst),
    by simpa [list.nodup_append, not_or_distrib, and_comm, and.left_comm] using nd)
    with ⟨nd1, nd2, nm1, nm2, dj⟩,
  have v' := v.insert _ _ c.2 (λHc, nm2 $ (v.contains_aux_iff _ c.1).1 Hc),
  apply IH _ _ v',
  suffices : ∀ ⦃a : α⦄ (b : β a), sigma.mk a b ∈ l →
    ∀ (b' : β a), sigma.mk a b' ∈ (reinsert_aux hash_fn t c.1 c.2).as_list → false,
  { simpa [list.nodup_append, nd1, v'.as_list_nodup _, list.disjoint] },
  intros a b m1 b' m2,
  rcases (reinsert_aux hash_fn t c.1 c.2).mem_as_list.1 m2 with ⟨i, im⟩,
  have : sigma.mk a b' ∉ array.read t i,
  { intro m3,
    have : a ∈ list.map sigma.fst t.as_list :=
      list.mem_map_of_mem sigma.fst (t.mem_as_list.2 ⟨_, m3⟩),
    exact dj (list.mem_map_of_mem sigma.fst m1) this },
  by_cases h : mk_idx n' (hash_fn c.1) = i,
  { subst h,
    have e : sigma.mk a b' = ⟨c.1, c.2⟩,
    { simpa [reinsert_aux, bucket_array.modify, array.read_write, this] using im },
    injection e with e, subst a,
    exact nm1.elim (@list.mem_map_of_mem _ _ sigma.fst _ _ m1) },
  { apply this,
    simpa [reinsert_aux, bucket_array.modify, array.read_write_of_ne _ _ h] using im }
end

/-- Insert a key-value pair into the map. (Modifies `m` in-place when applicable) -/
def insert : Π (m : hash_map α β) (a : α) (b : β a), hash_map α β
| ⟨hash_fn, size, n, buckets, v⟩ a b :=
let bkt := buckets.read hash_fn a in
if hc : contains_aux a bkt then
{ hash_fn  := hash_fn,
  size     := size,
  nbuckets := n,
  buckets  := buckets.modify hash_fn a (replace_aux a b),
  is_valid := v.replace _ a b hc }
else
let size'    := size + 1,
    buckets' := buckets.modify hash_fn a (λl, ⟨a, b⟩::l),
    valid'   := v.insert _ a b hc in
if size' ≤ n.1 then
{ hash_fn  := hash_fn,
  size     := size',
  nbuckets := n,
  buckets  := buckets',
  is_valid := valid' }
else
let n'        : ℕ+ := ⟨n.1 * 2, mul_pos n.2 dec_trivial⟩,
    buckets'' : bucket_array α β n' :=
                buckets'.foldl (mk_array _ []) (reinsert_aux hash_fn) in
{ hash_fn  := hash_fn,
  size     := size',
  nbuckets := n',
  buckets  := buckets'',
  is_valid := insert_lemma _ valid' }

theorem mem_insert : Π (m : hash_map α β) (a b a' b'),
  (sigma.mk a' b' : sigma β) ∈ (m.insert a b).entries ↔
  if a = a' then b == b' else sigma.mk a' b' ∈ m.entries
| ⟨hash_fn, size, n, bkts, v⟩ a b a' b' := begin
  let bkt := bkts.read hash_fn a,
  have nd : (bkt.map sigma.fst).nodup := v.nodup (mk_idx n (hash_fn a)),
  have lem : Π (bkts' : bucket_array α β n) (v1 u w)
    (hl : bucket_array.as_list bkts = u ++ v1 ++ w)
    (hfl : bucket_array.as_list bkts' = u ++ [⟨a, b⟩] ++ w)
    (veq : (v1 = [] ∧ ¬ contains_aux a bkt) ∨ ∃b'', v1 = [⟨a, b''⟩]),
    sigma.mk a' b' ∈ bkts'.as_list ↔
    if a = a' then b == b' else sigma.mk a' b' ∈ bkts.as_list,
  { intros bkts' v1 u w hl hfl veq,
    rw [hl, hfl],
    by_cases h : a = a',
    { subst a',
      suffices : b = b' ∨ sigma.mk a b' ∈ u ∨ sigma.mk a b' ∈ w ↔ b = b',
      { simpa [eq_comm, or.left_comm] },
      refine or_iff_left_of_imp (not.elim $ not_or_distrib.2 _),
      rcases veq with ⟨rfl, Hnc⟩ | ⟨b'', rfl⟩,
      { have na := (not_iff_not_of_iff $ v.contains_aux_iff _ _).1 Hnc,
        simp [hl, not_or_distrib] at na, simp [na] },
      { have nd' := v.as_list_nodup _,
        simp [hl, list.nodup_append] at nd', simp [nd'] } },
    { suffices : sigma.mk a' b' ∉ v1, {simp [h, ne.symm h, this]},
      rcases veq with ⟨rfl, Hnc⟩ | ⟨b'', rfl⟩; simp [ne.symm h] } },
  by_cases Hc : (contains_aux a bkt : Prop),
  { rcases hash_map.valid.replace_aux a b (array.read bkts (mk_idx n (hash_fn a)))
      ((contains_aux_iff nd).1 Hc) with ⟨u', w', b'', hl', hfl'⟩,
    rcases (append_of_modify u' [⟨a, b''⟩] [⟨a, b⟩] w' hl' hfl') with ⟨u, w, hl, hfl⟩,
    simpa [insert, @dif_pos (contains_aux a bkt) _ Hc]
      using lem _ _ u w hl hfl (or.inr ⟨b'', rfl⟩) },
  { let size' := size + 1,
    let bkts' := bkts.modify hash_fn a (λl, ⟨a, b⟩::l),
    have mi : sigma.mk a' b' ∈ bkts'.as_list ↔
        if a = a' then b == b' else sigma.mk a' b' ∈ bkts.as_list :=
      let ⟨u, w, hl, hfl⟩ := append_of_modify [] [] [⟨a, b⟩] _ rfl rfl in
      lem bkts' _ u w hl hfl $ or.inl ⟨rfl, Hc⟩,
    simp [insert, @dif_neg (contains_aux a bkt) _ Hc],
    by_cases h : size' ≤ n.1,
    -- TODO(Mario): Why does the by_cases assumption look different than the stated one?
    { simpa [show size' ≤ n.1, from h] using mi },
    { let n' : ℕ+ := ⟨n.1 * 2, mul_pos n.2 dec_trivial⟩,
      let bkts'' : bucket_array α β n' := bkts'.foldl (mk_array _ []) (reinsert_aux hash_fn),
      suffices : sigma.mk a' b' ∈ bkts''.as_list ↔ sigma.mk a' b' ∈ bkts'.as_list.reverse,
      { simpa [show ¬ size' ≤ n.1, from h, mi] },
      rw [show bkts'' = bkts'.as_list.foldl _ _, from bkts'.foldl_eq _ _,
          ← list.foldr_reverse],
      induction bkts'.as_list.reverse with a l IH,
      { simp [mk_as_list] },
      { cases a with a'' b'',
        let B := l.foldr (λ (y : sigma β) (x : bucket_array α β n'),
          reinsert_aux hash_fn x y.1 y.2) (mk_array n'.1 []),
        rcases append_of_modify [] [] [⟨a'', b''⟩] _ rfl rfl with ⟨u, w, hl, hfl⟩,
        simp [IH.symm, or.left_comm, show B.as_list = _, from hl,
              show (reinsert_aux hash_fn B a'' b'').as_list = _, from hfl] } } }
end

theorem find_insert_eq (m : hash_map α β) (a : α) (b : β a) : (m.insert a b).find a = some b :=
(find_iff (m.insert a b) a b).2 $ (mem_insert m a b a b).2 $ by rw if_pos rfl

theorem find_insert_ne (m : hash_map α β) (a a' : α) (b : β a) (h : a ≠ a') :
  (m.insert a b).find a' = m.find a' :=
option.eq_of_eq_some $ λb',
let t := mem_insert m a b a' b' in
(find_iff _ _ _).trans $ iff.trans (by rwa if_neg h at t) (find_iff _ _ _).symm

theorem find_insert (m : hash_map α β) (a' a : α) (b : β a) :
  (m.insert a b).find a' = if h : a = a' then some (eq.rec_on h b) else m.find a' :=
if h : a = a' then by rw dif_pos h; exact
  match a', h with ._, rfl := find_insert_eq m a b end
else by rw dif_neg h; exact find_insert_ne m a a' b h

/-- Insert a list of key-value pairs into the map. (Modifies `m` in-place when applicable) -/
def insert_all (l : list (Σ a, β a)) (m : hash_map α β) : hash_map α β :=
l.foldl (λ m ⟨a, b⟩, insert m a b) m

/-- Construct a hash map from a list of key-value pairs. -/
def of_list (l : list (Σ a, β a)) (hash_fn) : hash_map α β :=
insert_all l (mk_hash_map hash_fn (2 * l.length))

/-- Remove a key from the map. (Modifies `m` in-place when applicable) -/
def erase (m : hash_map α β) (a : α) : hash_map α β :=
match m with ⟨hash_fn, size, n, buckets, v⟩ :=
  if hc : contains_aux a (buckets.read hash_fn a) then
  { hash_fn  := hash_fn,
    size     := size - 1,
    nbuckets := n,
    buckets  := buckets.modify hash_fn a (erase_aux a),
    is_valid := v.erase _ a hc }
  else m
end

theorem mem_erase : Π (m : hash_map α β) (a a' b'),
  (sigma.mk a' b' : sigma β) ∈ (m.erase a).entries ↔
  a ≠ a' ∧ sigma.mk a' b' ∈ m.entries
| ⟨hash_fn, size, n, bkts, v⟩ a a' b' := begin
  let bkt := bkts.read hash_fn a,
  by_cases Hc : (contains_aux a bkt : Prop),
  { let bkts' := bkts.modify hash_fn a (erase_aux a),
    suffices : sigma.mk a' b' ∈ bkts'.as_list ↔ a ≠ a' ∧ sigma.mk a' b' ∈ bkts.as_list,
    { simpa [erase, @dif_pos (contains_aux a bkt) _ Hc] },
    have nd := v.nodup (mk_idx n (hash_fn a)),
    rcases valid.erase_aux a bkt ((contains_aux_iff nd).1 Hc) with ⟨u', w', b, hl', hfl'⟩,
    rcases append_of_modify u' [⟨a, b⟩] [] _ hl' hfl' with ⟨u, w, hl, hfl⟩,
    suffices : ∀_:sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w, a ≠ a',
    { have : sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w ↔ (¬a = a' ∧ a' = a) ∧ b' == b ∨
        ¬a = a' ∧ (sigma.mk a' b' ∈ u ∨ sigma.mk a' b' ∈ w),
      { simp [eq_comm, not_and_self_iff, and_iff_right_of_imp this] },
      simpa [hl, show bkts'.as_list = _, from hfl, and_or_distrib_left,
             and_comm, and.left_comm, or.left_comm] },
    intros m e, subst a', revert m, apply not_or_distrib.2,
    have nd' := v.as_list_nodup _,
    simp [hl, list.nodup_append] at nd', simp [nd'] },
  { suffices : ∀_:sigma.mk a' b' ∈ bucket_array.as_list bkts, a ≠ a',
    { simp [erase, @dif_neg (contains_aux a bkt) _ Hc, entries, and_iff_right_of_imp this] },
    intros m e, subst a',
    exact Hc ((v.contains_aux_iff _ _).2 (list.mem_map_of_mem sigma.fst m)) }
end

theorem find_erase_eq (m : hash_map α β) (a : α) : (m.erase a).find a = none :=
begin
  cases h : (m.erase a).find a with b, {refl},
  exact absurd rfl ((mem_erase m a a b).1 ((find_iff (m.erase a) a b).1 h)).left
end

theorem find_erase_ne (m : hash_map α β) (a a' : α) (h : a ≠ a') :
  (m.erase a).find a' = m.find a' :=
option.eq_of_eq_some $ λb',
(find_iff _ _ _).trans $ (mem_erase m a a' b').trans $
  (and_iff_right h).trans (find_iff _ _ _).symm

theorem find_erase (m : hash_map α β) (a' a : α) :
  (m.erase a).find a' = if a = a' then none else m.find a' :=
if h : a = a' then by subst a'; simp [find_erase_eq m a]
else by rw if_neg h; exact find_erase_ne m a a' h

section string
variables [has_to_string α] [∀ a, has_to_string (β a)]
open prod
private def key_data_to_string (a : α) (b : β a) (first : bool) : string :=
(if first then "" else ", ") ++ sformat!"{a} ← {b}"

private def to_string (m : hash_map α β) : string :=
"⟨" ++ (fst (fold m ("", tt) (λ p a b, (fst p ++ key_data_to_string a b (snd p), ff)))) ++ "⟩"

instance : has_to_string (hash_map α β) :=
⟨to_string⟩

end string

section format
open format prod
variables [has_to_format α] [∀ a, has_to_format (β a)]

private meta def format_key_data (a : α) (b : β a) (first : bool) : format :=
(if first then to_fmt "" else to_fmt "," ++ line) ++ to_fmt a ++ space ++ to_fmt "←" ++ space ++ to_fmt b

private meta def to_format (m : hash_map α β) : format :=
group $ to_fmt "⟨" ++ nest 1 (fst (fold m (to_fmt "", tt) (λ p a b, (fst p ++ format_key_data a b (snd p), ff)))) ++
        to_fmt "⟩"

meta instance : has_to_format (hash_map α β) :=
⟨to_format⟩
end format
end hash_map