/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/

import algebra.order.absolute_value
import algebra.big_operators.basic

/-!
# Results about big operators with values in an ordered algebraic structure.

Mostly monotonicity results for the `∏` and `∑` operations.

-/

open_locale big_operators

variables {ι α β M N G k R : Type*}

namespace finset

section ordered_comm_monoid

variables [comm_monoid M] [ordered_comm_monoid N]

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
submultiplicative on `{x | p x}`, i.e., `p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be
a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∏ x in s, g x) ≤ ∏ x in s, f (g x)`. -/
@[to_additive le_sum_nonempty_of_subadditive_on_pred]
lemma le_prod_nonempty_of_submultiplicative_on_pred
  (f : M → N) (p : M → Prop) (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) (s : finset ι) (hs_nonempty : s.nonempty)
  (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul _ _ _) _,
  { simp [hs_nonempty.ne_empty], },
  { exact multiset.forall_mem_map_iff.mpr hs, },
  rw multiset.map_map,
  refl,
end

/-- Let `{x | p x}` be an additive subsemigroup of an additive commutative monoid `M`. Let
`f : M → N` be a map subadditive on `{x | p x}`, i.e., `p x → p y → f (x + y) ≤ f x + f y`. Let
`g i`, `i ∈ s`, be a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_nonempty_of_subadditive]
lemma le_prod_nonempty_of_submultiplicative
  (f : M → N) (h_mul : ∀ x y, f (x * y) ≤ f x * f y) {s : finset ι} (hs : s.nonempty) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (λ x y _ _, h_mul x y)
  (λ _ _ _ _, trivial) g s hs (λ _ _, trivial)

/-- If `f : M → N` is a subadditive function, `f (x + y) ≤ f x + f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
such that `f 1 = 1` and `f` is submultiplicative on `{x | p x}`, i.e.,
`p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be a finite family of elements of `M` such
that `∀ i ∈ s, p (g i)`. Then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive_on_pred]
lemma le_prod_of_submultiplicative_on_pred (f : M → N) (p : M → Prop) (h_one : f 1 = 1)
  (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) {s : finset ι} (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  rcases eq_empty_or_nonempty s with rfl|hs_nonempty,
  { simp [h_one] },
  { exact le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul g s hs_nonempty hs, },
end

/-- Let `{x | p x}` be a subsemigroup of a commutative additive monoid `M`. Let `f : M → N` be a map
such that `f 0 = 0` and `f` is subadditive on `{x | p x}`, i.e. `p x → p y → f (x + y) ≤ f x + f y`.
Let `g i`, `i ∈ s`, be a finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∑ x in s, g x) ≤ ∑ x in s, f (g x)`. -/
add_decl_doc le_sum_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y`, `f 1 = 1`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive]
lemma le_prod_of_submultiplicative (f : M → N) (h_one : f 1 = 1)
  (h_mul : ∀ x y, f (x * y) ≤ f x * f y) (s : finset ι) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_of_submultiplicative f h_one h_mul _) _,
  rw multiset.map_map,
  refl,
end

/-- If `f : M → N` is a subadditive function, `f (x + y) ≤ f x + f y`, `f 0 = 0`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_of_subadditive

variables {f g : ι → N} {s t : finset ι}

