/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller

! This file was ported from Lean 3 source module data.finite.defs
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Basic

/-!
# Definition of the `finite` typeclass

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

This file defines a typeclass `finite` saying that `α : Sort*` is finite. A type is `finite` if it
is equivalent to `fin n` for some `n`. We also define `infinite α` as a typeclass equivalent to
`¬finite α`.

The `finite` predicate has no computational relevance and, being `Prop`-valued, gets to enjoy proof
irrelevance -- it represents the mere fact that the type is finite.  While the `fintype` class also
represents finiteness of a type, a key difference is that a `fintype` instance represents finiteness
in a computable way: it gives a concrete algorithm to produce a `finset` whose elements enumerate
the terms of the given type. As such, one generally relies on congruence lemmas when rewriting
expressions involving `fintype` instances.

Every `fintype` instance automatically gives a `finite` instance, see `fintype.finite`, but not vice
versa. Every `fintype` instance should be computable since they are meant for computation. If it's
not possible to write a computable `fintype` instance, one should prefer writing a `finite` instance
instead.

## Main definitions

* `finite α` denotes that `α` is a finite type.
* `infinite α` denotes that `α` is an infinite type.

## Implementation notes

The definition of `finite α` is not just `nonempty (fintype α)` since `fintype` requires
that `α : Type*`, and the definition in this module allows for `α : Sort*`. This means
we can write the instance `finite.prop`.

## Tags

finite, fintype
-/

universe u v

open Function

variable {α β : Sort _}

#print Finite /-
/-- A type is `finite` if it is in bijective correspondence to some
`fin n`.

While this could be defined as `nonempty (fintype α)`, it is defined
in this way to allow there to be `finite` instances for propositions.
-/
class inductive Finite (α : Sort _) : Prop
  | intro {n : ℕ} : α ≃ Fin n → Finite
#align finite Finite
-/

/- warning: finite_iff_exists_equiv_fin -> finite_iff_exists_equiv_fin is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}}, Iff (Finite.{u1} α) (Exists.{1} Nat (fun (n : Nat) => Nonempty.{max 1 (max u1 1) (imax 1 u1)} (Equiv.{u1, 1} α (Fin n))))
but is expected to have type
  forall {α : Sort.{u1}}, Iff (Finite.{u1} α) (Exists.{1} Nat (fun (n : Nat) => Nonempty.{max 1 u1} (Equiv.{u1, 1} α (Fin n))))
Case conversion may be inaccurate. Consider using '#align finite_iff_exists_equiv_fin finite_iff_exists_equiv_finₓ'. -/
theorem finite_iff_exists_equiv_fin {α : Sort _} : Finite α ↔ ∃ n, Nonempty (α ≃ Fin n) :=
  ⟨fun ⟨e⟩ => ⟨_, ⟨e⟩⟩, fun ⟨n, ⟨e⟩⟩ => ⟨e⟩⟩
#align finite_iff_exists_equiv_fin finite_iff_exists_equiv_fin

/- warning: finite.exists_equiv_fin -> Finite.exists_equiv_fin is a dubious translation:
lean 3 declaration is
  forall (α : Sort.{u1}) [h : Finite.{u1} α], Exists.{1} Nat (fun (n : Nat) => Nonempty.{max 1 (max u1 1) (imax 1 u1)} (Equiv.{u1, 1} α (Fin n)))
but is expected to have type
  forall (α : Sort.{u1}) [h : Finite.{u1} α], Exists.{1} Nat (fun (n : Nat) => Nonempty.{max 1 u1} (Equiv.{u1, 1} α (Fin n)))
Case conversion may be inaccurate. Consider using '#align finite.exists_equiv_fin Finite.exists_equiv_finₓ'. -/
theorem Finite.exists_equiv_fin (α : Sort _) [h : Finite α] : ∃ n : ℕ, Nonempty (α ≃ Fin n) :=
  finite_iff_exists_equiv_fin.mp h
#align finite.exists_equiv_fin Finite.exists_equiv_fin

#print Finite.of_equiv /-
theorem Finite.of_equiv (α : Sort _) [h : Finite α] (f : α ≃ β) : Finite β :=
  by
  cases' h with n e
  exact Finite.intro (f.symm.trans e)
#align finite.of_equiv Finite.of_equiv
-/

