/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Yaël Dillies
-/
import order.compare
import order.max
import order.rel_classes

/-!
# Monotonicity

This file defines (strictly) monotone/antitone functions. Contrary to standard mathematical usage,
"monotone"/"mono" here means "increasing", not "increasing or decreasing". We use "antitone"/"anti"
to mean "decreasing".

## Definitions

* `monotone f`: A function `f` between two preorders is monotone if `a ≤ b` implies `f a ≤ f b`.
* `antitone f`: A function `f` between two preorders is antitone if `a ≤ b` implies `f b ≤ f a`.
* `monotone_on f s`: Same as `monotone f`, but for all `a, b ∈ s`.
* `antitone_on f s`: Same as `antitone f`, but for all `a, b ∈ s`.
* `strict_mono f` : A function `f` between two preorders is strictly monotone if `a < b` implies
  `f a < f b`.
* `strict_anti f` : A function `f` between two preorders is strictly antitone if `a < b` implies
  `f b < f a`.
* `strict_mono_on f s`: Same as `strict_mono f`, but for all `a, b ∈ s`.
* `strict_anti_on f s`: Same as `strict_anti f`, but for all `a, b ∈ s`.

## Main theorems

* `monotone_nat_of_le_succ`, `monotone_int_of_le_succ`: If `f : ℕ → α` or `f : ℤ → α` and
  `f n ≤ f (n + 1)` for all `n`, then `f` is monotone.
* `antitone_nat_of_succ_le`, `antitone_int_of_succ_le`: If `f : ℕ → α` or `f : ℤ → α` and
  `f (n + 1) ≤ f n` for all `n`, then `f` is antitone.
* `strict_mono_nat_of_lt_succ`, `strict_mono_int_of_lt_succ`: If `f : ℕ → α` or `f : ℤ → α` and
  `f n < f (n + 1)` for all `n`, then `f` is strictly monotone.
* `strict_anti_nat_of_succ_lt`, `strict_anti_int_of_succ_lt`: If `f : ℕ → α` or `f : ℤ → α` and
  `f (n + 1) < f n` for all `n`, then `f` is strictly antitone.

## Implementation notes

Some of these definitions used to only require `has_le α` or `has_lt α`. The advantage of this is
unclear and it led to slight elaboration issues. Now, everything requires `preorder α` and seems to
work fine. Related Zulip discussion:
https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Order.20diamond/near/254353352.

## TODO

The above theorems are also true in `ℕ+`, `fin n`... To make that work, we need `succ_order α`
and `succ_archimedean α`.

## Tags

monotone, strictly monotone, antitone, strictly antitone, increasing, strictly increasing,
decreasing, strictly decreasing
-/

open function order_dual

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type*} {r : α → α → Prop}

section monotone_def
variables [preorder α] [preorder β]

/-- A function `f` is monotone if `a ≤ b` implies `f a ≤ f b`. -/
def monotone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f a ≤ f b

/-- A function `f` is antitone if `a ≤ b` implies `f b ≤ f a`. -/
def antitone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f b ≤ f a

/-- A function `f` is monotone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f a ≤ f b`. -/
def monotone_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f a ≤ f b

/-- A function `f` is antitone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f b ≤ f a`. -/
def antitone_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f b ≤ f a

/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
def strict_mono (f : α → β) : Prop :=
∀ ⦃a b⦄, a < b → f a < f b

/-- A function `f` is strictly antitone if `a < b` implies `f b < f a`. -/
def strict_anti (f : α → β) : Prop :=
∀ ⦃a b⦄, a < b → f b < f a

/-- A function `f` is strictly monotone on `s` if, for all `a, b ∈ s`, `a < b` implies
`f a < f b`. -/
def strict_mono_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a < f b

/-- A function `f` is strictly antitone on `s` if, for all `a, b ∈ s`, `a < b` implies
`f b < f a`. -/
def strict_anti_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b < f a

end monotone_def

/-! ### Monotonicity on the dual order

Strictly, many of the `*_on.dual` lemmas in this section should use `of_dual ⁻¹' s` instead of `s`,
but right now this is not possible as `set.preimage` is not defined yet, and importing it creates
an import cycle.

Often, you should not need the rewriting lemmas. Instead, you probably want to add `.dual`,
`.dual_left` or `.dual_right` to your `monotone`/`antitone` hypothesis.
-/

section order_dual

variables [preorder α] [preorder β] {f : α → β} {s : set α}

@[simp] lemma monotone_comp_of_dual_iff : monotone (f ∘ of_dual) ↔ antitone f := forall_swap
@[simp] lemma antitone_comp_of_dual_iff : antitone (f ∘ of_dual) ↔ monotone f := forall_swap
@[simp] lemma monotone_to_dual_comp_iff : monotone (to_dual ∘ f) ↔ antitone f := iff.rfl
@[simp] lemma antitone_to_dual_comp_iff : antitone (to_dual ∘ f) ↔ monotone f := iff.rfl

@[simp] lemma monotone_on_comp_of_dual_iff : monotone_on (f ∘ of_dual) s ↔ antitone_on f s :=
forall₂_swap
@[simp] lemma antitone_on_comp_of_dual_iff : antitone_on (f ∘ of_dual) s ↔ monotone_on f s :=
forall₂_swap
@[simp] lemma monotone_on_to_dual_comp_iff : monotone_on (to_dual ∘ f) s ↔ antitone_on f s :=
iff.rfl
@[simp] lemma antitone_on_to_dual_comp_iff : antitone_on (to_dual ∘ f) s ↔ monotone_on f s :=
iff.rfl

@[simp] lemma strict_mono_comp_of_dual_iff : strict_mono (f ∘ of_dual) ↔ strict_anti f :=
forall_swap
@[simp] lemma strict_anti_comp_of_dual_iff : strict_anti (f ∘ of_dual) ↔ strict_mono f :=
forall_swap
@[simp] lemma strict_mono_to_dual_comp_iff : strict_mono (to_dual ∘ f) ↔ strict_anti f := iff.rfl
@[simp] lemma strict_anti_to_dual_comp_iff : strict_anti (to_dual ∘ f) ↔ strict_mono f := iff.rfl

@[simp] lemma strict_mono_on_comp_of_dual_iff :
  strict_mono_on (f ∘ of_dual) s ↔ strict_anti_on f s := forall₂_swap
@[simp] lemma strict_anti_on_comp_of_dual_iff :
  strict_anti_on (f ∘ of_dual) s ↔ strict_mono_on f s := forall₂_swap
@[simp] lemma strict_mono_on_to_dual_comp_iff :
  strict_mono_on (to_dual ∘ f) s ↔ strict_anti_on f s := iff.rfl
@[simp] lemma strict_anti_on_to_dual_comp_iff :
  strict_anti_on (to_dual ∘ f) s ↔ strict_mono_on f s := iff.rfl

protected lemma monotone.dual (hf : monotone f) : monotone (to_dual ∘ f ∘ of_dual) := swap hf
protected lemma antitone.dual (hf : antitone f) : antitone (to_dual ∘ f ∘ of_dual) := swap hf
protected lemma monotone_on.dual (hf : monotone_on f s) : monotone_on (to_dual ∘ f ∘ of_dual) s :=
swap₂ hf
protected lemma antitone_on.dual (hf : antitone_on f s) : antitone_on (to_dual ∘ f ∘ of_dual) s :=
swap₂ hf
protected lemma strict_mono.dual (hf : strict_mono f) : strict_mono (to_dual ∘ f ∘ of_dual) :=
swap hf
protected lemma strict_anti.dual (hf : strict_anti f) : strict_anti (to_dual ∘ f ∘ of_dual) :=
swap hf
protected lemma strict_mono_on.dual (hf : strict_mono_on f s) :
  strict_mono_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf
protected lemma strict_anti_on.dual (hf : strict_anti_on f s) :
  strict_anti_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf

alias antitone_comp_of_dual_iff ↔ _ monotone.dual_left
alias monotone_comp_of_dual_iff ↔ _ antitone.dual_left
alias antitone_to_dual_comp_iff ↔ _ monotone.dual_right
alias monotone_to_dual_comp_iff ↔ _ antitone.dual_right
alias antitone_on_comp_of_dual_iff ↔ _ monotone_on.dual_left
alias monotone_on_comp_of_dual_iff ↔ _ antitone_on.dual_left
alias antitone_on_to_dual_comp_iff ↔ _ monotone_on.dual_right
alias monotone_on_to_dual_comp_iff ↔ _ antitone_on.dual_right
alias strict_anti_comp_of_dual_iff ↔ _ strict_mono.dual_left
alias strict_mono_comp_of_dual_iff ↔ _ strict_anti.dual_left
alias strict_anti_to_dual_comp_iff ↔ _ strict_mono.dual_right
alias strict_mono_to_dual_comp_iff ↔ _ strict_anti.dual_right
alias strict_anti_on_comp_of_dual_iff ↔ _ strict_mono_on.dual_left
alias strict_mono_on_comp_of_dual_iff ↔ _ strict_anti_on.dual_left
alias strict_anti_on_to_dual_comp_iff ↔ _ strict_mono_on.dual_right
alias strict_mono_on_to_dual_comp_iff ↔ _ strict_anti_on.dual_right

end order_dual

/-! ### Monotonicity in function spaces -/

section preorder
variables [preorder α]

theorem monotone.comp_le_comp_left [preorder β]
  {f : β → α} {g h : γ → β} (hf : monotone f) (le_gh : g ≤ h) :
  has_le.le.{max w u} (f ∘ g) (f ∘ h) :=
λ x, hf (le_gh x)

variables [preorder γ]

theorem monotone_lam {f : α → β → γ} (hf : ∀ b, monotone (λ a, f a b)) : monotone f :=
λ a a' h b, hf b h

theorem monotone_app (f : β → α → γ) (b : β) (hf : monotone (λ a b, f b a)) : monotone (f b) :=
λ a a' h, hf h b

theorem antitone_lam {f : α → β → γ} (hf : ∀ b, antitone (λ a, f a b)) : antitone f :=
λ a a' h b, hf b h

theorem antitone_app (f : β → α → γ) (b : β) (hf : antitone (λ a b, f b a)) : antitone (f b) :=
λ a a' h, hf h b

end preorder

lemma function.monotone_eval {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] (i : ι) :
  monotone (function.eval i : (Π i, α i) → α i) :=
λ f g H, H i

/-! ### Monotonicity hierarchy -/

section preorder
variables [preorder α]

section preorder
variables [preorder β] {f : α → β} {a b : α}

/-!
These four lemmas are there to strip off the semi-implicit arguments `⦃a b : α⦄`. This is useful
when you do not want to apply a `monotone` assumption (i.e. your goal is `a ≤ b → f a ≤ f b`).
However if you find yourself writing `hf.imp h`, then you should have written `hf h` instead.
-/

lemma monotone.imp (hf : monotone f) (h : a ≤ b) : f a ≤ f b := hf h
lemma antitone.imp (hf : antitone f) (h : a ≤ b) : f b ≤ f a := hf h
lemma strict_mono.imp (hf : strict_mono f) (h : a < b) : f a < f b := hf h
lemma strict_anti.imp (hf : strict_anti f) (h : a < b) : f b < f a := hf h

protected lemma monotone.monotone_on (hf : monotone f) (s : set α) : monotone_on f s :=
λ a _ b _, hf.imp

protected lemma antitone.antitone_on (hf : antitone f) (s : set α) : antitone_on f s :=
λ a _ b _, hf.imp

lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
⟨λ h a b, h trivial trivial, λ h, h.monotone_on _⟩

lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
⟨λ h a b, h trivial trivial, λ h, h.antitone_on _⟩

protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : strict_mono_on f s :=
λ a _ b _, hf.imp

protected lemma strict_anti.strict_anti_on (hf : strict_anti f) (s : set α) : strict_anti_on f s :=
λ a _ b _, hf.imp

lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
⟨λ h a b, h trivial trivial, λ h, h.strict_mono_on _⟩

lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
⟨λ h a b, h trivial trivial, λ h, h.strict_anti_on _⟩

end preorder

section partial_order
variables [partial_order β] {f : α → β}

lemma monotone.strict_mono_of_injective (h₁ : monotone f) (h₂ : injective f) : strict_mono f :=
λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H)

lemma antitone.strict_anti_of_injective (h₁ : antitone f) (h₂ : injective f) : strict_anti f :=
λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H.symm)

end partial_order
end preorder

section partial_order
variables [partial_order α] [preorder β] {f : α → β} {s : set α}

lemma monotone_iff_forall_lt : monotone f ↔ ∀ ⦃a b⦄, a < b → f a ≤ f b :=
forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) hf⟩

lemma antitone_iff_forall_lt : antitone f ↔ ∀ ⦃a b⦄, a < b → f b ≤ f a :=
forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) hf⟩

lemma monotone_on_iff_forall_lt :
  monotone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a ≤ f b :=
⟨λ hf a ha b hb h, hf ha hb h.le,
  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) (hf ha hb)⟩

lemma antitone_on_iff_forall_lt :
  antitone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b ≤ f a :=
⟨λ hf a ha b hb h, hf ha hb h.le,
  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) (hf ha hb)⟩

-- `preorder α` isn't strong enough: if the preorder on `α` is an equivalence relation,
-- then `strict_mono f` is vacuously true.
protected lemma strict_mono_on.monotone_on (hf : strict_mono_on f s) : monotone_on f s :=
monotone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le