/-- In an ordered commutative monoid, if each factor `f i` of one finite product is less than or
equal to the corresponding factor `g i` of another finite product, then
`∏ i in s, f i ≤ ∏ i in s, g i`. -/
@[to_additive sum_le_sum]
lemma prod_le_prod'' (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction_on with i s hi ihs h,
  { refl },
  { simp only [prod_insert hi],
    exact mul_le_mul' (h _ (mem_insert_self _ _)) (ihs $ λ j hj, h j (mem_insert_of_mem hj)) }
end

/-- In an ordered additive commutative monoid, if each summand `f i` of one finite sum is less than
or equal to the corresponding summand `g i` of another finite sum, then
`∑ i in s, f i ≤ ∑ i in s, g i`. -/
add_decl_doc sum_le_sum

@[to_additive sum_nonneg]  lemma one_le_prod' (h : ∀i ∈ s, 1 ≤ f i) : 1 ≤ (∏ i in s, f i) :=
le_trans (by rw prod_const_one) (prod_le_prod'' h)

@[to_additive sum_nonpos] lemma prod_le_one' (h : ∀i ∈ s, f i ≤ 1) : (∏ i in s, f i) ≤ 1 :=
(prod_le_prod'' h).trans_eq (by rw prod_const_one)

@[to_additive sum_le_sum_of_subset_of_nonneg]
lemma prod_le_prod_of_subset_of_one_le' (h : s ⊆ t) (hf : ∀ i ∈ t, i ∉ s → 1 ≤ f i) :
  ∏ i in s, f i ≤ ∏ i in t, f i :=
by classical;
calc (∏ i in s, f i) ≤ (∏ i in t \ s, f i) * (∏ i in s, f i) :
    le_mul_of_one_le_left' $ one_le_prod' $ by simpa only [mem_sdiff, and_imp]
  ... = ∏ i in t \ s ∪ s, f i : (prod_union sdiff_disjoint).symm
  ... = ∏ i in t, f i         : by rw [sdiff_union_of_subset h]

@[to_additive sum_mono_set_of_nonneg]
lemma prod_mono_set_of_one_le' (hf : ∀ x, 1 ≤ f x) : monotone (λ s, ∏ x in s, f x) :=
λ s t hst, prod_le_prod_of_subset_of_one_le' hst $ λ x _ _, hf x

@[to_additive sum_le_univ_sum_of_nonneg]
lemma prod_le_univ_prod_of_one_le' [fintype ι] {s : finset ι} (w : ∀ x, 1 ≤ f x) :
  ∏ x in s, f x ≤ ∏ x, f x :=
prod_le_prod_of_subset_of_one_le' (subset_univ s) (λ a _ _, w a)

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_one_le' : (∀ i ∈ s, 1 ≤ f i) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
begin
  classical,
  apply finset.induction_on s,
  exact λ _, ⟨λ _ _, false.elim, λ _, rfl⟩,
  assume a s ha ih H,
  have : ∀ i ∈ s, 1 ≤ f i, from λ _, H _ ∘ mem_insert_of_mem,
  rw [prod_insert ha, mul_eq_one_iff' (H _ $ mem_insert_self _ _) (one_le_prod' this),
    forall_mem_insert, ih this]
end

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_le_one' : (∀ i ∈ s, f i ≤ 1) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
@prod_eq_one_iff_of_one_le' _ (order_dual N) _ _ _

@[to_additive single_le_sum]
lemma single_le_prod' (hf : ∀ i ∈ s, 1 ≤ f i) {a} (h : a ∈ s) : f a ≤ (∏ x in s, f x) :=
calc f a = ∏ i in {a}, f i : prod_singleton.symm
     ... ≤ ∏ i in s, f i   :
  prod_le_prod_of_subset_of_one_le' (singleton_subset_iff.2 h) $ λ i hi _, hf i hi

@[to_additive]
lemma prod_le_of_forall_le (s : finset ι) (f : ι → N) (n : N) (h : ∀ x ∈ s, f x ≤ n) :
  s.prod f ≤ n ^ s.card :=
begin
  refine (multiset.prod_le_of_forall_le (s.val.map f) n _).trans _,
  { simpa using h },
  { simpa }
end

@[to_additive]
lemma le_prod_of_forall_le (s : finset ι) (f : ι → N) (n : N) (h : ∀ x ∈ s, n ≤ f x) :
  n ^ s.card ≤ s.prod f :=
@finset.prod_le_of_forall_le _ (order_dual N) _ _ _ _ h

lemma card_bUnion_le_card_mul [decidable_eq β] (s : finset ι) (f : ι → finset β) (n : ℕ)
  (h : ∀ a ∈ s, (f a).card ≤ n) :
  (s.bUnion f).card ≤ s.card * n :=
card_bUnion_le.trans $ sum_le_of_forall_le _ _ _ h

variables {ι' : Type*} [decidable_eq ι']

@[to_additive sum_fiberwise_le_sum_of_sum_fiber_nonneg]
lemma prod_fiberwise_le_prod_of_one_le_prod_fiber' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (1 : N) ≤ ∏ x in s.filter (λ x, g x = y), f x) :
  ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x ≤ ∏ x in s, f x :=
calc (∏ y in t, ∏ x in s.filter (λ x, g x = y), f x) ≤
  (∏ y in t ∪ s.image g, ∏ x in s.filter (λ x, g x = y), f x) :
  prod_le_prod_of_subset_of_one_le' (subset_union_left _ _) $ λ y hyts, h y
... = ∏ x in s, f x :
  prod_fiberwise_of_maps_to (λ x hx, mem_union.2 $ or.inr $ mem_image_of_mem _ hx) _

@[to_additive sum_le_sum_fiberwise_of_sum_fiber_nonpos]
lemma prod_le_prod_fiberwise_of_prod_fiber_le_one' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (∏ x in s.filter (λ x, g x = y), f x) ≤ 1) :
  (∏ x in s, f x) ≤ ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x :=
@prod_fiberwise_le_prod_of_one_le_prod_fiber' _ (order_dual N) _ _ _ _ _ _ _ h

end ordered_comm_monoid

lemma abs_sum_le_sum_abs {G : Type*} [linear_ordered_add_comm_group G] (f : ι → G) (s : finset ι) :
  |∑ i in s, f i| ≤ ∑ i in s, |f i| :=
le_sum_of_subadditive _ abs_zero abs_add s f

lemma abs_prod {R : Type*} [linear_ordered_comm_ring R] {f : ι → R} {s : finset ι} :
  |∏ x in s, f x| = ∏ x in s, |f x| :=
(abs_hom.to_monoid_hom : R →* R).map_prod _ _

section pigeonhole

variable [decidable_eq β]

theorem card_le_mul_card_image_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * t.card :=
calc s.card = (∑ a in t, (s.filter (λ x, f x = a)).card) : card_eq_sum_card_fiberwise Hf
        ... ≤ (∑ _ in t, n)                              : sum_le_sum hn
        ... = _                                          : by simp [mul_comm]

theorem card_le_mul_card_image {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * (s.image f).card :=
card_le_mul_card_image_of_maps_to (λ x, mem_image_of_mem _) n hn

theorem mul_card_image_le_card_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, n ≤ (s.filter (λ x, f x = a)).card) :
  n * t.card ≤ s.card :=
calc n * t.card = (∑ _ in t, n) : by simp [mul_comm]
            ... ≤ (∑ a in t, (s.filter (λ x, f x = a)).card) : sum_le_sum hn
            ... = s.card : by rw ← card_eq_sum_card_fiberwise Hf

theorem mul_card_image_le_card {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, n ≤ (s.filter (λ x, f x = a)).card) :
  n * (s.image f).card ≤ s.card :=
mul_card_image_le_card_of_maps_to (λ x, mem_image_of_mem _) n hn

end pigeonhole

section double_counting
variables [decidable_eq α] {s : finset α} {B : finset (finset α)} {n : ℕ}

/-- If every element belongs to at most `n` finsets, then the sum of their sizes is at most `n`
times how many they are. -/
lemma sum_card_inter_le (h : ∀ a ∈ s, (B.filter $ (∈) a).card ≤ n) :
  ∑ t in B, (s ∩ t).card ≤ s.card * n :=
begin
  refine le_trans _ (s.sum_le_of_forall_le _ _ h),
  simp_rw [←filter_mem_eq_inter, card_eq_sum_ones, sum_filter],
  exact sum_comm.le,
end

/-- If every element belongs to at most `n` finsets, then the sum of their sizes is at most `n`
times how many they are. -/
lemma sum_card_le [fintype α] (h : ∀ a, (B.filter $ (∈) a).card ≤ n) :
  ∑ s in B, s.card ≤ fintype.card α * n :=
calc ∑ s in B, s.card = ∑ s in B, (univ ∩ s).card : by simp_rw univ_inter
                  ... ≤ fintype.card α * n        : sum_card_inter_le (λ a _, h a)

/-- If every element belongs to at least `n` finsets, then the sum of their sizes is at least `n`
times how many they are. -/
lemma le_sum_card_inter (h : ∀ a ∈ s, n ≤ (B.filter $ (∈) a).card) :
  s.card * n ≤ ∑ t in B, (s ∩ t).card :=
begin
  apply (s.le_sum_of_forall_le _ _ h).trans,
  simp_rw [←filter_mem_eq_inter, card_eq_sum_ones, sum_filter],
  exact sum_comm.le,
end

/-- If every element belongs to at least `n` finsets, then the sum of their sizes is at least `n`
times how many they are. -/
lemma le_sum_card [fintype α] (h : ∀ a, n ≤ (B.filter $ (∈) a).card) :
  fintype.card α * n ≤ ∑ s in B, s.card :=
calc fintype.card α * n ≤ ∑ s in B, (univ ∩ s).card : le_sum_card_inter (λ a _, h a)
                    ... = ∑ s in B, s.card          : by simp_rw univ_inter

/-- If every element belongs to exactly `n` finsets, then the sum of their sizes is `n` times how
many they are. -/
lemma sum_card_inter (h : ∀ a ∈ s, (B.filter $ (∈) a).card = n) :
  ∑ t in B, (s ∩ t).card = s.card * n :=
(sum_card_inter_le $ λ a ha, (h a ha).le).antisymm (le_sum_card_inter $ λ a ha, (h a ha).ge)

/-- If every element belongs to exactly `n` finsets, then the sum of their sizes is `n` times how
many they are. -/
lemma sum_card [fintype α] (h : ∀ a, (B.filter $ (∈) a).card = n) :
  ∑ s in B, s.card = fintype.card α * n :=
by simp_rw [fintype.card, ←sum_card_inter (λ a _, h a), univ_inter]

end double_counting

section canonically_ordered_monoid

variables [canonically_ordered_monoid M] {f : ι → M} {s t : finset ι}

@[simp, to_additive sum_eq_zero_iff]
lemma prod_eq_one_iff' : ∏ x in s, f x = 1 ↔ ∀ x ∈ s, f x = 1 :=
prod_eq_one_iff_of_one_le' $ λ x hx, one_le (f x)

@[to_additive sum_le_sum_of_subset]
lemma prod_le_prod_of_subset' (h : s ⊆ t) : ∏ x in s, f x ≤ ∏ x in t, f x :=
prod_le_prod_of_subset_of_one_le' h $ assume x h₁ h₂, one_le _

@[to_additive sum_mono_set]
lemma prod_mono_set' (f : ι → M) : monotone (λ s, ∏ x in s, f x) :=
λ s₁ s₂ hs, prod_le_prod_of_subset' hs

@[to_additive sum_le_sum_of_ne_zero]
lemma prod_le_prod_of_ne_one' (h : ∀ x ∈ s, f x ≠ 1 → x ∈ t) :
  ∏ x in s, f x ≤ ∏ x in t, f x :=
by classical;
calc ∏ x in s, f x = (∏ x in s.filter (λ x, f x = 1), f x) * ∏ x in s.filter (λ x, f x ≠ 1), f x :
    by rw [← prod_union, filter_union_filter_neg_eq];
       exact disjoint_filter.2 (assume _ _ h n_h, n_h h)
  ... ≤ (∏ x in t, f x) : mul_le_of_le_one_of_le
      (prod_le_one' $ by simp only [mem_filter, and_imp]; exact λ _ _, le_of_eq)
      (prod_le_prod_of_subset' $ by simpa only [subset_iff, mem_filter, and_imp])

end canonically_ordered_monoid

section ordered_cancel_comm_monoid

variables [ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive sum_lt_sum]
theorem prod_lt_prod' (Hle : ∀ i ∈ s, f i ≤ g i) (Hlt : ∃ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  classical,
  rcases Hlt with ⟨i, hi, hlt⟩,
  rw [← insert_erase hi, prod_insert (not_mem_erase _ _), prod_insert (not_mem_erase _ _)],
  exact mul_lt_mul_of_lt_of_le hlt (prod_le_prod'' $ λ j hj, Hle j  $ mem_of_mem_erase hj)
end

@[to_additive sum_lt_sum_of_nonempty]
lemma prod_lt_prod_of_nonempty' (hs : s.nonempty) (Hlt : ∀ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  apply prod_lt_prod',
  { intros i hi, apply le_of_lt (Hlt i hi) },
  cases hs with i hi,
  exact ⟨i, hi, Hlt i hi⟩,
end

@[to_additive sum_lt_sum_of_subset]
lemma prod_lt_prod_of_subset' (h : s ⊆ t) {i : ι} (ht : i ∈ t) (hs : i ∉ s) (hlt : 1 < f i)
  (hle : ∀ j ∈ t, j ∉ s → 1 ≤ f j) :
  ∏ j in s, f j < ∏ j in t, f j :=
by classical;
calc ∏ j in s, f j < ∏ j in insert i s, f j :
begin
  rw prod_insert hs,
  exact lt_mul_of_one_lt_left' (∏ j in s, f j) hlt,
end
... ≤ ∏ j in t, f j :
begin
  apply prod_le_prod_of_subset_of_one_le',
  { simp [finset.insert_subset, h, ht] },
  { assume x hx h'x,
    simp only [mem_insert, not_or_distrib] at h'x,
    exact hle x hx h'x.2 }
end

@[to_additive single_lt_sum]
lemma single_lt_prod' {i j : ι} (hij : j ≠ i) (hi : i ∈ s) (hj : j ∈ s) (hlt : 1 < f j)
  (hle : ∀ k ∈ s, k ≠ i → 1 ≤ f k) :
  f i < ∏ k in s, f k :=
calc f i = ∏ k in {i}, f k : prod_singleton.symm
     ... < ∏ k in s, f k   :
  prod_lt_prod_of_subset' (singleton_subset_iff.2 hi) hj (mt mem_singleton.1 hij) hlt $
    λ k hks hki, hle k hks (mt mem_singleton.2 hki)

@[to_additive sum_pos] lemma one_lt_prod (h : ∀i ∈ s, 1 < f i) (hs : s.nonempty) :
  1 < (∏ i in s, f i) :=
lt_of_le_of_lt (by rw prod_const_one) $ prod_lt_prod_of_nonempty' hs h

@[to_additive] lemma prod_lt_one (h : ∀i ∈ s, f i < 1) (hs : s.nonempty) :
  (∏ i in s, f i) < 1 :=
(prod_lt_prod_of_nonempty' hs h).trans_le (by rw prod_const_one)

end ordered_cancel_comm_monoid

section linear_ordered_cancel_comm_monoid

variables [linear_ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive exists_lt_of_sum_lt]
theorem exists_lt_of_prod_lt' (Hlt : ∏ i in s, f i < ∏ i in s, g i) :
  ∃ i ∈ s, f i < g i :=
begin
  contrapose! Hlt with Hle,
  exact prod_le_prod'' Hle
end

@[to_additive exists_le_of_sum_le]
theorem exists_le_of_prod_le' (hs : s.nonempty) (Hle : ∏ i in s, f i ≤ ∏ i in s, g i) :
  ∃ i ∈ s, f i ≤ g i :=
begin
  contrapose! Hle with Hlt,
  exact prod_lt_prod_of_nonempty' hs Hlt
end

@[to_additive exists_pos_of_sum_zero_of_exists_nonzero]
lemma exists_one_lt_of_prod_one_of_exists_ne_one' (f : ι → M)
  (h₁ : ∏ i in s, f i = 1) (h₂ : ∃ i ∈ s, f i ≠ 1) :
  ∃ i ∈ s, 1 < f i :=
begin
  contrapose! h₁,
  obtain ⟨i, m, i_ne⟩ : ∃ i ∈ s, f i ≠ 1 := h₂,
  apply ne_of_lt,
  calc ∏ j in s, f j < ∏ j in s, 1 : prod_lt_prod' h₁ ⟨i, m, (h₁ i m).lt_of_ne i_ne⟩
                 ... = 1           : prod_const_one
end

end linear_ordered_cancel_comm_monoid

section ordered_comm_semiring

variables [ordered_comm_semiring R] {f g : ι → R} {s t : finset ι}
open_locale classical

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_nonneg (h0 : ∀ i ∈ s, 0 ≤ f i) : 0 ≤ ∏ i in s, f i :=
prod_induction f (λ i, 0 ≤ i) (λ _ _ ha hb, mul_nonneg ha hb) zero_le_one h0

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_pos [nontrivial R] (h0 : ∀ i ∈ s, 0 < f i) :
  0 < ∏ i in s, f i :=
prod_induction f (λ x, 0 < x) (λ _ _ ha hb, mul_pos ha hb) zero_lt_one h0

/-- If all `f i`, `i ∈ s`, are nonnegative and each `f i` is less than or equal to `g i`, then the
product of `f i` is less than or equal to the product of `g i`. See also `finset.prod_le_prod''` for
the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_prod (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  induction s using finset.induction with a s has ih h,
  { simp },
  { simp only [prod_insert has], apply mul_le_mul,
    { exact h1 a (mem_insert_self a s) },
    { apply ih (λ x H, h0 _ _) (λ x H, h1 _ _); exact (mem_insert_of_mem H) },
    { apply prod_nonneg (λ x H, h0 x (mem_insert_of_mem H)) },
    { apply le_trans (h0 a (mem_insert_self a s)) (h1 a (mem_insert_self a s)) } }
end

/-- If each `f i`, `i ∈ s` belongs to `[0, 1]`, then their product is less than or equal to one.
See also `finset.prod_le_one'` for the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_one (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ 1) :
  ∏ i in s, f i ≤ 1 :=
begin
  convert ← prod_le_prod h0 h1,
  exact finset.prod_const_one
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `ordered_comm_semiring`. -/
lemma prod_add_prod_le {i : ι} {f g h : ι → R}
  (hi : i ∈ s) (h2i : g i + h i ≤ f i) (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j)
  (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) (hg : ∀ i ∈ s, 0 ≤ g i) (hh : ∀ i ∈ s, 0 ≤ h i) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (mul_le_mul_of_nonneg_right h2i _),
  { rw [right_distrib],
    apply add_le_add; apply mul_le_mul_of_nonneg_left; try { apply_assumption; assumption };
      apply prod_le_prod; simp * { contextual := tt } },
  { apply prod_nonneg, simp only [and_imp, mem_sdiff, mem_singleton],
    intros j h1j h2j, exact le_trans (hg j h1j) (hgf j h1j h2j) }
end

end ordered_comm_semiring

section canonically_ordered_comm_semiring

variables [canonically_ordered_comm_semiring R] {f g h : ι → R} {s : finset ι} {i : ι}

lemma prod_le_prod' (h : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction with a s has ih h,
  { simp },
  { rw [finset.prod_insert has, finset.prod_insert has],
    apply mul_le_mul',
    { exact h _ (finset.mem_insert_self a s) },
    { exact ih (λ i hi, h _ (finset.mem_insert_of_mem hi)) } }
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `canonically_ordered_comm_semiring`.
-/
lemma prod_add_prod_le' (hi : i ∈ s) (h2i : g i + h i ≤ f i)
  (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j) (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  classical, simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (mul_le_mul_right' h2i _),
  rw [right_distrib],
  apply add_le_add; apply mul_le_mul_left'; apply prod_le_prod';
  simp only [and_imp, mem_sdiff, mem_singleton]; intros; apply_assumption; assumption
end

end canonically_ordered_comm_semiring

end finset

namespace fintype

variables [fintype ι]

@[to_additive sum_mono, mono]
lemma prod_mono' [ordered_comm_monoid M] : monotone (λ f : ι → M, ∏ i, f i) :=
λ f g hfg, finset.prod_le_prod'' $ λ x _, hfg x

attribute [mono] sum_mono

@[to_additive sum_strict_mono]
lemma prod_strict_mono' [ordered_cancel_comm_monoid M] : strict_mono (λ f : ι → M, ∏ x, f x) :=
λ f g hfg, let ⟨hle, i, hlt⟩ := pi.lt_def.mp hfg in
  finset.prod_lt_prod' (λ i _, hle i) ⟨i, finset.mem_univ i, hlt⟩

end fintype

namespace with_top
open finset

/-- A product of finite numbers is still finite -/
lemma prod_lt_top [canonically_ordered_comm_semiring R] [nontrivial R] [decidable_eq R]
  {s : finset ι} {f : ι → with_top R} (h : ∀ i ∈ s, f i ≠ ⊤) :
  ∏ i in s, f i < ⊤ :=
prod_induction f (λ a, a < ⊤) (λ a b h₁ h₂, mul_lt_top h₁.ne h₂.ne) (coe_lt_top 1) $
  λ a ha, lt_top_iff_ne_top.2 (h a ha)

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M}
  (h : ∀ i ∈ s, f i ≠ ⊤) : (∑ i in s, f i) < ⊤ :=
sum_induction f (λ a, a < ⊤) (λ a b h₁ h₂, add_lt_top.2 ⟨h₁, h₂⟩) zero_lt_top $
  λ i hi, lt_top_iff_ne_top.2 (h i hi)

/-- A sum of numbers is infinite iff one of them is infinite -/
lemma sum_eq_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i = ⊤ ↔ ∃ i ∈ s, f i = ⊤ :=
begin
  classical,
  split,
  { contrapose!,
    exact λ h, (sum_lt_top $ λ i hi, (h i hi)).ne },
  { rintro ⟨i, his, hi⟩,
    rw [sum_eq_add_sum_diff_singleton his, hi, top_add] }
end

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i < ⊤ ↔ ∀ i ∈ s, f i < ⊤ :=
by simp only [lt_top_iff_ne_top, ne.def, sum_eq_top_iff, not_exists]

end with_top

section absolute_value

variables {S : Type*}

lemma absolute_value.sum_le [semiring R] [ordered_semiring S]
  (abv : absolute_value R S) (s : finset ι) (f : ι → R) :
  abv (∑ i in s, f i) ≤ ∑ i in s, abv (f i) :=
begin
  letI := classical.dec_eq ι,
  refine finset.induction_on s _ (λ i s hi ih, _),
  { simp },
  { simp only [finset.sum_insert hi],
  exact (abv.add_le _ _).trans (add_le_add (le_refl _) ih) },
end

lemma is_absolute_value.abv_sum [semiring R] [ordered_semiring S] (abv : R → S)
  [is_absolute_value abv] (f : ι → R) (s : finset ι) :
  abv (∑ i in s, f i) ≤ ∑ i in s, abv (f i) :=
(is_absolute_value.to_absolute_value abv).sum_le _ _

lemma absolute_value.map_prod [comm_semiring R] [nontrivial R] [linear_ordered_comm_ring S]
  (abv : absolute_value R S) (f : ι → R) (s : finset ι) :
  abv (∏ i in s, f i) = ∏ i in s, abv (f i) :=
abv.to_monoid_hom.map_prod f s

lemma is_absolute_value.map_prod [comm_semiring R] [nontrivial R] [linear_ordered_comm_ring S]
  (abv : R → S) [is_absolute_value abv] (f : ι → R) (s : finset ι) :
  abv (∏ i in s, f i) = ∏ i in s, abv (f i) :=
(is_absolute_value.to_absolute_value abv).map_prod _ _

end absolute_value


/-
Copyright (c) 2020 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import data.set.finite

/-!
# Infinitude of intervals

Bounded intervals in dense orders are infinite, as are unbounded intervals
in orders that are unbounded on the appropriate side. We also prove that an unbounded
preorder is an infinite type.
-/

variables {α : Type*} [preorder α]

/-- A nonempty preorder with no maximal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_max_order.infinite [nonempty α] [no_max_order α] : infinite α :=
let ⟨f, hf⟩ := nat.exists_strict_mono α in infinite.of_injective f hf.injective

/-- A nonempty preorder with no minimal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_min_order.infinite [nonempty α] [no_min_order α] : infinite α :=
@no_max_order.infinite αᵒᵈ _ _ _

namespace set

section densely_ordered

variables [densely_ordered α] {a b : α} (h : a < b)

lemma Ioo.infinite : infinite (Ioo a b) := @no_max_order.infinite _ _ (nonempty_Ioo_subtype h) _
lemma Ioo_infinite : (Ioo a b).infinite := infinite_coe_iff.1 $ Ioo.infinite h

lemma Ico_infinite : (Ico a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ico_self
lemma Ico.infinite : infinite (Ico a b) := infinite_coe_iff.2 $ Ico_infinite h

lemma Ioc_infinite : (Ioc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ioc_self
lemma Ioc.infinite : infinite (Ioc a b) := infinite_coe_iff.2 $ Ioc_infinite h

lemma Icc_infinite : (Icc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Icc_self
lemma Icc.infinite : infinite (Icc a b) := infinite_coe_iff.2 $ Icc_infinite h

end densely_ordered

instance [no_min_order α] {a : α} : infinite (Iio a) := no_min_order.infinite
lemma Iio_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite

instance [no_min_order α] {a : α} : infinite (Iic a) := no_min_order.infinite
lemma Iic_infinite [no_min_order α] (a : α) : (Iic a).infinite := infinite_coe_iff.1 Iic.infinite

instance [no_max_order α] {a : α} : infinite (Ioi a) := no_max_order.infinite
lemma Ioi_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite

instance [no_max_order α] {a : α} : infinite (Ici a) := no_max_order.infinite
lemma Ici_infinite [no_max_order α] (a : α) : (Ici a).infinite := infinite_coe_iff.1 Ici.infinite

end set


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.bounds
import Mathlib.data.set.intervals.image_preimage
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Intervals without endpoints ordering

In any decidable linear order `α`, we define the set of elements lying between two elements `a` and
`b` as `Icc (min a b) (max a b)`.

`Icc a b` requires the assumption `a ≤ b` to be meaningful, which is sometimes inconvenient. The
interval as defined in this file is always the set of things lying between `a` and `b`, regardless
of the relative order of `a` and `b`.

For real numbers, `Icc (min a b) (max a b)` is the same as `segment a b`.

## Notation

We use the localized notation `[a, b]` for `interval a b`. One can open the locale `interval` to
make the notation available.

-/

namespace set

/-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
def interval {α : Type u} [linear_order α] (a : α) (b : α) : set α := Icc (min a b) (max a b)

@[simp] theorem interval_of_le {α : Type u} [linear_order α] {a : α} {b : α} (h : a ≤ b) :
    interval a b = Icc a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (interval a b = Icc a b)) (interval.equations._eqn_1 a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Icc (min a b) (max a b) = Icc a b)) (min_eq_left h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (Icc a (max a b) = Icc a b)) (max_eq_right h)))
        (Eq.refl (Icc a b))))

@[simp] theorem interval_of_ge {α : Type u} [linear_order α] {a : α} {b : α} (h : b ≤ a) :
    interval a b = Icc b a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (interval a b = Icc b a)) (interval.equations._eqn_1 a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Icc (min a b) (max a b) = Icc b a)) (min_eq_right h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (Icc b (max a b) = Icc b a)) (max_eq_left h)))
        (Eq.refl (Icc b a))))