/- warning: equiv.finite_iff -> Equiv.finite_iff is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, (Equiv.{u1, u2} α β) -> (Iff (Finite.{u1} α) (Finite.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, (Equiv.{u2, u1} α β) -> (Iff (Finite.{u2} α) (Finite.{u1} β))
Case conversion may be inaccurate. Consider using '#align equiv.finite_iff Equiv.finite_iffₓ'. -/
theorem Equiv.finite_iff (f : α ≃ β) : Finite α ↔ Finite β :=
  ⟨fun _ => Finite.of_equiv _ f, fun _ => Finite.of_equiv _ f.symm⟩
#align equiv.finite_iff Equiv.finite_iff

/- warning: function.bijective.finite_iff -> Function.Bijective.finite_iff is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {f : α -> β}, (Function.Bijective.{u1, u2} α β f) -> (Iff (Finite.{u1} α) (Finite.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {f : α -> β}, (Function.Bijective.{u2, u1} α β f) -> (Iff (Finite.{u2} α) (Finite.{u1} β))
Case conversion may be inaccurate. Consider using '#align function.bijective.finite_iff Function.Bijective.finite_iffₓ'. -/
theorem Function.Bijective.finite_iff {f : α → β} (h : Bijective f) : Finite α ↔ Finite β :=
  (Equiv.ofBijective f h).finite_iff
#align function.bijective.finite_iff Function.Bijective.finite_iff

/- warning: finite.of_bijective -> Finite.ofBijective is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u1} α] {f : α -> β}, (Function.Bijective.{u1, u2} α β f) -> (Finite.{u2} β)
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} [_inst_1 : Finite.{u2} α] {f : α -> β}, (Function.Bijective.{u2, u1} α β f) -> (Finite.{u1} β)
Case conversion may be inaccurate. Consider using '#align finite.of_bijective Finite.ofBijectiveₓ'. -/
theorem Finite.ofBijective [Finite α] {f : α → β} (h : Bijective f) : Finite β :=
  h.finite_iff.mp ‹_›
#align finite.of_bijective Finite.ofBijective

instance [Finite α] : Finite (PLift α) :=
  Finite.of_equiv α Equiv.plift.symm

instance {α : Type v} [Finite α] : Finite (ULift.{u} α) :=
  Finite.of_equiv α Equiv.ulift.symm

#print Infinite /-
/-- A type is said to be infinite if it is not finite. Note that `infinite α` is equivalent to
`is_empty (fintype α)` or `is_empty (finite α)`. -/
class Infinite (α : Sort _) : Prop where
  not_finite : ¬Finite α
#align infinite Infinite
-/

#print not_finite_iff_infinite /-
@[simp]
theorem not_finite_iff_infinite : ¬Finite α ↔ Infinite α :=
  ⟨Infinite.mk, fun h => h.1⟩
#align not_finite_iff_infinite not_finite_iff_infinite
-/

#print not_infinite_iff_finite /-
@[simp]
theorem not_infinite_iff_finite : ¬Infinite α ↔ Finite α :=
  not_finite_iff_infinite.not_right.symm
#align not_infinite_iff_finite not_infinite_iff_finite
-/

/- warning: equiv.infinite_iff -> Equiv.infinite_iff is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, (Equiv.{u1, u2} α β) -> (Iff (Infinite.{u1} α) (Infinite.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, (Equiv.{u2, u1} α β) -> (Iff (Infinite.{u2} α) (Infinite.{u1} β))
Case conversion may be inaccurate. Consider using '#align equiv.infinite_iff Equiv.infinite_iffₓ'. -/
theorem Equiv.infinite_iff (e : α ≃ β) : Infinite α ↔ Infinite β :=
  not_finite_iff_infinite.symm.trans <| e.finite_iff.Not.trans not_finite_iff_infinite
#align equiv.infinite_iff Equiv.infinite_iff

instance [Infinite α] : Infinite (PLift α) :=
  Equiv.plift.infinite_iff.2 ‹_›

instance {α : Type v} [Infinite α] : Infinite (ULift.{u} α) :=
  Equiv.ulift.infinite_iff.2 ‹_›

#print finite_or_infinite /-
theorem finite_or_infinite (α : Sort _) : Finite α ∨ Infinite α :=
  or_iff_not_imp_left.2 <| not_finite_iff_infinite.1
#align finite_or_infinite finite_or_infinite
-/

#print not_finite /-
theorem not_finite (α : Sort _) [Infinite α] [Finite α] : False :=
  @Infinite.not_finite α ‹_› ‹_›
#align not_finite not_finite
-/

#print Finite.false /-
protected theorem Finite.false [Infinite α] (h : Finite α) : False :=
  not_finite α
#align finite.false Finite.false
-/

#print Infinite.false /-
protected theorem Infinite.false [Finite α] (h : Infinite α) : False :=
  not_finite α
#align infinite.false Infinite.false
-/

alias not_infinite_iff_finite ↔ Finite.of_not_infinite Finite.not_infinite
#align finite.of_not_infinite Finite.of_not_infinite
#align finite.not_infinite Finite.not_infinite


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johannes Hölzl
-/
import data.list.infix

/-!
# Double universal quantification on a list

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

This file provides an API for `list.forall₂` (definition in `data.list.defs`).
`forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length, and whenever `a` is the nth element
of `l₁`, and `b` is the nth element of `l₂`, then `R a b` is satisfied.
-/

open nat function

namespace list

variables {α β γ δ : Type*} {R S : α → β → Prop} {P : γ → δ → Prop} {Rₐ : α → α → Prop}
open relator

mk_iff_of_inductive_prop list.forall₂ list.forall₂_iff

@[simp] theorem forall₂_cons {a b l₁ l₂} :
  forall₂ R (a :: l₁) (b :: l₂) ↔ R a b ∧ forall₂ R l₁ l₂ :=
⟨λ h, by cases h with h₁ h₂; split; assumption, λ ⟨h₁, h₂⟩, forall₂.cons h₁ h₂⟩

theorem forall₂.imp
  (H : ∀ a b, R a b → S a b) {l₁ l₂}
  (h : forall₂ R l₁ l₂) : forall₂ S l₁ l₂ :=
by induction h; constructor; solve_by_elim

lemma forall₂.mp {Q : α → β → Prop} (h : ∀ a b, Q a b → R a b → S a b) :
  ∀ {l₁ l₂}, forall₂ Q l₁ l₂ → forall₂ R l₁ l₂ → forall₂ S l₁ l₂
| []        []        forall₂.nil           forall₂.nil           := forall₂.nil
| (a :: l₁) (b :: l₂) (forall₂.cons hr hrs) (forall₂.cons hq hqs) :=
  forall₂.cons (h a b hr hq) (forall₂.mp hrs hqs)

lemma forall₂.flip : ∀ {a b}, forall₂ (flip R) b a → forall₂ R a b
| _ _                 forall₂.nil          := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons h₁ h₂.flip

@[simp] lemma forall₂_same : ∀ {l : list α}, forall₂ Rₐ l l ↔ ∀ x ∈ l, Rₐ x x
| [] := by simp
| (a :: l) := by simp [@forall₂_same l]

lemma forall₂_refl [is_refl α Rₐ] (l : list α) : forall₂ Rₐ l l :=
forall₂_same.2 $ λ a h, refl _

@[simp] lemma forall₂_eq_eq_eq : forall₂ ((=) : α → α → Prop) = (=) :=
begin
  funext a b, apply propext,
  split,
  { intro h, induction h, {refl}, simp only [*]; split; refl },
  { rintro rfl, exact forall₂_refl _ }
end

@[simp, priority 900] lemma forall₂_nil_left_iff {l} : forall₂ R nil l ↔ l = nil :=
⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩

@[simp, priority 900] lemma forall₂_nil_right_iff {l} : forall₂ R l nil ↔ l = nil :=
⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩

lemma forall₂_cons_left_iff {a l u} :
  forall₂ R (a :: l) u ↔ (∃b u', R a b ∧ forall₂ R l u' ∧ u = b :: u') :=
iff.intro
  (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end)
  (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end)

lemma forall₂_cons_right_iff {b l u} :
  forall₂ R u (b :: l) ↔ (∃a u', R a b ∧ forall₂ R u' l ∧ u = a :: u') :=
iff.intro
  (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end)
  (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end)

lemma forall₂_and_left {p : α → Prop} :
  ∀ l u, forall₂ (λa b, p a ∧ R a b) l u ↔ (∀ a∈l, p a) ∧ forall₂ R l u
| []     u := by simp only [forall₂_nil_left_iff, forall_prop_of_false (not_mem_nil _),
    imp_true_iff, true_and]
| (a :: l) u := by simp only [forall₂_and_left l, forall₂_cons_left_iff, forall_mem_cons,
    and_assoc, and_comm, and.left_comm, exists_and_distrib_left.symm]

@[simp] lemma forall₂_map_left_iff {f : γ → α} :
  ∀ {l u}, forall₂ R (map f l) u ↔ forall₂ (λc b, R (f c) b) l u
| []     _ := by simp only [map, forall₂_nil_left_iff]
| (a :: l) _ := by simp only [map, forall₂_cons_left_iff, forall₂_map_left_iff]

@[simp] lemma forall₂_map_right_iff {f : γ → β} :
  ∀ {l u}, forall₂ R l (map f u) ↔ forall₂ (λa c, R a (f c)) l u
| _ []     := by simp only [map, forall₂_nil_right_iff]
| _ (b :: u) := by simp only [map, forall₂_cons_right_iff, forall₂_map_right_iff]

lemma left_unique_forall₂' (hr : left_unique R) :
  ∀ {a b c}, forall₂ R a c → forall₂ R b c → a = b
| a₀ nil a₁ forall₂.nil forall₂.nil := rfl
| (a₀ :: l₀) (b :: l) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) :=
  hr ha₀ ha₁ ▸ left_unique_forall₂' h₀ h₁ ▸ rfl

lemma _root_.relator.left_unique.forall₂ (hr : left_unique R) : left_unique (forall₂ R) :=
@left_unique_forall₂' _ _ _ hr

lemma right_unique_forall₂' (hr : right_unique R) : ∀ {a b c}, forall₂ R a b → forall₂ R a c → b = c
| nil a₀ a₁ forall₂.nil forall₂.nil := rfl
| (b :: l) (a₀ :: l₀) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) :=
  hr ha₀ ha₁ ▸ right_unique_forall₂' h₀ h₁ ▸ rfl

lemma _root_.relator.right_unique.forall₂ (hr : right_unique R) : right_unique (forall₂ R) :=
@right_unique_forall₂' _ _ _ hr

lemma _root_.relator.bi_unique.forall₂ (hr : bi_unique R) : bi_unique (forall₂ R) :=
⟨hr.left.forall₂, hr.right.forall₂⟩

theorem forall₂.length_eq :
  ∀ {l₁ l₂}, forall₂ R l₁ l₂ → length l₁ = length l₂
| _ _ forall₂.nil          := rfl
| _ _ (forall₂.cons h₁ h₂) := congr_arg succ (forall₂.length_eq h₂)

lemma forall₂_of_length_eq_of_nth_le : ∀ {x : list α} {y : list β},
  x.length = y.length → (∀ i h₁ h₂, R (x.nth_le i h₁) (y.nth_le i h₂)) → forall₂ R x y
| []         []         hl h := forall₂.nil
| (a₁ :: l₁) (a₂ :: l₂) hl h := forall₂.cons
    (h 0 (nat.zero_lt_succ _) (nat.zero_lt_succ _))
    (forall₂_of_length_eq_of_nth_le (succ.inj hl) (
      λ i h₁ h₂, h i.succ (succ_lt_succ h₁) (succ_lt_succ h₂)))

theorem forall₂_iff_nth_le {l₁ : list α} {l₂ : list β} :
  forall₂ R l₁ l₂ ↔ l₁.length = l₂.length ∧ ∀ i h₁ h₂, R (l₁.nth_le i h₁) (l₂.nth_le i h₂) :=
⟨λ h, ⟨h.length_eq, h.nth_le⟩, and.rec forall₂_of_length_eq_of_nth_le⟩

theorem forall₂_zip :
  ∀ {l₁ l₂}, forall₂ R l₁ l₂ → ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b
| _ _ (forall₂.cons h₁ h₂) x y (or.inl rfl) := h₁
| _ _ (forall₂.cons h₁ h₂) x y (or.inr h₃) := forall₂_zip h₂ h₃

theorem forall₂_iff_zip {l₁ l₂} : forall₂ R l₁ l₂ ↔
  length l₁ = length l₂ ∧ ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b :=
⟨λ h, ⟨forall₂.length_eq h, @forall₂_zip _ _ _ _ _ h⟩,
 λ h, begin
  cases h with h₁ h₂,
  induction l₁ with a l₁ IH generalizing l₂,
  { cases length_eq_zero.1 h₁.symm, constructor },
  { cases l₂ with b l₂; injection h₁ with h₁,
    exact forall₂.cons (h₂ $ or.inl rfl) (IH h₁ $ λ a b h, h₂ $ or.inr h) }
end⟩

theorem forall₂_take :
  ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (take n l₁) (take n l₂)
| 0 _ _ _ := by simp only [forall₂.nil, take]
| (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, take]
| (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_take n]

theorem forall₂_drop :
  ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (drop n l₁) (drop n l₂)
| 0 _ _ h := by simp only [drop, h]
| (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, drop]
| (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_drop n]

theorem forall₂_take_append (l : list α) (l₁ : list β) (l₂ : list β)
  (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.take (length l₁) l) l₁ :=
have h': forall₂ R (take (length l₁) l) (take (length l₁) (l₁ ++ l₂)),
from forall₂_take (length l₁) h,
by rwa [take_left] at h'

theorem forall₂_drop_append (l : list α) (l₁ : list β) (l₂ : list β)
  (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.drop (length l₁) l) l₂ :=
have h': forall₂ R (drop (length l₁) l) (drop (length l₁) (l₁ ++ l₂)),
from forall₂_drop (length l₁) h,
by rwa [drop_left] at h'

lemma rel_mem (hr : bi_unique R) : (R ⇒ forall₂ R ⇒ iff) (∈) (∈)
| a b h [] [] forall₂.nil := by simp only [not_mem_nil]
| a b h (a' :: as) (b' :: bs) (forall₂.cons h₁ h₂) := rel_or (rel_eq hr h h₁) (rel_mem h h₂)

lemma rel_map : ((R ⇒ P) ⇒ forall₂ R ⇒ forall₂ P) map map
| f g h [] [] forall₂.nil := forall₂.nil
| f g h (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons (h h₁) (rel_map @h h₂)

lemma rel_append : (forall₂ R ⇒ forall₂ R ⇒ forall₂ R) append append
| [] [] h l₁ l₂ hl := hl
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) l₁ l₂ hl := forall₂.cons h₁ (rel_append h₂ hl)

lemma rel_reverse : (forall₂ R ⇒ forall₂ R) reverse reverse
| [] [] forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := begin
  simp only [reverse_cons],
  exact rel_append (rel_reverse h₂) (forall₂.cons h₁ forall₂.nil)
end

@[simp]
lemma forall₂_reverse_iff {l₁ l₂} : forall₂ R (reverse l₁) (reverse l₂) ↔ forall₂ R l₁ l₂ :=
iff.intro
  (λ h, by { rw [← reverse_reverse l₁, ← reverse_reverse l₂], exact rel_reverse h })
  (λ h, rel_reverse h)

lemma rel_join : (forall₂ (forall₂ R) ⇒ forall₂ R) join join
| [] [] forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := rel_append h₁ (rel_join h₂)

lemma rel_bind : (forall₂ R ⇒ (R ⇒ forall₂ P) ⇒ forall₂ P) list.bind list.bind :=
λ a b h₁ f g h₂, rel_join (rel_map @h₂ h₁)

lemma rel_foldl : ((P ⇒ R ⇒ P) ⇒ P ⇒ forall₂ R ⇒ P) foldl foldl
| f g hfg _ _ h _ _ forall₂.nil := h
| f g hfg x y hxy _ _ (forall₂.cons hab hs) := rel_foldl @hfg (hfg hxy hab) hs

lemma rel_foldr : ((R ⇒ P ⇒ P) ⇒ P ⇒ forall₂ R ⇒ P) foldr foldr
| f g hfg _ _ h _ _ forall₂.nil := h
| f g hfg x y hxy _ _ (forall₂.cons hab hs) := hfg hab (rel_foldr @hfg hxy hs)

lemma rel_filter {p : α → Prop} {q : β → Prop} [decidable_pred p] [decidable_pred q]
  (hpq : (R ⇒ (↔)) p q) :
  (forall₂ R ⇒ forall₂ R) (filter p) (filter q)
| _ _ forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) :=
  begin
    by_cases p a,
    { have : q b, { rwa [← hpq h₁] },
      simp only [filter_cons_of_pos _ h, filter_cons_of_pos _ this, forall₂_cons, h₁, rel_filter h₂,
        and_true], },
    { have : ¬ q b, { rwa [← hpq h₁] },
      simp only [filter_cons_of_neg _ h, filter_cons_of_neg _ this, rel_filter h₂], },
  end

lemma rel_filter_map : ((R ⇒ option.rel P) ⇒ forall₂ R ⇒ forall₂ P) filter_map filter_map
| f g hfg _ _ forall₂.nil := forall₂.nil
| f g hfg (a :: as) (b :: bs) (forall₂.cons h₁ h₂) :=
  by rw [filter_map_cons, filter_map_cons];
  from match f a, g b, hfg h₁ with
  | _, _, option.rel.none := rel_filter_map @hfg h₂
  | _, _, option.rel.some h := forall₂.cons h (rel_filter_map @hfg h₂)
  end

@[to_additive]
lemma rel_prod [monoid α] [monoid β]
  (h : R 1 1) (hf : (R ⇒ R ⇒ R) (*) (*)) : (forall₂ R ⇒ R) prod prod :=
rel_foldl hf h

/-- Given a relation `R`, `sublist_forall₂ r l₁ l₂` indicates that there is a sublist of `l₂` such
  that `forall₂ r l₁ l₂`. -/
inductive sublist_forall₂ (R : α → β → Prop) : list α → list β → Prop
| nil {l} : sublist_forall₂ [] l
| cons {a₁ a₂ l₁ l₂} : R a₁ a₂ → sublist_forall₂ l₁ l₂ →
  sublist_forall₂ (a₁ :: l₁) (a₂ :: l₂)
| cons_right {a l₁ l₂} : sublist_forall₂ l₁ l₂ → sublist_forall₂ l₁ (a :: l₂)

lemma sublist_forall₂_iff {l₁ : list α} {l₂ : list β} :
  sublist_forall₂ R l₁ l₂ ↔ ∃ l, forall₂ R l₁ l ∧ l <+ l₂ :=
begin
  split; intro h,
  { induction h with _ a b l1 l2 rab rll ih b l1 l2 hl ih,
    { exact ⟨nil, forall₂.nil, nil_sublist _⟩ },
    { obtain ⟨l, hl1, hl2⟩ := ih,
      refine ⟨b :: l, forall₂.cons rab hl1, hl2.cons_cons b⟩ },
    { obtain ⟨l, hl1, hl2⟩ := ih,
      exact ⟨l, hl1, hl2.trans (sublist.cons _ _ _ (sublist.refl _))⟩ } },
  { obtain ⟨l, hl1, hl2⟩ := h,
    revert l₁,
    induction hl2 with _ _ _ _ ih _ _ _ _ ih; intros l₁ hl1,
    { rw [forall₂_nil_right_iff.1 hl1],
      exact sublist_forall₂.nil },
    { exact sublist_forall₂.cons_right (ih hl1) },
    { cases hl1 with _ _ _ _ hr hl _,
      exact sublist_forall₂.cons hr (ih hl) } }
end

instance sublist_forall₂.is_refl [is_refl α Rₐ] :
  is_refl (list α) (sublist_forall₂ Rₐ) :=
⟨λ l, sublist_forall₂_iff.2 ⟨l, forall₂_refl l, sublist.refl l⟩⟩

instance sublist_forall₂.is_trans [is_trans α Rₐ] :
  is_trans (list α) (sublist_forall₂ Rₐ) :=
⟨λ a b c, begin
  revert a b,
  induction c with _ _ ih,
  { rintros _ _ h1 (_ | _ | _),
    exact h1 },
  { rintros a b h1 h2,
    cases h2 with _ _ _ _ _ hbc tbc _ _ y1 btc,
    { cases h1,
      exact sublist_forall₂.nil },
    { cases h1 with _ _ _ _ _ hab tab _ _ _ atb,
      { exact sublist_forall₂.nil },
      { exact sublist_forall₂.cons (trans hab hbc) (ih _ _ tab tbc) },
      { exact sublist_forall₂.cons_right (ih _ _ atb tbc) } },
    { exact sublist_forall₂.cons_right (ih _ _ h1 btc), } }
end⟩

lemma sublist.sublist_forall₂ {l₁ l₂ : list α} (h : l₁ <+ l₂) [is_refl α Rₐ] :
  sublist_forall₂ Rₐ l₁ l₂ :=
sublist_forall₂_iff.2 ⟨l₁, forall₂_refl l₁, h⟩

lemma tail_sublist_forall₂_self [is_refl α Rₐ] (l : list α) :
  sublist_forall₂ Rₐ l.tail l :=
l.tail_sublist.sublist_forall₂

end list


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import data.nat.choose.sum
import algebra.algebra.bilinear
import ring_theory.ideal.operations

/-!
# Nilpotent elements

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

## Main definitions

  * `is_nilpotent`
  * `is_nilpotent_neg_iff`
  * `commute.is_nilpotent_add`
  * `commute.is_nilpotent_mul_left`
  * `commute.is_nilpotent_mul_right`
  * `commute.is_nilpotent_sub`

-/

universes u v

variables {R S : Type u} {x y : R}

/-- An element is said to be nilpotent if some natural-number-power of it equals zero.

Note that we require only the bare minimum assumptions for the definition to make sense. Even
`monoid_with_zero` is too strong since nilpotency is important in the study of rings that are only
power-associative. -/
def is_nilpotent [has_zero R] [has_pow R ℕ] (x : R) : Prop := ∃ (n : ℕ), x^n = 0

lemma is_nilpotent.mk [has_zero R] [has_pow R ℕ] (x : R) (n : ℕ)
  (e : x ^ n = 0) : is_nilpotent x := ⟨n, e⟩

lemma is_nilpotent.zero [monoid_with_zero R] : is_nilpotent (0 : R) := ⟨1, pow_one 0⟩

lemma is_nilpotent.neg [ring R] (h : is_nilpotent x) : is_nilpotent (-x) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  rw [neg_pow, hn, mul_zero],
end

@[simp] lemma is_nilpotent_neg_iff [ring R] : is_nilpotent (-x) ↔ is_nilpotent x :=
⟨λ h, neg_neg x ▸ h.neg, λ h, h.neg⟩

lemma is_nilpotent.map [monoid_with_zero R] [monoid_with_zero S] {r : R}
  {F : Type*} [monoid_with_zero_hom_class F R S] (hr : is_nilpotent r) (f : F) :
    is_nilpotent (f r) :=
by { use hr.some, rw [← map_pow, hr.some_spec, map_zero] }

/-- A structure that has zero and pow is reduced if it has no nonzero nilpotent elements. -/
@[mk_iff] class is_reduced (R : Type*) [has_zero R] [has_pow R ℕ] : Prop :=
(eq_zero : ∀ (x : R), is_nilpotent x → x = 0)

@[priority 900]
instance is_reduced_of_no_zero_divisors [monoid_with_zero R] [no_zero_divisors R] : is_reduced R :=
⟨λ _ ⟨_, hn⟩, pow_eq_zero hn⟩

@[priority 900]
instance is_reduced_of_subsingleton [has_zero R] [has_pow R ℕ] [subsingleton R] :
  is_reduced R := ⟨λ _ _, subsingleton.elim _ _⟩

lemma is_nilpotent.eq_zero [has_zero R] [has_pow R ℕ] [is_reduced R]
  (h : is_nilpotent x) : x = 0 :=
is_reduced.eq_zero x h

@[simp] lemma is_nilpotent_iff_eq_zero [monoid_with_zero R] [is_reduced R] :
  is_nilpotent x ↔ x = 0 :=
⟨λ h, h.eq_zero, λ h, h.symm ▸ is_nilpotent.zero⟩

lemma is_reduced_of_injective [monoid_with_zero R] [monoid_with_zero S]
  {F : Type*} [monoid_with_zero_hom_class F R S] (f : F)
  (hf : function.injective f) [_root_.is_reduced S] : _root_.is_reduced R :=
begin
  constructor,
  intros x hx,
  apply hf,
  rw map_zero,
  exact (hx.map f).eq_zero,
end

lemma ring_hom.ker_is_radical_iff_reduced_of_surjective {S F} [comm_semiring R] [comm_ring S]
  [ring_hom_class F R S] {f : F} (hf : function.surjective f) :
  (ring_hom.ker f).is_radical ↔ is_reduced S :=
by simp_rw [is_reduced_iff, hf.forall, is_nilpotent, ← map_pow, ← ring_hom.mem_ker]; refl

/-- An element `y` in a monoid is radical if for any element `x`, `y` divides `x` whenever it
  divides a power of `x`. -/
def is_radical [has_dvd R] [has_pow R ℕ] (y : R) : Prop := ∀ (n : ℕ) x, y ∣ x ^ n → y ∣ x

lemma zero_is_radical_iff [monoid_with_zero R] : is_radical (0 : R) ↔ is_reduced R :=
by { simp_rw [is_reduced_iff, is_nilpotent, exists_imp_distrib, ← zero_dvd_iff], exact forall_swap }

lemma is_radical_iff_span_singleton [comm_semiring R] :
  is_radical y ↔ (ideal.span ({y} : set R)).is_radical :=
begin
  simp_rw [is_radical, ← ideal.mem_span_singleton],
  exact forall_swap.trans (forall_congr $ λ r, exists_imp_distrib.symm),
end

lemma is_radical_iff_pow_one_lt [monoid_with_zero R] (k : ℕ) (hk : 1 < k) :
  is_radical y ↔ ∀ x, y ∣ x ^ k → y ∣ x :=
⟨λ h x, h k x, λ h, k.cauchy_induction_mul
  (λ n h x hd, h x $ (pow_succ' x n).symm ▸ hd.mul_right x) 0 hk
  (λ x hd, pow_one x ▸ hd) (λ n _ hn x hd, h x $ hn _ $ (pow_mul x k n).subst hd)⟩

lemma is_reduced_iff_pow_one_lt [monoid_with_zero R] (k : ℕ) (hk : 1 < k) :
  is_reduced R ↔ ∀ x : R, x ^ k = 0 → x = 0 :=
by simp_rw [← zero_is_radical_iff, is_radical_iff_pow_one_lt k hk, zero_dvd_iff]

namespace commute

section semiring

variables [semiring R] (h_comm : commute x y)

include h_comm

lemma is_nilpotent_mul_left (h : is_nilpotent x) : is_nilpotent (x * y) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  rw [h_comm.mul_pow, hn, zero_mul],
end

lemma is_nilpotent_mul_right (h : is_nilpotent y) : is_nilpotent (x * y) :=
by { rw h_comm.eq, exact h_comm.symm.is_nilpotent_mul_left h, }

end semiring

section ring

variables [ring R] (h_comm : commute x y)

include h_comm

lemma is_nilpotent_sub (hx : is_nilpotent x) (hy : is_nilpotent y) : is_nilpotent (x - y) :=
begin
  rw ← neg_right_iff at h_comm,
  rw ← is_nilpotent_neg_iff at hy,
  rw sub_eq_add_neg,
  exact h_comm.is_nilpotent_add hx hy,
end

end ring

end commute

section comm_semiring

variable [comm_semiring R]

/-- The nilradical of a commutative semiring is the ideal of nilpotent elements. -/
def nilradical (R : Type*) [comm_semiring R] : ideal R := (0 : ideal R).radical

lemma mem_nilradical : x ∈ nilradical R ↔ is_nilpotent x := iff.rfl

lemma nilradical_eq_Inf (R : Type*) [comm_semiring R] :
  nilradical R = Inf { J : ideal R | J.is_prime } :=
(ideal.radical_eq_Inf ⊥).trans $ by simp_rw and_iff_right bot_le

lemma nilpotent_iff_mem_prime : is_nilpotent x ↔ ∀ (J : ideal R), J.is_prime → x ∈ J :=
by { rw [← mem_nilradical, nilradical_eq_Inf, submodule.mem_Inf], refl }

lemma nilradical_le_prime (J : ideal R) [H : J.is_prime] : nilradical R ≤ J :=
(nilradical_eq_Inf R).symm ▸ Inf_le H

@[simp] lemma nilradical_eq_zero (R : Type*) [comm_semiring R] [is_reduced R] : nilradical R = 0 :=
ideal.ext $ λ _, is_nilpotent_iff_eq_zero

end comm_semiring

namespace linear_map

variables (R) {A : Type v} [comm_semiring R] [semiring A] [algebra R A]

@[simp] lemma is_nilpotent_mul_left_iff (a : A) :
  is_nilpotent (mul_left R a) ↔ is_nilpotent a :=
begin
  split; rintros ⟨n, hn⟩; use n;
  simp only [mul_left_eq_zero_iff, pow_mul_left] at ⊢ hn;
  exact hn,
end

@[simp] lemma is_nilpotent_mul_right_iff (a : A) :
  is_nilpotent (mul_right R a) ↔ is_nilpotent a :=
begin
  split; rintros ⟨n, hn⟩; use n;
  simp only [mul_right_eq_zero_iff, pow_mul_right] at ⊢ hn;
  exact hn,
end

end linear_map

namespace module.End

variables {M : Type v} [ring R] [add_comm_group M] [module R M]
variables {f : module.End R M} {p : submodule R M} (hp : p ≤ p.comap f)

lemma is_nilpotent.mapq (hnp : is_nilpotent f) : is_nilpotent (p.mapq p f hp) :=
begin
  obtain ⟨k, hk⟩ := hnp,
  use k,
  simp [← p.mapq_pow, hk],
end

end module.End


/-
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, Mario Carneiro
-/
import algebra.big_operators.basic
import algebra.smul_with_zero
import group_theory.group_action.group
import tactic.norm_num

/-!
# Modules over a ring

In this file we define

* `module R M` : an additive commutative monoid `M` is a `module` over a
  `semiring R` if for `r : R` and `x : M` their "scalar multiplication `r • x : M` is defined, and
  the operation `•` satisfies some natural associativity and distributivity axioms similar to those
  on a ring.

## Implementation notes

In typical mathematical usage, our definition of `module` corresponds to "semimodule", and the
word "module" is reserved for `module R M` where `R` is a `ring` and `M` an `add_comm_group`.
If `R` is a `field` and `M` an `add_comm_group`, `M` would be called an `R`-vector space.
Since those assumptions can be made by changing the typeclasses applied to `R` and `M`,
without changing the axioms in `module`, mathlib calls everything a `module`.

In older versions of mathlib, we had separate `semimodule` and `vector_space` abbreviations.
This caused inference issues in some cases, while not providing any real advantages, so we decided
to use a canonical `module` typeclass throughout.

## Tags

semimodule, module, vector space
-/

open function
open_locale big_operators

universes u u' v w x y z
variables {R : Type u} {k : Type u'} {S : Type v} {M : Type w} {M₂ : Type x} {M₃ : Type y}
  {ι : Type z}

/-- A module is a generalization of vector spaces to a scalar semiring.
  It consists of a scalar semiring `R` and an additive monoid of "vectors" `M`,
  connected by a "scalar multiplication" operation `r • x : M`
  (where `r : R` and `x : M`) with some natural associativity and
  distributivity axioms similar to those on a ring. -/
@[protect_proj] class module (R : Type u) (M : Type v) [semiring R]
  [add_comm_monoid M] extends distrib_mul_action R M :=
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(zero_smul : ∀x : M, (0 : R) • x = 0)

section add_comm_monoid
variables [semiring R] [add_comm_monoid M] [module R M] (r s : R) (x y : M)

/-- A module over a semiring automatically inherits a `mul_action_with_zero` structure. -/
@[priority 100] -- see Note [lower instance priority]
instance module.to_mul_action_with_zero :
  mul_action_with_zero R M :=
{ smul_zero := smul_zero,
  zero_smul := module.zero_smul,
  ..(infer_instance : mul_action R M) }

instance add_comm_monoid.nat_module : module ℕ M :=
{ one_smul := one_nsmul,
  mul_smul := λ m n a, mul_nsmul a m n,
  smul_add := λ n a b, nsmul_add a b n,
  smul_zero := nsmul_zero,
  zero_smul := zero_nsmul,
  add_smul := λ r s x, add_nsmul x r s }

theorem add_smul : (r + s) • x = r • x + s • x := module.add_smul r s x
variables (R)

theorem two_smul : (2 : R) • x = x + x := by rw [bit0, add_smul, one_smul]

theorem two_smul' : (2 : R) • x = bit0 x := two_smul R x

/-- Pullback a `module` structure along an injective additive monoid homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M₂ →+ M)
  (hf : injective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) :
  module R M₂ :=
{ smul := (•),
  add_smul := λ c₁ c₂ x, hf $ by simp only [smul, f.map_add, add_smul],
  zero_smul := λ x, hf $ by simp only [smul, zero_smul, f.map_zero],
  .. hf.distrib_mul_action f smul }

/-- Pushforward a `module` structure along a surjective additive monoid homomorphism. -/
protected def function.surjective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M →+ M₂)
  (hf : surjective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) :
  module R M₂ :=
{ smul := (•),
  add_smul := λ c₁ c₂ x, by { rcases hf x with ⟨x, rfl⟩,
    simp only [add_smul, ← smul, ← f.map_add] },
  zero_smul := λ x, by { rcases hf x with ⟨x, rfl⟩, simp only [← f.map_zero, ← smul, zero_smul] },
  .. hf.distrib_mul_action f smul }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →+* S`.

See also `function.surjective.mul_action_left` and `function.surjective.distrib_mul_action_left`.
-/
@[reducible]
def function.surjective.module_left {R S M : Type*} [semiring R] [add_comm_monoid M]
  [module R M] [semiring S] [has_scalar S M]
  (f : R →+* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  module S M :=
{ smul := (•),
  zero_smul := λ x, by rw [← f.map_zero, hsmul, zero_smul],
  add_smul := hf.forall₂.mpr (λ a b x, by simp only [← f.map_add, hsmul, add_smul]),
  .. hf.distrib_mul_action_left f.to_monoid_hom hsmul }

variables {R} (M)

/-- Compose a `module` with a `ring_hom`, with action `f s • m`.

See note [reducible non-instances]. -/
@[reducible] def module.comp_hom [semiring S] (f : S →+* R) :
  module S M :=
{ smul := has_scalar.comp.smul f,
  add_smul := λ r s x, by simp [add_smul],
  .. mul_action_with_zero.comp_hom M f.to_monoid_with_zero_hom,
  .. distrib_mul_action.comp_hom M (f : S →* R) }

variables (R) (M)

/-- `(•)` as an `add_monoid_hom`.

This is a stronger version of `distrib_mul_action.to_add_monoid_End` -/
@[simps apply_apply]
def module.to_add_monoid_End : R →+* add_monoid.End M :=
{ map_zero' := add_monoid_hom.ext $ λ r, by simp,
  map_add' := λ x y, add_monoid_hom.ext $ λ r, by simp [add_smul],
  ..distrib_mul_action.to_add_monoid_End R M }

/-- A convenience alias for `module.to_add_monoid_End` as an `add_monoid_hom`, usually to allow the
use of `add_monoid_hom.flip`. -/
def smul_add_hom : R →+ M →+ M :=
(module.to_add_monoid_End R M).to_add_monoid_hom

variables {R M}

@[simp] lemma smul_add_hom_apply (r : R) (x : M) :
  smul_add_hom R M r x = r • x := rfl

lemma module.eq_zero_of_zero_eq_one (zero_eq_one : (0 : R) = 1) : x = 0 :=
by rw [←one_smul R x, ←zero_eq_one, zero_smul]

lemma list.sum_smul {l : list R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum :=
((smul_add_hom R M).flip x).map_list_sum l

lemma multiset.sum_smul {l : multiset R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum :=
((smul_add_hom R M).flip x).map_multiset_sum l

lemma finset.sum_smul {f : ι → R} {s : finset ι} {x : M} :
  (∑ i in s, f i) • x = (∑ i in s, (f i) • x) :=
((smul_add_hom R M).flip x).map_sum f s

end add_comm_monoid

variables (R)

/-- An `add_comm_monoid` that is a `module` over a `ring` carries a natural `add_comm_group`
structure.
See note [reducible non-instances]. -/
@[reducible]
def module.add_comm_monoid_to_add_comm_group [ring R] [add_comm_monoid M] [module R M] :
  add_comm_group M :=
{ neg          := λ a, (-1 : R) • a,
  add_left_neg := λ a, show (-1 : R) • a + a = 0, by
  { nth_rewrite 1 ← one_smul _ a,
    rw [← add_smul, add_left_neg, zero_smul] },
  ..(infer_instance : add_comm_monoid M), }

variables {R}

section add_comm_group

variables (R M) [semiring R] [add_comm_group M]

instance add_comm_group.int_module : module ℤ M :=
{ one_smul := one_zsmul,
  mul_smul := λ m n a, mul_zsmul a m n,
  smul_add := λ n a b, zsmul_add a b n,
  smul_zero := zsmul_zero,
  zero_smul := zero_zsmul,
  add_smul := λ r s x, add_zsmul x r s }

/-- A structure containing most informations as in a module, except the fields `zero_smul`
and `smul_zero`. As these fields can be deduced from the other ones when `M` is an `add_comm_group`,
this provides a way to construct a module structure by checking less properties, in
`module.of_core`. -/
@[nolint has_inhabited_instance]
structure module.core extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀(r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀x : M, (1 : R) • x = x)

variables {R M}

/-- Define `module` without proving `zero_smul` and `smul_zero` by using an auxiliary
structure `module.core`, when the underlying space is an `add_comm_group`. -/
def module.of_core (H : module.core R M) : module R M :=
by letI := H.to_has_scalar; exact
{ zero_smul := λ x, (add_monoid_hom.mk' (λ r : R, r • x) (λ r s, H.add_smul r s x)).map_zero,
  smul_zero := λ r, (add_monoid_hom.mk' ((•) r) (H.smul_add r)).map_zero,
  ..H }

end add_comm_group

/--
To prove two module structures on a fixed `add_comm_monoid` agree,
it suffices to check the scalar multiplications agree.
-/
-- We'll later use this to show `module ℕ M` and `module ℤ M` are subsingletons.
@[ext]
lemma module_ext {R : Type*} [semiring R] {M : Type*} [add_comm_monoid M] (P Q : module R M)
  (w : ∀ (r : R) (m : M), by { haveI := P, exact r • m } = by { haveI := Q, exact r • m }) :
  P = Q :=
begin
  unfreezingI { rcases P with ⟨⟨⟨⟨P⟩⟩⟩⟩, rcases Q with ⟨⟨⟨⟨Q⟩⟩⟩⟩ },
  obtain rfl : P = Q, by { funext r m, exact w r m },
  congr
end

section module
variables [ring R] [add_comm_group M] [module R M] (r s : R) (x y : M)

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

@[simp] lemma neg_smul_neg : -r • -x = r • x :=
by rw [neg_smul, smul_neg, neg_neg]

@[simp] theorem units.neg_smul (u : units R) (x : M) : -u • x = - (u • x) :=
by rw [units.smul_def, units.coe_neg, neg_smul, units.smul_def]

variables (R)
theorem neg_one_smul (x : M) : (-1 : R) • x = -x := by simp
variables {R}

theorem sub_smul (r s : R) (y : M) : (r - s) • y = r • y - s • y :=
by simp [add_smul, sub_eq_add_neg]

end module

/-- A module over a `subsingleton` semiring is a `subsingleton`. We cannot register this
as an instance because Lean has no way to guess `R`. -/
protected
theorem module.subsingleton (R M : Type*) [semiring R] [subsingleton R] [add_comm_monoid M]
  [module R M] :
  subsingleton M :=
⟨λ x y, by rw [← one_smul R x, ← one_smul R y, subsingleton.elim (1:R) 0, zero_smul, zero_smul]⟩

@[priority 910] -- see Note [lower instance priority]
instance semiring.to_module [semiring R] : module R R :=
{ smul_add := mul_add,
  add_smul := add_mul,
  zero_smul := zero_mul,
  smul_zero := mul_zero }

/-- Like `semiring.to_module`, but multiplies on the right. -/
@[priority 910] -- see Note [lower instance priority]
instance semiring.to_opposite_module [semiring R] : module Rᵐᵒᵖ R :=
{ smul_add := λ r x y, add_mul _ _ _,
  add_smul := λ r x y, mul_add _ _ _,
  ..monoid_with_zero.to_opposite_mul_action_with_zero R}

/-- A ring homomorphism `f : R →+* M` defines a module structure by `r • x = f r * x`. -/
def ring_hom.to_module [semiring R] [semiring S] (f : R →+* S) : module R S :=
module.comp_hom S f

/-- The tautological action by `R →+* R` on `R`.

This generalizes `function.End.apply_mul_action`. -/
instance ring_hom.apply_distrib_mul_action [semiring R] : distrib_mul_action (R →+* R) R :=
{ smul := ($),
  smul_zero := ring_hom.map_zero,
  smul_add := ring_hom.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma ring_hom.smul_def [semiring R] (f : R →+* R) (a : R) :
  f • a = f a := rfl

/-- `ring_hom.apply_distrib_mul_action` is faithful. -/
instance ring_hom.apply_has_faithful_scalar [semiring R] : has_faithful_scalar (R →+* R) R :=
⟨ring_hom.ext⟩

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]

section
variables (R)
/-- `nsmul` is equal to any other module structure via a cast. -/
lemma nsmul_eq_smul_cast (n : ℕ) (b : M) :
  n • b = (n : R) • b :=
begin
  induction n with n ih,
  { rw [nat.cast_zero, zero_smul, zero_smul] },
  { rw [nat.succ_eq_add_one, nat.cast_succ, add_smul, add_smul, one_smul, ih, one_smul], }
end
end

/-- Convert back any exotic `ℕ`-smul to the canonical instance. This should not be needed since in
mathlib all `add_comm_monoid`s should normally have exactly one `ℕ`-module structure by design.
-/
lemma nat_smul_eq_nsmul (h : module ℕ M) (n : ℕ) (x : M) :
  @has_scalar.smul ℕ M h.to_has_scalar n x = n • x :=
by rw [nsmul_eq_smul_cast ℕ n x, nat.cast_id]

/-- All `ℕ`-module structures are equal. Not an instance since in mathlib all `add_comm_monoid`
should normally have exactly one `ℕ`-module structure by design. -/
def add_comm_monoid.nat_module.unique : unique (module ℕ M) :=
{ default := by apply_instance,
  uniq := λ P, module_ext P _ $ λ n, nat_smul_eq_nsmul P n }

instance add_comm_monoid.nat_is_scalar_tower :
  is_scalar_tower ℕ R M :=
{ smul_assoc := λ n x y, nat.rec_on n
    (by simp only [zero_smul])
    (λ n ih, by simp only [nat.succ_eq_add_one, add_smul, one_smul, ih]) }

instance add_comm_monoid.nat_smul_comm_class : smul_comm_class ℕ R M :=
{ smul_comm := λ n r m, nat.rec_on n
    (by simp only [zero_smul, smul_zero])
    (λ n ih, by simp only [nat.succ_eq_add_one, add_smul, one_smul, ←ih, smul_add]) }

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop
instance add_comm_monoid.nat_smul_comm_class' : smul_comm_class R ℕ M :=
smul_comm_class.symm _ _ _

end add_comm_monoid

section add_comm_group

variables [semiring S] [ring R] [add_comm_group M] [module S M] [module R M]

section
variables (R)
/-- `zsmul` is equal to any other module structure via a cast. -/
lemma zsmul_eq_smul_cast (n : ℤ) (b : M) : n • b = (n : R) • b :=
have (smul_add_hom ℤ M).flip b = ((smul_add_hom R M).flip b).comp (int.cast_add_hom R),
  by { ext, simp },
add_monoid_hom.congr_fun this n
end

/-- Convert back any exotic `ℤ`-smul to the canonical instance. This should not be needed since in
mathlib all `add_comm_group`s should normally have exactly one `ℤ`-module structure by design. -/
lemma int_smul_eq_zsmul (h : module ℤ M) (n : ℤ) (x : M) :
  @has_scalar.smul ℤ M h.to_has_scalar n x = n • x :=
by rw [zsmul_eq_smul_cast ℤ n x, int.cast_id]

/-- All `ℤ`-module structures are equal. Not an instance since in mathlib all `add_comm_group`
should normally have exactly one `ℤ`-module structure by design. -/
def add_comm_group.int_module.unique : unique (module ℤ M) :=
{ default := by apply_instance,
  uniq := λ P, module_ext P _ $ λ n, int_smul_eq_zsmul P n }

end add_comm_group

namespace add_monoid_hom

lemma map_nat_module_smul [add_comm_monoid M] [add_comm_monoid M₂]
  (f : M →+ M₂) (x : ℕ) (a : M) : f (x • a) = x • f a :=
f.map_nsmul a x

lemma map_int_module_smul [add_comm_group M] [add_comm_group M₂]
  (f : M →+ M₂) (x : ℤ) (a : M) : f (x • a) = x • f a :=
f.map_zsmul a x

lemma map_int_cast_smul [add_comm_group M] [add_comm_group M₂]
  (f : M →+ M₂) (R S : Type*) [ring R] [ring S] [module R M] [module S M₂]
  (x : ℤ) (a : M) : f ((x : R) • a) = (x : S) • f a :=
by simp only [←zsmul_eq_smul_cast, f.map_zsmul]

lemma map_nat_cast_smul [add_comm_monoid M] [add_comm_monoid M₂] (f : M →+ M₂)
  (R S : Type*) [semiring R] [semiring S] [module R M] [module S M₂] (x : ℕ) (a : M) :
  f ((x : R) • a) = (x : S) • f a :=
by simp only [←nsmul_eq_smul_cast, f.map_nsmul]

lemma map_inv_int_cast_smul {E F : Type*} [add_comm_group E] [add_comm_group F] (f : E →+ F)
  (R S : Type*) [division_ring R] [division_ring S] [module R E] [module S F]
  (n : ℤ) (x : E) :
  f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x :=
begin
  by_cases hR : (n : R) = 0; by_cases hS : (n : S) = 0,
  { simp [hR, hS] },
  { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x,
    rw [← inv_smul_smul₀ hS (f x), ← map_int_cast_smul f R S], simp [hR] },
  { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x,
    rw [← smul_inv_smul₀ hR x, map_int_cast_smul f R S, hS, zero_smul] },
  { rw [← inv_smul_smul₀ hS (f _), ← map_int_cast_smul f R S, smul_inv_smul₀ hR] }
end

lemma map_inv_nat_cast_smul {E F : Type*} [add_comm_group E] [add_comm_group F] (f : E →+ F)
  (R S : Type*) [division_ring R] [division_ring S] [module R E] [module S F]
  (n : ℕ) (x : E) :
  f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x :=
f.map_inv_int_cast_smul R S n x

lemma map_rat_cast_smul {E F : Type*} [add_comm_group E] [add_comm_group F] (f : E →+ F)
  (R S : Type*) [division_ring R] [division_ring S] [module R E] [module S F]
  (c : ℚ) (x : E) :
  f ((c : R) • x) = (c : S) • f x :=
by rw [rat.cast_def, rat.cast_def, div_eq_mul_inv, div_eq_mul_inv, mul_smul, mul_smul,
  map_int_cast_smul f R S, map_inv_nat_cast_smul f R S]

lemma map_rat_module_smul {E : Type*} [add_comm_group E] [module ℚ E]
  {F : Type*} [add_comm_group F] [module ℚ F] (f : E →+ F) (c : ℚ) (x : E) :
  f (c • x) = c • f x :=
rat.cast_id c ▸ f.map_rat_cast_smul ℚ ℚ c x

end add_monoid_hom

/-- There can be at most one `module ℚ E` structure on an additive commutative group. This is not
an instance because `simp` becomes very slow if we have many `subsingleton` instances,
see [gh-6025]. -/
lemma subsingleton_rat_module (E : Type*) [add_comm_group E] : subsingleton (module ℚ E) :=
⟨λ P Q, module_ext P Q $ λ r x,
  @add_monoid_hom.map_rat_module_smul E ‹_› P E ‹_› Q (add_monoid_hom.id _) r x⟩

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on inverses of integer numbers in `R` and `S`. -/
lemma inv_int_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (n : ℤ) (x : E) :
  (n⁻¹ : R) • x = (n⁻¹ : S) • x :=
(add_monoid_hom.id E).map_inv_int_cast_smul R S n x

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on inverses of natural numbers in `R` and `S`. -/
lemma inv_nat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (n : ℕ) (x : E) :
  (n⁻¹ : R) • x = (n⁻¹ : S) • x :=
(add_monoid_hom.id E).map_inv_nat_cast_smul R S n x

/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications
agree on rational numbers in `R` and `S`. -/
lemma rat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R]
  [division_ring S] [module R E] [module S E] (r : ℚ) (x : E) :
  (r : R) • x = (r : S) • x :=
(add_monoid_hom.id E).map_rat_cast_smul R S r x

instance add_comm_group.int_is_scalar_tower {R : Type u} {M : Type v} [ring R] [add_comm_group M]
  [module R M]: is_scalar_tower ℤ R M :=
{ smul_assoc := λ n x y, ((smul_add_hom R M).flip y).map_int_module_smul n x }

instance add_comm_group.int_smul_comm_class {S : Type u} {M : Type v} [semiring S]
  [add_comm_group M] [module S M] :
  smul_comm_class ℤ S M :=
{ smul_comm := λ n x y, ((smul_add_hom S M x).map_zsmul y n).symm }

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop
instance add_comm_group.int_smul_comm_class' {S : Type u} {M : Type v} [semiring S]
  [add_comm_group M] [module S M] : smul_comm_class S ℤ M :=
smul_comm_class.symm _ _ _

instance is_scalar_tower.rat {R : Type u} {M : Type v} [ring R] [add_comm_group M]
  [module R M] [module ℚ R] [module ℚ M] : is_scalar_tower ℚ R M :=
{ smul_assoc := λ r x y, ((smul_add_hom R M).flip y).map_rat_module_smul r x }

instance smul_comm_class.rat {R : Type u} {M : Type v} [semiring R] [add_comm_group M]
  [module R M] [module ℚ M] : smul_comm_class ℚ R M :=
{ smul_comm := λ r x y, ((smul_add_hom R M x).map_rat_module_smul r y).symm }

instance smul_comm_class.rat' {R : Type u} {M : Type v} [semiring R] [add_comm_group M]
  [module R M] [module ℚ M] : smul_comm_class R ℚ M :=
smul_comm_class.symm _ _ _

section no_zero_smul_divisors
/-! ### `no_zero_smul_divisors`

This section defines the `no_zero_smul_divisors` class, and includes some tests
for the vanishing of elements (especially in modules over division rings).
-/

/-- `no_zero_smul_divisors R M` states that a scalar multiple is `0` only if either argument is `0`.
This a version of saying that `M` is torsion free, without assuming `R` is zero-divisor free.

The main application of `no_zero_smul_divisors R M`, when `M` is a module,
is the result `smul_eq_zero`: a scalar multiple is `0` iff either argument is `0`.

It is a generalization of the `no_zero_divisors` class to heterogeneous multiplication.
-/
class no_zero_smul_divisors (R M : Type*) [has_zero R] [has_zero M] [has_scalar R M] : Prop :=
(eq_zero_or_eq_zero_of_smul_eq_zero : ∀ {c : R} {x : M}, c • x = 0 → c = 0 ∨ x = 0)

export no_zero_smul_divisors (eq_zero_or_eq_zero_of_smul_eq_zero)

/-- Pullback a `no_zero_smul_divisors` instance along an injective function. -/
lemma function.injective.no_zero_smul_divisors {R M N : Type*} [has_zero R] [has_zero M]
  [has_zero N] [has_scalar R M] [has_scalar R N] [no_zero_smul_divisors R N] (f : M → N)
  (hf : function.injective f) (h0 : f 0 = 0) (hs : ∀ (c : R) (x : M), f (c • x) = c • f x) :
  no_zero_smul_divisors R M :=
⟨λ c m h,
  or.imp_right (@hf _ _) $ h0.symm ▸ eq_zero_or_eq_zero_of_smul_eq_zero (by rw [←hs, h, h0])⟩

section module

variables [semiring R] [add_comm_monoid M] [module R M]

instance no_zero_smul_divisors.of_no_zero_divisors [no_zero_divisors R] :
  no_zero_smul_divisors R R :=
⟨λ c x, no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero⟩

@[simp]
theorem smul_eq_zero [no_zero_smul_divisors R M] {c : R} {x : M} :
  c • x = 0 ↔ c = 0 ∨ x = 0 :=
⟨eq_zero_or_eq_zero_of_smul_eq_zero,
 λ h, h.elim (λ h, h.symm ▸ zero_smul R x) (λ h, h.symm ▸ smul_zero c)⟩

theorem smul_ne_zero [no_zero_smul_divisors R M] {c : R} {x : M} :
  c • x ≠ 0 ↔ c ≠ 0 ∧ x ≠ 0 :=
by simp only [ne.def, smul_eq_zero, not_or_distrib]

section nat

variables (R) (M) [no_zero_smul_divisors R M] [char_zero R]
include R

lemma nat.no_zero_smul_divisors : no_zero_smul_divisors ℕ M :=
⟨by { intros c x, rw [nsmul_eq_smul_cast R, smul_eq_zero], simp }⟩

variables {M}

lemma eq_zero_of_two_nsmul_eq_zero {v : M} (hv : 2 • v = 0) : v = 0 :=
by haveI := nat.no_zero_smul_divisors R M;
exact (smul_eq_zero.mp hv).resolve_left (by norm_num)

end nat

variables (R M)

/-- If `M` is an `R`-module with one and `M` has characteristic zero, then `R` has characteristic
zero as well. Usually `M` is an `R`-algebra. -/
lemma char_zero.of_module [has_one M] [char_zero M] : char_zero R :=
begin
  refine ⟨λ m n h, @nat.cast_injective M _ _ _ _ _ _⟩,
  rw [← nsmul_one, ← nsmul_one, nsmul_eq_smul_cast R m (1 : M), nsmul_eq_smul_cast R n (1 : M), h]
end

end module

section add_comm_group -- `R` can still be a semiring here

variables [semiring R] [add_comm_group M] [module R M]

section smul_injective

variables (M)

lemma smul_right_injective [no_zero_smul_divisors R M] {c : R} (hc : c ≠ 0) :
  function.injective (λ (x : M), c • x) :=
λ x y h, sub_eq_zero.mp ((smul_eq_zero.mp
  (calc c • (x - y) = c • x - c • y : smul_sub c x y
                ... = 0 : sub_eq_zero.mpr h)).resolve_left hc)

end smul_injective

section nat

variables (R) [no_zero_smul_divisors R M] [char_zero R]
include R

lemma eq_zero_of_eq_neg {v : M} (hv : v = - v) : v = 0 :=
begin
  refine eq_zero_of_two_nsmul_eq_zero R _,
  rw two_smul,
  exact add_eq_zero_iff_eq_neg.mpr hv
end

end nat

end add_comm_group

section module

variables [ring R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]

section smul_injective

variables (R)

lemma smul_left_injective {x : M} (hx : x ≠ 0) :
  function.injective (λ (c : R), c • x) :=
λ c d h, sub_eq_zero.mp ((smul_eq_zero.mp
  (calc (c - d) • x = c • x - d • x : sub_smul c d x
                ... = 0 : sub_eq_zero.mpr h)).resolve_right hx)

end smul_injective

section nat

variables [char_zero R]

lemma ne_neg_of_ne_zero [no_zero_divisors R] {v : R} (hv : v ≠ 0) : v ≠ -v :=
λ h, hv (eq_zero_of_eq_neg R h)

end nat

end module

section division_ring

variables [division_ring R] [add_comm_group M] [module R M]

@[priority 100] -- see note [lower instance priority]
instance no_zero_smul_divisors.of_division_ring : no_zero_smul_divisors R M :=
⟨λ c x h, or_iff_not_imp_left.2 $ λ hc, (smul_eq_zero_iff_eq' hc).1 h⟩

end division_ring

end no_zero_smul_divisors

@[simp] lemma nat.smul_one_eq_coe {R : Type*} [semiring R] (m : ℕ) :
  m • (1 : R) = ↑m :=
by rw [nsmul_eq_mul, mul_one]

@[simp] lemma int.smul_one_eq_coe {R : Type*} [ring R] (m : ℤ) :
  m • (1 : R) = ↑m :=
by rw [zsmul_eq_mul, mul_one]


theorem ex1 (n : Nat) : 0 + n = n := by
  let m := n
  have h : ∃ k, id k = m := ⟨m, rfl⟩
  cases h with
  | intro a e =>
    traceState
    subst e
    traceState
    apply Nat.zero_add

theorem ex2 (n : Nat) : 0 + n = n := by
  let m := n
  have h : ∃ k, m = id k := ⟨m, rfl⟩
  cases h with
  | intro a e =>
    traceState
    subst e
    traceState
    apply Nat.zero_add

theorem ex3 (n : Nat) (h : n = 0) : 0 + n = 0 := by
  let m := n + 1
  let v := m + 1
  have : v = n + 2 := rfl
  subst v -- error
  done


import data.nat.prime
import tactic.linarith

set_option pp.generalized_field_notation false

/-! # LoVe Preface

## Proof Assistants

Proof assistants (also called interactive theorem provers)

* check and help develop formal proofs;
* can be used to prove big theorems, not only logic puzzles;
* can be tedious to use;
* are highly addictive (think video games).

A selection of proof assistants, classified by logical foundations:

* set theory: Isabelle/ZF, Metamath, Mizar;
* simple type theory: HOL4, HOL Light, Isabelle/HOL;
* **dependent type theory**: Agda, Coq, **Lean**, Matita, PVS.

## Success Stories

Mathematics:

* the four-color theorem (in Coq);
* the odd-order theorem (in Coq);
* the Kepler conjecture (in HOL Light and Isabelle/HOL).

Computer science:

* hardware
* operating systems
* programming language theory
* compilers
* security

## Lean

Lean is a proof assistant developed primarily by Leonardo de Moura (Microsoft
Research) since 2012.

Its mathematical library, `mathlib`, is developed by a user community.

We use community version 3.43.0. We use its basic libraries, `mathlib`, and
`LoVelib`. Lean is a research project.

Strengths:

* highly expressive logic based on a dependent type theory called the
  **calculus of inductive constructions**;
* extended with classical axioms and quotient types;
* metaprogramming framework;
* modern user interface;
* documentation;
* open source;
* wonderful user community.

## This Course

### Web Site

    https://BrownCS1951x.github.io

### Repository (Demos, Exercises, Homework)

    https://github.com/BrownCS1951x/fpv2022

The file you are currently looking at is a demo.
For each chapter of the Hitchhiker's Guide, there will be approximately
one demo, one exercise sheet, and one homework.

* Demos will be covered in class. These are "lecture notes."
  We'll post skeletons of the demos before class, and completed demos after class.

* Exercises are ungraded practice problems for you to use to learn.
  Sometimes we'll cover exercise problems in class. Occasionally we may run
  class like a lab, giving you time to work on exercise problems with us around.

* Homeworks are for you to do on your own, and submit via Gradescope.

### The Hitchhiker's Guide to Logical Verification

    https://cs.brown.edu/courses/cs1951x/static_files/main.pdf

The lecture notes consist of a preface and 13 chapters. They cover the same
material as the corresponding lectures but with more details. Sometimes there
will not be enough time to cover everything in class, so reading the lecture
notes will be necessary.

Download this version, not others that you might find online!

## Our Goal

We want you to

* master fundamental theory and techniques in interactive theorem proving;
* familiarize yourselves with some application areas;
* develop some practical skills you can apply on a larger project (as a hobby,
  for an MSc or PhD, or in industry);
* feel ready to move to another proof assistant and apply what you have learned;
* understand the domain well enough to start reading scientific papers.

This course is neither a pure logical foundations course nor a Lean tutorial.
Lean is our vehicle, not an end in itself.

-/

open nat
open_locale nat

theorem infinitude_of_primes : ∀ N, ∃ p ≥ N, nat.prime p :=
begin
  intro N,
  let M := N! + 1,
  let q := min_fac M,

  have hq : nat.prime q := begin
    refine min_fac_prime _,
    have hn : N! > 0 := factorial_pos N,
    linarith
  end,

  use q,

  split,

  { by_contradiction,
    have h1 : q ∣ N! + 1 := min_fac_dvd M,
    have h1' : q ≤ N := le_of_not_ge h,
    have h2 : q ∣ N! := (prime.dvd_factorial hq).mpr h1',
    have h3 : q ∣ 1 := (nat.dvd_add_right h2).mp h1,
    exact nat.prime.not_dvd_one hq h3 },

  { exact hq },
end

#print infinitude_of_primes

#eval min_fac 30


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Yury Kudryashov, Frédéric Dupuis

! This file was ported from Lean 3 source module topology.algebra.infinite_sum.module
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.InfiniteSum.Basic
import Mathbin.Topology.Algebra.Module.Basic

/-! # Infinite sums in topological vector spaces -/

variable {ι R R₂ M M₂ : Type _}

section SmulConst

variable [Semiring R] [TopologicalSpace R] [TopologicalSpace M] [AddCommMonoid M] [Module R M]
  [ContinuousSMul R M] {f : ι → R}

theorem HasSum.smul_const {r : R} (hf : HasSum f r) (a : M) : HasSum (fun z => f z • a) (r • a) :=
  hf.map ((smulAddHom R M).flip a) (continuous_id.smul continuous_const)
#align has_sum.smul_const HasSum.smul_const

theorem Summable.smul_const (hf : Summable f) (a : M) : Summable fun z => f z • a :=
  (hf.HasSum.smul_const _).Summable
#align summable.smul_const Summable.smul_const

theorem tsum_smul_const [T2Space M] (hf : Summable f) (a : M) : (∑' z, f z • a) = (∑' z, f z) • a :=
  (hf.HasSum.smul_const _).tsum_eq
#align tsum_smul_const tsum_smul_const

end SmulConst

section HasSum

-- Results in this section hold for continuous additive monoid homomorphisms or equivalences but we
-- don't have bundled continuous additive homomorphisms.
variable [Semiring R] [Semiring R₂] [AddCommMonoid M] [Module R M] [AddCommMonoid M₂] [Module R₂ M₂]
  [TopologicalSpace M] [TopologicalSpace M₂] {σ : R →+* R₂} {σ' : R₂ →+* R} [RingHomInvPair σ σ']
  [RingHomInvPair σ' σ]

/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected theorem ContinuousLinearMap.hasSum {f : ι → M} (φ : M →SL[σ] M₂) {x : M}
    (hf : HasSum f x) : HasSum (fun b : ι => φ (f b)) (φ x) := by
  simpa only using hf.map φ.to_linear_map.to_add_monoid_hom φ.continuous
#align continuous_linear_map.has_sum ContinuousLinearMap.hasSum

alias ContinuousLinearMap.hasSum ← HasSum.mapL
#align has_sum.mapL HasSum.mapL

protected theorem ContinuousLinearMap.summable {f : ι → M} (φ : M →SL[σ] M₂) (hf : Summable f) :
    Summable fun b : ι => φ (f b) :=
  (hf.HasSum.mapL φ).Summable
#align continuous_linear_map.summable ContinuousLinearMap.summable

alias ContinuousLinearMap.summable ← Summable.mapL
#align summable.mapL Summable.mapL

protected theorem ContinuousLinearMap.map_tsum [T2Space M₂] {f : ι → M} (φ : M →SL[σ] M₂)
    (hf : Summable f) : φ (∑' z, f z) = ∑' z, φ (f z) :=
  (hf.HasSum.mapL φ).tsum_eq.symm
#align continuous_linear_map.map_tsum ContinuousLinearMap.map_tsum

include σ'

/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected theorem ContinuousLinearEquiv.hasSum {f : ι → M} (e : M ≃SL[σ] M₂) {y : M₂} :
    HasSum (fun b : ι => e (f b)) y ↔ HasSum f (e.symm y) :=
  ⟨fun h => by simpa only [e.symm.coe_coe, e.symm_apply_apply] using h.mapL (e.symm : M₂ →SL[σ'] M),
    fun h => by simpa only [e.coe_coe, e.apply_symm_apply] using (e : M →SL[σ] M₂).HasSum h⟩
#align continuous_linear_equiv.has_sum ContinuousLinearEquiv.hasSum

/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
protected theorem ContinuousLinearEquiv.has_sum' {f : ι → M} (e : M ≃SL[σ] M₂) {x : M} :
    HasSum (fun b : ι => e (f b)) (e x) ↔ HasSum f x := by
  rw [e.has_sum, ContinuousLinearEquiv.symm_apply_apply]
#align continuous_linear_equiv.has_sum' ContinuousLinearEquiv.has_sum'

protected theorem ContinuousLinearEquiv.summable {f : ι → M} (e : M ≃SL[σ] M₂) :
    (Summable fun b : ι => e (f b)) ↔ Summable f :=
  ⟨fun hf => (e.HasSum.1 hf.HasSum).Summable, (e : M →SL[σ] M₂).Summable⟩
#align continuous_linear_equiv.summable ContinuousLinearEquiv.summable

theorem ContinuousLinearEquiv.tsum_eq_iff [T2Space M] [T2Space M₂] {f : ι → M} (e : M ≃SL[σ] M₂)
    {y : M₂} : (∑' z, e (f z)) = y ↔ (∑' z, f z) = e.symm y :=
  by
  by_cases hf : Summable f
  ·
    exact
      ⟨fun h => (e.has_sum.mp ((e.summable.mpr hf).hasSum_iff.mpr h)).tsum_eq, fun h =>
        (e.has_sum.mpr (hf.has_sum_iff.mpr h)).tsum_eq⟩
  · have hf' : ¬Summable fun z => e (f z) := fun h => hf (e.summable.mp h)
    rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable hf']
    exact
      ⟨by
        rintro rfl
        simp, fun H => by simpa using congr_arg (fun z => e z) H⟩
#align continuous_linear_equiv.tsum_eq_iff ContinuousLinearEquiv.tsum_eq_iff

protected theorem ContinuousLinearEquiv.map_tsum [T2Space M] [T2Space M₂] {f : ι → M}
    (e : M ≃SL[σ] M₂) : e (∑' z, f z) = ∑' z, e (f z) :=
  by
  refine' symm (e.tsum_eq_iff.mpr _)
  rw [e.symm_apply_apply _]
#align continuous_linear_equiv.map_tsum ContinuousLinearEquiv.map_tsum

end HasSum


/-
Copyright (c) 2020 Johan Commelin and Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin and Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.rename
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!

# Monad operations on `mv_polynomial`

This file defines two monadic operations on `mv_polynomial`. Given `p : mv_polynomial σ R`,

* `mv_polynomial.bind₁` and `mv_polynomial.join₁` operate on the variable type `σ`.
* `mv_polynomial.bind₂` and `mv_polynomial.join₂` operate on the coefficient type `R`.

- `mv_polynomial.bind₁ f φ` with `f : σ → mv_polynomial τ R` and `φ : mv_polynomial σ R`,
  is the polynomial `φ(f 1, ..., f i, ...) : mv_polynomial τ R`.
- `mv_polynomial.join₁ φ` with `φ : mv_polynomial (mv_polynomial σ R) R` collapses `φ` to
  a `mv_polynomial σ R`, by evaluating `φ` under the map `X f ↦ f` for `f : mv_polynomial σ R`.
  In other words, if you have a polynomial `φ` in a set of variables indexed by a polynomial ring,
  you evaluate the polynomial in these indexing polynomials.
- `mv_polynomial.bind₂ f φ` with `f : R →+* mv_polynomial σ S` and `φ : mv_polynomial σ R`
  is the `mv_polynomial σ S` obtained from `φ` by mapping the coefficients of `φ` through `f`
  and considering the resulting polynomial as polynomial expression in `mv_polynomial σ R`.
- `mv_polynomial.join₂ φ` with `φ : mv_polynomial σ (mv_polynomial σ R)` collapses `φ` to
  a `mv_polynomial σ R`, by considering `φ` as polynomial expression in `mv_polynomial σ R`.

These operations themselves have algebraic structure: `mv_polynomial.bind₁`
and `mv_polynomial.join₁` are algebra homs and
`mv_polynomial.bind₂` and `mv_polynomial.join₂` are ring homs.

They interact in convenient ways with `mv_polynomial.rename`, `mv_polynomial.map`,
`mv_polynomial.vars`, and other polynomial operations.
Indeed, `mv_polynomial.rename` is the "map" operation for the (`bind₁`, `join₁`) pair,
whereas `mv_polynomial.map` is the "map" operation for the other pair.

## Implementation notes

We add an `is_lawful_monad` instance for the (`bind₁`, `join₁`) pair.
The second pair cannot be instantiated as a `monad`,
since it is not a monad in `Type` but in `CommRing` (or rather `CommSemiRing`).

-/

namespace mv_polynomial

/--
`bind₁` is the "left hand side" bind operation on `mv_polynomial`, operating on the variable type.
Given a polynomial `p : mv_polynomial σ R` and a map `f : σ → mv_polynomial τ R` taking variables
in `p` to polynomials in the variable type `τ`, `bind₁ f p` replaces each variable in `p` with
its value under `f`, producing a new polynomial in `τ`. The coefficient type remains the same.
This operation is an algebra hom.
-/
def bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) : alg_hom R (mv_polynomial σ R) (mv_polynomial τ R) :=
  aeval f

/--
`bind₂` is the "right hand side" bind operation on `mv_polynomial`, operating on the coefficient type.
Given a polynomial `p : mv_polynomial σ R` and a map `f : R → mv_polynomial σ S` taking coefficients
in `p` to polynomials over a new ring `S`, `bind₂ f p` replaces each coefficient in `p` with its
value under `f`, producing a new polynomial over `S`. The variable type remains the same.
This operation is a ring hom.
-/
def bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R] [comm_semiring S]
    (f : R →+* mv_polynomial σ S) : mv_polynomial σ R →+* mv_polynomial σ S :=
  eval₂_hom f X

/--
`join₁` is the monadic join operation corresponding to `mv_polynomial.bind₁`. Given a polynomial `p`
with coefficients in `R` whose variables are polynomials in `σ` with coefficients in `R`,
`join₁ p` collapses `p` to a polynomial with variables in `σ` and coefficients in `R`.
This operation is an algebra hom.
-/
def join₁ {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    alg_hom R (mv_polynomial (mv_polynomial σ R) R) (mv_polynomial σ R) :=
  aeval id

/--
`join₂` is the monadic join operation corresponding to `mv_polynomial.bind₂`. Given a polynomial `p`
with variables in `σ` whose coefficients are polynomials in `σ` with coefficients in `R`,
`join₂ p` collapses `p` to a polynomial with variables in `σ` and coefficients in `R`.
This operation is a ring hom.
-/
def join₂ {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    mv_polynomial σ (mv_polynomial σ R) →+* mv_polynomial σ R :=
  eval₂_hom (ring_hom.id (mv_polynomial σ R)) X

@[simp] theorem aeval_eq_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) : aeval f = bind₁ f :=
  rfl

@[simp] theorem eval₂_hom_C_eq_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) : eval₂_hom C f = ↑(bind₁ f) :=
  rfl

@[simp] theorem eval₂_hom_eq_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) : eval₂_hom f X = bind₂ f :=
  rfl

@[simp] theorem aeval_id_eq_join₁ (σ : Type u_1) (R : Type u_3) [comm_semiring R] :
    aeval id = join₁ :=
  rfl

theorem eval₂_hom_C_id_eq_join₁ (σ : Type u_1) (R : Type u_3) [comm_semiring R]
    (φ : mv_polynomial (mv_polynomial σ R) R) : coe_fn (eval₂_hom C id) φ = coe_fn join₁ φ :=
  rfl

@[simp] theorem eval₂_hom_id_X_eq_join₂ (σ : Type u_1) (R : Type u_3) [comm_semiring R] :
    eval₂_hom (ring_hom.id (mv_polynomial σ R)) X = join₂ :=
  rfl

-- In this file, we don't want to use these simp lemmas,

-- because we first need to show how these new definitions interact

-- and the proofs fall back on unfolding the definitions and call simp afterwards

@[simp] theorem bind₁_X_right {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) (i : σ) : coe_fn (bind₁ f) (X i) = f i :=
  aeval_X f i

@[simp] theorem bind₂_X_right {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) (i : σ) : coe_fn (bind₂ f) (X i) = X i :=
  eval₂_hom_X' f X i

@[simp] theorem bind₁_X_left {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    bind₁ X = alg_hom.id R (mv_polynomial σ R) :=
  sorry

theorem aeval_X_left {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    aeval X = alg_hom.id R (mv_polynomial σ R) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (aeval X = alg_hom.id R (mv_polynomial σ R))) (aeval_eq_bind₁ X)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (bind₁ X = alg_hom.id R (mv_polynomial σ R))) bind₁_X_left))
      (Eq.refl (alg_hom.id R (mv_polynomial σ R))))

theorem aeval_X_left_apply {σ : Type u_1} {R : Type u_3} [comm_semiring R] (φ : mv_polynomial σ R) :
    coe_fn (aeval X) φ = φ :=
  sorry

@[simp] theorem bind₁_C_right {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) (x : R) : coe_fn (bind₁ f) (coe_fn C x) = coe_fn C x :=
  sorry

@[simp] theorem bind₂_C_right {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) (r : R) :
    coe_fn (bind₂ f) (coe_fn C r) = coe_fn f r :=
  eval₂_hom_C f X r

@[simp] theorem bind₂_C_left {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    bind₂ C = ring_hom.id (mv_polynomial σ R) :=
  sorry

@[simp] theorem bind₂_comp_C {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) : ring_hom.comp (bind₂ f) C = f :=
  ring_hom.ext (bind₂_C_right f)

@[simp] theorem join₂_map {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) (φ : mv_polynomial σ R) :
    coe_fn join₂ (coe_fn (map f) φ) = coe_fn (bind₂ f) φ :=
  sorry

@[simp] theorem join₂_comp_map {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) : ring_hom.comp join₂ (map f) = bind₂ f :=
  ring_hom.ext (join₂_map f)

theorem aeval_id_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) (p : mv_polynomial σ R) :
    coe_fn (aeval id) (coe_fn (rename f) p) = coe_fn (aeval f) p :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (coe_fn (aeval id) (coe_fn (rename f) p) = coe_fn (aeval f) p))
        (aeval_rename f id p)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (coe_fn (aeval (id ∘ f)) p = coe_fn (aeval f) p))
          (function.comp.left_id f)))
      (Eq.refl (coe_fn (aeval f) p)))

@[simp] theorem join₁_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
    coe_fn join₁ (coe_fn (rename f) φ) = coe_fn (bind₁ f) φ :=
  aeval_id_rename f φ

@[simp] theorem bind₁_id {σ : Type u_1} {R : Type u_3} [comm_semiring R] : bind₁ id = join₁ := rfl

@[simp] theorem bind₂_id {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    bind₂ (ring_hom.id (mv_polynomial σ R)) = join₂ :=
  rfl

theorem bind₁_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] {υ : Type u_4}
    (f : σ → mv_polynomial τ R) (g : τ → mv_polynomial υ R) (φ : mv_polynomial σ R) :
    coe_fn (bind₁ g) (coe_fn (bind₁ f) φ) =
        coe_fn (bind₁ fun (i : σ) => coe_fn (bind₁ g) (f i)) φ :=
  sorry

theorem bind₁_comp_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    {υ : Type u_4} (f : σ → mv_polynomial τ R) (g : τ → mv_polynomial υ R) :
    alg_hom.comp (bind₁ g) (bind₁ f) = bind₁ fun (i : σ) => coe_fn (bind₁ g) (f i) :=
  alg_hom_ext fun (i : σ) => bind₁_bind₁ (fun (n : σ) => f n) (fun (n : τ) => g n) (X i)

theorem bind₂_comp_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5}
    [comm_semiring R] [comm_semiring S] [comm_semiring T] (f : R →+* mv_polynomial σ S)
    (g : S →+* mv_polynomial σ T) :
    ring_hom.comp (bind₂ g) (bind₂ f) = bind₂ (ring_hom.comp (bind₂ g) f) :=
  sorry

theorem bind₂_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5} [comm_semiring R]
    [comm_semiring S] [comm_semiring T] (f : R →+* mv_polynomial σ S) (g : S →+* mv_polynomial σ T)
    (φ : mv_polynomial σ R) :
    coe_fn (bind₂ g) (coe_fn (bind₂ f) φ) = coe_fn (bind₂ (ring_hom.comp (bind₂ g) f)) φ :=
  ring_hom.congr_fun (bind₂_comp_bind₂ f g) φ