protected lemma strict_anti_on.antitone_on (hf : strict_anti_on f s) : antitone_on f s :=
antitone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le

protected lemma strict_mono.monotone (hf : strict_mono f) : monotone f :=
monotone_iff_forall_lt.2 $ λ a b h, (hf h).le

protected lemma strict_anti.antitone (hf : strict_anti f) : antitone f :=
antitone_iff_forall_lt.2 $ λ a b h, (hf h).le

end partial_order

/-! ### Monotonicity from and to subsingletons -/

namespace subsingleton
variables [preorder α] [preorder β]

protected lemma monotone [subsingleton α] (f : α → β) : monotone f :=
λ a b _, (congr_arg _ $ subsingleton.elim _ _).le

protected lemma antitone [subsingleton α] (f : α → β) : antitone f :=
λ a b _, (congr_arg _ $ subsingleton.elim _ _).le

lemma monotone' [subsingleton β] (f : α → β) : monotone f := λ a b _, (subsingleton.elim _ _).le
lemma antitone' [subsingleton β] (f : α → β) : antitone f := λ a b _, (subsingleton.elim _ _).le

protected lemma strict_mono [subsingleton α] (f : α → β) : strict_mono f :=
λ a b h, (h.ne $ subsingleton.elim _ _).elim

protected lemma strict_anti [subsingleton α] (f : α → β) : strict_anti f :=
λ a b h, (h.ne $ subsingleton.elim _ _).elim

end subsingleton

/-! ### Miscellaneous monotonicity results -/

lemma monotone_id [preorder α] : monotone (id : α → α) := λ a b, id

lemma strict_mono_id [preorder α] : strict_mono (id : α → α) := λ a b, id

theorem monotone_const [preorder α] [preorder β] {c : β} : monotone (λ (a : α), c) :=
λ a b _, le_refl c

theorem antitone_const [preorder α] [preorder β] {c : β} : antitone (λ (a : α), c) :=
λ a b _, le_refl c

lemma strict_mono_of_le_iff_le [preorder α] [preorder β] {f : α → β}
  (h : ∀ x y, x ≤ y ↔ f x ≤ f y) : strict_mono f :=
λ a b, (lt_iff_lt_of_le_iff_le' (h _ _) (h _ _)).1

lemma injective_of_lt_imp_ne [linear_order α] {f : α → β} (h : ∀ x y, x < y → f x ≠ f y) :
  injective f :=
begin
  intros x y hxy,
  contrapose hxy,
  cases ne.lt_or_lt hxy with hxy hxy,
  exacts [h _ _ hxy, (h _ _ hxy).symm]
end

lemma injective_of_le_imp_le [partial_order α] [preorder β] (f : α → β)
  (h : ∀ {x y}, f x ≤ f y → x ≤ y) : injective f :=
λ x y hxy, (h hxy.le).antisymm (h hxy.ge)

section preorder
variables [preorder α] [preorder β] {f g : α → β} {a : α}

lemma strict_mono.is_max_of_apply (hf : strict_mono f) (ha : is_max (f a)) : is_max a :=
of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_max ha

lemma strict_mono.is_min_of_apply (hf : strict_mono f) (ha : is_min (f a)) : is_min a :=
of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_min ha

lemma strict_anti.is_max_of_apply (hf : strict_anti f) (ha : is_min (f a)) : is_max a :=
of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_min ha

lemma strict_anti.is_min_of_apply (hf : strict_anti f) (ha : is_max (f a)) : is_min a :=
of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_max ha

protected lemma strict_mono.ite' (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → f x < g y) :
  strict_mono (λ x, if p x then f x else g x) :=
begin
  intros x y h,
  by_cases hy : p y,
  { have hx : p x := hp h hy,
    simpa [hx, hy] using hf h },
  by_cases hx : p x,
  { simpa [hx, hy] using hfg hx hy h },
  { simpa [hx, hy] using hg h}
end

protected lemma strict_mono.ite (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, f x ≤ g x) :
  strict_mono (λ x, if p x then f x else g x) :=
hf.ite' hg hp $ λ x y hx hy h, (hf h).trans_le (hfg y)

protected lemma strict_anti.ite' (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → g y < f x) :
  strict_anti (λ x, if p x then f x else g x) :=
(strict_mono.ite' hf.dual_right hg.dual_right hp hfg).dual_right

protected lemma strict_anti.ite (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, g x ≤ f x) :
  strict_anti (λ x, if p x then f x else g x) :=
hf.ite' hg hp $ λ x y hx hy h, (hfg y).trans_lt (hf h)

end preorder

/-! ### Monotonicity under composition -/

section composition
variables [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β} {s : set α}

protected lemma monotone.comp (hg : monotone g) (hf : monotone f) :
  monotone (g ∘ f) :=
λ a b h, hg (hf h)

lemma monotone.comp_antitone (hg : monotone g) (hf : antitone f) :
  antitone (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma antitone.comp (hg : antitone g) (hf : antitone f) :
  monotone (g ∘ f) :=
λ a b h, hg (hf h)

lemma antitone.comp_monotone (hg : antitone g) (hf : monotone f) :
  antitone (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma monotone.iterate {f : α → α} (hf : monotone f) (n : ℕ) : monotone (f^[n]) :=
nat.rec_on n monotone_id (λ n h, h.comp hf)

protected lemma monotone.comp_monotone_on (hg : monotone g) (hf : monotone_on f s) :
  monotone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma monotone.comp_antitone_on (hg : monotone g) (hf : antitone_on f s) :
  antitone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma antitone.comp_antitone_on (hg : antitone g) (hf : antitone_on f s) :
  monotone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma antitone.comp_monotone_on (hg : antitone g) (hf : monotone_on f s) :
  antitone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma strict_mono.comp (hg : strict_mono g) (hf : strict_mono f) :
  strict_mono (g ∘ f) :=
λ a b h, hg (hf h)

lemma strict_mono.comp_strict_anti (hg : strict_mono g) (hf : strict_anti f) :
  strict_anti (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma strict_anti.comp (hg : strict_anti g) (hf : strict_anti f) :
  strict_mono (g ∘ f) :=
λ a b h, hg (hf h)

lemma strict_anti.comp_strict_mono (hg : strict_anti g) (hf : strict_mono f) :
  strict_anti (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma strict_mono.iterate {f : α → α} (hf : strict_mono f) (n : ℕ) :
  strict_mono (f^[n]) :=
nat.rec_on n strict_mono_id (λ n h, h.comp hf)

protected lemma strict_mono.comp_strict_mono_on (hg : strict_mono g) (hf : strict_mono_on f s) :
  strict_mono_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma strict_mono.comp_strict_anti_on (hg : strict_mono g) (hf : strict_anti_on f s) :
  strict_anti_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma strict_anti.comp_strict_anti_on (hg : strict_anti g) (hf : strict_anti_on f s) :
  strict_mono_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma strict_anti.comp_strict_mono_on (hg : strict_anti g) (hf : strict_mono_on f s) :
  strict_anti_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

end composition

namespace list

section fold

theorem foldl_monotone [preorder α] {f : α → β → α} (H : ∀ b, monotone (λ a, f a b)) (l : list β) :
  monotone (λ a, l.foldl f a) :=
list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))

theorem foldr_monotone [preorder β] {f : α → β → β} (H : ∀ a, monotone (f a)) (l : list α) :
  monotone (λ b, l.foldr f b) :=
λ _ _ h, list.rec_on l h (λ i l hl, H i hl)

theorem foldl_strict_mono [preorder α] {f : α → β → α} (H : ∀ b, strict_mono (λ a, f a b))
  (l : list β) : strict_mono (λ a, l.foldl f a) :=
list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))

theorem foldr_strict_mono [preorder β] {f : α → β → β} (H : ∀ a, strict_mono (f a)) (l : list α) :
  strict_mono (λ b, l.foldr f b) :=
λ _ _ h, list.rec_on l h (λ i l hl, H i hl)

end fold

end list

/-! ### Monotonicity in linear orders  -/

section linear_order
variables [linear_order α]

section preorder
variables [preorder β] {f : α → β} {s : set α}

open ordering

lemma monotone.reflect_lt (hf : monotone f) {a b : α} (h : f a < f b) : a < b :=
lt_of_not_ge (λ h', h.not_le (hf h'))

lemma antitone.reflect_lt (hf : antitone f) {a b : α} (h : f a < f b) : b < a :=
lt_of_not_ge (λ h', h.not_le (hf h'))

lemma monotone_on.reflect_lt (hf : monotone_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s)
  (h : f a < f b) :
  a < b :=
lt_of_not_ge $ λ h', h.not_le $ hf hb ha h'

lemma antitone_on.reflect_lt (hf : antitone_on f s) {a b : α}  (ha : a ∈ s) (hb : b ∈ s)
  (h : f a < f b) :
  b < a :=
lt_of_not_ge $ λ h', h.not_le $ hf ha hb h'

lemma strict_mono_on.le_iff_le (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a ≤ f b ↔ a ≤ b :=
⟨λ h, le_of_not_gt $ λ h', (hf hb ha h').not_le h,
 λ h, h.lt_or_eq_dec.elim (λ h', (hf ha hb h').le) (λ h', h' ▸ le_rfl)⟩