theorem interval_swap {α : Type u} [linear_order α] (a : α) (b : α) : interval a b = interval b a :=
  sorry

theorem interval_of_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : a < b) :
    interval a b = Icc a b :=
  interval_of_le (le_of_lt h)

theorem interval_of_gt {α : Type u} [linear_order α] {a : α} {b : α} (h : b < a) :
    interval a b = Icc b a :=
  interval_of_ge (le_of_lt h)

theorem interval_of_not_le {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬a ≤ b) :
    interval a b = Icc b a :=
  interval_of_gt (lt_of_not_ge h)

theorem interval_of_not_ge {α : Type u} [linear_order α] {a : α} {b : α} (h : ¬b ≤ a) :
    interval a b = Icc a b :=
  interval_of_lt (lt_of_not_ge h)

@[simp] theorem interval_self {α : Type u} [linear_order α] {a : α} : interval a a = singleton a :=
  sorry

@[simp] theorem nonempty_interval {α : Type u} [linear_order α] {a : α} {b : α} :
    set.nonempty (interval a b) :=
  sorry

@[simp] theorem left_mem_interval {α : Type u} [linear_order α] {a : α} {b : α} :
    a ∈ interval a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ interval a b)) (interval.equations._eqn_1 a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ Icc (min a b) (max a b))) (propext mem_Icc)))
      { left := min_le_left a b, right := le_max_left a b })

@[simp] theorem right_mem_interval {α : Type u} [linear_order α] {a : α} {b : α} :
    b ∈ interval a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b ∈ interval a b)) (interval_swap a b))) left_mem_interval

theorem Icc_subset_interval {α : Type u} [linear_order α] {a : α} {b : α} :
    Icc a b ⊆ interval a b :=
  id
    fun (x : α) (h : x ∈ Icc a b) =>
      eq.mpr
        (id
          (Eq._oldrec (Eq.refl (x ∈ interval a b))
            (interval_of_le (le_trans (and.left h) (and.right h)))))
        h

theorem Icc_subset_interval' {α : Type u} [linear_order α] {a : α} {b : α} :
    Icc b a ⊆ interval a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Icc b a ⊆ interval a b)) (interval_swap a b)))
    Icc_subset_interval

theorem mem_interval_of_le {α : Type u} [linear_order α] {a : α} {b : α} {x : α} (ha : a ≤ x)
    (hb : x ≤ b) : x ∈ interval a b :=
  Icc_subset_interval { left := ha, right := hb }

theorem mem_interval_of_ge {α : Type u} [linear_order α] {a : α} {b : α} {x : α} (hb : b ≤ x)
    (ha : x ≤ a) : x ∈ interval a b :=
  Icc_subset_interval' { left := hb, right := ha }

theorem interval_subset_interval {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α}
    (h₁ : a₁ ∈ interval a₂ b₂) (h₂ : b₁ ∈ interval a₂ b₂) : interval a₁ b₁ ⊆ interval a₂ b₂ :=
  Icc_subset_Icc (le_min (and.left h₁) (and.left h₂)) (max_le (and.right h₁) (and.right h₂))

theorem interval_subset_interval_iff_mem {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α}
    {b₂ : α} : interval a₁ b₁ ⊆ interval a₂ b₂ ↔ a₁ ∈ interval a₂ b₂ ∧ b₁ ∈ interval a₂ b₂ :=
  { mp :=
      fun (h : interval a₁ b₁ ⊆ interval a₂ b₂) =>
        { left := h left_mem_interval, right := h right_mem_interval },
    mpr :=
      fun (h : a₁ ∈ interval a₂ b₂ ∧ b₁ ∈ interval a₂ b₂) =>
        interval_subset_interval (and.left h) (and.right h) }

theorem interval_subset_interval_iff_le {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α}
    {b₂ : α} : interval a₁ b₁ ⊆ interval a₂ b₂ ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
  sorry

theorem interval_subset_interval_right {α : Type u} [linear_order α] {a : α} {b : α} {x : α}
    (h : x ∈ interval a b) : interval x b ⊆ interval a b :=
  interval_subset_interval h right_mem_interval

theorem interval_subset_interval_left {α : Type u} [linear_order α] {a : α} {b : α} {x : α}
    (h : x ∈ interval a b) : interval a x ⊆ interval a b :=
  interval_subset_interval left_mem_interval h

theorem bdd_below_bdd_above_iff_subset_interval {α : Type u} [linear_order α] (s : set α) :
    bdd_below s ∧ bdd_above s ↔ ∃ (a : α), ∃ (b : α), s ⊆ interval a b :=
  sorry

@[simp] theorem preimage_const_add_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => a + x) ⁻¹' interval b c = interval (b - a) (c - a) :=
  sorry

@[simp] theorem preimage_add_const_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => x + a) ⁻¹' interval b c = interval (b - a) (c - a) :=
  sorry

@[simp] theorem preimage_neg_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) : -interval a b = interval (-a) (-b) :=
  sorry

@[simp] theorem preimage_sub_const_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => x - a) ⁻¹' interval b c = interval (b + a) (c + a) :=
  sorry

@[simp] theorem preimage_const_sub_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => a - x) ⁻¹' interval b c = interval (a - b) (a - c) :=
  sorry

@[simp] theorem image_const_add_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => a + x) '' interval b c = interval (a + b) (a + c) :=
  sorry

@[simp] theorem image_add_const_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => x + a) '' interval b c = interval (b + a) (c + a) :=
  sorry

@[simp] theorem image_const_sub_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => a - x) '' interval b c = interval (a - b) (a - c) :=
  sorry

@[simp] theorem image_sub_const_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α)
    (b : α) (c : α) : (fun (x : α) => x - a) '' interval b c = interval (b - a) (c - a) :=
  sorry

theorem image_neg_interval {α : Type u} [linear_ordered_add_comm_group α] (a : α) (b : α) :
    Neg.neg '' interval a b = interval (-a) (-b) :=
  sorry

/-- If `[x, y]` is a subinterval of `[a, b]`, then the distance between `x` and `y`
is less than or equal to that of `a` and `b` -/
theorem abs_sub_le_of_subinterval {α : Type u} [linear_ordered_add_comm_group α] {a : α} {b : α}
    {x : α} {y : α} (h : interval x y ⊆ interval a b) : abs (y - x) ≤ abs (b - a) :=
  sorry

/-- If `x ∈ [a, b]`, then the distance between `a` and `x` is less than or equal to
that of `a` and `b`  -/
theorem abs_sub_left_of_mem_interval {α : Type u} [linear_ordered_add_comm_group α] {a : α} {b : α}
    {x : α} (h : x ∈ interval a b) : abs (x - a) ≤ abs (b - a) :=
  abs_sub_le_of_subinterval (interval_subset_interval_left h)

/-- If `x ∈ [a, b]`, then the distance between `x` and `b` is less than or equal to
that of `a` and `b`  -/
theorem abs_sub_right_of_mem_interval {α : Type u} [linear_ordered_add_comm_group α] {a : α} {b : α}
    {x : α} (h : x ∈ interval a b) : abs (b - x) ≤ abs (b - a) :=
  abs_sub_le_of_subinterval (interval_subset_interval_right h)

@[simp] theorem preimage_mul_const_interval {k : Type u} [linear_ordered_field k] {a : k}
    (ha : a ≠ 0) (b : k) (c : k) :
    (fun (x : k) => x * a) ⁻¹' interval b c = interval (b / a) (c / a) :=
  sorry

@[simp] theorem preimage_const_mul_interval {k : Type u} [linear_ordered_field k] {a : k}
    (ha : a ≠ 0) (b : k) (c : k) :
    (fun (x : k) => a * x) ⁻¹' interval b c = interval (b / a) (c / a) :=
  sorry

@[simp] theorem preimage_div_const_interval {k : Type u} [linear_ordered_field k] {a : k}
    (ha : a ≠ 0) (b : k) (c : k) :
    (fun (x : k) => x / a) ⁻¹' interval b c = interval (b * a) (c * a) :=
  sorry

@[simp] theorem image_mul_const_interval {k : Type u} [linear_ordered_field k] (a : k) (b : k)
    (c : k) : (fun (x : k) => x * a) '' interval b c = interval (b * a) (c * a) :=
  sorry

@[simp] theorem image_const_mul_interval {k : Type u} [linear_ordered_field k] (a : k) (b : k)
    (c : k) : (fun (x : k) => a * x) '' interval b c = interval (a * b) (a * c) :=
  sorry

@[simp] theorem image_div_const_interval {k : Type u} [linear_ordered_field k] (a : k) (b : k)
    (c : k) : (fun (x : k) => x / a) '' interval b c = interval (b / a) (c / a) :=
  image_mul_const_interval (a⁻¹) b c

end Mathlib


variables a b c d : ℤ

example : a + 0 = a := add_zero a
example : 0 + a = a := zero_add a
example : a * 1 = a := mul_one a
example : 1 * a = a := one_mul a
example : -a + a = 0 := neg_add_self a
example : a + -a = 0 := add_neg_self a
example : a - a = 0 := sub_self a
example : a + b = b + a := add_comm a b
example : a + b + c = a + (b + c) := add_assoc a b c
example : a * b = b * a := mul_comm a b
example : a * b * c = a * (b * c) := mul_assoc a b c
example : a * (b + c) = a * b + a * c := mul_add a b c
example : a * (b + c) = a * b + a * c := left_distrib a b c
example : (a + b) * c = a * c + b * c := add_mul a b c
example : (a + b) * c = a * c + b * c := right_distrib a b c
example : a * (b - c) = a * b - a * c := mul_sub a b c
example : (a - b) * c = a * c - b * c := sub_mul a b c


/-
Algebraic geometry M4P33, Jan-Mar 2020, formalised in Lean.

Copyright (c) 2020 Kevin Buzzard
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, and whoever else in the class wants to join in.

Note: if you are viewing this file in a browser via the following
link:

https://leanprover-community.github.io/lean-web-editor/#url=https%3A%2F%2Fraw.githubusercontent.com%2FImperialCollegeLondon%2FM4P33%2Fmaster%2Fsrc%2Faffine_algebraic_set%2FV.lean

then you can click around on the code and see the state of Lean's "brain"
at any point within any begin/end proof block.
-/

-- imports the theory of multivariable polynomials over rings
import data.mv_polynomial
import for_mathlib.mv_polynomial

-- imports the concept of the radical of an ideal
import ring_theory.ideal_operations
import ring_theory.noetherian
import ring_theory.polynomial
import topology.basic

/-!
# Lecture 2 : The 𝕍 construction

Let k be a commutative ring and let n be a natural number.

This file defines the map 𝕍 from subsets of k[X₁,X₂,…,Xₙ]
to subsets of kⁿ, and proves basic properties about this map.

To get 𝕍 in VS Code, type `\bbV`.

Note: we never assume that the number of variables is finite,
so actually instead of using a natural number n, we use an
arbitrary set n for our variables.

All the definitions work for k a commutative ring, but not all
of the the theorems do. However, computer scientists want us to set
up the theory in as much generality as possible, and I believe that
mathematicians should learn to think more like computer scientists.
So k starts off being a commutative ring, and occasionally changes later.

## Lean 3 notation: important comments.

Because we're not using Lean 4, we will have to deal with some
awkward notational issues.

* the multivariable polynomial ring k[X₁,X₂,…,Xₙ] is denoted
  `mv_polynomial n k`.

* The set kⁿ is denoted
  `n → k`.

  (note: this means maps from n to k, and if you're thinking
   about n as {1,2,3,...,n} then you can see that this makes sense).

* subsets of a set X are denoted
  `set X`

* The subset of X which is all of X is not called X :-) It's called
  `univ`

* To evaluate a polynomial f on a vector x, we write
  `eval x f`

  Note the order! "Maps on the right".

## Important definitions

* `𝕍 : set (mv_polynomial n k) → set (n → k)`
  sending a subset S of k[X₁,X₂,…Xₙ] to the subset of kⁿ cut out
  by the zeros of all the elements of S.

## References

Martin Orr's lecture notes at
  https://homepages.warwick.ac.uk/staff/Martin.Orr/2017-8/alg-geom/

## Tags

algebraic geometry, algebraic variety, 𝕍
-/
-- code starts here

-- We're dealing with multivariable polynomials so let's open the
-- namespace to get easy access to all the functions
open mv_polynomial

-- let k be a commutative ring
variables {k : Type*} [comm_semiring k]

-- and let σ be any set, but pretend it's {1,2,...,n} with n a natural number.
-- We'll work with polynomials in variables X_i for i ∈ σ.
variable {σ : Type*}

local notation `𝔸ⁿ` := σ → k

/- recall:

     Maths                 Lean 3
     ---------------------------------------
     k[X₁, X₂, ..., Xₙ]    mv_polynomial σ k
     kⁿ or 𝔸ⁿ              σ → k
     subsets of X          set X
     the subset X of X     univ
     f(x)                  eval x f
-/

/-- 𝕍 : the function sending a subset S of k[X₁,X₂,…Xₙ] to
  the subset of kⁿ defined as the intersection of the zeros of all
  the elements of S. For more details, see Martin Orr's notes -/
def 𝕍 (S : set (mv_polynomial σ k)) : set 𝔸ⁿ :=
{x : 𝔸ⁿ | ∀ f ∈ S, eval x f = 0}