theorem rename_comp_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    {υ : Type u_4} (f : σ → mv_polynomial τ R) (g : τ → υ) :
    alg_hom.comp (rename g) (bind₁ f) = bind₁ fun (i : σ) => coe_fn (rename g) (f i) :=
  sorry

theorem rename_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] {υ : Type u_4}
    (f : σ → mv_polynomial τ R) (g : τ → υ) (φ : mv_polynomial σ R) :
    coe_fn (rename g) (coe_fn (bind₁ f) φ) =
        coe_fn (bind₁ fun (i : σ) => coe_fn (rename g) (f i)) φ :=
  alg_hom.congr_fun (rename_comp_bind₁ f g) φ

theorem map_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5} [comm_semiring R]
    [comm_semiring S] [comm_semiring T] (f : R →+* mv_polynomial σ S) (g : S →+* T)
    (φ : mv_polynomial σ R) :
    coe_fn (map g) (coe_fn (bind₂ f) φ) = coe_fn (bind₂ (ring_hom.comp (map g) f)) φ :=
  sorry

theorem bind₁_comp_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    {υ : Type u_4} (f : τ → mv_polynomial υ R) (g : σ → τ) :
    alg_hom.comp (bind₁ f) (rename g) = bind₁ (f ∘ g) :=
  sorry