lemma strict_anti_on.le_iff_le (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a ≤ f b ↔ b ≤ a :=
hf.dual_right.le_iff_le hb ha

lemma strict_mono_on.lt_iff_lt (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a < f b ↔ a < b :=
by rw [lt_iff_le_not_le, lt_iff_le_not_le, hf.le_iff_le ha hb, hf.le_iff_le hb ha]

lemma strict_anti_on.lt_iff_lt (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a < f b ↔ b < a :=
hf.dual_right.lt_iff_lt hb ha

lemma strict_mono.le_iff_le (hf : strict_mono f) {a b : α} :
  f a ≤ f b ↔ a ≤ b :=
(hf.strict_mono_on set.univ).le_iff_le trivial trivial

lemma strict_anti.le_iff_le (hf : strict_anti f) {a b : α} :
  f a ≤ f b ↔ b ≤ a :=
(hf.strict_anti_on set.univ).le_iff_le trivial trivial

lemma strict_mono.lt_iff_lt (hf : strict_mono f) {a b : α} :
  f a < f b ↔ a < b :=
(hf.strict_mono_on set.univ).lt_iff_lt trivial trivial

lemma strict_anti.lt_iff_lt (hf : strict_anti f) {a b : α} :
  f a < f b ↔ b < a :=
(hf.strict_anti_on set.univ).lt_iff_lt trivial trivial

protected theorem strict_mono_on.compares (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s)
  (hb : b ∈ s) :
  ∀ {o : ordering}, o.compares (f a) (f b) ↔ o.compares a b
| ordering.lt := hf.lt_iff_lt ha hb
| ordering.eq := ⟨λ h, ((hf.le_iff_le ha hb).1 h.le).antisymm ((hf.le_iff_le hb ha).1 h.symm.le),
                   congr_arg _⟩
| ordering.gt := hf.lt_iff_lt hb ha

protected theorem strict_anti_on.compares (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s)
  (hb : b ∈ s) {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares b a :=
to_dual_compares_to_dual.trans $ hf.dual_right.compares hb ha

protected theorem strict_mono.compares (hf : strict_mono f) {a b : α} {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares a b :=
(hf.strict_mono_on set.univ).compares trivial trivial

protected theorem strict_anti.compares (hf : strict_anti f) {a b : α} {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares b a :=
(hf.strict_anti_on set.univ).compares trivial trivial

lemma strict_mono.injective (hf : strict_mono f) : injective f :=
λ x y h, show compares eq x y, from hf.compares.1 h

lemma strict_anti.injective (hf : strict_anti f) : injective f :=
λ x y h, show compares eq x y, from hf.compares.1 h.symm

lemma strict_mono.maximal_of_maximal_image (hf : strict_mono f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
  x ≤ a :=
hf.le_iff_le.mp (hmax (f x))

lemma strict_mono.minimal_of_minimal_image (hf : strict_mono f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
  a ≤ x :=
hf.le_iff_le.mp (hmin (f x))

lemma strict_anti.minimal_of_maximal_image (hf : strict_anti f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
  a ≤ x :=
hf.le_iff_le.mp (hmax (f x))

lemma strict_anti.maximal_of_minimal_image (hf : strict_anti f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
  x ≤ a :=
hf.le_iff_le.mp (hmin (f x))

end preorder

section partial_order
variables [partial_order β] {f : α → β}

lemma monotone.strict_mono_iff_injective (hf : monotone f) :
  strict_mono f ↔ injective f :=
⟨λ h, h.injective, hf.strict_mono_of_injective⟩

lemma antitone.strict_anti_iff_injective (hf : antitone f) :
  strict_anti f ↔ injective f :=
⟨λ h, h.injective, hf.strict_anti_of_injective⟩

end partial_order

/-!
### Strictly monotone functions and `cmp`
-/

variables [linear_order β] {f : α → β} {s : set α} {x y : α}

lemma strict_mono_on.cmp_map_eq (hf : strict_mono_on f s) (hx : x ∈ s) (hy : y ∈ s) :
  cmp (f x) (f y) = cmp x y :=
((hf.compares hx hy).2 (cmp_compares x y)).cmp_eq

lemma strict_mono.cmp_map_eq (hf : strict_mono f) (x y : α) : cmp (f x) (f y) = cmp x y :=
(hf.strict_mono_on set.univ).cmp_map_eq trivial trivial

lemma strict_anti_on.cmp_map_eq (hf : strict_anti_on f s) (hx : x ∈ s) (hy : y ∈ s) :
  cmp (f x) (f y) = cmp y x :=
hf.dual_right.cmp_map_eq hy hx

lemma strict_anti.cmp_map_eq (hf : strict_anti f) (x y : α) : cmp (f x) (f y) = cmp y x :=
(hf.strict_anti_on set.univ).cmp_map_eq trivial trivial

end linear_order

/-! ### Monotonicity in `ℕ` and `ℤ` -/

section preorder
variables [preorder α]

lemma nat.rel_of_forall_rel_succ_of_le_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
  (hab : a ≤ b) (hbc : b < c) :
  r (f b) (f c) :=
begin
  induction hbc with k b_lt_k r_b_k,
  exacts [h _ hab, trans r_b_k (h _ (hab.trans_lt b_lt_k).le)]
end

lemma nat.rel_of_forall_rel_succ_of_le_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
  (hab : a ≤ b) (hbc : b ≤ c) :
  r (f b) (f c) :=
hbc.eq_or_lt.elim (λ h, h ▸ refl _) (nat.rel_of_forall_rel_succ_of_le_of_lt r h hab)

lemma nat.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a < b) : r (f a) (f b) :=
nat.rel_of_forall_rel_succ_of_le_of_lt r (λ n _, h n) le_rfl hab

lemma nat.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a ≤ b) : r (f a) (f b) :=
nat.rel_of_forall_rel_succ_of_le_of_le r (λ n _, h n) le_rfl hab

lemma monotone_nat_of_le_succ {f : ℕ → α} (hf : ∀ n, f n ≤ f (n + 1)) :
  monotone f :=
nat.rel_of_forall_rel_succ_of_le (≤) hf

lemma antitone_nat_of_succ_le {f : ℕ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
@monotone_nat_of_le_succ αᵒᵈ _ _ hf

lemma strict_mono_nat_of_lt_succ {f : ℕ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
nat.rel_of_forall_rel_succ_of_lt (<) hf

lemma strict_anti_nat_of_succ_lt {f : ℕ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
@strict_mono_nat_of_lt_succ αᵒᵈ _ f hf

namespace nat

/-- If `α` is a preorder with no maximal elements, then there exists a strictly monotone function
`ℕ → α` with any prescribed value of `f 0`. -/
lemma exists_strict_mono' [no_max_order α] (a : α) : ∃ f : ℕ → α, strict_mono f ∧ f 0 = a :=
begin
  have := (λ x : α, exists_gt x),
  choose g hg,
  exact ⟨λ n, nat.rec_on n a (λ _, g), strict_mono_nat_of_lt_succ $ λ n, hg _, rfl⟩
end

/-- If `α` is a preorder with no maximal elements, then there exists a strictly antitone function
`ℕ → α` with any prescribed value of `f 0`. -/
lemma exists_strict_anti' [no_min_order α] (a : α) : ∃ f : ℕ → α, strict_anti f ∧ f 0 = a :=
exists_strict_mono' (order_dual.to_dual a)

variable (α)

/-- If `α` is a nonempty preorder with no maximal elements, then there exists a strictly monotone
function `ℕ → α`. -/
lemma exists_strict_mono [nonempty α] [no_max_order α] : ∃ f : ℕ → α, strict_mono f :=
let ⟨a⟩ := ‹nonempty α›, ⟨f, hf, hfa⟩ := exists_strict_mono' a in ⟨f, hf⟩

/-- If `α` is a nonempty preorder with no minimal elements, then there exists a strictly antitone
function `ℕ → α`. -/
lemma exists_strict_anti [nonempty α] [no_min_order α] : ∃ f : ℕ → α, strict_anti f :=
exists_strict_mono αᵒᵈ

end nat

lemma int.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a < b) : r (f a) (f b) :=
begin
  rcases hab.dest with ⟨n, rfl⟩, clear hab,
  induction n with n ihn,
  { rw int.coe_nat_one, apply h },
  { rw [int.coe_nat_succ, ← int.add_assoc],
    exact trans ihn (h _) }
end

lemma int.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a ≤ b) : r (f a) (f b) :=
hab.eq_or_lt.elim (λ h, h ▸ refl _) (λ h', int.rel_of_forall_rel_succ_of_lt r h h')

lemma monotone_int_of_le_succ {f : ℤ → α} (hf : ∀ n, f n ≤ f (n + 1)) : monotone f :=
int.rel_of_forall_rel_succ_of_le (≤) hf

lemma antitone_int_of_succ_le {f : ℤ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
int.rel_of_forall_rel_succ_of_le (≥) hf

lemma strict_mono_int_of_lt_succ {f : ℤ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
int.rel_of_forall_rel_succ_of_lt (<) hf

lemma strict_anti_int_of_succ_lt {f : ℤ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
int.rel_of_forall_rel_succ_of_lt (>) hf

namespace int

variables (α) [nonempty α] [no_min_order α] [no_max_order α]

/-- If `α` is a nonempty preorder with no minimal or maximal elements, then there exists a strictly
monotone function `f : ℤ → α`. -/
lemma exists_strict_mono : ∃ f : ℤ → α, strict_mono f :=
begin
  inhabit α,
  rcases nat.exists_strict_mono' (default : α) with ⟨f, hf, hf₀⟩,
  rcases nat.exists_strict_anti' (default : α) with ⟨g, hg, hg₀⟩,
  refine ⟨λ n, int.cases_on n f (λ n, g (n + 1)), strict_mono_int_of_lt_succ _⟩,
  rintro (n|_|n),
  { exact hf n.lt_succ_self },
  { show g 1 < f 0,
    rw [hf₀, ← hg₀],
    exact hg nat.zero_lt_one },
  { exact hg (nat.lt_succ_self _) }
end

/-- If `α` is a nonempty preorder with no minimal or maximal elements, then there exists a strictly
antitone function `f : ℤ → α`. -/
lemma exists_strict_anti : ∃ f : ℤ → α, strict_anti f := exists_strict_mono αᵒᵈ

end int

-- TODO@Yael: Generalize the following four to succ orders
/-- If `f` is a monotone function from `ℕ` to a preorder such that `x` lies between `f n` and
  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
lemma monotone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : monotone f) (n : ℕ) {x : α}
  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℕ) :
  f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h1).not_le (nat.le_of_lt_succ $ hf.reflect_lt h2) }

/-- If `f` is an antitone function from `ℕ` to a preorder such that `x` lies between `f (n + 1)` and
`f n`, then `x` doesn't lie in the range of `f`. -/
lemma antitone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : antitone f)
  (n : ℕ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℕ) : f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h2).not_le (nat.le_of_lt_succ $ hf.reflect_lt h1) }

/-- If `f` is a monotone function from `ℤ` to a preorder and `x` lies between `f n` and
  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
lemma monotone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : monotone f) (n : ℤ) {x : α}
  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℤ) :
  f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h1).not_le (int.le_of_lt_add_one $ hf.reflect_lt h2) }

/-- If `f` is an antitone function from `ℤ` to a preorder and `x` lies between `f (n + 1)` and
`f n`, then `x` doesn't lie in the range of `f`. -/
lemma antitone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : antitone f)
  (n : ℤ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℤ) : f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h2).not_le (int.le_of_lt_add_one $ hf.reflect_lt h1) }

lemma strict_mono.id_le {φ : ℕ → ℕ} (h : strict_mono φ) : ∀ n, n ≤ φ n :=
λ n, nat.rec_on n (nat.zero_le _)
  (λ n hn, nat.succ_le_of_lt (hn.trans_lt $ h $ nat.lt_succ_self n))

end preorder

lemma subtype.mono_coe [preorder α] (t : set α) : monotone (coe : (subtype t) → α) :=
λ x y, id

lemma subtype.strict_mono_coe [preorder α] (t : set α) : strict_mono (coe : (subtype t) → α) :=
λ x y, id

section preorder
variables [preorder α] [preorder β] [preorder γ] [preorder δ] {f : α → γ} {g : β → δ} {a b : α}

lemma monotone_fst : monotone (@prod.fst α β) := λ a b, and.left
lemma monotone_snd : monotone (@prod.snd α β) := λ a b, and.right

lemma monotone.prod_map (hf : monotone f) (hg : monotone g) : monotone (prod.map f g) :=
λ a b h, ⟨hf h.1, hg h.2⟩

lemma antitone.prod_map (hf : antitone f) (hg : antitone g) : antitone (prod.map f g) :=
λ a b h, ⟨hf h.1, hg h.2⟩

end preorder

section partial_order
variables [partial_order α] [partial_order β] [preorder γ] [preorder δ]
  {f : α → γ} {g : β → δ}

lemma strict_mono.prod_map (hf : strict_mono f) (hg : strict_mono g) : strict_mono (prod.map f g) :=
λ a b, by { simp_rw prod.lt_iff,
  exact or.imp (and.imp hf.imp hg.monotone.imp) (and.imp hf.monotone.imp hg.imp) }

lemma strict_anti.prod_map (hf : strict_anti f) (hg : strict_anti g) : strict_anti (prod.map f g) :=
λ a b, by { simp_rw prod.lt_iff,
  exact or.imp (and.imp hf.imp hg.antitone.imp) (and.imp hf.antitone.imp hg.imp) }

end partial_order


import week_8.ideas.Part_C_H1
/-

# Boundary maps

If 0 → A → B → C → 0 is exact, we want
a boundary map `H0 G C →+ H1 G A`

We're going to use the axiom of choice in our definition.
Whenever we invoke the axiom of choice we are using something
noncomputable, so it's important that we make a proper API
for the object we construct.

-/

-- missing?
section missing

variables {A B : Type*} [group A] [group B]
  (f : A →* B) (a1 a2 : A)

@[to_additive] lemma monoid_hom.map_div (a1 a2 : A) :
  f (a1 / a2) = f a1 / f a2 :=
by simp [div_eq_mul_inv]

@[simp, to_additive] lemma group.div_self (a : A) : a / a = 1 :=
by simp [div_eq_mul_inv]

@[simp, to_additive] lemma group.div_eq_one_iff (a1 a2 : A) : a1 / a2 = 1 ↔ a1 = a2 :=
⟨by simp [div_eq_mul_inv, mul_eq_one_iff_eq_inv], by {rintro rfl, simp}⟩

@[to_additive] lemma monoid_hom.div_mem_ker (f : A →* B) (a1 a2 : A) :
  a1 / a2 ∈ f.ker ↔ f a1 = f a2 :=
begin
  rw monoid_hom.mem_ker,
  rw f.map_div,
  rw group.div_eq_one_iff,
end

end missing

namespace boundary_map

variables {G M N P : Type} [monoid G]
  [add_comm_group M] [distrib_mul_action G M]
  [add_comm_group N] [distrib_mul_action G N]
  [add_comm_group P] [distrib_mul_action G P]
  {φ : M →+[G] N} {ψ : N →+[G] P} (hse : is_short_exact φ ψ)

include hse

noncomputable def raw_boundary_function : H0 G P → (G → M) :=
λ p g, hse.inverse_φ (g • (hse.inverse_ψ p) - hse.inverse_ψ p)
begin
  rw hse.exact_set,
  simp [hse.inverse_ψ_spec, p.spec],
end

lemma raw_boundary_function.is_cocycle
  {p : H0 G P} : is_cocycle (raw_boundary_function hse p) :=
begin
  intros g h,
  unfold raw_boundary_function,
  apply hse.injective,
  -- should `smul_sub` be a `simp` lemma?
  simp [mul_smul, smul_sub],
end

noncomputable def delta : H0 G P →+ H1 G M :=
{ to_fun := λ p, Z1.quotient
  { to_fun := raw_boundary_function hse p,
    is_cocycle' := raw_boundary_function.is_cocycle hse },
  map_zero' := begin
    rw ← add_monoid_hom.mem_ker,
    rw H1.ker_quotient,
    simp [raw_boundary_function],
    refine ⟨hse.inverse_φ (hse.inverse_ψ 0) _, _⟩,
    { rw hse.exact_set,
      rw hse.inverse_ψ_spec },
    ext g,
    simp,
    apply hse.injective,
    simp [hse.inverse_φ_spec],
  end,
  map_add' := begin
    intros p q,
    rw ← add_monoid_hom.map_add,
    rw ← add_monoid_hom.sub_mem_ker,
    rw H1.ker_quotient,
    have crucial :
      ∃ m : M, φ m = hse.inverse_ψ (↑p + ↑q) - hse.inverse_ψ p - hse.inverse_ψ q,
    { simp [hse.exact_set] },
    refine ⟨hse.inverse_φ _ crucial, _⟩,
    ext g,
    simp [cochain_map, Z1.coe_add, raw_boundary_function],
    apply hse.injective,
    simp [smul_sub],
    abel,
  end }

/-

todo
In Part D of this week's workshop we will define
a boundary map `H0 G C →+ H1 H A` coming from a short
exact sequence of `G`-modules. In this definition we make
a choice of sign ("do we use `g b - b` or `b - g b`?").
The final boss of this course
is verifying the first seven terms of the long exact sequence
of group cohomology associated to a short exact sequence of
G-modules.

TODO

boundary map API

7 term exact sequnce

inf-res

-/

end boundary_map


import .love07_metaprogramming_demo

/- # LoVe Exercise 7: Metaprogramming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: A Term Exploder

In this exercise, we develop a string format for the `expr` metatype. By
default, there is no `has_repr` instance to print a nice string. For example: -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)   -- result: `[external]`
#eval (`(λx : ℕ, x + x) : expr)                     -- result: `[external]`