-- Now let's prove a bunch of theorems about 𝕍, in a namespace

namespace affine_algebraic_set

-- the theorems will be about sets, so let's open the set namespace
-- giving us easier access to theorems about sets

open set

-- The following lemma has a trivial proof so don't worry about it.
/-- x ∈ 𝕍 S ↔ for all f ∈ S, f(x) = 0. This is true by definition. -/
lemma mem_𝕍_iff {S : set (mv_polynomial σ k)} {x : σ → k} :
  x ∈ 𝕍 S ↔ ∀ f ∈ S, eval x f = 0 := iff.rfl

-- The rest of the proofs in this file are supposed to be comprehensible
-- to mathematicians

/-- 𝕍(∅) = kⁿ -/
lemma 𝕍_empty : 𝕍 (∅ : set (mv_polynomial σ k)) = univ :=
begin
  -- We need to show that for all x in kⁿ, x ∈ 𝕍 ∅
  rw eq_univ_iff_forall,
  -- so say x ∈ kⁿ.
  intro x,
  -- By definition of 𝕍, we need to check that f(x) = 0 for all f in ∅
  rw mem_𝕍_iff,
  -- so say f is a polynomial
  intro f,
  -- and f is in the empty set
  intro hf,
  -- well, our assumptions give a contradiction,
  -- and we can deduce anything from a contradiction
  cases hf,
end

/-- Over a non-zero commutative ring, 𝕍 (k[X₁,X₂,…,Xₙ]) = ∅ -/
lemma 𝕍_univ {k : Type*} [nonzero_comm_ring k] {n : Type*} :
  𝕍 (univ : set (mv_polynomial n k)) = ∅ :=
begin
  -- It suffices to show that for all x ∈ kⁿ, x isn't in 𝕍 (all polynomials)
  rw eq_empty_iff_forall_not_mem,
  -- so say x ∈ kⁿ
  intro x,
  -- we need to check that it's not true that for every polynomial f, f(x) = 0
  rw mem_𝕍_iff,
  -- so let's assume that f(x) = 0 for every polynomial f,
  intro h,
  -- and get a contradiction (note that the goal is now `false`).
  -- Let's consider the constant polynomial 1; we deduce 1(x) = 0.
  replace h := h (C 1) (mem_univ _),
  -- evaluating 1 at x gives the value 1
  rw eval_C at h,
  -- so 1 = 0 in k, which contradicts k being non-zero
  exact zero_ne_one h.symm
end

/-- 𝕍({0}) = kⁿ -/
lemma 𝕍_zero : 𝕍 ({0} : set (mv_polynomial σ k)) = univ :=
begin
  -- It suffices to prove every element of kⁿ is in 𝕍(0)
  rw eq_univ_iff_forall,
  -- so say x ∈ kⁿ
  intro x,
  -- To prove it's in V(0), we need to show f(x)=0 for all f in {0}
  rw mem_𝕍_iff,
  -- so take f in {0}
  intros f hf,
  -- Then it's zero!
  rw mem_singleton_iff at hf,
  -- so we have to prove 0(x) = 0
  rw hf,
  -- which is obvious
  refl,
end

/-- If k ≠ 0 then 𝕍({1}) = ∅ -/
lemma 𝕍_one {k : Type*} [nonzero_comm_ring k] {n : Type*} :
  𝕍 ({1} : set (mv_polynomial n k)) = ∅ :=
begin
  -- this is basically the same proof as 𝕍_univ
  -- It suffices to show that for all x ∈ kⁿ, x isn't in 𝕍 ({1})
  rw eq_empty_iff_forall_not_mem,
  -- so say x ∈ kⁿ
  intro x,
  -- we need to check that it's not true that for all f ∈ {1}, f(x) = 0
  rw mem_𝕍_iff,
  -- so let's assume that f(x) = 0 for every polynomial f in {1},
  intro h,
  -- and get a contradiction (note that the goal is now `false`).
  -- Setting f = 1, we deduce 1(x) = 0.
  replace h := h (C 1) (mem_singleton _),
  -- evaluating the polynomial 1 at x gives the value 1
  rw eval_C at h,
  -- so 1 = 0 in k, which contradicts k being non-zero
  exact zero_ne_one h.symm
end

/-- If S ⊆ T then 𝕍(T) ⊆ 𝕍(S) -/
theorem 𝕍_antimono (S T : set (mv_polynomial σ k)) :
  S ⊆ T → 𝕍 T ⊆ 𝕍 S :=
begin
  -- We are assuming S ⊆ T
  intro hST,
  -- Let x ∈ 𝕍 T be arbitrary
  intros x hx,
  -- We want to prove x ∈ 𝕍 S.
  -- We know that ∀ t ∈ T, t(x) = 0, and we want to
  -- prove that ∀ s ∈ S, s(x) = 0.
  rw mem_𝕍_iff at hx ⊢,
  -- So say s ∈ S.
  intros s hs,
  -- we want to prove s(x) = 0.
  -- But t(x) = 0 for all t in T, so it suffices to prove s ∈ T
  apply hx,
  -- and this is clear because S ⊆ T
  exact hST hs
end

theorem 𝕍_union (S T : set (mv_polynomial σ k)) :
𝕍 (S ∪ T) = 𝕍 S ∩ 𝕍 T :=
begin
  -- let's prove this equality of sets by proving ⊆ and ⊇
  apply set.subset.antisymm,
  { -- Step 1: we prove the inclusion 𝕍 (S ∪ T) ⊆ 𝕍 S ∩ 𝕍 T.
    -- So let x be an element of the LHS
    intros x hx,
    -- then x ∈ 𝕍 (S ∪ T) so ∀ f ∈ S ∪ T, f(x) = 0. Call this hypothesis `hx`.
    rw mem_𝕍_iff at hx,
    -- To prove x ∈ 𝕍 S ∩ 𝕍 T, it suffices to prove x ∈ 𝕍 S and x ∈ 𝕍 T
    split,
    { -- We deal with the two cases separately.
      -- To prove x ∈ 𝕍 S, we need to show that for all f ∈ S, f(x) = 0
      rw mem_𝕍_iff,
      -- so say f ∈ S
      intros f hf,
      -- By hypothesis `hx`, it suffices to prove that f ∈ S ∪ T
      apply hx,
      -- but this is obvious
      left, assumption
    },
    { -- To prove x ∈ 𝕍 T, the argument is the same,
      -- so we write it the way a computer scientist would.
      -- (they prefer one incomprehensible line to four simple ones)
      exact mem_𝕍_iff.2 (λ f hf, hx _ (set.subset_union_right _ _ hf)),
    },
  },
  { -- Step 2: we prove the other inclusion.
    -- ⊢ 𝕍 S ∩ 𝕍 T ⊆ 𝕍 (S ∪ T) (NB `⊢` means "the goal is")
    -- say x is in 𝕍 S and 𝕍 T
    rintro x ⟨hxS, hxT⟩,
    -- We need to show that for all f ∈ S ∪ T, f(x) = 0
    rw mem_𝕍_iff,
    -- so choose f in S ∪ T
    intros f hf,
    -- Well, f is either in S or in T, so there are two cases.
    cases hf,
    { -- Say f ∈ S
      -- Recall that x ∈ 𝕍 S, so ∀ f ∈ S, f(x) = 0
      rw mem_𝕍_iff at hxS,
      -- so we're done.
      exact hxS f hf
    },
    { -- Say f ∈ T
      -- The argument is the same so we do it in one step
      exact hxT f hf,
    }
  }
end

-- Infinite (or rather, arbitrary) unions work just the same
-- We consider a collection Sᵢ of subsets indexed by i ∈ I.
theorem 𝕍_Union {I : Type*} (S : I → set (mv_polynomial σ k)) :
𝕍 (⋃ i, S i) = ⋂ i, 𝕍 (S i) :=
begin
  -- To prove equality of two subsets of kⁿ it suffices to prove ⊆ and ⊇.
  apply set.subset.antisymm,
  { -- Goal: 𝕍 (⋃ i, S i) ⊆ ⋂ i, 𝕍 (S i)
    -- Let x be in the left hand side
    intros x hx,
    -- it suffices to prove that for all j, x ∈ 𝕍 (S j)
    rw set.mem_Inter,
    -- so choose some j ∈ I
    intro j,
    -- and say f ∈ S j.
    intros f hf,
    -- We now want to prove f(x) = 0.
    -- Now we know x ∈ 𝕍 (⋃ i, S i), so g(x) = 0 for all g in ⋃ i, S i
    -- Hence it suffices to prove that f ∈ ⋃ i, S i
    apply hx,
    -- By definition of the infinite union, it suffices to find
    -- some i ∈ I such that f ∈ S i
    rw set.mem_Union,
    -- and we can use j for this i
    use j,
    -- and what we need to show is true now by assumption, because f ∈ S j
    assumption
  },
  { -- Now the other way.
    -- ⊢ (⋂ (i : I), 𝕍 (S i)) ⊆ 𝕍 (⋃ (i : I), S i)
    -- Say x is in the left hand side
    intros x hx,
    -- It suffices to show that for all f ∈ ⋃ i, S i, f(x) = 0
    rw mem_𝕍_iff,
    -- so say f is a polynomial in this union
    intros f hf,
    -- If f is in the union, then it's in one of the S i, so say f ∈ S j
    rw set.mem_Union at hf,
    cases hf with j hj,
    -- Now we know x is in the intersection of the 𝕍 (S i) for all i,
    -- so x ∈ 𝕍 (S j)
    rw set.mem_Inter at hx,
    have hxj := hx j,
    -- and because h(x) = 0 for every element h ∈ S j,
    -- and we know f ∈ S j, we deduce f(x) = 0 as required.
    exact hxj _ hj
  }
end

-- For convenience, let's define multiplication on subsets of k[X₁,X₂,…,Xₙ]
-- in the obvious way: S * T := {s * t | s ∈ S, t ∈ T}.
instance : has_mul (set (mv_polynomial σ k)) :=
⟨λ S T, {u | ∃ (s ∈ S) (t ∈ T), u = s * t}⟩

-- For this theorem, we need that k satisfies a * b = 0 => a = 0 or b = 0
theorem 𝕍_mul {k : Type*} [integral_domain k] {n : Type*}
  (S T : set (mv_polynomial n k)) :
𝕍 (S * T) = 𝕍 S ∪ 𝕍 T :=
begin
  -- to prove that the two sets are equal we will prove ⊆ and ⊇
  apply set.subset.antisymm,
  { -- This is the "harder" of the two inclusions;
    -- we need to check that if x vanishes on every element of S*T,
    -- then x ∈ 𝕍 S or x ∈ 𝕍 T. So let x be in 𝕍 (S * T)
    intros x hx,
    -- We then know that for every f ∈ S * T, f(x) = 0
    rw mem_𝕍_iff at hx,
    -- Note for logicians: in this proof, we will assume
    -- the law of the excluded middle.
    classical,
    -- If x ∈ 𝕍 S then the result is easy...
    by_cases hx2 : x ∈ 𝕍 S,
      -- because 𝕍 S ⊆ 𝕍 S ∪ 𝕍 T
      exact subset_union_left _ _ hx2,
    -- ...so we can assume assume x ∉ 𝕍 S,
    -- and hence that there's s ∈ S such that s(x) ≠ 0
    rw mem_𝕍_iff at hx2, push_neg at hx2, rcases hx2 with ⟨s, hs, hsx⟩,
    -- we now show x ∈ 𝕍 T,
      right,
    -- i.e., that for all t ∈ T we have t(x) = 0
    rw mem_𝕍_iff,
    -- So say t ∈ T
    intros t ht,
    -- We want to prove that t(x) = 0.
    -- Now by assumption, x vanishes on s * t.
    replace hx := hx (s * t) ⟨s, hs, t, ht, rfl⟩,
    -- so s(x) * t(x) = 0
    rw eval_mul at hx,
    -- so either s(x) or t(x) = 0,
    cases mul_eq_zero.1 hx with hxs hxt,
      -- So the case s(x) = 0 is a contradiction
      contradiction,
    -- and t(x) = 0 is what we wanted to prove
    assumption
  },
  { -- Here's the easier of the two inclusions.
    -- say x ∈ 𝕍 S ∪ 𝕍 T,
    intros x hx,
    -- it's either in 𝕍 S or 𝕍 T.
    cases hx with hxS hxT,
    { -- Say x ∈ 𝕍 S.
      -- We know that x vanishes at every element of S.
      rw mem_𝕍_iff at hxS,
      -- We want to prove x vanishes at every polynomial of the form s * t
      -- with s ∈ S and t ∈ T.
      rw mem_𝕍_iff,
      -- so let's take a polynomial of the form s * t
      rintro _ ⟨s, hs, t, ht, rfl⟩,
      -- we need to show st(x)=0. So it suffices to show s(x)*t(x)=0
      rw eval_mul,
      -- Because x ∈ 𝕍 S, we have s(x)=0.
      replace hxS := hxS s hs,
      -- so it suffices to show 0 * t(x) = 0
      rw hxS,
      -- but this is obvious
      apply zero_mul,
    },
    { -- This is the case x ∈ 𝕍 T and it's of course completely analogous.
      -- If I knew more about Lean's `WLOG` tactic I might not have to do
      -- this case. I'll just do it the computer science way (i.e., a proof
      -- which is quick to write but harder for a human to understand)
      rintro _ ⟨s, hs, t, ht, rfl⟩,
      rw [eval_mul, hxT t ht, mul_zero],
    }
  }
end

-- Pedantic exercise: we assumed a * b = 0 => a = 0 or b = 0. Give an
-- example of a commutative ring with that property which is not an
-- integral domain. Is the theorem still true for this ring?

-- there seems to be no `semiideal.span`.

/-- 𝕍(S) equals 𝕍(<S>), where <S> denotes the
  ideal of k[X₁,…,Xₙ] spanned by S. -/
theorem 𝕍_span {k : Type*} [comm_ring k] {n : Type*}
  (S : set (mv_polynomial n k)) :