theorem bind₁_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] {υ : Type u_4}
    (f : τ → mv_polynomial υ R) (g : σ → τ) (φ : mv_polynomial σ R) :
    coe_fn (bind₁ f) (coe_fn (rename g) φ) = coe_fn (bind₁ (f ∘ g)) φ :=
  alg_hom.congr_fun (bind₁_comp_rename f g) φ

theorem bind₂_map {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5} [comm_semiring R]
    [comm_semiring S] [comm_semiring T] (f : S →+* mv_polynomial σ T) (g : R →+* S)
    (φ : mv_polynomial σ R) :
    coe_fn (bind₂ f) (coe_fn (map g) φ) = coe_fn (bind₂ (ring_hom.comp f g)) φ :=
  sorry

@[simp] theorem map_comp_C {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) : ring_hom.comp (map f) C = ring_hom.comp C f :=
  ring_hom.ext fun (x : R) => map_C f x

-- mixing the two monad structures

theorem hom_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : mv_polynomial τ R →+* S) (g : σ → mv_polynomial τ R)
    (φ : mv_polynomial σ R) :
    coe_fn f (coe_fn (bind₁ g) φ) =
        coe_fn (eval₂_hom (ring_hom.comp f C) fun (i : σ) => coe_fn f (g i)) φ :=
  sorry