/- 1.1. Define a metafunction `expr.repr` that converts an `expr` into a
`string`. It is acceptable to leave out some fields from the `expr`
constructors, such as the level `l` of a sort, the binder information `bi` of
a `λ` or `∀` binder, and the arguments of the `macro` constructor.

Hint: Use `name.to_string` to convert a name to a string, and `repr` for other
types that belong to the `has_repr` type class. -/

meta def expr.repr : expr → string
| (expr.var n)                := "(var " ++ repr n ++ ")"
| (expr.sort l)               := "sort"
| (expr.const n ls)           := "(const " ++ n.to_string ++ ")"
| (expr.mvar n m t)           :=
  "(mvar " ++ name.to_string n ++ " " ++ name.to_string m ++ " " ++
  expr.repr t ++ ")"
| (expr.local_const n m bi t) :=
  "(local_const " ++ name.to_string n ++ " " ++ name.to_string m ++ " " ++
  expr.repr t ++ ")"
| (expr.app e f)              :=
  "(app " ++ expr.repr e ++ " " ++ expr.repr f ++ ")"
| (expr.lam n bi e t)         :=
  "(lam " ++ name.to_string n ++ " " ++ expr.repr e ++ " " ++ expr.repr t ++ ")"
| (expr.pi n bi e t)          :=
  "(pi " ++ name.to_string n ++ " " ++ expr.repr e ++ " " ++ expr.repr t ++ ")"
| (expr.elet n g e f)         :=
  "(elet " ++ name.to_string n ++ " " ++ expr.repr g ++ " " ++ expr.repr e ++
  " " ++ expr.repr f ++ ")"
| (expr.macro d args)         := "macro"

/- We register `expr.repr` in the `has_repr` type class, so that we can use
`repr` without qualification in the future, and so that it is available to
`#eval`. We need the `meta` keyword in front of the command we enter. -/

meta instance expr.has_repr : has_repr expr :=
{ repr := expr.repr }

/- 1.2. Test your setup. -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)
#eval (`(λx : ℕ, x + x) : expr)

/- 1.3. Compare your answer with `expr.to_raw_fmt`. -/

#check expr.to_raw_fmt

/- ## Question 2: `destruct_and` on Steroids

Recall from the lecture that `destruct_and` fails on easy goals such as -/

lemma abc_ac₂ (a b c : Prop) (h : a ∧ b ∧ c) :
  a ∧ c :=
sorry

/- We will now address this by developing a new tactic called `destro_and`,
which applies both **des**truction and in**tro**duction rules for conjunction.
It will also go automatically through the hypotheses instead of taking an
argument. We will develop it in three steps.

2.1. Develop a tactic `intro_ands` that replaces all goals of the form
`a ∧ b` with two new goals `a` and `b` systematically, until all top-level
conjunctions are gone.

For this, we can use tactics such as `tactic.repeat` (which repeatedly applies a
tactic on all goals and subgoals until the tactic fails on each of the goal) and
`tactic.applyc` (which can be used to apply a rule, in connection with backtick
quoting). -/