𝕍 S = 𝕍 (ideal.span S) :=
begin
  -- Let's prove ⊆ and ⊇
  apply set.subset.antisymm,
  { -- This way is the tricky way
    -- We need to prove 𝕍(S) ⊆ 𝕍(<S>), and we prove
    -- this by induction on the ideal <S>.
    -- Say x ∈ 𝕍(S)
    intros x hx,
    -- We need to prove that f(x) = 0 for all f in <S>
    rw mem_𝕍_iff,
    -- so say f ∈ <S>
    intros f hf,
    -- Apply the principle of induction for ideals.
    apply submodule.span_induction hf,
    -- We now have four goals!
    {
      -- first goal -- check that if g ∈ S then g(x) = 0
      intros g hg,
      -- this follows because x ∈ 𝕍(S)
      exact hx _ hg,
    },
    { -- second goal -- check that if g = 0 then g(x) = 0
      -- this is true by definition
      refl
    },
    { -- third goal -- check that if g(x) = 0 and h(x) = 0
      -- then (g+h)(x) = 0
      intros g h hg hh,
      -- This is easy because (g+h)(x)=g(x)+h(x)
      rw eval_add,
      -- and 0 + 0 = 0
      rw [hg, hh, zero_add],
    },
    { -- finally, say g(x) = 0 and r ∈ k[X₁,…,Xₙ]
      intros r g hg,
      -- Need to check (r*g)(x) = 0
      rw smul_eq_mul,
      -- i.e. that r(x)*g(x)=0
      rw eval_mul,
      -- but g(x)=0
      rw hg,
      -- so this is obvious
      exact mul_zero _,
    }
  },
  { -- The fact that 𝕍(<S>) ⊆ 𝕍(S) follows from 𝕍_antimono and
    -- the fact that S ⊆ <S>
    apply 𝕍_antimono,
    exact ideal.subset_span,
  }
end

/-- If I is an ideal of k[X₁,…,Xₙ] then 𝕍(I)=𝕍(√I), where √I is
the radical of I -/
theorem 𝕍_radical' {k : Type*} [integral_domain k] {n : Type*}
  (I : ideal (mv_polynomial n k)) :
  𝕍 (↑I : set (mv_polynomial n k)) = 𝕍 (↑(ideal.radical I) : set _) :=
begin
  apply set.subset.antisymm,
  { -- this is the slightly trickier direction;
    -- we want to prove 𝕍(I) ⊆ 𝕍(√I). So say x ∈ 𝕍(I).
    intros x hx,
    rw mem_𝕍_iff,
    intro f,
    intro hf,
    cases hf with n hfn,
    rw mem_𝕍_iff at hx,
    replace hx := hx _ hfn,
    rw eval_pow at hx,
    exact pow_eq_zero hx,
  },
  { -- this is the easy way
    apply 𝕍_antimono,
    apply ideal.le_radical,
  }
end

open_locale classical

--
theorem 𝕍_fin {k : Type*} [comm_ring k] {n : Type*}
  (S : set (mv_polynomial n k)) [fintype n] [is_noetherian_ring k] :
∃ (T : finset (mv_polynomial n k)), 𝕍 (S) = 𝕍 (↑T) :=
begin
  -- We want to utilize the fact that all ideals in a notherian ring are
  -- finitely generated. In lean this is true by definition. First we use a
  -- theorem in lean that mv_poynomial n k is notherian
  haveI : is_noetherian_ring (mv_polynomial n k) :=
    is_noetherian_ring_mv_polynomial_of_fintype,

  -- We can now use the fact that the ring is notherian to show that S is
  -- finitely generated
  have fg_s : (submodule.fg : ideal (mv_polynomial n k) -> Prop) (ideal.span S),
  {
    apply (is_noetherian.noetherian (ideal.span S)),
  },
  -- unpack the definition of finitely generated S
  cases fg_s with T span_eq,
  -- T will satisfy the required property so we "use T" and now our goal will
  -- be to show that T indeed satisfies the property
  use T,
  -- We now use the fact that V(S) = V(Span S) and the fact that the span of
  -- S and T are the same
  rw [𝕍_span S, 𝕍_span ↑T, ←span_eq],
  -- The goal is now true by definition, so we use refl
  refl,
end

end affine_algebraic_set

-- Questions or comments? You can often find Kevin on the Lean chat
-- at https://leanprover.zulipchat.com (login required,
-- real names preferred, be nice)

-- Prove a theorem. Write a function. xenaproject.wordpress.com


/-
Copyright (c) 2021 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov

! This file was ported from Lean 3 source module combinatorics.simple_graph.strongly_regular
! leanprover-community/mathlib commit 2b35fc7bea4640cb75e477e83f32fbd538920822
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Basic
import Mathlib.Data.Set.Finite

/-!
# Strongly regular graphs

## Main definitions

* `G.IsSRGWith n k ℓ μ` (see `SimpleGraph.IsSRGWith`) is a structure for
  a `SimpleGraph` satisfying the following conditions:
  * The cardinality of the vertex set is `n`
  * `G` is a regular graph with degree `k`
  * The number of common neighbors between any two adjacent vertices in `G` is `ℓ`
  * The number of common neighbors between any two nonadjacent vertices in `G` is `μ`

## TODO
- Prove that the parameters of a strongly regular graph
  obey the relation `(n - k - 1) * μ = k * (k - ℓ - 1)`
- Prove that if `I` is the identity matrix and `J` is the all-one matrix,
  then the adj matrix `A` of SRG obeys relation `A^2 = kI + ℓA + μ(J - I - A)`
-/

open Finset

universe u

namespace SimpleGraph

variable {V : Type u} [Fintype V] [DecidableEq V]
variable (G : SimpleGraph V) [DecidableRel G.Adj]

/-- A graph is strongly regular with parameters `n k ℓ μ` if
 * its vertex set has cardinality `n`
 * it is regular with degree `k`
 * every pair of adjacent vertices has `ℓ` common neighbors
 * every pair of nonadjacent vertices has `μ` common neighbors
-/
structure IsSRGWith (n k ℓ μ : ℕ) : Prop where
  card : Fintype.card V = n
  regular : G.IsRegularOfDegree k
  of_adj : ∀ v w : V, G.Adj v w → Fintype.card (G.commonNeighbors v w) = ℓ
  of_not_adj : ∀ v w : V, v ≠ w → ¬G.Adj v w → Fintype.card (G.commonNeighbors v w) = μ
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with SimpleGraph.IsSRGWith

variable {G} {n k ℓ μ : ℕ}

/-- Empty graphs are strongly regular. Note that `ℓ` can take any value
for empty graphs, since there are no pairs of adjacent vertices. -/
theorem bot_strongly_regular : (⊥ : SimpleGraph V).IsSRGWith (Fintype.card V) 0 ℓ 0 where
  card := rfl
  regular := bot_degree
  of_adj := fun v w h => h.elim
  of_not_adj := fun v w _h => by
    simp only [card_eq_zero, Fintype.card_ofFinset, forall_true_left, not_false_iff, bot_adj]
    ext
    simp [mem_commonNeighbors]
#align simple_graph.bot_strongly_regular SimpleGraph.bot_strongly_regular

/-- Complete graphs are strongly regular. Note that `μ` can take any value
for complete graphs, since there are no distinct pairs of non-adjacent vertices. -/
theorem IsSRGWith.top :
    (⊤ : SimpleGraph V).IsSRGWith (Fintype.card V) (Fintype.card V - 1) (Fintype.card V - 2) μ where
  card := rfl
  regular := IsRegularOfDegree.top
  of_adj := fun v w h => by
    rw [card_commonNeighbors_top]
    exact h
  of_not_adj := fun v w h h' => False.elim (h' ((top_adj v w).2 h))
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.top SimpleGraph.IsSRGWith.top

theorem IsSRGWith.card_neighborFinset_union_eq {v w : V} (h : G.IsSRGWith n k ℓ μ) :
    (G.neighborFinset v ∪ G.neighborFinset w).card =
      2 * k - Fintype.card (G.commonNeighbors v w) := by
  apply Nat.add_right_cancel (m := Fintype.card (G.commonNeighbors v w))
  rw [Nat.sub_add_cancel, ← Set.toFinset_card]
  -- porting note: Set.toFinset_inter needs workaround to use unification to solve for one of the
  -- instance arguments:
  · simp [commonNeighbors, @Set.toFinset_inter _ _ _ _ _ _ (_),
      ← neighborFinset_def, Finset.card_union_add_card_inter, card_neighborFinset_eq_degree,
      h.regular.degree_eq, two_mul]
  · apply le_trans (card_commonNeighbors_le_degree_left _ _ _)
    simp [h.regular.degree_eq, two_mul]
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.card_neighbor_finset_union_eq SimpleGraph.IsSRGWith.card_neighborFinset_union_eq

/-- Assuming `G` is strongly regular, `2*(k + 1) - m` in `G` is the number of vertices that are
adjacent to either `v` or `w` when `¬G.Adj v w`. So it's the cardinality of
`G.neighborSet v ∪ G.neighborSet w`. -/
theorem IsSRGWith.card_neighborFinset_union_of_not_adj {v w : V} (h : G.IsSRGWith n k ℓ μ)
    (hne : v ≠ w) (ha : ¬G.Adj v w) :
    (G.neighborFinset v ∪ G.neighborFinset w).card = 2 * k - μ := by
  rw [← h.of_not_adj v w hne ha]
  apply h.card_neighborFinset_union_eq
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.card_neighbor_finset_union_of_not_adj SimpleGraph.IsSRGWith.card_neighborFinset_union_of_not_adj

theorem IsSRGWith.card_neighborFinset_union_of_adj {v w : V} (h : G.IsSRGWith n k ℓ μ)
    (ha : G.Adj v w) : (G.neighborFinset v ∪ G.neighborFinset w).card = 2 * k - ℓ := by
  rw [← h.of_adj v w ha]
  apply h.card_neighborFinset_union_eq
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.card_neighbor_finset_union_of_adj SimpleGraph.IsSRGWith.card_neighborFinset_union_of_adj

theorem compl_neighborFinset_sdiff_inter_eq {v w : V} :
    G.neighborFinset vᶜ \ {v} ∩ (G.neighborFinset wᶜ \ {w}) =
      (G.neighborFinset vᶜ ∩ G.neighborFinset wᶜ) \ ({w} ∪ {v}) := by
  ext
  rw [← not_iff_not]
  simp [imp_iff_not_or, or_assoc, or_comm, or_left_comm]
#align simple_graph.compl_neighbor_finset_sdiff_inter_eq SimpleGraph.compl_neighborFinset_sdiff_inter_eq

theorem sdiff_compl_neighborFinset_inter_eq {v w : V} (h : G.Adj v w) :
    (G.neighborFinset vᶜ ∩ G.neighborFinset wᶜ) \ ({w} ∪ {v}) =
      G.neighborFinset vᶜ ∩ G.neighborFinset wᶜ := by
  ext
  simp only [and_imp, mem_union, mem_sdiff, mem_compl, and_iff_left_iff_imp, mem_neighborFinset,
    mem_inter, mem_singleton]
  rintro hnv hnw (rfl | rfl)
  · exact hnv h
  · apply hnw
    rwa [adj_comm]
#align simple_graph.sdiff_compl_neighbor_finset_inter_eq SimpleGraph.sdiff_compl_neighborFinset_inter_eq

theorem IsSRGWith.compl_is_regular (h : G.IsSRGWith n k ℓ μ) :
  Gᶜ.IsRegularOfDegree (n - k - 1) := by
  rw [← h.card, Nat.sub_sub, add_comm, ← Nat.sub_sub]
  exact h.regular.compl
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.compl_is_regular SimpleGraph.IsSRGWith.compl_is_regular

theorem IsSRGWith.card_commonNeighbors_eq_of_adj_compl (h : G.IsSRGWith n k ℓ μ) {v w : V}
    (ha : Gᶜ.Adj v w) : Fintype.card (↥(Gᶜ.commonNeighbors v w)) = n - (2 * k - μ) - 2 := by
  simp only [← Set.toFinset_card, commonNeighbors, Set.toFinset_inter, neighborSet_compl,
    Set.toFinset_diff, Set.toFinset_singleton, Set.toFinset_compl, ← neighborFinset_def]
  simp_rw [compl_neighborFinset_sdiff_inter_eq]
  have hne : v ≠ w := ne_of_adj _ ha
  rw [compl_adj] at ha
  rw [card_sdiff, ← insert_eq, card_insert_of_not_mem, card_singleton, ← Finset.compl_union]
  · rw [card_compl, h.card_neighborFinset_union_of_not_adj hne ha.2, ← h.card]
  · simp only [hne.symm, not_false_iff, mem_singleton]
  · intro u
    simp only [mem_union, mem_compl, mem_neighborFinset, mem_inter, mem_singleton]
    rintro (rfl | rfl) <;> simpa [adj_comm] using ha.2
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.card_common_neighbors_eq_of_adj_compl SimpleGraph.IsSRGWith.card_commonNeighbors_eq_of_adj_compl