theorem map_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (g : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
    coe_fn (map f) (coe_fn (bind₁ g) φ) =
        coe_fn (bind₁ fun (i : σ) => coe_fn (map f) (g i)) (coe_fn (map f) φ) :=
  sorry

@[simp] theorem eval₂_hom_comp_C {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (g : σ → S) : ring_hom.comp (eval₂_hom f g) C = f :=
  ring_hom.ext fun (r : R) => eval₂_C f g r

theorem eval₂_hom_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} {S : Type u_4}
    [comm_semiring R] [comm_semiring S] (f : R →+* S) (g : τ → S) (h : σ → mv_polynomial τ R)
    (φ : mv_polynomial σ R) :
    coe_fn (eval₂_hom f g) (coe_fn (bind₁ h) φ) =
        coe_fn (eval₂_hom f fun (i : σ) => coe_fn (eval₂_hom f g) (h i)) φ :=
  sorry

theorem aeval_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] [algebra R S] (f : τ → S) (g : σ → mv_polynomial τ R)
    (φ : mv_polynomial σ R) :
    coe_fn (aeval f) (coe_fn (bind₁ g) φ) =
        coe_fn (aeval fun (i : σ) => coe_fn (aeval f) (g i)) φ :=
  eval₂_hom_bind₁ (algebra_map R S) (fun (n : τ) => f n) g φ

