/-
Copyright (c) 2015 Nathaniel Thomas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl

Modules over a ring.
-/

import algebra.ring algebra.big_operators data.set.lattice tidy.tidy
open function

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

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
class has_scalar (α : out_param $ Type u) (γ : Type v) := (smul : α → γ → γ)

infixr ` • `:73 := has_scalar.smul

/-- A semimodule is a generalization of vector spaces to a scalar semiring.
  It consists of a scalar semiring `α` and an additive monoid of "vectors" `β`,
  connected by a "scalar multiplication" operation `r • x : β`
  (where `r : α` and `x : β`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
class semimodule (α : out_param $ Type u) (β : Type v) [out_param $ semiring α]
  extends has_scalar α β, add_comm_monoid β :=
(smul_add : ∀r (x y : β), r • (x + y) = r • x + r • y)
(add_smul : ∀r s (x : β), (r + s) • x = r • x + s • x)
(mul_smul : ∀r s (x : β), (r * s) • x = r • s • x)
(one_smul : ∀x : β, (1 : α) • x = x)
(zero_smul : ∀x : β, (0 : α) • x = 0)
(smul_zero {} : ∀r, r • (0 : β) = 0)

section semimodule
variables {R:semiring α} [semimodule α β] {r s : α} {x y : β}
include R

theorem smul_add' : r • (x + y) = r • x + r • y := semimodule.smul_add r x y
theorem add_smul' : (r + s) • x = r • x + s • x := semimodule.add_smul r s x
theorem mul_smul' : (r * s) • x = r • s • x := semimodule.mul_smul r s x
@[simp] theorem one_smul' : (1 : α) • x = x := semimodule.one_smul x
@[simp] theorem zero_smul' : (0 : α) • x = 0 := semimodule.zero_smul x
@[simp] theorem smul_zero' : r • (0 : β) = 0 := semimodule.smul_zero r

lemma smul_smul' : r • s • x = (r * s) • x := mul_smul'.symm

end semimodule

/-- A module is a generalization of vector spaces to a scalar ring.
  It consists of a scalar ring `α` and an additive group of "vectors" `β`,
  connected by a "scalar multiplication" operation `r • x : β`
  (where `r : α` and `x : β`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
class module (α : out_param $ Type u) (β : Type v) [out_param $ ring α]
  extends has_scalar α β, add_comm_group β :=
(smul_add : ∀r (x y : β), r • (x + y) = r • x + r • y)
(add_smul : ∀r s (x : β), (r + s) • x = r • x + s • x)
(mul_smul : ∀r s (x : β), (r * s) • x = r • s • x)
(one_smul : ∀x : β, (1 : α) • x = x)

section module
variables {R:ring α} [module α β] {r s : α} {x y : β}
include R

theorem smul_add : r • (x + y) = r • x + r • y := module.smul_add r x y
theorem add_smul : (r + s) • x = r • x + s • x := module.add_smul r s x
theorem mul_smul : (r * s) • x = r • s • x := module.mul_smul r s x
@[simp] theorem one_smul : (1 : α) • x = x := module.one_smul x

@[simp] theorem zero_smul : (0 : α) • x = 0 :=
have (0 : α) • x + 0 • x = 0 • x + 0, by rw ← add_smul; simp,
add_left_cancel this

@[simp] theorem smul_zero : r • (0 : β) = 0 :=
have r • (0:β) + r • 0 = r • 0 + 0, by rw ← smul_add; simp,
add_left_cancel this

instance module.to_semimodule : semimodule α β :=
{ zero_smul := λ x, zero_smul,
  smul_zero := λ r, smul_zero,
  ..‹module α β› }

@[simp] theorem neg_smul : -r • x = - (r • x) :=
eq_neg_of_add_eq_zero (by rw [← add_smul, add_left_neg, zero_smul])

local attribute [search, simp] smul_add add_smul mul_smul

@[search] theorem neg_one_smul (x : β) : (-1 : α) • x = -x := □

@[simp] theorem smul_neg : r • (-x) = -(r • x) := □

theorem smul_sub (r : α) (x y : β) : r • (x - y) = r • x - r • y := □

theorem sub_smul (r s : α) (y : β) : (r - s) • y = r • y - s • y := □

lemma smul_smul : r • s • x = (r * s) • x := □!

end module

instance semiring.to_semimodule [r : semiring α] : semimodule α α :=
{ smul := (*),
  smul_add := mul_add,
  add_smul := add_mul,
  mul_smul := mul_assoc,
  one_smul := one_mul,
  zero_smul := zero_mul,
  smul_zero := mul_zero, ..r }

@[simp] lemma smul_eq_mul' [semiring α] {a a' : α} : a • a' = a * a' := rfl

instance ring.to_module [r : ring α] : module α α :=
{ ..semiring.to_semimodule }

@[simp] lemma smul_eq_mul [ring α] {a a' : α} : a • a' = a * a' := rfl

local attribute [search] smul_add add_smul mul_smul one_smul zero_smul smul_zero neg_smul neg_one_smul smul_neg neg_one_smul smul_neg smul_sub sub_smul smul_smul smul_eq_mul

structure is_linear_map {α : Type u} {β : Type v} {γ : Type w} [ring α] [module α β] [module α γ]
  (f : β → γ) : Prop :=
(add  : ∀x y, f (x + y) = f x + f y)
(smul : ∀c x, f (c • x) = c • f x)

local attribute [search] is_linear_map.add is_linear_map.smul

namespace is_linear_map
variables [ring α] [module α β] [module α γ] [module α δ]
variables {f g h : β → γ} {r : α} {x y : β}
include α

section
variable (hf : is_linear_map f)
include hf

@[simp, search] lemma zero : f 0 = 0 :=
calc f 0 = f (0 • 0 : β) : □
     ... = 0 : by rewrite_search

@[simp, search] lemma neg (x : β) : f (- x) = - f x :=
eq_neg_of_add_eq_zero $ □

@[simp] lemma sub (x y : β) : f (x - y) = f x - f y := □

@[simp] lemma sum {ι : Type x} {t : finset ι} {g : ι → β} : f (t.sum g) = t.sum (λi, f (g i)) :=
(finset.sum_hom f hf.zero hf.add).symm

end

lemma comp {g : δ → β} (hf : is_linear_map f) (hg : is_linear_map g) : is_linear_map (f ∘ g) := by qed [comp]

lemma id : is_linear_map (id : β → β) := □

lemma inverse {f : γ → β} {g : β → γ}
  (hf : is_linear_map f) (h₁ : left_inverse g f) (h₂ : right_inverse g f): is_linear_map g :=
⟨assume x y,
  have g (f (g (x + y))) = g (f (g x + g y)),
    by rewrite_search_with [h₂],
  by rwa [h₁ (g (x + y)), h₁ (g x + g y)] at this,
assume a b,
  have g (f (g (a • b))) = g (f (a • g b)),
    by rewrite_search_with [h₂],
  by rwa [h₁ (g (a • b)), h₁ (a • g b)] at this ⟩

lemma map_zero : is_linear_map (λb, 0 : β → γ) := □

lemma map_neg (hf : is_linear_map f) : is_linear_map (λb, - f b) := □

lemma map_add (hf : is_linear_map f) (hg : is_linear_map g) : is_linear_map (λb, f b + g b) := □

lemma map_sum [decidable_eq δ] {t : finset δ} {f : δ → β → γ} :
  (∀d∈t, is_linear_map (f d)) → is_linear_map (λb, t.sum $ λd, f d b) :=
finset.induction_on t (by simp [map_zero]) (by simp [map_add] {contextual := tt})

lemma map_sub (hf : is_linear_map f) (hg : is_linear_map g) : is_linear_map (λb, f b - g b) := □

suggestion arithmetic

lemma map_smul_right {α : Type u} {β : Type v} {γ : Type w} [comm_ring α] [module α β] [module α γ]
  {f : β → γ} {r : α} (hf : is_linear_map f) :
  is_linear_map (λb, r • f b) := □

lemma map_smul_left {f : γ → α} (hf : is_linear_map f) : is_linear_map (λb, f b • x) := □

end is_linear_map

/-- A submodule of a module is one which is closed under vector operations.
  This is a sufficient condition for the subset of vectors in the submodule
  to themselves form a module. -/
class is_submodule {α : Type u} {β : Type v} [ring α] [module α β] (p : set β) : Prop :=
(zero_ : (0:β) ∈ p)
(add_  : ∀ {x y}, x ∈ p → y ∈ p → x + y ∈ p)
(smul : ∀ c {x}, x ∈ p → c • x ∈ p)

namespace is_submodule
variables [ring α] [module α β] [module α γ]
variables {p p' : set β} [is_submodule p] [is_submodule p']
variables {r : α}
include α

section
variables {x y : β}

lemma zero : (0 : β) ∈ p := is_submodule.zero_ α p

lemma add : x ∈ p → y ∈ p → x + y ∈ p := is_submodule.add_ α

local attribute [simp] is_submodule.zero is_submodule.add is_submodule.smul

lemma neg (hx : x ∈ p) : -x ∈ p := by rw ← neg_one_smul x; exact smul (-1) hx

lemma sub (hx : x ∈ p) (hy : y ∈ p) : x - y ∈ p := add hx (neg hy)

lemma sum {ι : Type w} [decidable_eq ι] {t : finset ι} {f : ι → β} :
  (∀c∈t, f c ∈ p) → t.sum f ∈ p :=
finset.induction_on t □ □!

lemma sum2 {ι : Type w} [decidable_eq ι] {t : finset ι} {f : ι → β} :
  (∀c∈t, f c ∈ p) → t.sum f ∈ p :=
finset.induction_on t □ □!

lemma smul_ne_0 {a : α} {b : β} (h : a ≠ 0 → b ∈ p) : a • b ∈ p :=
classical.by_cases
  (assume : a = 0, □!)
  (assume : a ≠ 0, by simp [h this, smul])

instance single_zero : is_submodule ({0} : set β) := □

instance univ : is_submodule (set.univ : set β) := □

instance image {f : β → γ} (hf : is_linear_map f) : is_submodule (f '' p) :=
{ is_submodule .
  zero_ := ⟨0, zero, hf.zero⟩,
  add_  := assume c₁ c₂ ⟨b₁, hb₁, eq₁⟩ ⟨b₂, hb₂, eq₂⟩,
    ⟨b₁ + b₂, add hb₁ hb₂, by simp [eq₁, eq₂, hf.add]⟩,
  smul  := assume a c ⟨b, hb, eq⟩, ⟨a • b, smul a hb, □!⟩ }

instance range {f : β → γ} (hf : is_linear_map f) : is_submodule (set.range f) :=
by rw [← set.image_univ]; exact is_submodule.image hf

instance preimage {f : γ → β} (hf : is_linear_map f) : is_submodule (f ⁻¹' p) :=
by refine {..}; simp [hf.zero, hf.add, hf.smul, zero, add, smul] {contextual:=tt}

instance add_submodule : is_submodule {z | ∃x∈p, ∃y∈p', z = x + y} :=
{ is_submodule .
  zero_ := ⟨0, □, 0, □, □⟩,
  add_  := assume b₁ b₂ ⟨x₁, hx₁, y₁, hy₁, eq₁⟩ ⟨x₂, hx₂, y₂, hy₂, eq₂⟩,
    ⟨x₁ + x₂, add hx₁ hx₂, y₁ + y₂, add hy₁ hy₂, by simp [eq₁, eq₂]⟩,
  smul  := assume a b ⟨x, hx, y, hy, eq⟩,
    ⟨a • x, smul _ hx, a • y, smul _ hy, by simp [eq, smul_add]⟩ }

local attribute [simp] zero add smul

lemma Inter_submodule {ι : Sort w} {s : ι → set β} (h : ∀i, is_submodule (s i)) :
  is_submodule (⋂i, s i) := begin
  weak_tidy,
  simp_search,
  simp_search,
  simp_search,

  end

instance Inter_submodule' {ι : Sort w} {s : ι → set β} [h : ∀i, is_submodule (s i)] :
  is_submodule (⋂i, s i) :=
Inter_submodule h

instance sInter_submodule {s : set (set β)} [hs : ∀t∈s, is_submodule t] : is_submodule (⋂₀ s) :=
by rw set.sInter_eq_bInter; exact Inter_submodule (assume t, Inter_submodule $ hs t)

instance inter_submodule : is_submodule (p ∩ p') :=
suffices is_submodule (⋂₀ {p, p'} : set β), by simpa [set.inter_comm],
@is_submodule.sInter_submodule α β _ _ {p, p'} $
  by simp [or_imp_distrib, ‹is_submodule p›, ‹is_submodule p'›] {contextual := tt}

end

end is_submodule

section comm_ring

theorem is_submodule.eq_univ_of_contains_unit {α : Type u} [comm_ring α] (S : set α) [is_submodule S]
  (x y : α) (hx : x ∈ S) (h : y * x = 1) : S = set.univ :=
set.ext $ λ z, ⟨λ hz, trivial, λ hz, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ S : is_submodule.smul (z * y) hx⟩

theorem is_submodule.univ_of_one_mem {α : Type u} [comm_ring α] (S : set α) [is_submodule S] :
  (1:α) ∈ S → S = set.univ :=
λ h, set.ext $ λ z, ⟨λ hz, trivial, λ hz, by simpa using (is_submodule.smul z h : z * 1 ∈ S)⟩

end comm_ring

/-- A vector space is the same as a module, except the scalar ring is actually
  a field. (This adds commutativity of the multiplication and existence of inverses.)
  This is the traditional generalization of spaces like `ℝ^n`, which have a natural
  addition operation and a way to multiply them by real numbers, but no multiplication
  operation between vectors. -/
class vector_space (α : out_param $ Type u) (β : Type v) [out_param $ field α] extends module α β

/-- Subspace of a vector space. Defined to equal `is_submodule`. -/
@[reducible] def subspace {α : Type u} {β : Type v} [field α] [vector_space α β] (p : set β) :
  Prop :=
is_submodule p


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Oliver Nash
-/
import data.finset.basic

/-!
# Finsets in product types

This file defines finset constructions on the product type `α × β`. Beware not to confuse with the
`finset.prod` operation which computes the multiplicative product.

## Main declarations

* `finset.product`: Turns `s : finset α`, `t : finset β` into their product in `finset (α × β)`.
* `finset.diag`: For `s : finset α`, `s.diag` is the `finset (α × α)` of pairs `(a, a)` with
  `a ∈ s`.
* `finset.off_diag`: For `s : finset α`, `s.off_diag` is the `finset (α × α)` of pairs `(a, b)` with
  `a, b ∈ s` and `a ≠ b`.
-/

open multiset

variables {α β γ : Type*}

namespace finset

/-! ### prod -/
section prod
variables {s s' : finset α} {t t' : finset β}

/-- `product s t` is the set of pairs `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
protected def product (s : finset α) (t : finset β) : finset (α × β) := ⟨_, nodup_product s.2 t.2⟩

@[simp] lemma product_val : (s.product t).1 = s.1.product t.1 := rfl

@[simp] lemma mem_product {p : α × β} : p ∈ s.product t ↔ p.1 ∈ s ∧ p.2 ∈ t := mem_product

@[simp, norm_cast] lemma coe_product (s : finset α) (t : finset β) :
  (s.product t : set (α × β)) = (s : set α).prod t :=
set.ext $ λ x, finset.mem_product

lemma subset_product [decidable_eq α] [decidable_eq β] {s : finset (α × β)} :
  s ⊆ (s.image prod.fst).product (s.image prod.snd) :=
λ p hp, mem_product.2 ⟨mem_image_of_mem _ hp, mem_image_of_mem _ hp⟩

lemma product_subset_product (hs : s ⊆ s') (ht : t ⊆ t') : s.product t ⊆ s'.product t' :=
λ ⟨x,y⟩ h, mem_product.2 ⟨hs (mem_product.1 h).1, ht (mem_product.1 h).2⟩

lemma product_subset_product_left (hs : s ⊆ s') : s.product t ⊆ s'.product t :=
product_subset_product hs (subset.refl _)

lemma product_subset_product_right (ht : t ⊆ t') : s.product t ⊆ s.product t' :=
product_subset_product (subset.refl _) ht

lemma product_eq_bUnion [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) :
  s.product t = s.bUnion (λa, t.image $ λb, (a, b)) :=
ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff,
  and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left]

lemma product_eq_bUnion_right [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) :
  s.product t = t.bUnion (λ b, s.image $ λ a, (a, b)) :=
ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff,
  and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left]

/-- See also `finset.sup_product_left`. -/
@[simp] lemma product_bUnion [decidable_eq γ] (s : finset α) (t : finset β) (f : α × β → finset γ) :
  (s.product t).bUnion f = s.bUnion (λ a, t.bUnion (λ b, f (a, b))) :=
by { classical, simp_rw [product_eq_bUnion, bUnion_bUnion, image_bUnion] }

@[simp] lemma card_product (s : finset α) (t : finset β) : card (s.product t) = card s * card t :=
multiset.card_product _ _

lemma filter_product (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] :
  (s.product t).filter (λ (x : α × β), p x.1 ∧ q x.2) = (s.filter p).product (t.filter q) :=
by { ext ⟨a, b⟩, simp only [mem_filter, mem_product], finish }

lemma filter_product_card (s : finset α) (t : finset β)
  (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] :
  ((s.product t).filter (λ (x : α × β), p x.1 ↔ q x.2)).card =
  (s.filter p).card * (t.filter q).card + (s.filter (not ∘ p)).card * (t.filter (not ∘ q)).card :=
begin
  classical,
  rw [← card_product, ← card_product, ← filter_product, ← filter_product, ← card_union_eq],
  { apply congr_arg, ext ⟨a, b⟩, simp only [filter_union_right, mem_filter, mem_product],
    split; intros; finish },
  { rw disjoint_iff, change _ ∩ _ = ∅, ext ⟨a, b⟩, rw mem_inter, finish }
end

lemma empty_product (t : finset β) : (∅ : finset α).product t = ∅ := rfl

lemma product_empty (s : finset α) : s.product (∅ : finset β) = ∅ :=
eq_empty_of_forall_not_mem (λ x h, (finset.mem_product.1 h).2)

lemma nonempty.product (hs : s.nonempty) (ht : t.nonempty) : (s.product t).nonempty :=
let ⟨x, hx⟩ := hs, ⟨y, hy⟩ := ht in ⟨(x, y), mem_product.2 ⟨hx, hy⟩⟩

lemma nonempty.fst (h : (s.product t).nonempty) : s.nonempty :=
let ⟨xy, hxy⟩ := h in ⟨xy.1, (mem_product.1 hxy).1⟩

lemma nonempty.snd (h : (s.product t).nonempty) : t.nonempty :=
let ⟨xy, hxy⟩ := h in ⟨xy.2, (mem_product.1 hxy).2⟩

@[simp] lemma nonempty_product : (s.product t).nonempty ↔ s.nonempty ∧ t.nonempty :=
⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.product h.2⟩

@[simp] lemma union_product [decidable_eq α] [decidable_eq β] :
  (s ∪ s').product t = s.product t ∪ s'.product t :=
by { ext ⟨x, y⟩, simp only [or_and_distrib_right, mem_union, mem_product] }

@[simp] lemma product_union [decidable_eq α] [decidable_eq β] :
  s.product (t ∪ t') = s.product t ∪ s.product t' :=
by { ext ⟨x, y⟩, simp only [and_or_distrib_left, mem_union, mem_product] }

end prod

section diag
variables (s : finset α) [decidable_eq α]

/-- Given a finite set `s`, the diagonal, `s.diag` is the set of pairs of the form `(a, a)` for
`a ∈ s`. -/
def diag := (s.product s).filter (λ (a : α × α), a.fst = a.snd)

/-- Given a finite set `s`, the off-diagonal, `s.off_diag` is the set of pairs `(a, b)` with `a ≠ b`
for `a, b ∈ s`. -/
def off_diag := (s.product s).filter (λ (a : α × α), a.fst ≠ a.snd)

@[simp] lemma mem_diag (x : α × α) : x ∈ s.diag ↔ x.1 ∈ s ∧ x.1 = x.2 :=
by { simp only [diag, mem_filter, mem_product], split; intros; finish }

@[simp] lemma mem_off_diag (x : α × α) : x ∈ s.off_diag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 :=
by { simp only [off_diag, mem_filter, mem_product], split; intros; finish }

@[simp] lemma diag_card : (diag s).card = s.card :=
begin
  suffices : diag s = s.image (λ a, (a, a)), { rw this, apply card_image_of_inj_on, finish },
  ext ⟨a₁, a₂⟩, rw mem_diag, split; intros; finish,
end

@[simp] lemma off_diag_card : (off_diag s).card = s.card * s.card - s.card :=
begin
  suffices : (diag s).card + (off_diag s).card = s.card * s.card,
  { nth_rewrite 2 ← s.diag_card, finish },
  rw ← card_product,
  apply filter_card_add_filter_neg_card_eq_card,
end

@[simp] lemma diag_empty : (∅ : finset α).diag = ∅ := rfl

@[simp] lemma off_diag_empty : (∅ : finset α).off_diag = ∅ := rfl

end diag
end finset