theorem IsSRGWith.card_commonNeighbors_eq_of_not_adj_compl (h : G.IsSRGWith n k ℓ μ) {v w : V}
    (hn : v ≠ w) (hna : ¬Gᶜ.Adj v w) :
    Fintype.card (↥Gᶜ.commonNeighbors v w) = n - (2 * k - ℓ) := by
  simp only [← Set.toFinset_card, commonNeighbors, Set.toFinset_inter, neighborSet_compl,
    Set.toFinset_diff, Set.toFinset_singleton, Set.toFinset_compl, ← neighborFinset_def]
  simp only [not_and, Classical.not_not, compl_adj] at hna
  have h2' := hna hn
  simp_rw [compl_neighborFinset_sdiff_inter_eq, sdiff_compl_neighborFinset_inter_eq h2']
  rwa [← Finset.compl_union, card_compl, h.card_neighborFinset_union_of_adj, ← h.card]
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.card_common_neighbors_eq_of_not_adj_compl SimpleGraph.IsSRGWith.card_commonNeighbors_eq_of_not_adj_compl

/-- The complement of a strongly regular graph is strongly regular. -/
theorem IsSRGWith.compl (h : G.IsSRGWith n k ℓ μ) :
    Gᶜ.IsSRGWith n (n - k - 1) (n - (2 * k - μ) - 2) (n - (2 * k - ℓ)) where
  card := h.card
  regular := h.compl_is_regular
  of_adj := fun _v _w ha => h.card_commonNeighbors_eq_of_adj_compl ha
  of_not_adj := fun _v _w hn hna => h.card_commonNeighbors_eq_of_not_adj_compl hn hna
set_option linter.uppercaseLean3 false in
#align simple_graph.is_SRG_with.compl SimpleGraph.IsSRGWith.compl

end SimpleGraph


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.big_operators.order
import data.nat.interval
import data.nat.prime

/-!
# Divisor finsets

This file defines sets of divisors of a natural number. This is particularly useful as background
for defining Dirichlet convolution.

## Main Definitions
Let `n : ℕ`. All of the following definitions are in the `nat` namespace:
 * `divisors n` is the `finset` of natural numbers that divide `n`.
 * `proper_divisors n` is the `finset` of natural numbers that divide `n`, other than `n`.
 * `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
 * `perfect n` is true when `n` is positive and the sum of `proper_divisors n` is `n`.

## Implementation details
 * `divisors 0`, `proper_divisors 0`, and `divisors_antidiagonal 0` are defined to be `∅`.

## Tags
divisors, perfect numbers

-/

open_locale classical
open_locale big_operators
open finset

namespace nat
variable (n : ℕ)

/-- `divisors n` is the `finset` of divisors of `n`. As a special case, `divisors 0 = ∅`. -/
def divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 (n + 1))

/-- `proper_divisors n` is the `finset` of divisors of `n`, other than `n`.
  As a special case, `proper_divisors 0 = ∅`. -/
def proper_divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 n)

/-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
  As a special case, `divisors_antidiagonal 0 = ∅`. -/
def divisors_antidiagonal : finset (ℕ × ℕ) :=
((finset.Ico 1 (n + 1)).product (finset.Ico 1 (n + 1))).filter (λ x, x.fst * x.snd = n)

variable {n}

@[simp]
lemma filter_dvd_eq_divisors (h : n ≠ 0) :
  (finset.range n.succ).filter (∣ n) = n.divisors :=
begin
  ext,
  simp only [divisors, mem_filter, mem_range, mem_Ico, and.congr_left_iff, iff_and_self],
  exact λ ha _, succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt),
end

@[simp]
lemma filter_dvd_eq_proper_divisors (h : n ≠ 0) :
  (finset.range n).filter (∣ n) = n.proper_divisors :=
begin
  ext,
  simp only [proper_divisors, mem_filter, mem_range, mem_Ico, and.congr_left_iff, iff_and_self],
  exact λ ha _, succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt),
end

lemma proper_divisors.not_self_mem : ¬ n ∈ proper_divisors n :=
by simp [proper_divisors]

@[simp]
lemma mem_proper_divisors {m : ℕ} : n ∈ proper_divisors m ↔ n ∣ m ∧ n < m :=
begin
  rcases eq_or_ne m 0 with rfl | hm, { simp [proper_divisors] },
  simp only [and_comm, ←filter_dvd_eq_proper_divisors hm, mem_filter, mem_range],
end

lemma divisors_eq_proper_divisors_insert_self_of_pos (h : 0 < n):
  divisors n = has_insert.insert n (proper_divisors n) :=
by rw [divisors, proper_divisors, Ico_succ_right_eq_insert_Ico h, finset.filter_insert,
  if_pos (dvd_refl n)]

@[simp]
lemma mem_divisors {m : ℕ} : n ∈ divisors m ↔ (n ∣ m ∧ m ≠ 0) :=
begin
  rcases eq_or_ne m 0 with rfl | hm, { simp [divisors] },
  simp only [hm, ne.def, not_false_iff, and_true, ←filter_dvd_eq_divisors hm, mem_filter,
    mem_range, and_iff_right_iff_imp, lt_succ_iff],
  exact le_of_dvd hm.bot_lt,
end

lemma mem_divisors_self (n : ℕ) (h : n ≠ 0) : n ∈ n.divisors := mem_divisors.2 ⟨dvd_rfl, h⟩

lemma dvd_of_mem_divisors {m : ℕ} (h : n ∈ divisors m) : n ∣ m :=
begin
  cases m,
  { apply dvd_zero },
  { simp [mem_divisors.1 h], }
end

@[simp]
lemma mem_divisors_antidiagonal {x : ℕ × ℕ} :
  x ∈ divisors_antidiagonal n ↔ x.fst * x.snd = n ∧ n ≠ 0 :=
begin
  simp only [divisors_antidiagonal, finset.mem_Ico, ne.def, finset.mem_filter, finset.mem_product],
  rw and_comm,
  apply and_congr_right,
  rintro rfl,
  split; intro h,
  { contrapose! h, simp [h], },
  { rw [nat.lt_add_one_iff, nat.lt_add_one_iff],
    rw [mul_eq_zero, decidable.not_or_iff_and_not] at h,
    simp only [succ_le_of_lt (nat.pos_of_ne_zero h.1), succ_le_of_lt (nat.pos_of_ne_zero h.2),
               true_and],
    exact ⟨le_mul_of_pos_right (nat.pos_of_ne_zero h.2),
      le_mul_of_pos_left (nat.pos_of_ne_zero h.1)⟩ }
end

variable {n}

lemma divisor_le {m : ℕ}:
n ∈ divisors m → n ≤ m :=
begin
  cases m,
  { simp },
  simp only [mem_divisors, m.succ_ne_zero, and_true, ne.def, not_false_iff],
  exact nat.le_of_dvd (nat.succ_pos m),
end

lemma divisors_subset_of_dvd {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) : divisors m ⊆ divisors n :=
finset.subset_iff.2 $ λ x hx, nat.mem_divisors.mpr (⟨(nat.mem_divisors.mp hx).1.trans h, hzero⟩)

lemma divisors_subset_proper_divisors {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) (hdiff : m ≠ n) :
  divisors m ⊆ proper_divisors n :=
begin
  apply finset.subset_iff.2,
  intros x hx,
  exact nat.mem_proper_divisors.2 (⟨(nat.mem_divisors.1 hx).1.trans h,
    lt_of_le_of_lt (divisor_le hx) (lt_of_le_of_ne (divisor_le (nat.mem_divisors.2
    ⟨h, hzero⟩)) hdiff)⟩)
end

@[simp]
lemma divisors_zero : divisors 0 = ∅ := by { ext, simp }

@[simp]
lemma proper_divisors_zero : proper_divisors 0 = ∅ := by { ext, simp }

lemma proper_divisors_subset_divisors : proper_divisors n ⊆ divisors n :=
begin
  cases n,
  { simp },
  rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _)],
  apply subset_insert,
end

@[simp]
lemma divisors_one : divisors 1 = {1} := by { ext, simp }

@[simp]
lemma proper_divisors_one : proper_divisors 1 = ∅ :=
begin
  ext,
  simp only [finset.not_mem_empty, nat.dvd_one, not_and, not_lt, mem_proper_divisors, iff_false],
  apply ge_of_eq,
end

lemma pos_of_mem_divisors {m : ℕ} (h : m ∈ n.divisors) : 0 < m :=
begin
  cases m,
  { rw [mem_divisors, zero_dvd_iff] at h, cases h.2 h.1 },
  apply nat.succ_pos,
end

lemma pos_of_mem_proper_divisors {m : ℕ} (h : m ∈ n.proper_divisors) : 0 < m :=
pos_of_mem_divisors (proper_divisors_subset_divisors h)

lemma one_mem_proper_divisors_iff_one_lt :
  1 ∈ n.proper_divisors ↔ 1 < n :=
by rw [mem_proper_divisors, and_iff_right (one_dvd _)]

@[simp]
lemma divisors_antidiagonal_zero : divisors_antidiagonal 0 = ∅ := by { ext, simp }

@[simp]
lemma divisors_antidiagonal_one : divisors_antidiagonal 1 = {(1,1)} :=
by { ext, simp [nat.mul_eq_one_iff, prod.ext_iff], }

lemma swap_mem_divisors_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.swap ∈ divisors_antidiagonal n :=
begin
  rw [mem_divisors_antidiagonal, mul_comm] at h,
  simp [h.1, h.2],
end

lemma snd_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.snd ∈ divisors n :=
begin
  rw mem_divisors_antidiagonal at h,
  simp [dvd.intro_left _ h.1, h.2],
end

@[simp]
lemma map_swap_divisors_antidiagonal :
  (divisors_antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩
  = divisors_antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_divisors_antidiagonal, finset.mem_map, function.embedding.coe_fn_mk,
             ne.def, prod.swap_prod_mk, prod.exists],
  split,
  { rintros ⟨x, y, ⟨⟨rfl, h⟩, rfl⟩⟩,
    simp [mul_comm, h], },
  { rintros ⟨rfl, h⟩,
    use [a.snd, a.fst],
    rw mul_comm,
    simp [h] }
end

lemma sum_divisors_eq_sum_proper_divisors_add_self :
∑ i in divisors n, i = ∑ i in proper_divisors n, i + n :=
begin
  cases n,
  { simp },
  { rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _),
        finset.sum_insert (proper_divisors.not_self_mem), add_comm] }
end

/-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
  is positive. -/
def perfect (n : ℕ) : Prop := (∑ i in proper_divisors n, i = n) ∧ 0 < n

theorem perfect_iff_sum_proper_divisors (h : 0 < n) :
  perfect n ↔ ∑ i in proper_divisors n, i = n := and_iff_left h

theorem perfect_iff_sum_divisors_eq_two_mul (h : 0 < n) :
  perfect n ↔ ∑ i in divisors n, i = 2 * n :=
begin
  rw [perfect_iff_sum_proper_divisors h, sum_divisors_eq_sum_proper_divisors_add_self, two_mul],
  split; intro h,
  { rw h },
  { apply add_right_cancel h }
end

lemma mem_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) {x : ℕ} :
  x ∈ divisors (p ^ k) ↔ ∃ (j : ℕ) (H : j ≤ k), x = p ^ j :=
by rw [mem_divisors, nat.dvd_prime_pow pp, and_iff_left (ne_of_gt (pow_pos pp.pos k))]

lemma prime.divisors {p : ℕ} (pp : p.prime) :
  divisors p = {1, p} :=
begin
  ext,
  rw [mem_divisors, dvd_prime pp, and_iff_left pp.ne_zero, finset.mem_insert, finset.mem_singleton]
end

lemma prime.proper_divisors {p : ℕ} (pp : p.prime) :
  proper_divisors p = {1} :=
by rw [← erase_insert (proper_divisors.not_self_mem),
    ← divisors_eq_proper_divisors_insert_self_of_pos pp.pos,
    pp.divisors, pair_comm, erase_insert (λ con, pp.ne_one (mem_singleton.1 con))]

lemma divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
  divisors (p ^ k) = (finset.range (k + 1)).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
by { ext, simp [mem_divisors_prime_pow, pp, nat.lt_succ_iff, @eq_comm _ a] }

lemma eq_proper_divisors_of_subset_of_sum_eq_sum {s : finset ℕ} (hsub : s ⊆ n.proper_divisors) :
  ∑ x in s, x = ∑ x in n.proper_divisors, x → s = n.proper_divisors :=
begin
  cases n,
  { rw [proper_divisors_zero, subset_empty] at hsub,
    simp [hsub] },
  classical,
  rw [← sum_sdiff hsub],
  intros h,
  apply subset.antisymm hsub,
  rw [← sdiff_eq_empty_iff_subset],
  contrapose h,
  rw [← ne.def, ← nonempty_iff_ne_empty] at h,
  apply ne_of_lt,
  rw [← zero_add (∑ x in s, x), ← add_assoc, add_zero],
  apply add_lt_add_right,
  have hlt := sum_lt_sum_of_nonempty h (λ x hx, pos_of_mem_proper_divisors (sdiff_subset _ _ hx)),
  simp only [sum_const_zero] at hlt,
  apply hlt
end

lemma sum_proper_divisors_dvd (h : ∑ x in n.proper_divisors, x ∣ n) :
  (∑ x in n.proper_divisors, x = 1) ∨ (∑ x in n.proper_divisors, x = n) :=
begin
  cases n,
  { simp },
  cases n,
  { contrapose! h,
    simp, },
  rw or_iff_not_imp_right,
  intro ne_n,
  have hlt : ∑ x in n.succ.succ.proper_divisors, x < n.succ.succ :=
    lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h) ne_n,
  symmetry,
  rw [← mem_singleton, eq_proper_divisors_of_subset_of_sum_eq_sum (singleton_subset_iff.2
        (mem_proper_divisors.2 ⟨h, hlt⟩)) sum_singleton, mem_proper_divisors],
  refine ⟨one_dvd _, nat.succ_lt_succ (nat.succ_pos _)⟩,
end

@[simp, to_additive]
lemma prime.prod_proper_divisors {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in p.proper_divisors, f x = f 1 :=
by simp [h.proper_divisors]

@[simp, to_additive]
lemma prime.prod_divisors {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in p.divisors, f x = f p * f 1 :=
by rw [divisors_eq_proper_divisors_insert_self_of_pos h.pos,
       prod_insert proper_divisors.not_self_mem, h.prod_proper_divisors]

lemma proper_divisors_eq_singleton_one_iff_prime :
  n.proper_divisors = {1} ↔ n.prime :=
⟨λ h, begin
  have h1 := mem_singleton.2 rfl,
  rw [← h, mem_proper_divisors] at h1,
  refine nat.prime_def_lt''.mpr ⟨h1.2, λ m hdvd, _⟩,
  rw [← mem_singleton, ← h, mem_proper_divisors],
  have hle := nat.le_of_dvd (lt_trans (nat.succ_pos _) h1.2) hdvd,
  exact or.imp_left (λ hlt, ⟨hdvd, hlt⟩) hle.lt_or_eq
end, prime.proper_divisors⟩

lemma sum_proper_divisors_eq_one_iff_prime :
  ∑ x in n.proper_divisors, x = 1 ↔ n.prime :=
begin
  cases n,
  { simp [nat.not_prime_zero] },
  cases n,
  { simp [nat.not_prime_one] },
  rw [← proper_divisors_eq_singleton_one_iff_prime],
  refine ⟨λ h, _, λ h, h.symm ▸ sum_singleton⟩,
  rw [@eq_comm (finset ℕ) _ _],
  apply eq_proper_divisors_of_subset_of_sum_eq_sum
    (singleton_subset_iff.2 (one_mem_proper_divisors_iff_one_lt.2 (succ_lt_succ (nat.succ_pos _))))
    (eq.trans sum_singleton h.symm)
end

lemma mem_proper_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) {x : ℕ} :
  x ∈ proper_divisors (p ^ k) ↔ ∃ (j : ℕ) (H : j < k), x = p ^ j :=
begin
  rw [mem_proper_divisors, nat.dvd_prime_pow pp, ← exists_and_distrib_right],
  simp only [exists_prop, and_assoc],
  apply exists_congr,
  intro a,
  split; intro h,
  { rcases h with ⟨h_left, rfl, h_right⟩,
    rwa pow_lt_pow_iff pp.one_lt at h_right,
    simpa, },
  { rcases h with ⟨h_left, rfl⟩,
    rwa pow_lt_pow_iff pp.one_lt,
    simp [h_left, le_of_lt], },
end

lemma proper_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
  proper_divisors (p ^ k) = (finset.range k).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
by { ext, simp [mem_proper_divisors_prime_pow, pp, nat.lt_succ_iff, @eq_comm _ a], }

@[simp, to_additive]
lemma prod_proper_divisors_prime_pow {α : Type*} [comm_monoid α] {k p : ℕ} {f : ℕ → α}
  (h : p.prime) : ∏ x in (p ^ k).proper_divisors, f x = ∏ x in range k, f (p ^ x) :=
by simp [h, proper_divisors_prime_pow]

@[simp, to_additive sum_divisors_prime_pow]
lemma prod_divisors_prime_pow {α : Type*} [comm_monoid α] {k p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in (p ^ k).divisors, f x = ∏ x in range (k + 1), f (p ^ x) :=
by simp [h, divisors_prime_pow]

@[to_additive]
lemma prod_divisors_antidiagonal {M : Type*} [comm_monoid M] (f : ℕ → ℕ → M) {n : ℕ} :
  ∏ i in n.divisors_antidiagonal, f i.1 i.2 = ∏ i in n.divisors, f i (n / i) :=
begin
  refine prod_bij (λ i _, i.1) _ _ _ _,
  { intro i,
    apply fst_mem_divisors_of_mem_antidiagonal },
  { rintro ⟨i, j⟩ hij,
    simp only [mem_divisors_antidiagonal, ne.def] at hij,
    rw [←hij.1, nat.mul_div_cancel_left],
    apply nat.pos_of_ne_zero,
    rintro rfl,
    simp only [zero_mul] at hij,
    apply hij.2 hij.1.symm },
  { simp only [and_imp, prod.forall, mem_divisors_antidiagonal, ne.def],
    rintro i₁ j₁ ⟨i₂, j₂⟩ h - (rfl : i₂ * j₂ = _) h₁ (rfl : _ = i₂),
    simp only [nat.mul_eq_zero, not_or_distrib, ←ne.def] at h₁,
    rw mul_right_inj' h₁.1 at h,
    simp [h] },
  simp only [and_imp, exists_prop, mem_divisors_antidiagonal, exists_and_distrib_right, ne.def,
    exists_eq_right', mem_divisors, prod.exists],
  rintro _ ⟨k, rfl⟩ hn,
  exact ⟨⟨k, rfl⟩, hn⟩,
end

@[to_additive]
lemma prod_divisors_antidiagonal' {M : Type*} [comm_monoid M] (f : ℕ → ℕ → M) {n : ℕ} :
  ∏ i in n.divisors_antidiagonal, f i.1 i.2 = ∏ i in n.divisors, f (n / i) i :=
begin
  rw [←map_swap_divisors_antidiagonal, finset.prod_map],
  exact prod_divisors_antidiagonal (λ i j, f j i),
end

/-- The factors of `n` are the prime divisors -/
lemma prime_divisors_eq_to_filter_divisors_prime (n : ℕ) :
  n.factors.to_finset = (divisors n).filter prime :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp },
  { ext q,
    simpa [hn, hn.ne', mem_factors] using and_comm (prime q) (q ∣ n) }
end

@[simp]
lemma image_div_divisors_eq_divisors (n : ℕ) : image (λ (x : ℕ), n / x) n.divisors = n.divisors :=
begin
  by_cases hn : n = 0, { simp [hn] },
  ext,
  split,
  { rw mem_image,
    rintros ⟨x, hx1, hx2⟩,
    rw mem_divisors at *,
    refine ⟨_,hn⟩,
    rw ←hx2,
    exact div_dvd_of_dvd hx1.1 },
  { rw [mem_divisors, mem_image],
    rintros ⟨h1, -⟩,
    exact ⟨n/a, mem_divisors.mpr ⟨div_dvd_of_dvd h1, hn⟩,
           nat.div_div_self h1 (pos_iff_ne_zero.mpr hn)⟩ },
end

@[simp, to_additive sum_div_divisors]
lemma prod_div_divisors {α : Type*} [comm_monoid α] (n : ℕ) (f : ℕ → α) :
  ∏ d in n.divisors, f (n/d) = n.divisors.prod f :=
begin
  by_cases hn : n = 0, { simp [hn] },
  rw ←prod_image,
  { exact prod_congr (image_div_divisors_eq_divisors n) (by simp) },
  { intros x hx y hy h,
    rw mem_divisors at hx hy,
    exact (div_eq_iff_eq_of_dvd_dvd hn hx.1 hy.1).mp h }
end

end nat


/-
Copyright (c) 2022 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey, Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.special_functions.log
import analysis.special_functions.pow

/-!
# Real logarithm base `b`

In this file we define `real.logb` to be the logarithm of a real number in a given base `b`. We
define this as the division of the natural logarithms of the argument and the base, so that we have
a globally defined function with `logb b 0 = 0`, `logb b (-x) = logb b x` `logb 0 x = 0` and
`logb (-b) x = logb b x`.

We prove some basic properties of this function and it's relation to `rpow`.

## Tags

logarithm, continuity
-/

open set filter function
open_locale topological_space
noncomputable theory

namespace real

variables {b x y : ℝ}

/-- The real logarithm in a given base. As with the natural logarithm, we define `logb b x` to
be `logb b |x|` for `x < 0`, and `0` for `x = 0`.-/
@[pp_nodot] noncomputable def logb (b x : ℝ) : ℝ := log x / log b

lemma log_div_log : log x / log b = logb b x := rfl

@[simp] lemma logb_zero : logb b 0 = 0 := by simp [logb]

@[simp] lemma logb_one : logb b 1 = 0 := by simp [logb]

@[simp] lemma logb_abs (x : ℝ) : logb b (|x|) = logb b x := by rw [logb, logb, log_abs]

@[simp] lemma logb_neg_eq_logb (x : ℝ) : logb b (-x) = logb b x :=
by rw [← logb_abs x, ← logb_abs (-x), abs_neg]

lemma logb_mul (hx : x ≠ 0) (hy : y ≠ 0) : logb b (x * y) = logb b x + logb b y :=
by simp_rw [logb, log_mul hx hy, add_div]

lemma logb_div (hx : x ≠ 0) (hy : y ≠ 0) : logb b (x / y) = logb b x - logb b y :=
by simp_rw [logb, log_div hx hy, sub_div]

@[simp] lemma logb_inv (x : ℝ) : logb b (x⁻¹) = -logb b x := by simp [logb, neg_div]

section b_pos_and_ne_one

variable (b_pos : 0 < b)
variable (b_ne_one : b ≠ 1)
include b_pos b_ne_one

private lemma log_b_ne_zero : log b ≠ 0 :=
begin
  have b_ne_zero : b ≠ 0, linarith,
  have b_ne_minus_one : b ≠ -1, linarith,
  simp [b_ne_one, b_ne_zero, b_ne_minus_one],
end

@[simp] lemma logb_rpow :
  logb b (b ^ x) = x :=
begin
  rw [logb, div_eq_iff, log_rpow b_pos],
  exact log_b_ne_zero b_pos b_ne_one,
end

lemma rpow_logb_eq_abs (hx : x ≠ 0) : b ^ (logb b x) = |x| :=
begin
  apply log_inj_on_pos,
  simp only [set.mem_Ioi],
  apply rpow_pos_of_pos b_pos,
  simp only [abs_pos, mem_Ioi, ne.def, hx, not_false_iff],
  rw [log_rpow b_pos, logb, log_abs],
  field_simp [log_b_ne_zero b_pos b_ne_one],
end

@[simp] lemma rpow_logb (hx : 0 < x) : b ^ (logb b x) = x :=
by { rw rpow_logb_eq_abs b_pos b_ne_one (hx.ne'), exact abs_of_pos hx, }

lemma rpow_logb_of_neg (hx : x < 0) : b ^ (logb b x) = -x :=
by { rw rpow_logb_eq_abs b_pos b_ne_one (ne_of_lt hx), exact abs_of_neg hx }

lemma surj_on_logb : surj_on (logb b) (Ioi 0) univ :=
λ x _, ⟨rpow b x, rpow_pos_of_pos b_pos x, logb_rpow b_pos b_ne_one⟩

lemma logb_surjective : surjective (logb b) :=
λ x, ⟨b ^ x, logb_rpow b_pos b_ne_one⟩

@[simp] lemma range_logb : range (logb b) = univ :=
(logb_surjective b_pos b_ne_one).range_eq

lemma surj_on_logb' : surj_on (logb b) (Iio 0) univ :=
begin
  intros x x_in_univ,
  use -b ^ x,
  split,
  { simp only [right.neg_neg_iff, set.mem_Iio], apply rpow_pos_of_pos b_pos, },
  { rw [logb_neg_eq_logb, logb_rpow b_pos b_ne_one], },
end

end b_pos_and_ne_one

section one_lt_b

variable (hb : 1 < b)
include hb

private lemma b_pos : 0 < b := by linarith

private lemma b_ne_one : b ≠ 1 := by linarith

@[simp] lemma logb_le_logb (h : 0 < x) (h₁ : 0 < y) :
  logb b x ≤ logb b y ↔ x ≤ y :=
by { rw [logb, logb, div_le_div_right (log_pos hb), log_le_log h h₁], }

lemma logb_lt_logb (hx : 0 < x) (hxy : x < y) : logb b x < logb b y :=
by { rw [logb, logb, div_lt_div_right (log_pos hb)], exact log_lt_log hx hxy, }

@[simp] lemma logb_lt_logb_iff (hx : 0 < x) (hy : 0 < y) :
  logb b x < logb b y ↔ x < y :=
by { rw [logb, logb, div_lt_div_right (log_pos hb)], exact log_lt_log_iff hx hy, }

lemma logb_le_iff_le_rpow (hx : 0 < x) : logb b x ≤ y ↔ x ≤ b ^ y :=
by rw [←rpow_le_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hx]

lemma logb_lt_iff_lt_rpow (hx : 0 < x) : logb b x < y ↔ x < b ^ y :=
by rw [←rpow_lt_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hx]

lemma le_logb_iff_rpow_le (hy : 0 < y) : x ≤ logb b y ↔ b ^ x ≤ y :=
by rw [←rpow_le_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hy]

lemma lt_logb_iff_rpow_lt (hy : 0 < y) : x < logb b y ↔ b ^ x < y :=
by rw [←rpow_lt_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hy]

lemma logb_pos_iff (hx : 0 < x) : 0 < logb b x ↔ 1 < x :=
by { rw ← @logb_one b, rw logb_lt_logb_iff hb zero_lt_one hx, }

lemma logb_pos (hx : 1 < x) : 0 < logb b x :=
by { rw logb_pos_iff hb (lt_trans zero_lt_one hx), exact hx, }

lemma logb_neg_iff (h : 0 < x) : logb b x < 0 ↔ x < 1 :=
by { rw ← logb_one, exact logb_lt_logb_iff hb h zero_lt_one, }

lemma logb_neg (h0 : 0 < x) (h1 : x < 1) : logb b x < 0 :=
(logb_neg_iff hb h0).2 h1

lemma logb_nonneg_iff (hx : 0 < x) : 0 ≤ logb b x ↔ 1 ≤ x :=
by rw [← not_lt, logb_neg_iff hb hx, not_lt]

lemma logb_nonneg (hx : 1 ≤ x) : 0 ≤ logb b x :=
(logb_nonneg_iff hb (zero_lt_one.trans_le hx)).2 hx

lemma logb_nonpos_iff (hx : 0 < x) : logb b x ≤ 0 ↔ x ≤ 1 :=
by rw [← not_lt, logb_pos_iff hb hx, not_lt]

lemma logb_nonpos_iff' (hx : 0 ≤ x) : logb b x ≤ 0 ↔ x ≤ 1 :=
begin
  rcases hx.eq_or_lt with (rfl|hx),
  { simp [le_refl, zero_le_one] },
  exact logb_nonpos_iff hb hx,
end

lemma logb_nonpos (hx : 0 ≤ x) (h'x : x ≤ 1) : logb b x ≤ 0 :=
(logb_nonpos_iff' hb hx).2 h'x

lemma strict_mono_on_logb : strict_mono_on (logb b) (set.Ioi 0) :=
λ x hx y hy hxy, logb_lt_logb hb hx hxy

lemma strict_anti_on_logb : strict_anti_on (logb b) (set.Iio 0) :=
begin
  rintros x (hx : x < 0) y (hy : y < 0) hxy,
  rw [← logb_abs y, ← logb_abs x],
  refine logb_lt_logb hb (abs_pos.2 hy.ne) _,
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff],
end

lemma logb_inj_on_pos : set.inj_on (logb b) (set.Ioi 0) :=
(strict_mono_on_logb hb).inj_on

lemma eq_one_of_pos_of_logb_eq_zero (h₁ : 0 < x) (h₂ : logb b x = 0) :
x = 1 :=
logb_inj_on_pos hb (set.mem_Ioi.2 h₁) (set.mem_Ioi.2 zero_lt_one)
  (h₂.trans real.logb_one.symm)

lemma logb_ne_zero_of_pos_of_ne_one (hx_pos : 0 < x) (hx : x ≠ 1) :
  logb b x ≠ 0 :=
mt (eq_one_of_pos_of_logb_eq_zero hb hx_pos) hx

lemma tendsto_logb_at_top : tendsto (logb b) at_top at_top :=
tendsto.at_top_div_const (log_pos hb) tendsto_log_at_top

end one_lt_b

section b_pos_and_b_lt_one

variable (b_pos : 0 < b)
variable (b_lt_one : b < 1)
include b_lt_one

private lemma b_ne_one : b ≠ 1 := by linarith

include b_pos

@[simp] lemma logb_le_logb_of_base_lt_one (h : 0 < x) (h₁ : 0 < y) :
  logb b x ≤ logb b y ↔ y ≤ x :=
by { rw [logb, logb, div_le_div_right_of_neg (log_neg b_pos b_lt_one), log_le_log h₁ h], }

lemma logb_lt_logb_of_base_lt_one (hx : 0 < x) (hxy : x < y) : logb b y < logb b x :=
by { rw [logb, logb, div_lt_div_right_of_neg (log_neg b_pos b_lt_one)], exact log_lt_log hx hxy, }

@[simp] lemma logb_lt_logb_iff_of_base_lt_one (hx : 0 < x) (hy : 0 < y) :
  logb b x < logb b y ↔ y < x :=
by { rw [logb, logb, div_lt_div_right_of_neg (log_neg b_pos b_lt_one)], exact log_lt_log_iff hy hx }

lemma logb_le_iff_le_rpow_of_base_lt_one (hx : 0 < x) : logb b x ≤ y ↔ b ^ y ≤ x :=
by rw [←rpow_le_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hx]

lemma logb_lt_iff_lt_rpow_of_base_lt_one (hx : 0 < x) : logb b x < y ↔ b ^ y < x :=
by rw [←rpow_lt_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hx]

lemma le_logb_iff_rpow_le_of_base_lt_one (hy : 0 < y) : x ≤ logb b y ↔ y ≤ b ^ x :=
by rw [←rpow_le_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hy]

lemma lt_logb_iff_rpow_lt_of_base_lt_one (hy : 0 < y) : x < logb b y ↔ y < b ^ x :=
by rw [←rpow_lt_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hy]

lemma logb_pos_iff_of_base_lt_one (hx : 0 < x) : 0 < logb b x ↔ x < 1 :=
by rw [← @logb_one b, logb_lt_logb_iff_of_base_lt_one b_pos b_lt_one zero_lt_one hx]

lemma logb_pos_of_base_lt_one (hx : 0 < x) (hx' : x < 1) : 0 < logb b x :=
by { rw logb_pos_iff_of_base_lt_one b_pos b_lt_one hx, exact hx', }

lemma logb_neg_iff_of_base_lt_one (h : 0 < x) : logb b x < 0 ↔ 1 < x :=
by rw [← @logb_one b, logb_lt_logb_iff_of_base_lt_one b_pos b_lt_one h zero_lt_one]

lemma logb_neg_of_base_lt_one (h1 : 1 < x) : logb b x < 0 :=
(logb_neg_iff_of_base_lt_one b_pos b_lt_one (lt_trans zero_lt_one h1)).2 h1

lemma logb_nonneg_iff_of_base_lt_one (hx : 0 < x) : 0 ≤ logb b x ↔ x ≤ 1 :=
by rw [← not_lt, logb_neg_iff_of_base_lt_one b_pos b_lt_one hx, not_lt]

lemma logb_nonneg_of_base_lt_one (hx : 0 < x) (hx' : x ≤ 1) : 0 ≤ logb b x :=
by {rw [logb_nonneg_iff_of_base_lt_one b_pos b_lt_one hx], exact hx' }

lemma logb_nonpos_iff_of_base_lt_one (hx : 0 < x) : logb b x ≤ 0 ↔ 1 ≤ x :=
by rw [← not_lt, logb_pos_iff_of_base_lt_one b_pos b_lt_one hx, not_lt]

lemma strict_anti_on_logb_of_base_lt_one : strict_anti_on (logb b) (set.Ioi 0) :=
λ x hx y hy hxy, logb_lt_logb_of_base_lt_one b_pos b_lt_one hx hxy

lemma strict_mono_on_logb_of_base_lt_one : strict_mono_on (logb b) (set.Iio 0) :=
begin
  rintros x (hx : x < 0) y (hy : y < 0) hxy,
  rw [← logb_abs y, ← logb_abs x],
  refine logb_lt_logb_of_base_lt_one b_pos b_lt_one (abs_pos.2 hy.ne) _,
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff],
end

lemma logb_inj_on_pos_of_base_lt_one : set.inj_on (logb b) (set.Ioi 0) :=
(strict_anti_on_logb_of_base_lt_one b_pos b_lt_one).inj_on

lemma eq_one_of_pos_of_logb_eq_zero_of_base_lt_one (h₁ : 0 < x) (h₂ : logb b x = 0) :
x = 1 :=
logb_inj_on_pos_of_base_lt_one b_pos b_lt_one (set.mem_Ioi.2 h₁) (set.mem_Ioi.2 zero_lt_one)
  (h₂.trans real.logb_one.symm)

lemma logb_ne_zero_of_pos_of_ne_one_of_base_lt_one (hx_pos : 0 < x) (hx : x ≠ 1) :
  logb b x ≠ 0 :=
mt (eq_one_of_pos_of_logb_eq_zero_of_base_lt_one b_pos b_lt_one hx_pos) hx

lemma tendsto_logb_at_top_of_base_lt_one : tendsto (logb b) at_top at_bot :=
begin
  rw tendsto_at_top_at_bot,
  intro e,
  use 1 ⊔ b ^ e,
  intro a,
  simp only [and_imp, sup_le_iff],
  intro ha,
  rw logb_le_iff_le_rpow_of_base_lt_one b_pos b_lt_one,
  tauto,
  exact lt_of_lt_of_le zero_lt_one ha,
end

end b_pos_and_b_lt_one

@[simp] lemma logb_eq_zero :
  logb b x = 0 ↔ b = 0 ∨ b = 1 ∨ b = -1 ∨ x = 0 ∨ x = 1 ∨ x = -1 :=
begin
  simp_rw [logb, div_eq_zero_iff, log_eq_zero],
  tauto,
end

/- TODO add other limits and continuous API lemmas analogous to those in log.lean -/

open_locale big_operators

lemma logb_prod {α : Type*} (s : finset α) (f : α → ℝ) (hf : ∀ x ∈ s, f x ≠ 0):
  logb b (∏ i in s, f i) = ∑ i in s, logb b (f i) :=
begin
  classical,
  induction s using finset.induction_on with a s ha ih,
  { simp },
  simp only [finset.mem_insert, forall_eq_or_imp] at hf,
  simp [ha, ih hf.2, logb_mul hf.1 (finset.prod_ne_zero_iff.2 hf.2)],
end

end real


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import linear_algebra.basis -- basis of a vector space
import linear_algebra.matrix.to_lin -- relationship between matrices and linear maps
/-!

# Basis of a vector space

Plan:

1) If V,W are based vector spaces then matrices = linear maps

2) change of basis

-/

-- Let V be a vector space over a field k
variables (k : Type) [field k] (V : Type) [add_comm_group V] [module k V]

/-

What *is* a basis for a vector space `V`? Mathematicians use the term to mean two
different things! Sometimes it's a subset of `V` (this is particularly common
if `V` is infinite-dimensional) and sometimes it's a *list* `[e₁, e₂, ..., eₙ]`.
The issue is whether the basis is *indexed* or not. In `mathlib`, bases are
indexed, so we have an index type (e.g. `{1,2,3,...,n}`) and a basis
is a function from this type to `V` satisfying the axioms for a basis.

-/

-- Let `B` be a `k`-basis for `V` indexed by `I`.
variables (I : Type) (B : basis I k V)

-- Lean is allowing for the possibility that `I` is infinite, which makes
-- the theory noncomputable, so let's switch on non-computable mathematics

noncomputable theory

-- (I always do this when Lean complains something is not computable; this doesn't
-- mean that you can't do maths with it, it means that we're asking Lean to do things
-- for which there is no algorithm (e.g. picking a basis, especially in the infinite-dimensional
-- case)

-- If `(i : I)` then the basis element of `V` corresponding to `i` (i.e. the element eᵢ if
-- you're imagining i={1,2,3,...,n}) is `B i`

variable (i : I)

example : V := B i

-- A general element of V is uniquely a `k`-linear combination of elements of the basis.
-- In the finite-dimensional case we just write v = ∑ᵢ cᵢeᵢ. In the infinite-dimensional
-- case a basis will be infinite, but you can't take infinite sums so from `v` we should
-- expect to see a finitely-supported function on `I`, i.e., an element of `I →₀ k`.
-- Given a basis `B` with index set `I`, the function `basis.repr B`, or `B.repr`,
-- is the `k`-linear isomorphism from `V` to these finitely-supported functions.

example : V ≃ₗ[k] (I →₀ k) := B.repr

-- If `I` is finite, then you can use the space of all functions `I → k` (because they're
-- all finitely-supported) but because `I →₀ k` isn't *equal* to `I → k` (they're just
-- in bijection when `I` is finite) we need a different function to do this.

example [fintype I] : V ≃ₗ[k] (I → k) := B.equiv_fun

-- If you want to see the coefficient of `B i` in the expansion of `v` in terms
-- of the basis `B`, you can write

example (v : V) : k := B.repr v i

-- Again if `I` is finite, you can reconstruct `v` as `∑ B.repr v i • B i`, a sum over all `i`.

-- allow notation for sums
open_locale big_operators

example [fintype I] (v : V) : ∑ i, B.repr v i • B i = v := B.sum_repr v

-- You can also use `B.coord i`, which is the linear map from `V` to `k` sending a vector `V`
-- to the coefficient of `B i`

example : V →ₗ[k] k := B.coord i

-- Now let `W` be another `k`-vector space
variables (W : Type) [add_comm_group W] [module k W]

-- Let's prove that any map `f` from `I` to `W` extends uniquely to a linear map `φ` from `V` to `W`
-- such that forall `i : I`, `f i = φ (B i)`.

-- The two pieces of API you'll need:

-- the extension of `f : I → W` to a `k`-linear map `V →ₖ[W]` is `basis.constr B k f`
example (f : I → W) : V →ₗ[k] W := B.constr k f

-- The theorem that `B.constr k f` agrees with `f` (in the sense that `B.constr k f (B i) = f i`
-- is `basis.constr_basis B k f i`
example (f : I → W) (i : I) : B.constr k f (B i) = f i := B.constr_basis k f i

-- Finally, `basis.ext` is the theorem that two linear maps are equal if they agree
-- on a basis of the source
example (φ ψ : V →ₗ[k] W) (h : ∀ (i : I), φ (B i) = ψ (B i)) : φ = ψ := B.ext h

-- That should be all you need to do this!
example (f : I → W) : ∃! φ : V →ₗ[k] W, ∀ i, φ (B i) = f i :=
begin
  sorry,
end

-- Now say `C` is a basis of `W`, indexed by a type `J`
variables (J : Type) (C : basis J k W)

-- If everything is finite-dimensional
variables [fintype I] [fintype J]

-- then linear maps from `V` to `W` are the same as matrices with rows
-- indexed by `I` and columns indexed by `J`

open_locale classical -- apparently something isn't constructive here?

example : (V →ₗ[k] W) ≃ₗ[k] matrix J I k := linear_map.to_matrix B C

-- check that this bijection does give what we expect.
-- Right-click on `linear_map.to_matrix` and then "go to definition" to find
-- the API for `linear_map.to_matrix`.

example (φ : V →ₗ[k] W) (i : I) (j : J) : linear_map.to_matrix B C φ j i = C.repr (φ (B i)) j :=
sorry


import tactic

set_option pp.generalized_field_notation false

open nat

namespace training

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

lemma lowerBoundPowerOf2 (n : ℕ) :
  1 ≤ powerOf2 n :=
begin
  induction n; simp [powerOf2], linarith,
end

lemma sumSamePowerOf2 (n : ℕ) :
  powerOf2 n + powerOf2 n == 2 * powerOf2 n :=
by ring

lemma monotonicPowerOf2 :
  ∀ {n m}, n ≤ m → powerOf2 n ≤ powerOf2 m
| 0     m     le := lowerBoundPowerOf2 m
| (n+1) 0     le := by cases le
| (n+1) (m+1) le := begin simp [powerOf2], apply monotonicPowerOf2, linarith, end

lemma addPowerOf2 (n m : ℕ) :
  powerOf2 n * powerOf2 m = powerOf2 (n + m) :=
begin
  induction n; simp [powerOf2], rw [mul_assoc, n_ih, succ_add], simp [powerOf2],
end

inductive tree : Type
| leaf : tree
| node : tree → tree → tree

namespace tree

def height : tree → ℕ
| leaf       := 1
| (node l r) := max (height l) (height r) + 1

def nodeCount : tree → ℕ
| leaf       := 1
| (node l r) := nodeCount l + nodeCount r + 1

def leafCount : tree → ℕ
| leaf       := 1
| (node l r) := leafCount l + leafCount r

-- Move - 1 to LHS to avoid nat subtraction

lemma upperboundForNodeCount (root : tree) :
  nodeCount root + 1 ≤ powerOf2 (height root) :=
begin
  induction root with l r ih_l ih_r;
  simp [height, nodeCount, powerOf2],
  set hl := height l,
  set hr := height r,
  calc
    nodeCount (node l r) + 1
        = nodeCount l + nodeCount r + 1 + 1            : rfl
    ... ≤ powerOf2 hl + powerOf2 hr                    : by linarith
    ... ≤ powerOf2 (max hl hr) + powerOf2 (max hl hr)  :
      by linarith [ monotonicPowerOf2 (le_max_left hl hr)
                  , monotonicPowerOf2 (le_max_right hl hr) ]
    ... = 2 * powerOf2 (max hl hr)                     : by ring
    ... = powerOf2 (max hl hr + 1)                     : rfl
    ... = powerOf2 (height (node l r))                 : rfl
end

end tree

end training


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import ring_theory.trace
import field_theory.finite.galois_field

/-!
# The trace map for finite fields

We state the fact that the trace map from a finite field of
characteristic `p` to `zmod p` is nondegenerate.

## Tags
finite field, trace
-/

namespace finite_field

/-- The trace map from a finite field to its prime field is nongedenerate. -/
lemma trace_to_zmod_nondegenerate (F : Type*) [field F] [finite F] {a : F}
 (ha : a ≠ 0) : ∃ b : F, algebra.trace (zmod (ring_char F)) F (a * b) ≠ 0 :=
begin
  haveI : fact (ring_char F).prime := ⟨char_p.char_is_prime F _⟩,
  have htr := trace_form_nondegenerate (zmod (ring_char F)) F a,
  simp_rw [algebra.trace_form_apply] at htr,
  by_contra' hf,
  exact ha (htr hf),
end

end finite_field


def mod2 : ℕ → ℕ
| 0 := 0
| (nat.succ n) := match mod2 n with
    | 0 := 1
    | (nat.succ _) := 0
    end.

open nat

theorem mod2_0 : mod2 0 = 0 :=
begin
  simp [mod2],
end.

theorem mod2_1 : mod2 1 = 1 :=
begin
  simp [mod2],
end.

theorem mod2_return_0_1 : ∀ n, mod2 n = 0 ∨ mod2 n = 1 :=
begin
  intro n,
  induction n,
    left,
    unfold mod2,
  cases n_ih,
    right,
    unfold mod2,
    rw n_ih,
    unfold mod2._match_1,
  left,
  unfold mod2,
  rw n_ih,
  unfold mod2._match_1,
end.

theorem mod2_mul_2_0 : ∀ n,  mod2 (2 * n) = 0 :=
begin
  intro n,
  induction n with n Hn,
    simp [mod2],
  rw [mul_succ],
  unfold mod2,
  rw Hn,
  unfold mod2._match_1,
end.

theorem mod2_idempotent : ∀ n,  mod2 (mod2 n) = mod2 n :=
begin
  intro n,
  cases (mod2_return_0_1 n); simp [h, mod2],
end.

theorem mod2_add_homo : ∀ n m,  mod2 (n + m) = mod2 (mod2 n + mod2 m) :=
begin
  intros n m,
  revert n,
  induction m with m IH; intros n,
    simp [mod2, mod2_idempotent],
  unfold mod2,
  rewrite IH,
  cases (mod2_return_0_1 n) with Hn Hn;
    cases (mod2_return_0_1 m) with Hm Hm;
    simp [Hn, Hm, mod2],
end.

theorem sq_succ_n {n: nat} : (n+1) * (n+1) = n * n + 2 * n + 1 :=
begin
  simp,
  rw [nat.mul_succ, nat.mul_comm, nat.mul_succ],
  have H2n : 2 * n = n + n,
    rw [nat.mul_comm, nat.mul_succ, nat.mul_one],
  rw [H2n],
  simp [add_comm],
end.

example : ∀ n, mod2 n = mod2 (n * n) :=
begin
  intro n,
  induction n with n,
    simp [mod2],
  simp [mod2],
  rw [sq_succ_n, mod2_add_homo, mod2_1],
  unfold mod2,
  rw [mod2_add_homo, ←n_ih, mod2_mul_2_0, add_zero],
  simp [mod2_idempotent],
end.