theorem aeval_comp_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} {S : Type u_4}
    [comm_semiring R] [comm_semiring S] [algebra R S] (f : τ → S) (g : σ → mv_polynomial τ R) :
    alg_hom.comp (aeval f) (bind₁ g) = aeval fun (i : σ) => coe_fn (aeval f) (g i) :=
  alg_hom_ext fun (i : σ) => aeval_bind₁ (fun (n : τ) => f n) (fun (n : σ) => g n) (X i)

theorem eval₂_hom_comp_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5}
    [comm_semiring R] [comm_semiring S] [comm_semiring T] (f : S →+* T) (g : σ → T)
    (h : R →+* mv_polynomial σ S) :
    ring_hom.comp (eval₂_hom f g) (bind₂ h) = eval₂_hom (ring_hom.comp (eval₂_hom f g) h) g :=
  sorry

theorem eval₂_hom_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5}
    [comm_semiring R] [comm_semiring S] [comm_semiring T] (f : S →+* T) (g : σ → T)
    (h : R →+* mv_polynomial σ S) (φ : mv_polynomial σ R) :
    coe_fn (eval₂_hom f g) (coe_fn (bind₂ h) φ) =
        coe_fn (eval₂_hom (ring_hom.comp (eval₂_hom f g) h) g) φ :=
  ring_hom.congr_fun (eval₂_hom_comp_bind₂ f g h) φ