meta def intro_ands : tactic unit :=
tactic.repeat (tactic.applyc `and.intro)

lemma abcd_bd (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  intro_ands,
  /- The proof state should be as follows:

  2 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ d -/
  repeat { sorry }
end

lemma abcd_bacb (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  intro_ands,
  /- The proof state should be as follows:

  4 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ a

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ c

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b -/
  repeat { sorry }
end

/- 2.2. Develop a tactic `destruct_ands` that replaces hypotheses of the form
`h : a ∧ b` by two new hypotheses `h_left : a` and `h_right : b` systematically,
until all top-level conjunctions are gone.

Here is imperative-style pseudocode that you can follow:

1. Retrieve the list of hypotheses from the context. This is provided by the
   metaconstant `local_context`.

2. Find the first hypothesis (= term) with a type (= proposition) of the form
   `_ ∧ _`. Here, you can use the `list.mfirst` function, in conjunction with
   pattern matching. You can use `infer_type` to query the type of a term.

3. Perform a case split on the first found hypothesis. This can be achieved
   using the `cases` metafunction.

4. Repeat.

The above procedure might fail if there exists no hypotheses of the required
form. Make sure to handle this failure gracefully, for example using
`tactic.try` or `<|> pure ()`. -/

meta def destruct_ands : tactic unit :=
tactic.repeat (do
  hs ← tactic.local_context,
  h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
  tactic.cases h,
  pure ())

-- Alternative solutions:
meta def destruct_ands₂ : tactic unit :=
tactic.try
  (do
     hs ← tactic.local_context,
     h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
     tactic.cases h,
     destruct_ands₂)

meta def destruct_ands₃ : tactic unit :=
(do
   hs ← tactic.local_context,
   h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
   tactic.cases h,
   destruct_ands₃)
<|> pure ()

lemma abcd_bd₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  destruct_ands,
  /- The proof state should be as follows:

  a b c d : Prop,
  h_left : a,
  h_right_right : d,
  h_right_left_left : b,
  h_right_left_right : c
  ⊢ b ∧ d -/
  sorry
end

/- 2.3. Combine the two tactics developed above and `tactic.assumption` to
implement the desired `destro_and` tactic. -/

meta def destro_and : tactic unit :=
do
  destruct_ands,
  intro_ands,
  tactic.all_goals (tactic.try tactic.assumption),
  pure ()

lemma abcd_bd₃ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
by destro_and

lemma abcd_bacb₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
by destro_and

lemma abd_bacb (a b c d : Prop) (h : a ∧ b ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  destro_and,
  /- The proof state should be roughly as follows:

  a b c d : Prop,
  h_left : a,
  h_right_left : b,
  h_right_right : d
  ⊢ c -/
  sorry   -- unprovable
end

/- 2.4. Provide some more examples for `destro_and` to convince yourself that
it works as expected also on more complicated examples. -/

lemma ab (a b : Prop) (h : a ∨ b) :
  a ∨ b :=
by destro_and

lemma abcdef_1 (a b c d e f : Prop) (h : a ∧ b ∧ c ∧ d ∧ e ∧ f) :
  f ∧ e ∧ f ∧ a ∧ d ∧ b ∧ c ∧ a :=
by destro_and

lemma abcdef_2 (a b c d e f : Prop) (h : a ∧ ((b ∧ ((c ∧ d) ∧ e)) ∧ f)) :
  f ∧ e ∧ f ∧ a ∧ d ∧ b ∧ c ∧ a :=
by destro_and

lemma abcdef_3 (a b c d e f : Prop) (h : a ∧ (b ∧ (c ∧ (d ∧ e ∧ f)))) :
  f ∧ (e ∧ (f ∧ (a ∧ d ∧ b ∧ c ∧ a))) :=
by destro_and

/- ## Question 3 (**optional**): A Theorem Finder

We will implement a function that allows us to find theorems by constants
appearing in their statements. So given a list of constant names, the function
will list all theorems in which all these constants appear.

You can use the following metaconstants:

* `declaration` contains all data (name, type, value) associated with a
  declaration understood broadly (e.g., axiom, lemma, constant, etc.).

* `tactic.get_env` gives us access to the `environment`, a metatype that lists
  all `declaration`s (including all theorems).

* `environment.fold` allows us to walk through the environment and collect data.

* `expr.fold` allows us to walk through an expression and collect data.

3.1 (**optional**). Write a metafunction that checks whether an expression
contains a specific constant.

You can use `expr.fold` to walk through the expression, `||` and `ff` for
Booleans, and `expr.is_constant_of` to check whether an expression is a
constant. -/

meta def term_contains (e : expr) (nam : name) : bool :=
expr.fold e ff (λe' d c, c || expr.is_constant_of e' nam)

/- 3.2 (**optional**). Write a metafunction that checks whether an expression
contains **all** constants in a list.

You can use `list.band` (Boolean and). -/

meta def term_contains_all (nams : list name) (e : expr) : bool :=
list.band (list.map (term_contains e) nams)

/- 3.3 (**optional**). Produce the list of all theorems that contain all
constants `nams` in their statement.

`environment.fold` allows you to walk over the list of declarations. With
`declaration.type`, you get the type of a theorem, and with
`declaration.to_name` you get the name. -/

meta def list_constants (nams : list name) (e : environment) : list name :=
environment.fold e [] (λdecl nams',
  if term_contains_all nams decl.type then decl.to_name :: nams' else nams')

/- Finally, we develop a tactic that uses the above metafunctions to log all
found theorems: -/

meta def find_constants (nams : list name) : tactic unit :=
do
  env ← tactic.get_env,
  list.mmap' tactic.trace (list_constants nams env)

/- We test the solution. -/

run_cmd find_constants []   -- lists all theorems
run_cmd find_constants [`list.map, `function.comp]

end LoVe


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_304 :
  91^2 = 8281 :=
begin
  norm_num,
end


import tactic

variable {α : Type}

-- Stages-are-key. Every set is formed at some stage.
--
-- Stages-are-ordered. Stages are ordered: some come before others.
--
-- Stages-accumulate. For any stage S, and for any sets which were formed
-- before stage S: a set is formed at stage S whose members are exactly those
-- sets. Nothing else is formed at stage S.

#print notation ⋂₀

example : ⋂₀ (∅ : set (set α)) = set.univ :=
begin
  unfold set.sInter,
  unfold Inf,
  ext,
  simp only [forall_false_left, set.mem_empty_eq, forall_const, set.set_of_true],
end

-- Stages-keep-going. There is no last stage.
--
-- Stages-hit-infinity. There is an infinite stage. That is, there is a stage
-- which (a) is not the first stage, and which (b) has some stages before it,
-- but which (c) has no immediate predecessor.

noncomputable theory

axiom Set : Type

#check @has_mem
#check @has_subset
#print notation ∈
#print notation ⊆

axiom mem : Set → Set → Prop

instance : has_mem Set Set := ⟨mem⟩

def subset (A B : Set) :=
∀ ⦃x⦄, x ∈ A → x ∈ B

instance : has_subset Set := ⟨subset⟩

-- Theorem 8.1 (Russell’s Paradox). There is no set R = {x : x ∉ x}
theorem russell's_paradox : ¬ ∃ R : Set, ∀ x, x ∈ R ↔ x ∉ x :=
begin
  rintro ⟨R, hR⟩,
  specialize hR R,
  simpa using hR
end

-- no (ZFC) axioms
#print axioms russell's_paradox

-- Axiom (Extensionality). For any sets A and B: ∀ x (x ∈ A ↔ x ∈ B) → A = B
@[ext] axiom extensionality (A B : Set) (h : ∀ x, x ∈ A ↔ x ∈ B) : A = B

#check @set.ext_iff

lemma ext_iff {A B : Set} : A = B ↔ ∀ x, x ∈ A ↔ x ∈ B :=
begin
  have := extensionality A B,
  tidy
end

#print notation ↔
#print notation ∧

#check @classical.some
#check @classical.some_spec

-- Axiom (Scheme of Separation). For every formula φ(x) this is an axiom: for
-- any A, the set {x ∈ A : φ(x)} exists.
axiom separation (φ : Set → Prop) (A : Set) : Set
axiom separation_spec (φ : Set → Prop) (A : Set) : ∀ x, x ∈ separation φ A ↔ x ∈ A ∧ φ x

#check @has_sep

instance : has_sep Set Set := ⟨separation⟩

-- Theorem 9.1. There is no universal set, i.e., {x : x = x} does not exist.
theorem not_exists_universal_set : ¬ ∃ V : Set, ∀ x, x ∈ V :=
begin
  rintro ⟨V, hV⟩,
  let R := separation (λ x, x ∉ x) V,
  have hR := separation_spec (λ x, x ∉ x) V,
  change ∀ x, x ∈ R ↔ _ ∧ x ∉ x at hR,
  specialize hV R,
  specialize hR R,
  simpa [hV] using hR
end

-- separation
#print axioms not_exists_universal_set

-- Proposition 9.2. If any set exists, then ∅ exists.
lemma proposition_9_2 (A : Set) : ∃ S : Set, ∀ x, x ∉ S :=
begin
  let S := separation (λ x, false) A,
  have hS := separation_spec (λ x, false) A,
  change ∀ x, x ∈ S ↔ _ ∧ false at hS,
  use S,
  intros x hx,
  specialize hS x,
  simpa using hS
end

#check @has_sdiff.sdiff
#print notation \

-- Proposition 9.3. A \ B exists for any sets A and B
lemma proposition_9_3 (A B : Set) : ∃ S : Set, ∀ x, x ∈ S ↔ x ∈ A ∧ x ∉ B :=
⟨separation _ _, separation_spec _ _⟩

instance : has_sdiff Set :=
⟨λ A B, separation (λ x, x ∉ B) A⟩

#print notation ⋂₀

-- Proposition 9.4. If A ≠ ∅, then ⋂ A = {x : (∀ y ∈ A) x ∈ y} exists.
lemma proposition_9_4 (A c : Set) (hc : c ∈ A) :
  ∃ S : Set, ∀ x, x ∈ S ↔ (∀ y, y ∈ A → x ∈ y) :=
begin
  let S := separation (λ x, ∀ y, y ∈ A → x ∈ y) c,
  have hS := separation_spec (λ x, ∀ y, y ∈ A → x ∈ y) c,
  change ∀ x, x ∈ S ↔ _ ∧ ∀ y, y ∈ A → x ∈ y at hS,
  use S,
  intro x,
  specialize hS x,
  rw [hS, and_iff_right_iff_imp],
  intro h,
  specialize h c,
  specialize h hc,
  assumption
end

-- Axiom (Union). For any set A, the set ⋃ A = {x : (∃ b ∈ A) x ∈ b} exists.
-- ∀ A ∃ U ∀ x (x ∈ U ↔ (∃ b ∈ A) x ∈ b)
axiom union (A : Set) : Set
axiom union_spec (A : Set) : ∀ x, x ∈ union A ↔ ∃ b, b ∈ A ∧ x ∈ b

#print notation ↔
#print notation ∨

-- Axiom (Pairs). For any sets a, b, the set {a, b} exists.
-- ∀ a ∀ b ∃ P ∀ x (x ∈ P ↔ (x = a ∨ x = b))
axiom pair (a b : Set) : Set
axiom pair_spec (a b : Set) : ∀ x, x ∈ pair a b ↔ x = a ∨ x = b

-- Axiom (Powersets). For any set A, the set ℘(A) = {x : x ⊆ A} exists.
-- ∀ A ∃ P ∀ x (x ∈ P ↔ (∀ z ∈ x) z ∈ A)
axiom powerset (A : Set) : Set
axiom powerset_spec (A : Set) : ∀ x, x ∈ powerset A ↔ ∀ z, z ∈ x → z ∈ A

-- Axiom (Infinity). There is a set, I, such that ∅ ∈ I and x ∪ {x} ∈ I
-- whenever x ∈ I
-- ∃ I ((∃ o ∈ I) ∀ x x ∉ o ∧
--      (∀ x ∈ I) (∃ s ∈ I) ∀ z (z ∈ s ↔ (z ∈ x ∨ z = x)))
axiom infinity : Set
axiom infinity_spec_zero : ∃ o ∈ infinity, ∀ x, x ∉ o
axiom infinity_spec_succ : ∀ x ∈ infinity, ∃ s ∈ infinity, ∀ z, z ∈ s ↔ z ∈ x ∨ z = x

#print notation ∅

instance : has_emptyc Set := ⟨separation (λ x, false) infinity⟩

lemma empty_spec : ∀ x, x ∉ (∅ : Set) :=
begin
  intros x hx,
  change x ∈ separation _ _ at hx,
  have h := separation_spec (λ x, false) infinity,
  change x ∈ ∅ at hx,
  change ∀ x, x ∈ (∅ : Set) ↔ _ ∧ false at h,
  specialize h x,
  simpa [hx] using h
end

lemma empty_mem_infinity : ∅ ∈ infinity :=
begin
  obtain ⟨o, ho₁, ho₂⟩ := infinity_spec_zero,
  suffices : ∅ = o, by rwa this,
  ext x,
  have h₁ := empty_spec x,
  have h₂ := ho₂ x,
  simp [h₁, h₂]
end

--def closed (f : Set → Set) (X : Set) := ∀ x, x ∈ X → f x ∈ X

-- Proposition 9.5. For any sets a and b, the following sets exist:
-- 1. {a}
-- 2. a ∪ b
-- 3. ⟨a,b⟩
instance : has_singleton Set Set := ⟨λ a, pair a a⟩

lemma singleton_spec (a : Set) : ∀ x ∈ ({a} : Set), x = a :=
begin
  intros x hx,
  change x ∈ pair a a at hx,
  have h := pair_spec a a,
  change x ∈ {a} at hx,
  change ∀ x, x ∈ ({a} : Set) ↔ _ at h,
  specialize h x,
  simpa [hx] using h
end

#check @has_union
#check @has_union.union
#print notation ∪

instance : has_union Set := ⟨λ a b, union (pair a b)⟩

lemma union_spec' (a b : Set) : ∀ x, x ∈ a ∪ b ↔ x ∈ a ∨ x ∈ b :=
begin
  intro x,
  change x ∈ union (pair a b) ↔ _,
  have h := union_spec (pair a b),
  specialize h x,
  rw h,
  clear h,
  have h := pair_spec a b,
  split,
  { rintro ⟨c, hc₁, hc₂⟩,
    specialize h c,
    simp [hc₁] at h,
    cases h,
    { rw ←h,
      left,
      assumption },
    { rw ←h,
      right,
      assumption } },
  { intro hx,
    cases hx,
    { use a,
      specialize h a,
      simp at h,
      simp [h, hx] },
    { use b,
      specialize h b,
      simp at h,
      simp [h, hx] } }
end

#check @has_insert

instance : has_insert Set Set := ⟨λ a b, {a} ∪ b⟩

instance : is_lawful_singleton Set Set :=
⟨begin
  change ∀ x, {x} ∪ ∅ = {x},
  intro x,
  ext y,
  simp [union_spec', empty_spec]
end⟩

example {α : Type} (a b : α) (h : a ∈ ({b} : set α)) : a = b :=
set.mem_singleton_iff.mp h

#check @set.mem_singleton_iff

lemma mem_singleton_iff {a b : Set} : a ∈ ({b} : Set) ↔ a = b :=
begin
  change a ∈ pair b b ↔ _,
  have := pair_spec b b a,
  simp [this]
end

variables {a b c : Set}

#check ({a, b, c} : Set)

variables {a₁ a₂ b₁ b₂ : Set}

#check extensionality
#check set.ext_iff

lemma pair_spec' (a b : Set) : pair a b = {a, b} :=
begin
  ext x,
  have := pair_spec a b x,
  rw this,
  clear this,
  change _ ↔ x ∈ {a} ∪ {b},
  have := union_spec' {a} {b} x,
  rw [this, mem_singleton_iff, mem_singleton_iff]
end

lemma eq_of_eq_singleton (h : {b₁, b₂} = ({a} : Set)) : b₁ = b₂ :=
begin
  have h₁ : b₁ = a,
  { have := ext_iff.mp h b₁,
    rw [←pair_spec', mem_singleton_iff, pair_spec b₁ b₂ b₁] at this,
    simpa using this },
  have h₂ : b₂ = a,
  { have := ext_iff.mp h b₂,
    rw [←pair_spec', mem_singleton_iff, pair_spec b₁ b₂ b₂] at this,
    simpa using this },
  rw [h₁, h₂]
end

def tuple (a b : Set) : Set := pair (pair a a) (pair a b)

#check singleton_spec

example {α : Type} (a b : α) (h : ({a} : set α) = {b}) : a = b :=
by simpa only [set.singleton_eq_singleton_iff] using h

lemma singleton_eq_singleton_iff {a b : Set} : ({a} : Set) = {b} ↔ a = b :=
begin
  split,
  { intro h,
    have : a ∈ {b}, by rw [←h, mem_singleton_iff],
    rwa mem_singleton_iff at this },
  { intro h,
    rw h }
end

lemma fst_eq_fst_of_tuple_eq_tuple (h : tuple a₁ b₁ = tuple a₂ b₂) : a₁ = a₂ :=
begin
  have h' : pair a₂ a₂ ∈ tuple a₁ b₁,
  { rw h,
    have := pair_spec (pair a₂ a₂) (pair a₂ b₂) (pair a₂ a₂),
    simpa using this },
  unfold tuple at h',
  have := pair_spec (pair a₁ a₁) (pair a₁ b₁) (pair a₂ a₂),
  simp [h'] at this,
  clear h h',
  cases this,
  { change {a₂} = {a₁} at this,
    rw ←singleton_eq_singleton_iff,
    symmetry,
    assumption },
  { suffices h : a₁ = b₁,
    { subst h,
      change {a₂} = {a₁} at this,
      rw ←singleton_eq_singleton_iff,
      symmetry,
      assumption },
    change {a₂} = _ at this,
    have h := pair_spec' a₁ b₁,
    rw h at this,
    clear h,
    have := eq_of_eq_singleton (this).symm,
    assumption }
end

example {α : Type} (a b : α) : a = b ↔ b = a :=
eq_comm

lemma pair_eq_singleton (a : Set) : pair a a = {a} :=
begin
  ext,
  have := pair_spec a a x,
  simp [this, mem_singleton_iff]
end

lemma mem_pair_left (a b : Set) : a ∈ pair a b :=
begin
  have := pair_spec a b a,
  simpa using this
end

lemma mem_pair_right (a b : Set) : b ∈ pair a b :=
begin
  have := pair_spec a b b,
  simpa using this
end

lemma snd_eq_snd_of_tuple_eq_tuple (h : tuple a₁ b₁ = tuple a₂ b₂) : b₁ = b₂ :=
begin
  obtain rfl := fst_eq_fst_of_tuple_eq_tuple h,
  rename a₁ a,
  have h' : pair a b₂ ∈ tuple a b₁,
  { rw h,
    have := pair_spec (pair a a) (pair a b₂) (pair a b₂),
    simpa using this },
  unfold tuple at h',
  have := pair_spec (pair a a) (pair a b₁) (pair a b₂),
  simp [h'] at this,
  cases this,
  { have : a = b₂,
    { change _ = {a} at this,
      rw pair_spec' at this,
      simp [eq_of_eq_singleton this] },
    subst this,
    clear this,
    unfold tuple at h,
    rw [pair_eq_singleton, pair_eq_singleton, pair_spec', pair_spec'] at h,
    have h := eq_of_eq_singleton h,
    have h := eq_of_eq_singleton h.symm,
    rw h },
  { clear h h',
    have h₁ := pair_spec a b₁ b₂,
    rw ←this at h₁,
    simp [mem_pair_right] at h₁,
    have h₂ := pair_spec a b₂ b₁,
    rw this at h₂,
    simp [mem_pair_right] at h₂,
    cases h₁; cases h₂; tidy }
end

lemma tuple_spec : tuple a₁ b₁ = tuple a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
begin
  split; intro h,
  { simp [fst_eq_fst_of_tuple_eq_tuple h, snd_eq_snd_of_tuple_eq_tuple h] },
  { simp [h] }
end


/-
# EGAI 2.4.1
-/

import algebraic_geometry.AffineScheme
-- imports from mathlib

import about_local_rings
import target_affine_scheme
-- imports from this repo

noncomputable theory

open algebraic_geometry
open category_theory category_theory.limits
open topological_space
open opposite

namespace algebraic_geometry

universe u

namespace Scheme

section local_scheme

variables {Y : Scheme.{u}} (y : Y.carrier)

def _root_.algebraic_geometry.is_affine_open.iso_Spec
  {V : opens Y.carrier} (hV : is_affine_open V) :
  Y.restrict V.open_embedding ≅ _ :=
@Scheme.iso_Spec _ hV

instance restrict_stalk_is_local
  (V : opens Y.carrier) (hV : is_affine_open V) (mem_ : y ∈ V) :
  local_ring ((Y.restrict V.open_embedding).stalk ⟨y, mem_⟩) :=
@local_ring.of_equiv _
  (localization.at_prime ((hV.iso_Spec.hom.1.base ⟨y, mem_⟩).as_ideal :
    ideal $ Γ.obj $ op $ Y.restrict V.open_embedding)) _ _ _ $
@@Scheme.stalk_iso_of_affine' (Y.restrict $ V.open_embedding)
  hV ⟨y, mem_⟩

instance stalk_is_local : local_ring (Y.stalk y) :=
begin
  obtain ⟨⟨V, mem_y⟩, A, ⟨i⟩⟩ := Y.2 y,
  have hV : is_affine_open V,
  { refine @@is_affine_of_iso _ _ (algebraic_geometry.Spec_is_affine (op A)),
    exact i.hom, refine ⟨⟨i.inv, i.hom_inv_id, i.inv_hom_id⟩⟩, },
  haveI : local_ring ((Y.restrict V.open_embedding).stalk ⟨y, mem_y⟩) :=
    Scheme.restrict_stalk_is_local _ _ hV _,
  let i := Y.1.to_PresheafedSpace.restrict_stalk_iso V.open_embedding ⟨y, mem_y⟩,
  refine local_ring.of_equiv _
    ((Y.restrict V.open_embedding).stalk ⟨y, mem_y⟩)
    ⟨i.inv, i.hom, i.inv_hom_id_apply, i.hom_inv_id_apply, map_mul _, map_add _⟩,
end

section

variable {y}

def sections_to_stalk_restrict_aux
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  Γ.obj (op $ Y.restrict V.open_embedding) ⟶
  (Y.restrict V.open_embedding).stalk ⟨y, mem_⟩ :=
Top.presheaf.germ (Y.restrict V.open_embedding).presheaf
  ⟨⟨y, mem_⟩, by tauto⟩

/--
      Γ(Y|_ V) -------------`≅`---------> Γ(Spec Γ(Y|_ V))
          |                                   |
`sections_to_stalk_restrict_aux`              |
          |                                   |
          v                                   v
        𝒪_{Y|_ V, y} -------`≅`-------> 𝒪_{Spec Γ(Y|_ V), 𝔭}

-/
lemma sections_to_stalk_restrict_aux.commutative_sq
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  sections_to_stalk_restrict_aux hV mem_ ≫
  (eq_to_hom (by { congr, simpa only [←Scheme.comp_val_base_apply, iso.hom_inv_id] })
    ≫ PresheafedSpace.stalk_map (hV.iso_Spec.inv.1) _ :
      (Y.restrict V.open_embedding).stalk ⟨y, mem_⟩ ⟶
      (Spec_obj $ Γ.obj $ op $ Y.restrict V.open_embedding).stalk
        (hV.iso_Spec.hom.1.base ⟨y, mem_⟩)) =
  hV.iso_Spec.inv.1.c.app _ ≫ (Spec_obj $ Γ.obj $ op $ Y.restrict V.open_embedding).presheaf.germ
      (⟨hV.iso_Spec.hom.1.base ⟨y, mem_⟩, ⟨⟩⟩ : (⊤ : opens _)) :=
begin
  erw ←Top.presheaf.stalk_specializes_eq_to_hom,
  erw Top.presheaf.germ_stalk_specializes'_assoc,
  erw PresheafedSpace.stalk_map_germ hV.iso_Spec.inv.1 ⊤
    ⟨hV.iso_Spec.hom.val.base ⟨y, mem_⟩, ⟨⟩⟩,
  refl,

  simpa only [←Scheme.comp_val_base_apply, iso.hom_inv_id],
end

section

lemma sections_to_stalk_restrict_aux.apply_is_unit_iff_mem_prime_compl
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V)
  {z : Γ.obj (op $ Y.restrict V.open_embedding)} :
  is_unit (sections_to_stalk_restrict_aux hV mem_ z) ↔
  z ∈ (hV.iso_Spec.hom.1.base ⟨y, mem_⟩).as_ideal.prime_compl :=
begin
  delta sections_to_stalk_restrict_aux,
  rw ←Scheme.mem_basic_open,
  dsimp only [subtype.coe_mk],

  rw ←@Scheme.map_prime_spectrum_basic_open_of_affine _ hV,
  erw opens.map_obj,
  simp only [opens.mem_mk, set.mem_preimage],
  dsimp only [unop_op],
  refl,
end

def _root_.algebraic_geometry.is_affine_open.sections_algebra_stalk_restrict
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  algebra (Γ.obj $ op $ Y.restrict V.open_embedding)
    ((Y.restrict V.open_embedding).stalk ⟨y, mem_⟩) :=
ring_hom.to_algebra $ sections_to_stalk_restrict_aux hV mem_

end

def sections_to_stalk_restrict
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  Γ.obj (op $ Y.restrict V.open_embedding) ⟶ Y.stalk y :=
sections_to_stalk_restrict_aux hV mem_ ≫
(Y.1.to_PresheafedSpace.restrict_stalk_iso _ _).hom

def Spec_stalk_to_restrict
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  (Spec_obj $ Y.stalk y) ⟶ Y.restrict V.open_embedding :=
Spec_map (sections_to_stalk_restrict hV mem_) ≫ hV.iso_Spec.inv

section

variable (y)
def Spec_stalk_to_self :
  (Spec_obj $ Y.stalk y) ⟶ Y :=
Spec_stalk_to_restrict
begin
  have := (Y.2 y).some_spec.some_spec.some,
  refine @@is_affine_of_iso _ _ (algebraic_geometry.Spec_is_affine
    $ op $ (Y.2 y).some_spec.some),
  work_on_goal 2 { exact ((Y.2 y).some_spec.some_spec.some.hom) },
  refine ⟨⟨(Y.2 y).some_spec.some_spec.some.inv, iso.hom_inv_id _,
    iso.inv_hom_id _⟩⟩,
end
begin
  refine (Y.2 y).some.2,
end ≫ Scheme.of_restrict _ _

end

namespace Spec_stalk_to_self_independence_proof

variables {V W : opens Y.carrier} (hV : is_affine_open V) (hW : is_affine_open W)

def restrict_of_subset_rel (subset_rel : V ≤ W) :
  Y.restrict V.open_embedding ⟶ Y.restrict W.open_embedding :=
is_open_immersion.lift
  (Y.of_restrict W.open_embedding)
  (Y.of_restrict V.open_embedding)
  begin
    rintros _ ⟨⟨y, hy⟩, rfl⟩,
    refine ⟨⟨y, subset_rel hy⟩, rfl⟩,
  end

@[simps] def restrict_of_subset_rel'_PresheafedSpace (subset_rel : V ≤ W) :
  (Y.restrict V.open_embedding).to_PresheafedSpace ⟶
  (Y.restrict W.open_embedding).to_PresheafedSpace :=
{ base := ⟨λ y, ⟨y.1, subset_rel y.2⟩, by continuity⟩,
  c :=
  { app := λ U, Y.presheaf.map (hom_of_le
    begin
      rintros _ ⟨y, hy, rfl⟩,
      erw set.mem_preimage at hy,
      refine ⟨⟨_, subset_rel y.2⟩, hy, rfl⟩,
    end : V.open_embedding.is_open_map.functor.obj _ ⟶ W.open_embedding.is_open_map.functor.obj _).op,
    naturality' := λ U V inc,
    begin
      erw [←Y.presheaf.map_comp, ←Y.presheaf.map_comp],
      congr,
    end } }

lemma restrict_of_subset_rel'_PresheafedSpace_comp (subset_rel : V ≤ W) :
  restrict_of_subset_rel'_PresheafedSpace subset_rel ≫
    Y.to_PresheafedSpace.of_restrict W.open_embedding =
  Y.to_PresheafedSpace.of_restrict V.open_embedding :=
begin
  ext z,
  { dsimp, erw [←Y.presheaf.map_comp, ←Y.presheaf.map_comp], congr, },
  { ext pt : 1,
    dsimp, refl, },
end

lemma restrict_of_subset_rel'_PresheafedSpace_eq (subset_rel : V ≤ W) :
  restrict_of_subset_rel'_PresheafedSpace subset_rel =
  (restrict_of_subset_rel subset_rel).1 :=
begin
  dsimp [restrict_of_subset_rel, is_open_immersion.lift],
  rw PresheafedSpace.is_open_immersion.lift_uniq _ _ _ _
    (restrict_of_subset_rel'_PresheafedSpace_comp subset_rel),
  symmetry,
  refine PresheafedSpace.is_open_immersion.lift_uniq _ _ _ _ _,
  { rintros _ ⟨⟨y, hy⟩, rfl⟩,
    refine ⟨⟨y, subset_rel hy⟩, rfl⟩, },
  have := LocallyRingedSpace.is_open_immersion.lift_fac _ _ _,
  rw LocallyRingedSpace.hom.ext_iff at this,
  convert this,
end

instance (subset_rel : V ≤ W) (y) : is_local_ring_hom $
  PresheafedSpace.stalk_map (restrict_of_subset_rel'_PresheafedSpace subset_rel) y :=
begin
  rw restrict_of_subset_rel'_PresheafedSpace_eq,
  exact (restrict_of_subset_rel subset_rel).2 y,
end

def restrict_of_subset_rel' (subset_rel : V ≤ W) :
  Y.restrict V.open_embedding ⟶ Y.restrict W.open_embedding :=
{ val := restrict_of_subset_rel'_PresheafedSpace subset_rel,
  prop := infer_instance }

lemma restrict_of_subset_rel'_comp (subset_rel : V ≤ W) :
  restrict_of_subset_rel' subset_rel ≫ Y.of_restrict W.open_embedding =
  Y.of_restrict V.open_embedding :=
begin
  ext z,
  { dsimp, erw [←Y.presheaf.map_comp, ←Y.presheaf.map_comp], congr, },
  { ext pt : 1,
    dsimp, refl, },
end

lemma restrict_of_subset_rel_comp (subset_rel : V ≤ W) :
  restrict_of_subset_rel subset_rel ≫ Y.of_restrict W.open_embedding =
  Y.of_restrict V.open_embedding :=
is_open_immersion.lift_fac _ _ _

lemma restrict_of_subset_rel_comp' (subset_rel : V ≤ W) :
  Γ.map (Y.of_restrict W.open_embedding).op ≫
    Γ.map (restrict_of_subset_rel' subset_rel).op =
  Γ.map (Y.of_restrict V.open_embedding).op :=
by rw [←Γ.map_comp, ←op_comp, restrict_of_subset_rel'_comp]

def ring_hom_of_subset
  (subset_rel : V ≤ W) :
  Γ.obj (op $ Y.restrict W.open_embedding) ⟶ Γ.obj (op $ Y.restrict V.open_embedding) :=
Γ.map (restrict_of_subset_rel' subset_rel).op

lemma commutes (subset_rel : V ≤ W) (mem_ : y ∈ V) :
  ring_hom_of_subset subset_rel ≫ sections_to_stalk_restrict hV mem_ =
  sections_to_stalk_restrict hW (subset_rel mem_) :=
begin
  dsimp only [ring_hom_of_subset, sections_to_stalk_restrict,
    sections_to_stalk_restrict_aux, restrict_of_subset_rel', Γ],
  dsimp,
  erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ,
  erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ,
  convert Top.presheaf.germ_res _ _ _,
  rw subtype.coe_mk, refl,
end

example : true := ⟨⟩

lemma commutes' (subset_rel : V ≤ W) (mem_ : y ∈ V) :
  Spec_stalk_to_restrict hW (subset_rel mem_) =
  Spec_stalk_to_restrict hV mem_ ≫
  restrict_of_subset_rel' subset_rel :=
begin
  dsimp only [Spec_stalk_to_restrict],
  rw ←commutes hV hW subset_rel mem_,
  rw Spec_map_comp,
  rw [category.assoc, category.assoc],
  congr' 1,
  dsimp only [ring_hom_of_subset],
  have := whisker_eq hV.iso_Spec.inv
    (Γ_Spec.adjunction.unit_naturality (restrict_of_subset_rel' subset_rel)),
  dsimp at this,
  erw is_iso.inv_hom_id_assoc at this,
  erw this,
  erw [category.assoc, category.assoc, is_iso.hom_inv_id, category.comp_id],
end

lemma independent_aux (subset_rel : V ≤ W) (mem_V : y ∈ V) :
  Spec_stalk_to_restrict hW (subset_rel mem_V) ≫ Y.of_restrict W.open_embedding =
  Spec_stalk_to_restrict hV mem_V ≫ Y.of_restrict V.open_embedding :=
by rw [commutes' hV, category.assoc, restrict_of_subset_rel'_comp]

lemma is_affine_open.of_restrict
  (U : opens (Y.restrict V.open_embedding).carrier)
  (hU : is_affine_open U) :
  is_affine_open (V.open_embedding.is_open_map.functor.obj U) :=
begin
  refine is_affine_of_iso _,
  rotate 3, { exact hU },
  generalize_proofs h1 h2 h3 h4,
  let i : Y.restrict h3 ≅ (Y.restrict h2).restrict h4,
  { refine is_open_immersion.iso_of_range_eq (Scheme.of_restrict _ _)
      (Scheme.of_restrict _ _ ≫ Scheme.of_restrict _ _) _,
    ext : 1,
    rw [set.mem_range, set.mem_range],
    split,
    { rintros ⟨⟨_, ⟨⟨y, hy1⟩, hy2, rfl⟩⟩, rfl⟩,
      refine ⟨⟨⟨y, hy1⟩, hy2⟩, rfl⟩, },
    { rintros ⟨⟨⟨y, hy1⟩, hy2⟩, rfl⟩,
      refine ⟨⟨y, ⟨⟨y, hy1⟩, hy2, rfl⟩⟩, rfl⟩, }, },
  exact i.hom,
  exact is_iso.of_iso _,
end

lemma independent (mem_V : y ∈ V) (mem_W : y ∈ W) :
  Spec_stalk_to_restrict hW mem_W ≫ Y.of_restrict W.open_embedding =
  Spec_stalk_to_restrict hV mem_V ≫ Y.of_restrict V.open_embedding :=
begin
  suffices : ∃ (U : opens Y.carrier), is_affine_open U ∧ U ≤ V ⊓ W ∧ y ∈ U,
  { obtain ⟨U, hU, U_le, mem_U⟩ := this,
    have U_le1 : U ≤ V := U_le.trans inf_le_left,
    have U_le2 : U ≤ W := U_le.trans inf_le_right,
    erw independent_aux hU hV U_le1 mem_U,
    erw independent_aux hU hW U_le2 mem_U, },
  obtain ⟨⟨U, hU⟩, R, ⟨i⟩⟩ := (Y.restrict (V ⊓ W).open_embedding).2 ⟨y, ⟨mem_V, mem_W⟩⟩,
  refine ⟨(V ⊓ W).open_embedding.is_open_map.functor.obj U, _, _, _⟩,
  { apply is_affine_open.of_restrict,
    refine is_affine_of_iso _,
    rotate 3, { exact algebraic_geometry.Spec_is_affine (op R), },
    { exact i.hom },
    { refine ⟨⟨i.inv, i.hom_inv_id, i.inv_hom_id⟩⟩, }, },
  { rintros _ ⟨y, hy, rfl⟩, exact y.2, },
  { refine ⟨⟨y, ⟨mem_V, mem_W⟩⟩, hU, rfl⟩, },
end

end Spec_stalk_to_self_independence_proof

lemma Spec_stalk_to_self_on_affine_open {V : opens Y.carrier}
  (hV : is_affine_open V) (mem_ : y ∈ V) :
  Spec_stalk_to_self y =
  Spec_stalk_to_restrict hV mem_ ≫ Y.of_restrict _ :=
Spec_stalk_to_self_independence_proof.independent _ _ _ _

example -- is_affine_open.is_localization_restrict
  {V : opens Y.carrier} (hV : is_affine_open V) (mem_ : y ∈ V) :
  @@is_localization.at_prime _
    ((Y.restrict V.open_embedding).stalk ⟨y, mem_⟩) _
    (hV.sections_algebra_stalk_restrict mem_)
    (hV.iso_Spec.hom.1.base ⟨y, mem_⟩).as_ideal _ :=
{ map_units := λ z,
  begin
    rw ring_hom.algebra_map_to_algebra,
    rw sections_to_stalk_restrict_aux.apply_is_unit_iff_mem_prime_compl,
    exact z.2,
  end,
  surj := λ z,
  begin
    rw ring_hom.algebra_map_to_algebra,
    sorry
    -- have := PresheafedSpace.stalk_map hV.iso_Spec.inv.1 (hV.iso_Spec.hom.1 ⟨y, mem_⟩) _,
    -- refine ⟨⟨_, 1⟩, _⟩,
    -- swap,
    -- { dsimp only, conv_lhs { rw [submonoid.coe_one, map_one, mul_one] },
    --   sorry },
  end,
  eq_iff_exists := λ a b,
  begin
    rw ring_hom.algebra_map_to_algebra,
    split,
    { rintros h, sorry },
    { rintros ⟨⟨c, hc1⟩, (hc2 : a * c = b * c)⟩,
      rw ←sections_to_stalk_restrict_aux.apply_is_unit_iff_mem_prime_compl at hc1,
      have hc2' := congr_arg (sections_to_stalk_restrict_aux hV mem_) hc2,
      rw [map_mul, map_mul] at hc2',
      have hc2'' := congr_arg (λ y, y * hc1.unit.inv) hc2',
      dsimp only at hc2'',
      rw [mul_assoc, mul_assoc] at hc2'',
      change _ * (hc1.unit.1 * hc1.unit.inv) = _ * (hc1.unit.1 * hc1.unit.inv) at hc2'',
      rwa [hc1.unit.3, mul_one, mul_one] at hc2'', }
  end }
-- begin
--   have := is_localization.is_localization_of_alg_equiv
--     (hV.iso_Spec.hom.1.base ⟨y, mem_⟩).as_ideal.prime_compl,
--   refine this _,
--   work_on_goal 5
--   { exactI localization.is_localization },
--   clear this,
--   fconstructor,
--   { refine λ x, PresheafedSpace.stalk_map hV.iso_Spec.hom.1 _
--       (structure_sheaf.localization_to_stalk _ _ x), },
--   { sorry },
--   { sorry },
--   { sorry },
--   { sorry },
--   { sorry },
--   { rintros (r : Γ.obj _),
--     dsimp only [unop_op],
--     rw ring_hom.algebra_map_to_algebra,
--     rw [←comp_apply, ←comp_apply],
--     have := sections_to_stalk_restrict_aux.commutative_sq hV mem_, },
-- end

instance is_affine_open.algebra {V : opens Y.carrier}
  (hV : is_affine_open V) (mem_ : y ∈ V) :
  algebra (Γ.obj $ op $ Y.restrict V.open_embedding) (Y.stalk y) :=
ring_hom.to_algebra $ sections_to_stalk_restrict hV mem_

-- Do I even need this?
-- instance is_affine_open.is_localization {V : opens Y.carrier}
--   (hV : is_affine_open V) (mem_ : y ∈ V) :
--   @@is_localization.at_prime _ (Y.stalk y) _
--     (algebraic_geometry.Scheme.is_affine_open.algebra hV mem_)
--     (hV.iso_Spec.hom.1.base ⟨y, mem_⟩).as_ideal _ :=
-- begin
--   have := @@is_localization.is_localization_of_alg_equiv _ _ _ _ _ _
--     _ _,
--   refine this,
--   work_on_goal 4
--   { exact @algebraic_geometry.Scheme.stalk_is_localization'
--       (Y.restrict V.open_embedding) hV ⟨y, mem_⟩ },
--   refine { to_fun := _, inv_fun := _, left_inv := _, right_inv := _,
--     map_mul' := _, map_add' := _, commutes' := _ },
--   { -- to_fun
--     refine (Y.1.restrict_stalk_iso V.open_embedding ⟨y, mem_⟩).hom,
--    },
--   { -- inv_fun
--     refine (Y.1.restrict_stalk_iso V.open_embedding ⟨y, mem_⟩).inv,
--    },
--   { -- left inverse
--     sorry },
--   { -- right_inverse
--     sorry },
--   { -- map_mul,
--     intros, simp only [map_mul], },
--   { -- map_add,
--     intros, simp only [map_add] },
--   { -- commutes,
--     intros r,
--     rw [ring_hom.algebra_map_to_algebra, ring_hom.algebra_map_to_algebra],
--     rw [ring_hom.comp_apply],
--     apply_fun (Y.1.restrict_stalk_iso V.open_embedding ⟨y, mem_⟩).inv,
--     swap, exact concrete_category.injective_of_mono_of_preserves_pullback _,
--     rw iso.hom_inv_id_apply,
--     erw Scheme.stalk_iso_of_affine'_symm_apply,
--     rw [←localization.mk_one_eq_algebra_map, localization.mk_eq_mk'],
--     erw structure_sheaf.localization_to_stalk_mk',
--     simp_rw submonoid.coe_one,
--     erw ←structure_sheaf.to_open_eq_const,
--     erw structure_sheaf.germ_to_open,
--     sorry
--      }
-- end

end

end local_scheme

end Scheme

end algebraic_geometry


import tactic --hide

/-Lemma
If $P$ is a logical statement then $P$ implies $(P \implies \mathrm{false}) \implies \mathrm{false}$
-/
lemma P_to_P_to_false_to_false (P : Prop) :  P → ((P → false) → false) :=
begin
   intros hp hpf,
   apply hpf,
   exact hp,

end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_132
  (x : ℝ)
  (f g : ℝ → ℝ)
  (h₀ : ∀ x, f x = x + 2)
  (h₁ : ∀ x, g x = x^2)
  (h₂ : f (g x) = g (f x)) :
  x = - 1/2 :=
begin
  field_simp * at *,
  nlinarith,
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.submodule

/-!
# Ideal operations for Lie algebras

Given a Lie module `M` over a Lie algebra `L`, there is a natural action of the Lie ideals of `L`
on the Lie submodules of `M`. In the special case that `M = L` with the adjoint action, this
provides a pairing of Lie ideals which is especially important. For example, it can be used to
define solvability / nilpotency of a Lie algebra via the derived / lower-central series.

## Main definitions

  * `lie_submodule.has_bracket`
  * `lie_submodule.lie_ideal_oper_eq_linear_span`
  * `lie_ideal.map_bracket_le`
  * `lie_ideal.comap_bracket_le`

## Notation

Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M` and a Lie
ideal `I ⊆ L`, we introduce the notation `⁅I, N⁆` for the Lie submodule of `M` corresponding to
the action defined in this file.

## Tags

lie algebra, ideal operation
-/

universes u v w w₁ w₂

namespace lie_submodule

variables {R : Type u} {L : Type v} {M : Type w} {M₂ : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group M₂] [module R M₂] [lie_ring_module L M₂] [lie_module R L M₂]
variables (N N' : lie_submodule R L M) (I J : lie_ideal R L) (N₂ : lie_submodule R L M₂)

section lie_ideal_operations

/-- Given a Lie module `M` over a Lie algebra `L`, the set of Lie ideals of `L` acts on the set
of submodules of `M`. -/
instance has_bracket : has_bracket (lie_ideal R L) (lie_submodule R L M) :=
⟨λ I N, lie_span R L { m | ∃ (x : I) (n : N), ⁅(x : L), (n : M)⁆ = m }⟩

lemma lie_ideal_oper_eq_span :
  ⁅I, N⁆ = lie_span R L { m | ∃ (x : I) (n : N), ⁅(x : L), (n : M)⁆ = m } := rfl

/-- See also `lie_submodule.lie_ideal_oper_eq_linear_span'` and
`lie_submodule.lie_ideal_oper_eq_tensor_map_range`. -/
lemma lie_ideal_oper_eq_linear_span :
  (↑⁅I, N⁆ : submodule R M) = submodule.span R { m | ∃ (x : I) (n : N), ⁅(x : L), (n : M)⁆ = m } :=
begin
  apply le_antisymm,
  { let s := {m : M | ∃ (x : ↥I) (n : ↥N), ⁅(x : L), (n : M)⁆ = m},
    have aux : ∀ (y : L) (m' ∈ submodule.span R s), ⁅y, m'⁆ ∈ submodule.span R s,
    { intros y m' hm', apply submodule.span_induction hm',
      { rintros m'' ⟨x, n, hm''⟩, rw [← hm'', leibniz_lie],
        refine submodule.add_mem _ _ _; apply submodule.subset_span,
        { use [⟨⁅y, ↑x⁆, I.lie_mem x.property⟩, n], refl, },
        { use [x, ⟨⁅y, ↑n⁆, N.lie_mem n.property⟩], refl, }, },
      { simp only [lie_zero, submodule.zero_mem], },
      { intros m₁ m₂ hm₁ hm₂, rw lie_add, exact submodule.add_mem _ hm₁ hm₂, },
      { intros t m'' hm'', rw lie_smul, exact submodule.smul_mem _ t hm'', }, },
    change _ ≤ ↑({ lie_mem := aux, ..submodule.span R s } : lie_submodule R L M),
    rw [coe_submodule_le_coe_submodule, lie_ideal_oper_eq_span, lie_span_le],
    exact submodule.subset_span, },
  { rw lie_ideal_oper_eq_span, apply submodule_span_le_lie_span, },
end

lemma lie_ideal_oper_eq_linear_span' :
  (↑⁅I, N⁆ : submodule R M) = submodule.span R { m | ∃ (x ∈ I) (n ∈ N), ⁅x, n⁆ = m } :=
begin
  rw lie_ideal_oper_eq_linear_span,
  congr,
  ext m,
  split,
  { rintros ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩,
    exact ⟨x, hx, n, hn, rfl⟩, },
  { rintros ⟨x, hx, n, hn, rfl⟩,
    exact ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, },
end

lemma lie_le_iff : ⁅I, N⁆ ≤ N' ↔ ∀ (x ∈ I) (m ∈ N), ⁅x, m⁆ ∈ N' :=
begin
  rw [lie_ideal_oper_eq_span, lie_submodule.lie_span_le],
  refine ⟨λ h x hx m hm, h ⟨⟨x, hx⟩, ⟨m, hm⟩, rfl⟩, _⟩,
  rintros h _ ⟨⟨x, hx⟩, ⟨m, hm⟩, rfl⟩,
  exact h x hx m hm,
end

lemma lie_coe_mem_lie (x : I) (m : N) : ⁅(x : L), (m : M)⁆ ∈ ⁅I, N⁆ :=
by { rw lie_ideal_oper_eq_span, apply subset_lie_span, use [x, m], }

lemma lie_mem_lie {x : L} {m : M} (hx : x ∈ I) (hm : m ∈ N) : ⁅x, m⁆ ∈ ⁅I, N⁆ :=
N.lie_coe_mem_lie I ⟨x, hx⟩ ⟨m, hm⟩

lemma lie_comm : ⁅I, J⁆ = ⁅J, I⁆ :=
begin
  suffices : ∀ (I J : lie_ideal R L), ⁅I, J⁆ ≤ ⁅J, I⁆, { exact le_antisymm (this I J) (this J I), },
  clear I J, intros I J,
  rw [lie_ideal_oper_eq_span, lie_span_le], rintros x ⟨y, z, h⟩, rw ← h,
  rw [← lie_skew, ← lie_neg, ← lie_submodule.coe_neg],
  apply lie_coe_mem_lie,
end

lemma lie_le_right : ⁅I, N⁆ ≤ N :=
begin
  rw [lie_ideal_oper_eq_span, lie_span_le], rintros m ⟨x, n, hn⟩, rw ← hn,
  exact N.lie_mem n.property,
end

lemma lie_le_left : ⁅I, J⁆ ≤ I :=
by { rw lie_comm, exact lie_le_right I J, }

lemma lie_le_inf : ⁅I, J⁆ ≤ I ⊓ J :=
by { rw le_inf_iff, exact ⟨lie_le_left I J, lie_le_right J I⟩, }

@[simp] lemma lie_bot : ⁅I, (⊥ : lie_submodule R L M)⁆ = ⊥ :=
by { rw eq_bot_iff, apply lie_le_right, }

@[simp] lemma bot_lie : ⁅(⊥ : lie_ideal R L), N⁆ = ⊥ :=
begin
  suffices : ⁅(⊥ : lie_ideal R L), N⁆ ≤ ⊥, { exact le_bot_iff.mp this, },
  rw [lie_ideal_oper_eq_span, lie_span_le], rintros m ⟨⟨x, hx⟩, n, hn⟩, rw ← hn,
  change x ∈ (⊥ : lie_ideal R L) at hx, rw mem_bot at hx, simp [hx],
end

lemma lie_eq_bot_iff : ⁅I, N⁆ = ⊥ ↔ ∀ (x ∈ I) (m ∈ N), ⁅(x : L), m⁆ = 0 :=
begin
  rw [lie_ideal_oper_eq_span, lie_submodule.lie_span_eq_bot_iff],
  refine ⟨λ h x hx m hm, h ⁅x, m⁆ ⟨⟨x, hx⟩, ⟨m, hm⟩, rfl⟩, _⟩,
  rintros h - ⟨⟨x, hx⟩, ⟨⟨n, hn⟩, rfl⟩⟩,
  exact h x hx n hn,
end

lemma mono_lie (h₁ : I ≤ J) (h₂ : N ≤ N') : ⁅I, N⁆ ≤ ⁅J, N'⁆ :=
begin
  intros m h,
  rw [lie_ideal_oper_eq_span, mem_lie_span] at h, rw [lie_ideal_oper_eq_span, mem_lie_span],
  intros N hN, apply h, rintros m' ⟨⟨x, hx⟩, ⟨n, hn⟩, hm⟩, rw ← hm, apply hN,
  use [⟨x, h₁ hx⟩, ⟨n, h₂ hn⟩], refl,
end

lemma mono_lie_left (h : I ≤ J) : ⁅I, N⁆ ≤ ⁅J, N⁆ := mono_lie _ _ _ _ h (le_refl N)

lemma mono_lie_right (h : N ≤ N') : ⁅I, N⁆ ≤ ⁅I, N'⁆ := mono_lie _ _ _ _ (le_refl I) h

@[simp] lemma lie_sup : ⁅I, N ⊔ N'⁆ = ⁅I, N⁆ ⊔ ⁅I, N'⁆ :=
begin
  have h : ⁅I, N⁆ ⊔ ⁅I, N'⁆ ≤ ⁅I, N ⊔ N'⁆,
  { rw sup_le_iff, split; apply mono_lie_right; [exact le_sup_left, exact le_sup_right], },
  suffices : ⁅I, N ⊔ N'⁆ ≤ ⁅I, N⁆ ⊔ ⁅I, N'⁆, { exact le_antisymm this h, }, clear h,
  rw [lie_ideal_oper_eq_span, lie_span_le], rintros m ⟨x, ⟨n, hn⟩, h⟩, erw lie_submodule.mem_sup,
  erw lie_submodule.mem_sup at hn, rcases hn with ⟨n₁, hn₁, n₂, hn₂, hn'⟩,
  use ⁅(x : L), (⟨n₁, hn₁⟩ : N)⁆, split, { apply lie_coe_mem_lie, },
  use ⁅(x : L), (⟨n₂, hn₂⟩ : N')⁆, split, { apply lie_coe_mem_lie, },
  simp [← h, ← hn'],
end

@[simp] lemma sup_lie : ⁅I ⊔ J, N⁆ = ⁅I, N⁆ ⊔ ⁅J, N⁆ :=
begin
  have h : ⁅I, N⁆ ⊔ ⁅J, N⁆ ≤ ⁅I ⊔ J, N⁆,
  { rw sup_le_iff, split; apply mono_lie_left; [exact le_sup_left, exact le_sup_right], },
  suffices : ⁅I ⊔ J, N⁆ ≤ ⁅I, N⁆ ⊔ ⁅J, N⁆, { exact le_antisymm this h, }, clear h,
  rw [lie_ideal_oper_eq_span, lie_span_le], rintros m ⟨⟨x, hx⟩, n, h⟩, erw lie_submodule.mem_sup,
  erw lie_submodule.mem_sup at hx, rcases hx with ⟨x₁, hx₁, x₂, hx₂, hx'⟩,
  use ⁅((⟨x₁, hx₁⟩ : I) : L), (n : N)⁆, split, { apply lie_coe_mem_lie, },
  use ⁅((⟨x₂, hx₂⟩ : J) : L), (n : N)⁆, split, { apply lie_coe_mem_lie, },
  simp [← h, ← hx'],
end

@[simp] lemma lie_inf : ⁅I, N ⊓ N'⁆ ≤ ⁅I, N⁆ ⊓ ⁅I, N'⁆ :=
by { rw le_inf_iff, split; apply mono_lie_right; [exact inf_le_left, exact inf_le_right], }

@[simp] lemma inf_lie : ⁅I ⊓ J, N⁆ ≤ ⁅I, N⁆ ⊓ ⁅J, N⁆ :=
by { rw le_inf_iff, split; apply mono_lie_left; [exact inf_le_left, exact inf_le_right], }

variables (f : M →ₗ⁅R,L⁆ M₂)

lemma map_bracket_eq : map f ⁅I, N⁆ = ⁅I, map f N⁆ :=
begin
  rw [← coe_to_submodule_eq_iff, coe_submodule_map, lie_ideal_oper_eq_linear_span,
    lie_ideal_oper_eq_linear_span, submodule.map_span],
  congr,
  ext m,
  split,
  { rintros ⟨-, ⟨⟨x, ⟨n, hn⟩, rfl⟩, hm⟩⟩,
    simp only [lie_module_hom.coe_to_linear_map, lie_module_hom.map_lie] at hm,
    exact ⟨x, ⟨f n, (mem_map (f n)).mpr ⟨n, hn, rfl⟩⟩, hm⟩, },
  { rintros ⟨x, ⟨m₂, hm₂ : m₂ ∈ map f N⟩, rfl⟩,
    obtain ⟨n, hn, rfl⟩ := (mem_map m₂).mp hm₂,
    exact ⟨⁅x, n⁆, ⟨x, ⟨n, hn⟩, rfl⟩, by simp⟩, },
end

lemma map_comap_eq (hf : N₂ ≤ f.range) : map f (comap f N₂) = N₂ :=
begin
  rw set_like.ext'_iff,
  exact set.image_preimage_eq_of_subset hf,
end

lemma le_comap_map : N ≤ comap f (map f N) :=
(N : set M).subset_preimage_image f

lemma comap_map_eq (hf : f.ker = ⊥) : comap f (map f N) = N :=
begin
  rw set_like.ext'_iff,
  exact (N : set M).preimage_image_eq (f.ker_eq_bot.mp hf),
end

lemma comap_bracket_eq (hf₁ : f.ker = ⊥) (hf₂ : N₂ ≤ f.range) :
  comap f ⁅I, N₂⁆ = ⁅I, comap f N₂⁆ :=
begin
  conv_lhs { rw ← map_comap_eq N₂ f hf₂, },
  rw [← map_bracket_eq, comap_map_eq _ f hf₁],
end

@[simp] lemma map_comap_incl : map N.incl (comap N.incl N') = N ⊓ N' :=
begin
  rw ← coe_to_submodule_eq_iff,
  exact (N : submodule R M).map_comap_subtype N',
end

end lie_ideal_operations

end lie_submodule

namespace lie_ideal

open lie_algebra

variables {R : Type u} {L : Type v} {L' : Type w₂}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
variables (f : L →ₗ⁅R⁆ L') (I : lie_ideal R L) (J : lie_ideal R L')

/-- Note that the inequality can be strict; e.g., the inclusion of an Abelian subalgebra of a
simple algebra. -/
lemma map_bracket_le {I₁ I₂ : lie_ideal R L} : map f ⁅I₁, I₂⁆ ≤ ⁅map f I₁, map f I₂⁆ :=
begin
  rw map_le_iff_le_comap, erw lie_submodule.lie_span_le,
  intros x hx, obtain ⟨⟨y₁, hy₁⟩, ⟨y₂, hy₂⟩, hx⟩ := hx, rw ← hx,
  let fy₁ : ↥(map f I₁) := ⟨f y₁, mem_map hy₁⟩,
  let fy₂ : ↥(map f I₂) := ⟨f y₂, mem_map hy₂⟩,
  change _ ∈ comap f ⁅map f I₁, map f I₂⁆,
  simp only [submodule.coe_mk, mem_comap, lie_hom.map_lie],
  exact lie_submodule.lie_coe_mem_lie _ _ fy₁ fy₂,
end

lemma map_bracket_eq {I₁ I₂ : lie_ideal R L} (h : function.surjective f) :
  map f ⁅I₁, I₂⁆ = ⁅map f I₁, map f I₂⁆ :=
begin
  suffices : ⁅map f I₁, map f I₂⁆ ≤ map f ⁅I₁, I₂⁆, { exact le_antisymm (map_bracket_le f) this, },
  rw [← lie_submodule.coe_submodule_le_coe_submodule, coe_map_of_surjective h,
    lie_submodule.lie_ideal_oper_eq_linear_span,
    lie_submodule.lie_ideal_oper_eq_linear_span, linear_map.map_span],
  apply submodule.span_mono,
  rintros x ⟨⟨z₁, h₁⟩, ⟨z₂, h₂⟩, rfl⟩,
  obtain ⟨y₁, rfl⟩ := mem_map_of_surjective h h₁,
  obtain ⟨y₂, rfl⟩ := mem_map_of_surjective h h₂,
  use [⁅(y₁ : L), (y₂ : L)⁆, y₁, y₂],
  apply f.map_lie,
end

lemma comap_bracket_le {J₁ J₂ : lie_ideal R L'} : ⁅comap f J₁, comap f J₂⁆ ≤ comap f ⁅J₁, J₂⁆ :=
begin
  rw ← map_le_iff_le_comap,
  exact le_trans (map_bracket_le f) (lie_submodule.mono_lie _ _ _ _ map_comap_le map_comap_le),
end

variables {f}

lemma map_comap_incl {I₁ I₂ : lie_ideal R L} : map I₁.incl (comap I₁.incl I₂) = I₁ ⊓ I₂ :=
by { conv_rhs { rw ← I₁.incl_ideal_range, }, rw ← map_comap_eq, exact I₁.incl_is_ideal_morphism, }

lemma comap_bracket_eq {J₁ J₂ : lie_ideal R L'} (h : f.is_ideal_morphism) :
  comap f ⁅f.ideal_range ⊓ J₁, f.ideal_range ⊓ J₂⁆ = ⁅comap f J₁, comap f J₂⁆ ⊔ f.ker :=
begin
  rw [← lie_submodule.coe_to_submodule_eq_iff, comap_coe_submodule,
    lie_submodule.sup_coe_to_submodule, f.ker_coe_submodule, ← submodule.comap_map_eq,
    lie_submodule.lie_ideal_oper_eq_linear_span, lie_submodule.lie_ideal_oper_eq_linear_span,
    linear_map.map_span],
  congr, simp only [lie_hom.coe_to_linear_map, set.mem_set_of_eq], ext y,
  split,
  { rintros ⟨⟨x₁, hx₁⟩, ⟨x₂, hx₂⟩, hy⟩, rw ← hy,
    erw [lie_submodule.mem_inf, f.mem_ideal_range_iff h] at hx₁ hx₂,
    obtain ⟨⟨z₁, hz₁⟩, hz₁'⟩ := hx₁, rw ← hz₁ at hz₁',
    obtain ⟨⟨z₂, hz₂⟩, hz₂'⟩ := hx₂, rw ← hz₂ at hz₂',
    use [⁅z₁, z₂⁆, ⟨z₁, hz₁'⟩, ⟨z₂, hz₂'⟩, rfl],
    simp only [hz₁, hz₂, submodule.coe_mk, lie_hom.map_lie], },
  { rintros ⟨x, ⟨⟨z₁, hz₁⟩, ⟨z₂, hz₂⟩, hx⟩, hy⟩, rw [← hy, ← hx],
    have hz₁' : f z₁ ∈ f.ideal_range ⊓ J₁,
    { rw lie_submodule.mem_inf, exact ⟨f.mem_ideal_range, hz₁⟩, },
    have hz₂' : f z₂ ∈ f.ideal_range ⊓ J₂,
    { rw lie_submodule.mem_inf, exact ⟨f.mem_ideal_range, hz₂⟩, },
    use [⟨f z₁, hz₁'⟩, ⟨f z₂, hz₂'⟩], simp only [submodule.coe_mk, lie_hom.map_lie], },
end

lemma map_comap_bracket_eq {J₁ J₂ : lie_ideal R L'} (h : f.is_ideal_morphism) :
  map f ⁅comap f J₁, comap f J₂⁆ = ⁅f.ideal_range ⊓ J₁, f.ideal_range ⊓ J₂⁆ :=
by { rw [← map_sup_ker_eq_map, ← comap_bracket_eq h, map_comap_eq h, inf_eq_right],
     exact le_trans (lie_submodule.lie_le_left _ _) inf_le_left, }

lemma comap_bracket_incl {I₁ I₂ : lie_ideal R L} :
  ⁅comap I.incl I₁, comap I.incl I₂⁆ = comap I.incl ⁅I ⊓ I₁, I ⊓ I₂⁆ :=
begin
  conv_rhs { congr, skip, rw ← I.incl_ideal_range, }, rw comap_bracket_eq,
  simp only [ker_incl, sup_bot_eq], exact I.incl_is_ideal_morphism,
end

/-- This is a very useful result; it allows us to use the fact that inclusion distributes over the
Lie bracket operation on ideals, subject to the conditions shown. -/
lemma comap_bracket_incl_of_le {I₁ I₂ : lie_ideal R L} (h₁ : I₁ ≤ I) (h₂ : I₂ ≤ I) :
  ⁅comap I.incl I₁, comap I.incl I₂⁆ = comap I.incl ⁅I₁, I₂⁆ :=
by { rw comap_bracket_incl, rw ← inf_eq_right at h₁ h₂, rw [h₁, h₂], }

end lie_ideal