theorem aeval_bind₂ {σ : Type u_1} {R : Type u_3} {S : Type u_4} {T : Type u_5} [comm_semiring R]
    [comm_semiring S] [comm_semiring T] [algebra S T] (f : σ → T) (g : R →+* mv_polynomial σ S)
    (φ : mv_polynomial σ R) :
    coe_fn (aeval f) (coe_fn (bind₂ g) φ) = coe_fn (eval₂_hom (ring_hom.comp (↑(aeval f)) g) f) φ :=
  eval₂_hom_bind₂ (algebra_map S T) (fun (n : σ) => f n) g φ

theorem eval₂_hom_C_left {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) : eval₂_hom C f = ↑(bind₁ f) :=
  rfl

theorem bind₁_monomial {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → mv_polynomial τ R) (d : σ →₀ ℕ) (r : R) :
    coe_fn (bind₁ f) (monomial d r) =
        coe_fn C r * finset.prod (finsupp.support d) fun (i : σ) => f i ^ coe_fn d i :=
  sorry

theorem bind₂_monomial {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) (d : σ →₀ ℕ) (r : R) :
    coe_fn (bind₂ f) (monomial d r) = coe_fn f r * monomial d 1 :=
  sorry

@[simp] theorem bind₂_monomial_one {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* mv_polynomial σ S) (d : σ →₀ ℕ) :
    coe_fn (bind₂ f) (monomial d 1) = monomial d 1 :=
  sorry

protected instance monad {R : Type u_3} [comm_semiring R] :
    Monad fun (σ : Type u_1) => mv_polynomial σ R :=
  sorry

protected instance is_lawful_functor {R : Type u_3} [comm_semiring R] :
    is_lawful_functor fun (σ : Type u_1) => mv_polynomial σ R :=
  is_lawful_functor.mk
    (fun (α : Type u_1) (x : mv_polynomial α R) =>
      eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : mv_polynomial α R) (e_1 : a = a_1) (ᾰ ᾰ_1 : mv_polynomial α R)
                (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              (id <$> x) x (rename_id x) x x (Eq.refl x))
            (propext (eq_self_iff_true x))))
        trivial)
    fun (α β γ : Type u_1) (g : α → β) (h : β → γ) (x : mv_polynomial α R) =>
      eq.mpr
        (id
          (Eq.trans
            ((fun (a a_1 : mv_polynomial γ R) (e_1 : a = a_1) (ᾰ ᾰ_1 : mv_polynomial γ R)
                (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
              ((h ∘ g) <$> x) (coe_fn (rename (h ∘ g)) x) (Eq.refl (coe_fn (rename (h ∘ g)) x))
              (h <$> g <$> x) (coe_fn (rename (h ∘ g)) x) (rename_rename g h x))
            (propext (eq_self_iff_true (coe_fn (rename (h ∘ g)) x)))))
        trivial

protected instance is_lawful_monad {R : Type u_3} [comm_semiring R] :
    is_lawful_monad fun (σ : Type u_1) => mv_polynomial σ R :=
  sorry

end Mathlib


import data.nat.factorization.basic data.zmod.basic

/-!
# Representation of the coprime part of a `nat` in `zmod`

Given a positive integer `n = p^k t`, where `p` is prime, `k ≥ 0` and `t` is coprime with `p`,
  we define `zmod.ord_compl p n` as the image of `t` in `(zmod p)ˣ`.
We also prove some important properties of `zmod.ord_compl`

Some important properties on a positive integer can be evaluated just by
  analyzing the value of `k` and the image `u` of `t` in `(zmod p)ˣ`.
For example, `n` is a square in `ℤ_p`, `p ≠ 2` if and only if `k` is even and `u` is a square.
-/

namespace IMOSL
namespace extra
namespace zmod

@[simp] lemma unit_of_coprime_one {p : ℕ} [fact p.prime] (h0 : nat.coprime 1 p) :
  zmod.unit_of_coprime 1 h0 = 1 :=
  by rw zmod.unit_of_coprime;
    conv_lhs { congr, rw nat.cast_one, skip, rw [nat.cast_one, inv_one] }; refl

/-- The `p`-coprime part of a positive natural, embedded into `(zmod p)ˣ`.
  If `n = 0`, we define the `p`-coprime part to be `1` in `(zmod p)ˣ`. -/
def ord_compl (p : ℕ) [fact (p.prime)] (n : ℕ) : (zmod p)ˣ :=
  dite (n = 0) (λ _, 1) (λ h : n ≠ 0, zmod.unit_of_coprime (ord_compl[p] n)
    (nat.coprime_comm.mp (nat.coprime_ord_compl (fact.out p.prime) h)))

namespace ord_compl

variables {p : ℕ} [fact (p.prime)]

@[simp] theorem map_zero : ord_compl p 0 = 1 :=
  by rw [ord_compl, dif_pos rfl]

@[simp] theorem map_ne_zero_zmod {n : ℕ} (h : n ≠ 0) :
  (zmod.ord_compl p n : zmod p) = ((ord_compl[p] n : ℕ) : zmod p) :=
  by rw [ord_compl, dif_neg h, zmod.coe_unit_of_coprime]

theorem map_ne_zero_val {n : ℕ} (h : n ≠ 0) :
  (zmod.ord_compl p n : zmod p).val = ord_compl[p] n % p :=
  by rw [map_ne_zero_zmod h, zmod.val_nat_cast]

@[simp] theorem map_one : ord_compl p 1 = 1 :=
begin
  rw [ord_compl, dif_neg nat.one_ne_zero],
  conv_lhs { congr, rw [nat.factorization_one, finsupp.coe_zero,
    pi.zero_apply, pow_zero, nat.div_one] },
  exact unit_of_coprime_one _
end

@[simp] theorem map_mul {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) :
  ord_compl p (m * n) = ord_compl p m * ord_compl p n :=
  by rw [← units.eq_iff, map_ne_zero_zmod (nat.mul_ne_zero hm hn), units.coe_mul,
    map_ne_zero_zmod hm, map_ne_zero_zmod hn, nat.ord_compl_mul, nat.cast_mul]

@[simp] theorem map_pow : ∀ m k : ℕ, ord_compl p (m ^ k) = ord_compl p m ^ k
| _ 0 := by rw [pow_zero, map_one, pow_zero]
| 0 (k+1) := by rw [zero_pow k.succ_pos, map_zero, one_pow]
| (m+1) (k+1) := by rw [pow_succ, pow_succ, ← map_pow,
  map_mul m.succ_ne_zero (pow_ne_zero _ m.succ_ne_zero), map_pow]

@[simp] lemma map_self : ord_compl p p = 1 :=
  by have h := fact.out p.prime; rw [← units.coe_eq_one, map_ne_zero_zmod h.ne_zero,
    h.factorization_self, pow_one, nat.div_self h.pos, nat.cast_one]

@[simp] lemma map_self_pow (k : ℕ) : ord_compl p (p ^ k) = 1 :=
  by rw [map_pow, map_self, one_pow]

@[simp] lemma map_self_pow_mul (k n : ℕ) : ord_compl p (p ^ k * n) = ord_compl p n :=
begin
  rcases eq_or_ne n 0 with rfl | h,
  rw mul_zero,
  rw [map_mul (pow_ne_zero _ (fact.out p.prime).ne_zero) h, map_self_pow, one_mul]
end

lemma map_coprime {t : ℕ} (h : t.coprime p) : ord_compl p t = zmod.unit_of_coprime t h :=
begin
  have hp := fact.out p.prime,
  have h0 : ¬p ∣ t := by rwa [← nat.prime.coprime_iff_not_dvd hp, nat.coprime_comm],
  rw units.ext_iff; apply zmod.val_injective,
  rw [map_ne_zero_val, zmod.coe_unit_of_coprime, nat.factorization_def t hp,
      padic_val_nat.eq_zero_of_not_dvd h0, pow_zero, nat.div_one, zmod.val_nat_cast],
  rintros rfl; exact h0 (dvd_zero p)
end

lemma map_coprime_val {t : ℕ} (h : t.coprime p) : (ord_compl p t : zmod p).val = t % p :=
  by rw [map_coprime h, zmod.coe_unit_of_coprime, zmod.val_nat_cast]

lemma map_zmod_unit_val (x : (zmod p)ˣ) : ord_compl p (x : zmod p).val = x :=
  by rw [units.ext_iff, map_coprime (zmod.val_coe_unit_coprime x),
    zmod.coe_unit_of_coprime, zmod.nat_cast_val, zmod.cast_id', id.def]

lemma map_coprime_mod_p {t : ℕ} (h : t.coprime p) : ord_compl p t = ord_compl p (t % p) :=
begin
  refine units.ext (zmod.val_injective p _),
  rw [map_coprime_val h, map_coprime_val, nat.mod_mod],
  rw nat.coprime at h ⊢,
  rw ← h; apply nat.modeq.gcd_eq_of_modeq,
  rw [nat.modeq, nat.mod_mod]
end

lemma map_coprime_p_dvd_add {a b : ℕ} (h : a.coprime p) (h0 : p ∣ a + b) :
  ord_compl p b = -ord_compl p a :=
begin
  rwa [units.ext_iff, units.coe_neg, map_coprime h, zmod.coe_unit_of_coprime,
       map_coprime, zmod.coe_unit_of_coprime, eq_neg_iff_add_eq_zero,
       ← nat.cast_add, zmod.nat_coe_zmod_eq_zero_iff_dvd, add_comm],
  rw [nat.coprime_comm, (fact.out p.prime).coprime_iff_not_dvd] at h ⊢,
  intros h1; exact h ((nat.dvd_add_left h1).mp h0)
end

end ord_compl

end zmod
end extra
end IMOSL


-- Principio de no contradicción
-- =============================

import tactic

variable  (P : Prop)

-- ----------------------------------------------------
-- Ejercicio 1. Demostrar el principio de no contradicción
--    P ∧ ¬ P → false
-- ----------------------------------------------------

-- 1ª demostración
example : P ∧ ¬ P → false :=
begin
  intro h1,
  cases h1 with hP hnP,
  apply hnP,
  exact hP,
end

-- 2ª demostración
example : P ∧ ¬ P → false :=
begin
  rintro ⟨hP, hnP⟩,
  exact hnP hP,
end

-- 3ª demostración
example : P ∧ ¬ P → false :=
λ ⟨hP, hnP⟩, hnP hP

-- 4ª demostración
example : P ∧ ¬ P → false :=
-- by library_search
(and_not_self P).mp

-- 5ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
have hP : P,
  from and.elim_left h,
have hnP : ¬P,
  from and.elim_right h,
show false,
  from absurd hP hnP

-- 6ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
have hP : P,
  from and.left h,
have hnP : ¬P,
  from and.right h,
show false,
  from absurd hP hnP

-- 7ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
have hP : P,
  from h.left,
have hnP : ¬P,
  from h.right,
show false,
  from absurd hP hnP

-- 8ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
have hP : P,
  from h.1,
have hnP : ¬P,
  from h.2,
show false,
  from absurd hP hnP

-- 9ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
show false,
  from absurd h.1 h.2

-- 10ª demostración
example : P ∧ ¬ P → false :=
assume h : P ∧ ¬ P,
absurd h.1 h.2

-- 11ª demostración
example : P ∧ ¬ P → false :=
λ h, absurd h.1 h.2

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar el principio de no contradicción
--    P ∧ ¬ P → 0 = 1
-- ----------------------------------------------------

-- 1ª demostración
example : P ∧ ¬ P → 0 = 1 :=
begin
  rintro ⟨hP, hnP⟩,
  exfalso,
  exact hnP hP,
end

-- 2ª demostración
example : P ∧ ¬ P → 0 = 1 :=
λ h, absurd h.1 h.2


import GMLInit.Logic.Basic
import GMLInit.Logic.Connectives
import GMLInit.Logic.ListConnectives

def Stable.by_contrapositive {a b : Prop} [Stable b] : (¬b → ¬a) → (a → b) :=
  λ h ha => Stable.by_contradiction λ hnb => h hnb ha

def Stable.by_no_counterexample {α} {a : α → Prop} [(x : α) → Stable (a x)] :
  ¬ (∃ x, ¬ a x) → (∀ x, a x) :=
  λ h x => Stable.by_contradiction λ hax => h (Exists.intro x hax)

variable (a b : Prop)

instance [Stable b] : Stable (a → b) :=
  Stable.intro λ hnn ha => Stable.by_contradiction λ hnb => hnn λ h => hnb (h ha)

instance : Stable (¬a) := inferInstanceAs (Stable (a → False))

instance {α} (a : α → Prop) [(x : α) → Stable (a x)] : Stable (∀ x, a x) :=
  Stable.intro λ hnn x => Stable.by_contradiction λ hnax => hnn λ h => hnax (h x)

instance [Stable a] [Stable b] : Stable (a ∧ b) :=
  Stable.intro λ hnn =>
  let ha : a := Stable.by_contradiction λ hna => hnn λ h => hna h.left
  let hb : b := Stable.by_contradiction λ hnb => hnn λ h => hnb h.right
  And.intro ha hb

instance (α) (β : α → Sort _) [(x : α) → StableEq (β x)] : StableEq ((x : α) → β x) :=
  fun _ _ => Stable.intro λ hnn => funext λ _ => Stable.by_contradiction λ hn => hnn λ | rfl => hn rfl

instance (α β) [StableEq β] : StableEq (α → β) := inferInstance

instance instComplementedStableOrLeft [Stable a] : [Complemented b] → Stable (a ∨ b)
| Complemented.isTrue hb => Stable.intro (λ _ => Or.inr hb)
| Complemented.isFalse hb => Stable.intro λ hnn => Or.inl $
  Stable.by_contradiction λ ha => hnn (NOr.intro ha hb)

instance instComplementedStableOrRight [Stable b] : [Complemented a] → Stable (a ∨ b)
| Complemented.isTrue ha => Stable.intro (λ _ => Or.inl ha)
| Complemented.isFalse ha => Stable.intro λ hnn => Or.inr $
  Stable.by_contradiction λ hb => hnn (NOr.intro ha hb)

instance instStableAll : (as : List Prop) → [StableList as] → Stable (All as)
| [], _ => Stable.intro (λ _ => All.nil)
| a::as, StableList.cons ia ias => Stable.intro λ hnn =>
  let ha : a := ia.by_contradiction λ hna => hnn λ h => hna h.head
  let has : All as := (@instStableAll as ias).by_contradiction λ hnas => hnn λ h => hnas h.tail
  All.cons ha has


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.module.equiv
import group_theory.group_action.opposite

/-!
# Module operations on `Mᵐᵒᵖ`

This file contains definitions that build on top of the group action definitions in
`group_theory.group_action.opposite`.
-/

namespace mul_opposite
universes u v

variables (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [module R M]

/-- `mul_opposite.distrib_mul_action` extends to a `module` -/
instance : module R (mul_opposite M) :=
{ add_smul := λ r₁ r₂ x, unop_injective $ add_smul r₁ r₂ (unop x),
  zero_smul := λ x, unop_injective $ zero_smul _ (unop x),
  ..mul_opposite.distrib_mul_action M R }

/-- The function `op` is a linear equivalence. -/
def op_linear_equiv : M ≃ₗ[R] Mᵐᵒᵖ :=
{ map_smul' := mul_opposite.op_smul, .. op_add_equiv }

@[simp] lemma coe_op_linear_equiv :
  (op_linear_equiv R : M → Mᵐᵒᵖ) = op := rfl
@[simp] lemma coe_op_linear_equiv_symm :
  ((op_linear_equiv R).symm : Mᵐᵒᵖ → M) = unop := rfl

@[simp] lemma coe_op_linear_equiv_to_linear_map :
  ((op_linear_equiv R).to_linear_map : M → Mᵐᵒᵖ) = op := rfl
@[simp] lemma coe_op_linear_equiv_symm_to_linear_map :
  ((op_linear_equiv R).symm.to_linear_map : Mᵐᵒᵖ → M) = unop := rfl

@[simp] lemma op_linear_equiv_to_add_equiv :
  (op_linear_equiv R : M ≃ₗ[R] Mᵐᵒᵖ).to_add_equiv = op_add_equiv := rfl
@[simp] lemma op_linear_equiv_symm_to_add_equiv :
  (op_linear_equiv R : M ≃ₗ[R] Mᵐᵒᵖ).symm.to_add_equiv = op_add_equiv.symm := rfl

end mul_opposite


import Lean4Axiomatic.Integer.Multiplication

/-!
# Integer negation
-/

namespace Lean4Axiomatic.Integer

/-!
## Axioms
-/

/--
Definition of negation, and properties that it must satisfy.

All other properties of negation can be derived from these.
-/
class Negation
    {ℕ : outParam Type} [Natural ℕ]
    (ℤ : Type) [Core (ℕ := ℕ) ℤ] [Addition ℤ]
    :=
  /-- Definition of and syntax for negation. -/
  negOp : Neg ℤ

  /--
  Negation preserves equality of integers; two equal integers are still equal
  after both are negated.
  -/
  neg_substitutive : AA.Substitutive₁ (α := ℤ) (-·) (· ≃ ·) (· ≃ ·)

  /-- An integer added to its negation is always zero. -/
  neg_inverse : AA.Inverse (α := ℤ) (-·) (· + ·)

attribute [instance] Negation.negOp
attribute [instance] Negation.neg_inverse
attribute [instance] Negation.neg_substitutive

export Negation (negOp)

/-!
## Derived properties
-/

variable {ℕ : Type} [Natural ℕ]
variable {ℤ : Type} [Core (ℕ := ℕ) ℤ]
variable [Addition ℤ] [Multiplication ℤ] [Negation ℤ]

open Coe (coe)
open Natural (step)
open Signed (Positive)

/--
The integer negative one (`-1`) is not equivalent to zero.

**Proof intuition**: Assume that it is; add one to both sides, obtaining
`0 ≃ 1`. Contradict with `0 ≄ 1` to prove the negation.
-/
theorem neg_one_neqv_zero : -1 ≄ (0 : ℤ) := by
  intro (_ : -1 ≃ (0 : ℤ))
  show False
  have : 1 ≃ (0 : ℤ) := calc
    1      ≃ _ := Rel.symm AA.identR
    1 + 0  ≃ _ := AA.substR (Rel.symm ‹-1 ≃ (0 : ℤ)›)
    1 + -1 ≃ _ := AA.inverseR
    0      ≃ _ := Rel.refl
  have : 1 ≄ 0 := one_neqv_zero (ℤ := ℤ)
  exact absurd ‹1 ≃ (0 : ℤ)› ‹1 ≄ (0 : ℤ)›

/--
The integer negative one (`-1`) is not equivalent to one.

**Proof intuition**: Assume that it is; add one to both sides, obtaining
`0 ≃ 2`. Convert into natural numbers, `coe 0 ≃ coe 2`, then contradict with
the axiom `step n ≄ 0` to prove the negation.
-/
theorem neg_one_neqv_one : -1 ≄ (1 : ℤ) := by
  intro (_ : -1 ≃ (1 : ℤ))
  show False
  have : step 0 ≃ 1 := Rel.symm Natural.literal_step
  have : (step 1 : ℤ) ≃ (0 : ℤ) := calc
    (step 1 : ℤ)           ≃ _ := AA.subst₁ (AA.subst₁ (Rel.symm AA.identR))
    (step (1 + 0) : ℤ)     ≃ _ := AA.subst₁ AA.scompatR
    ((1 + step 0 : ℕ) : ℤ) ≃ _ := AA.subst₁ (AA.substR ‹step 0 ≃ 1›)
    ((1 + 1 : ℕ) : ℤ)      ≃ _ := AA.compat₂
    (1 : ℤ) + (1 : ℤ)      ≃ _ := AA.substR (Rel.symm ‹-1 ≃ (1 : ℤ)›)
    1 + -1                 ≃ _ := AA.inverseR
    0                      ≃ _ := Rel.refl
  have : step 1 ≃ 0 := AA.inject ‹(step 1 : ℤ) ≃ (0 : ℤ)›
  have : step 1 ≄ 0 := Natural.step_neqv_zero
  exact absurd ‹step 1 ≃ 0› ‹step 1 ≄ 0›

/--
None of the three sign values `0`, `1`, and `-1` are equivalent to each other.

This extremely obvious property is useful as a lemma when proving trichotomy of
the `sgn` function or of the ordering relations.
-/
theorem signs_distinct {a : ℤ} : ¬ AA.TwoOfThree (a ≃ 0) (a ≃ 1) (a ≃ -1) := by
  intro (two : AA.TwoOfThree (a ≃ 0) (a ≃ 1) (a ≃ -1))
  show False
  match two with
  | AA.TwoOfThree.oneAndTwo (_ : a ≃ 0) (_ : a ≃ 1) =>
    exact Rel.trans_failR ‹a ≃ 1› one_neqv_zero ‹a ≃ 0›
  | AA.TwoOfThree.oneAndThree (_ : a ≃ 0) (_ : a ≃ -1) =>
    exact Rel.trans_failR ‹a ≃ -1› neg_one_neqv_zero ‹a ≃ 0›
  | AA.TwoOfThree.twoAndThree (_ : a ≃ 1) (_ : a ≃ -1) =>
    exact Rel.trans_failR ‹a ≃ -1› neg_one_neqv_one ‹a ≃ 1›

/--
Non-typeclass version of `neg_inverse.inverseL`.

Eventually, this should become the axiom and the typeclass should be derived.
-/
theorem neg_invL {a : ℤ} : -a + a ≃ 0 := AA.inverseL

/--
Zero is a left absorbing element for multiplication.

**Property intuition**: A sum of zero terms should produce the empty sum, i.e.
the additive identity, which is zero.

**Proof intuition**: The only way to produce zero by itself, given the
properties of integer addition and multiplication, is by adding a value to its
negation. So we somehow need to obtain `0 * a + -(0 * a)` from `0 * a`. We can
easily get `0 * a + (0 * a + -(0 * a))` from the additive identity and inverse
properties. The key is then using associativity, distributivity, and again
additive identity to merge the two instances of `0 * a` into one.
-/
def mul_absorbL {a : ℤ} : 0 * a ≃ 0 := calc
  0 * a                      ≃ _ := Rel.symm AA.identR
  0 * a + 0                  ≃ _ := AA.substR (Rel.symm AA.inverseR)
  0 * a + (0 * a + -(0 * a)) ≃ _ := Rel.symm AA.assoc
  (0 * a + 0 * a) + -(0 * a) ≃ _ := AA.substL (Rel.symm AA.distribR)
  (0 + 0) * a + -(0 * a)     ≃ _ := AA.substL (AA.substL AA.identL)
  0 * a + -(0 * a)           ≃ _ := AA.inverseR
  (0 : ℤ)                    ≃ _ := Rel.refl

def mul_absorbingL : AA.AbsorbingOn Hand.L (α := ℤ) 0 (· * ·) := {
  absorb := mul_absorbL
}

instance mul_absorbing : AA.Absorbing (α := ℤ) 0 (· * ·) := {
  absorbingL := mul_absorbingL
  absorbingR := AA.absorbingR_from_absorbingL mul_absorbingL
}

/--
Negation is left-semicompatible with multiplication.

**Property intuition**: Negating the sum of `b` copies of `a` should be the
same as the sum of `b` copies of `-a`.

**Proof intuition**: We're showing how negation and multiplication interact, so
there's no preexisting property that tells us how to manipulate `-(a * b)`. The
next best thing is to try to introduce some new terms, one of which is our
desired result `(-a) * b`, but the other is `a * b` to cancel out `-(a * b)`.
And it turns out those new terms have a factor of `b` in common, so we can
produce them using distributivity and the additive inverse property.
-/
theorem neg_scompatL_mul {a b : ℤ} : -(a * b) ≃ (-a) * b := calc
  -(a * b)
    ≃ _ := Rel.symm AA.identL
  0 + -(a * b)
    ≃ _ := AA.substL (Rel.symm AA.absorbL)
  0 * b + -(a * b)
    ≃ _ := AA.substL (AA.substL (Rel.symm AA.inverseL))
  (-a + a) * b + -(a * b)
    ≃ _ := AA.substL AA.distribR
  (-a * b + a * b) + -(a * b)
    ≃ _ := AA.assoc
  (-a) * b + (a * b + -(a * b))
    ≃ _ := AA.substR AA.inverseR
  (-a) * b + 0
    ≃ _ := AA.identR
  (-a) * b
    ≃ _ := Rel.refl

def neg_semicompatibleL_mul
    : AA.SemicompatibleOn Hand.L (α := ℤ) (-·) (· * ·)
    := {
  scompat := neg_scompatL_mul
}

instance neg_semicompatible_mul
    : AA.Semicompatible (α := ℤ) (-·) (· * ·)
    := {
  semicompatibleL :=
    neg_semicompatibleL_mul
  semicompatibleR :=
    AA.semicompatibleR_from_semicompatibleL neg_semicompatibleL_mul
}

/--
Multiplication by negative one is equivalent to negation.

**Property and proof intuition**: Separating `-1` into its sign and its
magnitude, multiplying by the magnitude (`1`) leaves the result unchanged, and
multiplying with the sign (`-`) means the result is negated.
-/
theorem mul_neg_one {a : ℤ} : -1 * a ≃ -a := calc
  -1 * a     ≃ _ := Rel.symm AA.scompatL
  (-(1 * a)) ≃ _ := AA.subst₁ AA.identL
  (-a)       ≃ _ := Rel.refl

/--
Negation is an involution: applying it twice is equivalent to not applying it
at all.

**Property intuition**: Negation transforms an integer into its "mirror image"
reflection across zero. Reflecting twice gives back the original integer.

**Proof intuition**: The value `-a` is the additive inverse of `-(-a)` and also
`a`. Thus, it can be used as an intermediate to replace one with the other.
-/
theorem neg_involutive {a : ℤ} : -(-a) ≃ a := calc
  -(-a)            ≃ _ := Rel.symm AA.identL
  0 + -(-a)        ≃ _ := AA.substL (Rel.symm AA.inverseR)
  (a + -a) + -(-a) ≃ _ := AA.assoc
  a + (-a + -(-a)) ≃ _ := AA.substR AA.inverseR
  a + 0            ≃ _ := AA.identR
  a                ≃ _ := Rel.refl

/--
Negation is an injection: it sends distinct inputs to distinct outputs.

**Property intuition**: We expect this to be true because negation doesn't
change the magnitude of an integer, just its sign.

**Proof intuition**: Invoke involution to rewrite the integers in a form that
allows the assumption `-a₁ ≃ -a₂` to be used.
-/
theorem neg_inject {a₁ a₂ : ℤ} : -a₁ ≃ -a₂ → a₁ ≃ a₂ := by
  intro (_ : -a₁ ≃ -a₂)
  show a₁ ≃ a₂
  calc
    a₁       ≃ _ := Rel.symm neg_involutive
    (-(-a₁)) ≃ _ := AA.subst₁ ‹-a₁ ≃ -a₂›
    (-(-a₂)) ≃ _ := neg_involutive
    a₂       ≃ _ := Rel.refl

instance neg_injective : AA.Injective (α := ℤ) (-·) (· ≃ ·) (· ≃ ·) := {
  inject := neg_inject
}

/--
Negation is compatible with addition; i.e., it distributes over addition.

**Property intuition**: Visualizing integers as vectors, the theorem says that
adding vectors and then reflecting the result across zero is the same as
reflecting the vectors before adding them.

**Proof intuition**: Negation is the same as multiplication by -1. The result
follows from the distributive property.
-/
theorem neg_compat_add {a b : ℤ} : -(a + b) ≃ -a + -b := calc
  -(a + b)            ≃ _ := Rel.symm mul_neg_one
  (-1) * (a + b)      ≃ _ := AA.distribL
  (-1) * a + (-1) * b ≃ _ := AA.substL mul_neg_one
  (-a) + (-1) * b     ≃ _ := AA.substR mul_neg_one
  (-a) + -b           ≃ _ := Rel.refl

end Lean4Axiomatic.Integer