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

! This file was ported from Lean 3 source module order.zorn_atoms
! leanprover-community/mathlib commit 9aba7801eeecebb61f58a5763c2b6dd1b47dc6ef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Zorn
import Mathlib.Order.Atoms

/-!
# Zorn lemma for (co)atoms

In this file we use Zorn's lemma to prove that a partial order is atomic if every nonempty chain
`c`, `⊥ ∉ c`, has a lower bound not equal to `⊥`. We also prove the order dual version of this
statement.
-/

open Set

/-- **Zorn's lemma**: A partial order is coatomic if every nonempty chain `c`, `⊤ ∉ c`, has an upper
bound not equal to `⊤`. -/
theorem IsCoatomic.of_isChain_bounded {α : Type _} [PartialOrder α] [OrderTop α]
    (h :
      ∀ c : Set α,
        IsChain (· ≤ ·) c → c.Nonempty → ⊤ ∉ c → ∃ (x : _)(_ : x ≠ ⊤), x ∈ upperBounds c) :
    IsCoatomic α := by
  refine ⟨fun x => le_top.eq_or_lt.imp_right fun hx => ?_⟩
  have : ∃ y ∈ Ico x ⊤, x ≤ y ∧ ∀ z ∈ Ico x ⊤, y ≤ z → z = y := by
    refine zorn_nonempty_partialOrder₀ (Ico x ⊤) (fun c hxc hc y hy => ?_) x (left_mem_Ico.2 hx)
    rcases h c hc ⟨y, hy⟩ fun h => (hxc h).2.ne rfl with ⟨z, hz, hcz⟩
    exact ⟨z, ⟨le_trans (hxc hy).1 (hcz hy), hz.lt_top⟩, hcz⟩
  rcases this with ⟨y, ⟨hxy, hy⟩, -, hy'⟩
  refine ⟨y, ⟨hy.ne, fun z hyz => le_top.eq_or_lt.resolve_right fun hz => ?_⟩, hxy⟩
  exact hyz.ne' (hy' z ⟨hxy.trans hyz.le, hz⟩ hyz.le)
#align is_coatomic.of_is_chain_bounded IsCoatomic.of_isChain_bounded

/-- **Zorn's lemma**: A partial order is atomic if every nonempty chain `c`, `⊥ ∉ c`, has an lower
bound not equal to `⊥`. -/
theorem IsAtomic.of_isChain_bounded {α : Type _} [PartialOrder α] [OrderBot α]
    (h :
      ∀ c : Set α,
        IsChain (· ≤ ·) c → c.Nonempty → ⊥ ∉ c → ∃ (x : _)(_ : x ≠ ⊥), x ∈ lowerBounds c) :
    IsAtomic α :=
  isCoatomic_dual_iff_isAtomic.mp <| IsCoatomic.of_isChain_bounded fun c hc => h c hc.symm
#align is_atomic.of_is_chain_bounded IsAtomic.of_isChain_bounded


import tactic
import algebra.ring.equiv -- ring isomorphisms

/-

# Isomorphisms (of groups, rings, etc)

If `X` and `Y` are types, we have a type `X ≃ Y` of bijections
from `X` to `Y`. If `X` and `Y` additionally have the structure
of groups, or rings, or orders, or topological spaces, or...
then we can furthermore ask that the bijections preserves this
structure.

Just like in the homomorphism case, we don't do this by making
new predicates like `is_group_isomorphism : G ≃ H → Prop`, we do this
by making totally new types called things like `G ≃* H` (group
isomorphisms), `A ≃+* B` (ring isomorphisms) and so on.

-/

-- let A and B be rings
variables (A B : Type) [ring A] [ring B]

-- Here's the set of all ring isomorphisms from A to B
example : Type := A ≃+* B
-- `A ≃+* B` is notation for `ring_equiv A B`.

-- A ring isomorphism is magically a function

example (φ : A ≃+* B) (a : A) : B := φ a -- if you use this in a proof it will say ⇑φ a

-- A ring isomorphism is magically a ring homomorphism

example (φ : A ≃+* B) (x y : A) : φ (x + y) = φ x + φ y := map_add φ x y

-- You can compose two ring isomorphisms using ring_equiv.trans

-- let C be another ring
variables (C : Type) [ring C]

-- here using the power of dot notation
example (φ : A ≃+* B) (ψ : B ≃+* C) : A ≃+* C := φ.trans ψ

-- How do you make a ring isomorphism from two invertible ring homomorphisms?
example (φ : A →+* B) (ψ : B →+* A) (h1 : ∀ a, ψ (φ a) = a) (h2 : ∀ b, φ (ψ b) = b) : A ≃+* B :=
{ to_fun := φ,
  inv_fun := ψ,
  left_inv := h1,
  right_inv := h2,
  map_add' := φ.map_add,
  map_mul' := φ.map_mul }

-- Notice that `ring_equiv` *extends* `equiv`, so you need to fill in the `equiv` fields and then
-- add in the proofs that `φ(a+b)=φ(a)+φ(b)` and `φ(ab)=φ(a)φ(b)`.

-- Note that we never used that ψ was a ring homomorphism! It follows from the fact that ψ is a bijection
-- whose inverse is a ring homomorphism. But of course Lean knows that the inverse of a ring
-- isomorphism is a ring homomorphism -- it's just a theorem, rather than an axiom.

example (φ : A ≃+* B) (x y : B) : φ.symm (x * y) = φ.symm x * φ.symm y := map_mul φ.symm x y


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import data.set.intervals.basic
import algebra.ordered_group
/-!

# Upper / lower bounds

In this file we define:

* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
  (resp., lower) bounds of `s` is nonempty;
* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
  for a partial order, it is unique if exists;
* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
  of `s`; for a partial order, it is unique if exists.

We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
formulas for `∅`, `univ`, and intervals.
-/
open set

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

section
variables [preorder α] [preorder β] {s t : set α} {a b : α}

/-!
### Definitions
-/

/-- The set of upper bounds of a set. -/
def upper_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s →  a ≤ x }
/-- The set of lower bounds of a set. -/
def lower_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }

/-- A set is bounded above if there exists an upper bound. -/
def bdd_above (s : set α) := (upper_bounds s).nonempty
/-- A set is bounded below if there exists a lower bound. -/
def bdd_below (s : set α) := (lower_bounds s).nonempty

/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
def is_least (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ lower_bounds s
/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
def is_greatest (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ upper_bounds s

/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
def is_lub (s : set α) : α → Prop := is_least (upper_bounds s)
/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
def is_glb (s : set α) : α → Prop := is_greatest (lower_bounds s)

lemma mem_upper_bounds : a ∈ upper_bounds s ↔ ∀ x ∈ s, x ≤ a := iff.rfl

lemma mem_lower_bounds : a ∈ lower_bounds s ↔ ∀ x ∈ s, a ≤ x := iff.rfl

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
lemma not_bdd_above_iff' : ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, ¬(y ≤ x) :=
by simp [bdd_above, upper_bounds, set.nonempty]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
is not less than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
lemma not_bdd_below_iff' : ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, ¬(x ≤ y) :=
@not_bdd_above_iff' (order_dual α) _ _

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
lemma not_bdd_above_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, x < y :=
by simp only [not_bdd_above_iff', not_le]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
lemma not_bdd_below_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, y < x :=
@not_bdd_above_iff (order_dual α) _ _

/-!
### Monotonicity
-/

lemma upper_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  upper_bounds t ⊆ upper_bounds s :=
λ b hb x h, hb $ hst h

lemma lower_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  lower_bounds t ⊆ lower_bounds s :=
λ b hb x h, hb $ hst h

lemma upper_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
λ ha x h, le_trans (ha h) hab

lemma lower_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
λ hb x h, le_trans hab (hb h)

lemma upper_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  a ∈ upper_bounds t → b ∈ upper_bounds s :=
λ ha, upper_bounds_mono_set hst $ upper_bounds_mono_mem hab ha

lemma lower_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  b ∈ lower_bounds t → a ∈ lower_bounds s :=
λ hb, lower_bounds_mono_set hst $ lower_bounds_mono_mem hab hb

/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
lemma bdd_above.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_above t → bdd_above s :=
nonempty.mono $ upper_bounds_mono_set h

/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
lemma bdd_below.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_below t → bdd_below s :=
nonempty.mono $ lower_bounds_mono_set h

/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_lub.of_subset_of_superset {s t p : set α} (hs : is_lub s a) (hp : is_lub p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
⟨upper_bounds_mono_set htp hp.1, lower_bounds_mono_set (upper_bounds_mono_set hst) hs.2⟩

/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_glb.of_subset_of_superset {s t p : set α} (hs : is_glb s a) (hp : is_glb p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
@is_lub.of_subset_of_superset (order_dual α) _ a s t p hs hp hst htp

lemma is_least.mono (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
hb.2 (hst ha.1)

lemma is_greatest.mono (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
hb.2 (hst ha.1)

lemma is_lub.mono (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
hb.mono ha $ upper_bounds_mono_set hst

lemma is_glb.mono (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
hb.mono ha $ lower_bounds_mono_set hst

/-!
### Conversions
-/

lemma is_least.is_glb (h : is_least s a) : is_glb s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_greatest.is_lub (h : is_greatest s a) : is_lub s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_lub.upper_bounds_eq (h : is_lub s a) : upper_bounds s = Ici a :=
set.ext $ λ b, ⟨λ hb, h.2 hb, λ hb, upper_bounds_mono_mem hb h.1⟩

lemma is_glb.lower_bounds_eq (h : is_glb s a) : lower_bounds s = Iic a :=
@is_lub.upper_bounds_eq (order_dual α) _ _ _ h

lemma is_least.lower_bounds_eq (h : is_least s a) : lower_bounds s = Iic a :=
h.is_glb.lower_bounds_eq

lemma is_greatest.upper_bounds_eq (h : is_greatest s a) : upper_bounds s = Ici a :=
h.is_lub.upper_bounds_eq

lemma is_lub_le_iff (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
by { rw h.upper_bounds_eq, refl }

lemma le_is_glb_iff (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
by { rw h.lower_bounds_eq, refl }

/-- If `s` has a least upper bound, then it is bounded above. -/
lemma is_lub.bdd_above (h : is_lub s a) : bdd_above s := ⟨a, h.1⟩

/-- If `s` has a greatest lower bound, then it is bounded below. -/
lemma is_glb.bdd_below (h : is_glb s a) : bdd_below s := ⟨a, h.1⟩

/-- If `s` has a greatest element, then it is bounded above. -/
lemma is_greatest.bdd_above (h : is_greatest s a) : bdd_above s := ⟨a, h.2⟩

/-- If `s` has a least element, then it is bounded below. -/
lemma is_least.bdd_below (h : is_least s a) : bdd_below s := ⟨a, h.2⟩

lemma is_least.nonempty (h : is_least s a) : s.nonempty := ⟨a, h.1⟩

lemma is_greatest.nonempty (h : is_greatest s a) : s.nonempty := ⟨a, h.1⟩

/-!
### Union and intersection
-/

@[simp] lemma upper_bounds_union : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t :=
subset.antisymm
  (λ b hb, ⟨λ x hx, hb (or.inl hx), λ x hx, hb (or.inr hx)⟩)
  (λ b hb x hx, hx.elim (λ hs, hb.1 hs) (λ ht, hb.2 ht))

@[simp] lemma lower_bounds_union : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
@upper_bounds_union (order_dual α) _ s t

lemma union_upper_bounds_subset_upper_bounds_inter :
  upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
union_subset
  (upper_bounds_mono_set $ inter_subset_left _ _)
  (upper_bounds_mono_set $ inter_subset_right _ _)

lemma union_lower_bounds_subset_lower_bounds_inter :
  lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
@union_upper_bounds_subset_upper_bounds_inter (order_dual α) _ s t

lemma is_least_union_iff {a : α} {s t : set α} :
  is_least (s ∪ t) a ↔ (is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a) :=
by simp [is_least, lower_bounds_union, or_and_distrib_right, and_comm (a ∈ t), and_assoc]

lemma is_greatest_union_iff :
  is_greatest (s ∪ t) a ↔ (is_greatest s a ∧ a ∈ upper_bounds t ∨
    a ∈ upper_bounds s ∧ is_greatest t a) :=
@is_least_union_iff (order_dual α) _ a s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_left (h : bdd_above s) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_right (h : bdd_above t) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_left (h : bdd_below s) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_right (h : bdd_below t) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
lemma bdd_above.union [semilattice_sup γ] {s t : set γ} :
  bdd_above s → bdd_above t → bdd_above (s ∪ t) :=
begin
  rintros ⟨bs, hs⟩ ⟨bt, ht⟩,
  use bs ⊔ bt,
  rw upper_bounds_union,
  exact ⟨upper_bounds_mono_mem le_sup_left hs,
    upper_bounds_mono_mem le_sup_right ht⟩
end

/-- The union of two sets is bounded above if and only if each of the sets is. -/
lemma bdd_above_union [semilattice_sup γ] {s t : set γ} :
  bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
⟨λ h, ⟨h.mono $ subset_union_left s t, h.mono $ subset_union_right s t⟩,
  λ h, h.1.union h.2⟩

lemma bdd_below.union [semilattice_inf γ] {s t : set γ} :
  bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
@bdd_above.union (order_dual γ) _ s t

/--The union of two sets is bounded above if and only if each of the sets is.-/
lemma bdd_below_union [semilattice_inf γ] {s t : set γ} :
  bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
@bdd_above_union (order_dual γ) _ s t

/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
lemma is_lub.union [semilattice_sup γ] {a b : γ} {s t : set γ}
  (hs : is_lub s a) (ht : is_lub t b) :
  is_lub (s ∪ t) (a ⊔ b) :=
⟨assume c h, h.cases_on (λ h, le_sup_left_of_le $ hs.left h) (λ h, le_sup_right_of_le $ ht.left h),
  assume c hc, sup_le
    (hs.right $ assume d hd, hc $ or.inl hd) (ht.right $ assume d hd, hc $ or.inr hd)⟩

/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
lemma is_glb.union [semilattice_inf γ] {a₁ a₂ : γ} {s t : set γ}
  (hs : is_glb s a₁) (ht : is_glb t a₂) :
  is_glb (s ∪ t) (a₁ ⊓ a₂) :=
@is_lub.union (order_dual γ) _ _ _ _ _ hs ht

/-- If `a` is the least element of `s` and `b` is the least element of `t`,
then `min a b` is the least element of `s ∪ t`. -/
lemma is_least.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_glb.union hb.is_glb).1⟩

/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
then `max a b` is the greatest element of `s ∪ t`. -/
lemma is_greatest.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_lub.union hb.is_lub).1⟩

lemma is_lub.inter_Ici_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_lub s a)
  (hb : b ∈ s) : is_lub (s ∩ Ici b) a :=
⟨λ x hx, ha.1 hx.1, λ c hc, have hbc : b ≤ c, from hc ⟨hb, le_rfl⟩,
  ha.2 $ λ x hx, (le_total x b).elim (λ hxb, hxb.trans hbc) $ λ hbx, hc ⟨hx, hbx⟩⟩

lemma is_glb.inter_Iic_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_glb s a)
  (hb : b ∈ s) : is_glb (s ∩ Iic b) a :=
@is_lub.inter_Ici_of_mem (order_dual γ) _ _ _ _ ha hb

/-!
### Specific sets

#### Unbounded intervals
-/

lemma is_least_Ici : is_least (Ici a) a := ⟨left_mem_Ici, λ x, id⟩

lemma is_greatest_Iic : is_greatest (Iic a) a := ⟨right_mem_Iic, λ x, id⟩

lemma is_lub_Iic : is_lub (Iic a) a := is_greatest_Iic.is_lub

lemma is_glb_Ici : is_glb (Ici a) a := is_least_Ici.is_glb

lemma upper_bounds_Iic : upper_bounds (Iic a) = Ici a := is_lub_Iic.upper_bounds_eq

lemma lower_bounds_Ici : lower_bounds (Ici a) = Iic a := is_glb_Ici.lower_bounds_eq

lemma bdd_above_Iic : bdd_above (Iic a) := is_lub_Iic.bdd_above

lemma bdd_below_Ici : bdd_below (Ici a) := is_glb_Ici.bdd_below

lemma bdd_above_Iio : bdd_above (Iio a) := ⟨a, λ x hx, le_of_lt hx⟩

lemma bdd_below_Ioi : bdd_below (Ioi a) := ⟨a, λ x hx, le_of_lt hx⟩

section

variables [linear_order γ] [densely_ordered γ]

lemma is_lub_Iio {a : γ} : is_lub (Iio a) a :=
⟨λ x hx, le_of_lt hx, λ y hy, le_of_forall_ge_of_dense hy⟩

lemma is_glb_Ioi {a : γ} : is_glb (Ioi a) a := @is_lub_Iio (order_dual γ) _ _ a

lemma upper_bounds_Iio {a : γ} : upper_bounds (Iio a) = Ici a := is_lub_Iio.upper_bounds_eq

lemma lower_bounds_Ioi {a : γ} : lower_bounds (Ioi a) = Iic a := is_glb_Ioi.lower_bounds_eq

end

/-!
#### Singleton
-/

lemma is_greatest_singleton : is_greatest {a} a :=
⟨mem_singleton a, λ x hx, le_of_eq $ eq_of_mem_singleton hx⟩

lemma is_least_singleton : is_least {a} a :=
@is_greatest_singleton (order_dual α) _ a

lemma is_lub_singleton : is_lub {a} a := is_greatest_singleton.is_lub

lemma is_glb_singleton : is_glb {a} a := is_least_singleton.is_glb

lemma bdd_above_singleton : bdd_above ({a} : set α) := is_lub_singleton.bdd_above

lemma bdd_below_singleton : bdd_below ({a} : set α) := is_glb_singleton.bdd_below

@[simp] lemma upper_bounds_singleton : upper_bounds {a} = Ici a := is_lub_singleton.upper_bounds_eq

@[simp] lemma lower_bounds_singleton : lower_bounds {a} = Iic a := is_glb_singleton.lower_bounds_eq

/-!
#### Bounded intervals
-/

lemma bdd_above_Icc : bdd_above (Icc a b) := ⟨b, λ _, and.right⟩

lemma bdd_below_Icc : bdd_below (Icc a b) := ⟨a, λ _, and.left⟩

lemma bdd_above_Ico : bdd_above (Ico a b) := bdd_above_Icc.mono Ico_subset_Icc_self

lemma bdd_below_Ico : bdd_below (Ico a b) := bdd_below_Icc.mono Ico_subset_Icc_self

lemma bdd_above_Ioc : bdd_above (Ioc a b) := bdd_above_Icc.mono Ioc_subset_Icc_self

lemma bdd_below_Ioc : bdd_below (Ioc a b) := bdd_below_Icc.mono Ioc_subset_Icc_self

lemma bdd_above_Ioo : bdd_above (Ioo a b) := bdd_above_Icc.mono Ioo_subset_Icc_self

lemma bdd_below_Ioo : bdd_below (Ioo a b) := bdd_below_Icc.mono Ioo_subset_Icc_self

lemma is_greatest_Icc (h : a ≤ b) : is_greatest (Icc a b) b :=
⟨right_mem_Icc.2 h, λ x, and.right⟩

lemma is_lub_Icc (h : a ≤ b) : is_lub (Icc a b) b := (is_greatest_Icc h).is_lub

lemma upper_bounds_Icc (h : a ≤ b) : upper_bounds (Icc a b) = Ici b :=
(is_lub_Icc h).upper_bounds_eq

lemma is_least_Icc (h : a ≤ b) : is_least (Icc a b) a :=
⟨left_mem_Icc.2 h, λ x, and.left⟩

lemma is_glb_Icc (h : a ≤ b) : is_glb (Icc a b) a := (is_least_Icc h).is_glb

lemma lower_bounds_Icc (h : a ≤ b) : lower_bounds (Icc a b) = Iic a :=
(is_glb_Icc h).lower_bounds_eq

lemma is_greatest_Ioc (h : a < b) : is_greatest (Ioc a b) b :=
⟨right_mem_Ioc.2 h, λ x, and.right⟩

lemma is_lub_Ioc (h : a < b) : is_lub (Ioc a b) b :=
(is_greatest_Ioc h).is_lub

lemma upper_bounds_Ioc (h : a < b) : upper_bounds (Ioc a b) = Ici b :=
(is_lub_Ioc h).upper_bounds_eq

lemma is_least_Ico (h : a < b) : is_least (Ico a b) a :=
⟨left_mem_Ico.2 h, λ x, and.left⟩

lemma is_glb_Ico (h : a < b) : is_glb (Ico a b) a :=
(is_least_Ico h).is_glb

lemma lower_bounds_Ico (h : a < b) : lower_bounds (Ico a b) = Iic a :=
(is_glb_Ico h).lower_bounds_eq

section

variables [semilattice_sup γ] [densely_ordered γ]

lemma is_glb_Ioo {a b : γ} (h : a < b) :
  is_glb (Ioo a b) a :=
⟨λ x hx, hx.1.le, λ x hx,
begin
  cases eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂,
  { exact h₁.symm ▸ le_sup_left },
  obtain ⟨y, lty, ylt⟩ := exists_between h₂,
  apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim,
  obtain ⟨u, au, ub⟩ := exists_between h,
  apply (hx ⟨au, ub⟩).trans ub.le,
end⟩

lemma lower_bounds_Ioo {a b : γ} (hab : a < b) : lower_bounds (Ioo a b) = Iic a :=
(is_glb_Ioo hab).lower_bounds_eq

lemma is_glb_Ioc {a b : γ} (hab : a < b) : is_glb (Ioc a b) a :=
(is_glb_Ioo hab).of_subset_of_superset (is_glb_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self

lemma lower_bound_Ioc {a b : γ} (hab : a < b) : lower_bounds (Ioc a b) = Iic a :=
(is_glb_Ioc hab).lower_bounds_eq

end

section

variables [semilattice_inf γ] [densely_ordered γ]

lemma is_lub_Ioo {a b : γ} (hab : a < b) : is_lub (Ioo a b) b :=
by simpa only [dual_Ioo] using @is_glb_Ioo (order_dual γ) _ _ b a hab

lemma upper_bounds_Ioo {a b : γ} (hab : a < b) : upper_bounds (Ioo a b) = Ici b :=
(is_lub_Ioo hab).upper_bounds_eq

lemma is_lub_Ico {a b : γ} (hab : a < b) : is_lub (Ico a b) b :=
by simpa only [dual_Ioc] using @is_glb_Ioc (order_dual γ) _ _ b a hab

lemma upper_bounds_Ico {a b : γ} (hab : a < b) : upper_bounds (Ico a b) = Ici b :=
(is_lub_Ico hab).upper_bounds_eq

end

lemma bdd_below_iff_subset_Ici : bdd_below s ↔ ∃ a, s ⊆ Ici a := iff.rfl

lemma bdd_above_iff_subset_Iic : bdd_above s ↔ ∃ a, s ⊆ Iic a := iff.rfl

lemma bdd_below_bdd_above_iff_subset_Icc : bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ Icc a b :=
by simp only [Ici_inter_Iic.symm, subset_inter_iff, bdd_below_iff_subset_Ici,
  bdd_above_iff_subset_Iic, exists_and_distrib_left, exists_and_distrib_right]

/-!
### Univ
-/

lemma order_top.upper_bounds_univ [order_top γ] : upper_bounds (univ : set γ) = {⊤} :=
set.ext $ λ b, iff.trans ⟨λ hb, top_unique $ hb trivial, λ hb x hx, hb.symm ▸ le_top⟩
  mem_singleton_iff.symm

lemma is_greatest_univ [order_top γ] : is_greatest (univ : set γ) ⊤ :=
by simp only [is_greatest, order_top.upper_bounds_univ, mem_univ, mem_singleton, true_and]

lemma is_lub_univ [order_top γ] : is_lub (univ : set γ) ⊤ :=
is_greatest_univ.is_lub

lemma order_bot.lower_bounds_univ [order_bot γ] : lower_bounds (univ : set γ) = {⊥} :=
@order_top.upper_bounds_univ (order_dual γ) _

lemma is_least_univ [order_bot γ] : is_least (univ : set γ) ⊥ :=
@is_greatest_univ (order_dual γ) _

lemma is_glb_univ [order_bot γ] : is_glb (univ : set γ) ⊥ :=
is_least_univ.is_glb

lemma no_top_order.upper_bounds_univ [no_top_order α] : upper_bounds (univ : set α) = ∅ :=
eq_empty_of_subset_empty $ λ b hb, let ⟨x, hx⟩ := no_top b in
not_le_of_lt hx (hb trivial)

lemma no_bot_order.lower_bounds_univ [no_bot_order α] : lower_bounds (univ : set α) = ∅ :=
@no_top_order.upper_bounds_univ (order_dual α) _ _

/-!
### Empty set
-/

@[simp] lemma upper_bounds_empty : upper_bounds (∅ : set α) = univ :=
by simp only [upper_bounds, eq_univ_iff_forall, mem_set_of_eq, ball_empty_iff, forall_true_iff]

@[simp] lemma lower_bounds_empty : lower_bounds (∅ : set α) = univ :=
@upper_bounds_empty (order_dual α) _

@[simp] lemma bdd_above_empty [nonempty α] : bdd_above (∅ : set α) :=
by simp only [bdd_above, upper_bounds_empty, univ_nonempty]

@[simp] lemma bdd_below_empty [nonempty α] : bdd_below (∅ : set α) :=
by simp only [bdd_below, lower_bounds_empty, univ_nonempty]

lemma is_glb_empty [order_top γ] : is_glb ∅ (⊤:γ) :=
by simp only [is_glb, lower_bounds_empty, is_greatest_univ]

lemma is_lub_empty [order_bot γ] : is_lub ∅ (⊥:γ) :=
@is_glb_empty (order_dual γ) _

lemma is_lub.nonempty [no_bot_order α] (hs : is_lub s a) : s.nonempty :=
let ⟨a', ha'⟩ := no_bot a in
ne_empty_iff_nonempty.1 $ assume h,
have a ≤ a', from hs.right $ by simp only [h, upper_bounds_empty],
not_le_of_lt ha' this

lemma is_glb.nonempty [no_top_order α] (hs : is_glb s a) : s.nonempty :=
@is_lub.nonempty (order_dual α) _ _ _ _ hs

lemma nonempty_of_not_bdd_above [ha : nonempty α] (h : ¬bdd_above s) : s.nonempty :=
nonempty.elim ha $ λ x, (not_bdd_above_iff'.1 h x).imp $ λ a ha, ha.fst

lemma nonempty_of_not_bdd_below [ha : nonempty α] (h : ¬bdd_below s) : s.nonempty :=
@nonempty_of_not_bdd_above (order_dual α) _ _ _ h

/-!
### insert
-/

/-- Adding a point to a set preserves its boundedness above. -/
@[simp] lemma bdd_above_insert [semilattice_sup γ] (a : γ) {s : set γ} :
  bdd_above (insert a s) ↔ bdd_above s :=
by simp only [insert_eq, bdd_above_union, bdd_above_singleton, true_and]

lemma bdd_above.insert [semilattice_sup γ] (a : γ) {s : set γ} (hs : bdd_above s) :
  bdd_above (insert a s) :=
(bdd_above_insert a).2 hs

/--Adding a point to a set preserves its boundedness below.-/
@[simp] lemma bdd_below_insert [semilattice_inf γ] (a : γ) {s : set γ} :
  bdd_below (insert a s) ↔ bdd_below s :=
by simp only [insert_eq, bdd_below_union, bdd_below_singleton, true_and]

lemma bdd_below.insert [semilattice_inf γ] (a : γ) {s : set γ} (hs : bdd_below s) :
  bdd_below (insert a s) :=
(bdd_below_insert a).2 hs

lemma is_lub.insert [semilattice_sup γ] (a) {b} {s : set γ} (hs : is_lub s b) :
  is_lub (insert a s) (a ⊔ b) :=
by { rw insert_eq, exact is_lub_singleton.union hs }

lemma is_glb.insert [semilattice_inf γ] (a) {b} {s : set γ} (hs : is_glb s b) :
  is_glb (insert a s) (a ⊓ b) :=
by { rw insert_eq, exact is_glb_singleton.union hs }

lemma is_greatest.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_greatest s b) :
  is_greatest (insert a s) (max a b) :=
by { rw insert_eq, exact is_greatest_singleton.union hs }

lemma is_least.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_least s b) :
  is_least (insert a s) (min a b) :=
by { rw insert_eq, exact is_least_singleton.union hs }

@[simp] lemma upper_bounds_insert (a : α) (s : set α) :
  upper_bounds (insert a s) = Ici a ∩ upper_bounds s :=
by rw [insert_eq, upper_bounds_union, upper_bounds_singleton]

@[simp] lemma lower_bounds_insert (a : α) (s : set α) :
  lower_bounds (insert a s) = Iic a ∩ lower_bounds s :=
by rw [insert_eq, lower_bounds_union, lower_bounds_singleton]

/-- When there is a global maximum, every set is bounded above. -/
@[simp] protected lemma order_top.bdd_above [order_top γ] (s : set γ) : bdd_above s :=
⟨⊤, assume a ha, order_top.le_top a⟩

/-- When there is a global minimum, every set is bounded below. -/
@[simp] protected lemma order_bot.bdd_below [order_bot γ] (s : set γ) : bdd_below s :=
⟨⊥, assume a ha, order_bot.bot_le a⟩

/-!
### Pair
-/

lemma is_lub_pair [semilattice_sup γ] {a b : γ} : is_lub {a, b} (a ⊔ b) :=
is_lub_singleton.insert _

lemma is_glb_pair [semilattice_inf γ] {a b : γ} : is_glb {a, b} (a ⊓ b) :=
is_glb_singleton.insert _

lemma is_least_pair [linear_order γ] {a b : γ} : is_least {a, b} (min a b) :=
is_least_singleton.insert _

lemma is_greatest_pair [linear_order γ] {a b : γ} : is_greatest {a, b} (max a b) :=
is_greatest_singleton.insert _

end

/-!
### (In)equalities with the least upper bound and the greatest lower bound
-/

section preorder
variables [preorder α] {s : set α} {a b : α}

lemma lower_bounds_le_upper_bounds (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) :
  s.nonempty → a ≤ b
| ⟨c, hc⟩ := le_trans (ha hc) (hb hc)

lemma is_glb_le_is_lub (ha : is_glb s a) (hb : is_lub s b) (hs : s.nonempty) : a ≤ b :=
lower_bounds_le_upper_bounds ha.1 hb.1 hs

lemma is_lub_lt_iff (ha : is_lub s a) : a < b ↔ ∃ c ∈ upper_bounds s, c < b :=
⟨λ hb, ⟨a, ha.1, hb⟩, λ ⟨c, hcs, hcb⟩, lt_of_le_of_lt (ha.2 hcs) hcb⟩

lemma lt_is_glb_iff (ha : is_glb s a) : b < a ↔ ∃ c ∈ lower_bounds s, b < c :=
@is_lub_lt_iff (order_dual α) _ s _ _ ha

lemma le_of_is_lub_le_is_glb {x y} (ha : is_glb s a) (hb : is_lub s b) (hab : b ≤ a)
  (hx : x ∈ s) (hy : y ∈ s) : x ≤ y :=
calc x ≤ b : hb.1 hx
   ... ≤ a : hab
   ... ≤ y : ha.1 hy

end preorder

section partial_order
variables [partial_order α] {s : set α} {a b : α}

lemma is_least.unique (Ha : is_least s a) (Hb : is_least s b) : a = b :=
le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)

lemma is_least.is_least_iff_eq (Ha : is_least s a) : is_least s b ↔ a = b :=
iff.intro Ha.unique (assume h, h ▸ Ha)

lemma is_greatest.unique (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)

lemma is_greatest.is_greatest_iff_eq (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
iff.intro Ha.unique (assume h, h ▸ Ha)

lemma is_lub.unique (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
Ha.unique Hb

lemma is_glb.unique (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
Ha.unique Hb

lemma set.subsingleton_of_is_lub_le_is_glb (Ha : is_glb s a) (Hb : is_lub s b) (hab : b ≤ a) :
  s.subsingleton :=
λ x hx y hy, le_antisymm (le_of_is_lub_le_is_glb Ha Hb hab hx hy)
  (le_of_is_lub_le_is_glb Ha Hb hab hy hx)

lemma is_glb_lt_is_lub_of_ne (Ha : is_glb s a) (Hb : is_lub s b)
  {x y} (Hx : x ∈ s) (Hy : y ∈ s) (Hxy : x ≠ y) :
  a < b :=
lt_iff_le_not_le.2
  ⟨lower_bounds_le_upper_bounds Ha.1 Hb.1 ⟨x, Hx⟩,
    λ hab, Hxy $ set.subsingleton_of_is_lub_le_is_glb Ha Hb hab Hx Hy⟩

end partial_order

section linear_order
variables [linear_order α] {s : set α} {a b : α}

lemma lt_is_lub_iff (h : is_lub s a) : b < a ↔ ∃ c ∈ s, b < c :=
by simp only [← not_le, is_lub_le_iff h, mem_upper_bounds, not_forall]

lemma is_glb_lt_iff (h : is_glb s a) : a < b ↔ ∃ c ∈ s, c < b :=
@lt_is_lub_iff (order_dual α) _ _ _ _ h

lemma is_lub.exists_between (h : is_lub s a) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c ≤ a :=
let ⟨c, hcs, hbc⟩ := (lt_is_lub_iff h).1 hb in ⟨c, hcs, hbc, h.1 hcs⟩

lemma is_lub.exists_between' (h : is_lub s a) (h' : a ∉ s) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c < a :=
let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
in ⟨c, hcs, hbc, hca.lt_of_ne $ λ hac, h' $ hac ▸ hcs⟩

lemma is_glb.exists_between (h : is_glb s a) (hb : a < b) :
  ∃ c ∈ s, a ≤ c ∧ c < b :=
let ⟨c, hcs, hbc⟩ := (is_glb_lt_iff h).1 hb in ⟨c, hcs, h.1 hcs, hbc⟩

lemma is_glb.exists_between' (h : is_glb s a) (h' : a ∉ s) (hb : a < b) :
  ∃ c ∈ s, a < c ∧ c < b :=
let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
in ⟨c, hcs, hac.lt_of_ne $ λ hac, h' $ hac.symm ▸ hcs, hcb⟩

end linear_order

/-!
### Least upper bound and the greatest lower bound in linear ordered additive commutative groups
-/

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group α] {s : set α} {a ε : α}

lemma is_glb.exists_between_self_add (h : is_glb s a) (hε : 0 < ε) :
  ∃ b ∈ s, a ≤ b ∧ b < a + ε :=
h.exists_between $ lt_add_of_pos_right _ hε

lemma is_glb.exists_between_self_add' (h : is_glb s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a < b ∧ b < a + ε :=
h.exists_between' h₂ $ lt_add_of_pos_right _ hε

lemma is_lub.exists_between_sub_self  (h : is_lub s a) (hε : 0 < ε) : ∃ b ∈ s, a - ε < b ∧ b ≤ a :=
h.exists_between $ sub_lt_self _ hε

lemma is_lub.exists_between_sub_self' (h : is_lub s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a - ε < b ∧ b < a :=
h.exists_between' h₂ $ sub_lt_self _ hε

end linear_ordered_add_comm_group

/-!
### Images of upper/lower bounds under monotone functions
-/

namespace monotone

variables [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α}

lemma mem_upper_bounds_image (Ha : a ∈ upper_bounds s) :
  f a ∈ upper_bounds (f '' s) :=
ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))

lemma mem_lower_bounds_image (Ha : a ∈ lower_bounds s) :
  f a ∈ lower_bounds (f '' s) :=
ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))

/-- The image under a monotone function of a set which is bounded above is bounded above. -/
lemma map_bdd_above (hf : monotone f) : bdd_above s → bdd_above (f '' s)
| ⟨C, hC⟩ := ⟨f C, hf.mem_upper_bounds_image hC⟩

/-- The image under a monotone function of a set which is bounded below is bounded below. -/
lemma map_bdd_below (hf : monotone f) : bdd_below s → bdd_below (f '' s)
| ⟨C, hC⟩ := ⟨f C, hf.mem_lower_bounds_image hC⟩

/-- A monotone map sends a least element of a set to a least element of its image. -/
lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Ha.2⟩

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Ha.2⟩

lemma is_lub_image_le (Ha : is_lub s a) {b : β} (Hb : is_lub (f '' s) b) :
  b ≤ f a :=
Hb.2 (Hf.mem_upper_bounds_image Ha.1)

lemma le_is_glb_image (Ha : is_glb s a) {b : β} (Hb : is_glb (f '' s) b) :
  f a ≤ b :=
Hb.2 (Hf.mem_lower_bounds_image Ha.1)

end monotone

lemma is_glb.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) :
  is_glb s x :=
⟨λ y hy, hf.1 $ hx.1 $ mem_image_of_mem _ hy,
  λ y hy, hf.1 $ hx.2 $ monotone.mem_lower_bounds_image (λ x y, hf.2) hy⟩

lemma is_lub.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) :
  is_lub s x :=
@is_glb.of_image (order_dual α) (order_dual β) _ _ f (λ x y, hf) _ _ hx


import data.nat.prime
import tactic.norm_num
import data.list.basic
import data.int.basic
open nat
open list

theorem  prime_factors_unique: ∀ A B:list ℕ,prod A=prod B→(∀p:ℕ, p∈A→prime p)→(∀ p:ℕ,p∈ B→ prime p)→A~B:=begin
    intro A,induction A with pA A1 Hi,
    norm_num,intros,cases B with p B1,exact perm.refl nil,exfalso,revert a,norm_num,
    have H:=a_1 p (list.mem_cons_self _ _),have H1:=dvd_mul_right p (prod B1),intro,rw ←a at H1,exact prime.not_dvd_one H H1,
    intros,simp at a,have H:pA ∣ prod B, have:=dvd_mul_right pA (prod A1),rwa a at this,
    have H1: ∀ (B:list ℕ)(p:ℕ),prime p→(∀pB, pB ∈ B → prime pB)→p ∣ prod B → p ∈ B:=begin
        assume B,induction B with p1 B1 Hi,
        rw prod_nil,assume p Hp H H2,exfalso,revert H2,
        exact prime.not_dvd_one Hp,
        assume p2 Hp2 H H1,
        norm_num,rw prod_cons at H1,
        have H2:=iff.elim_left (prime.dvd_mul Hp2) H1,
        cases H2 with A A,left,
        have H3:=H p1,
        revert H3,norm_num,assume H4,
        unfold prime at H4,
        have H5:=and.right H4 p2 A,
        have H6:¬p2=1:=begin unfold prime at Hp2,intro,rw a_3 at Hp2,simp at Hp2,revert Hp2,exact dec_trivial,end,
        simp [H6] at H5,assumption,right,
        have H3:(∀ (pB : ℕ), pB ∈ B1 → prime pB):=begin revert H, norm_num,end,have H2:= Hi p2 Hp2 H3 A,assumption,
    end,
    have HppA: prime pA:=begin apply a_1,norm_num,  end,
    have H9:=H1 B pA HppA a_2 H,
    have H11:=prod_eq_of_perm (perm_erase H9),rw [H11,prod_cons] at a,
    rw nat.mul_left_inj (gt_of_ge_of_gt (and.left HppA) (dec_trivial:2>0)) at a,
    have HA1:∀ (p : ℕ), p ∈ A1 → prime p:=begin revert a_1,norm_num,end,
    have HB1:∀ (p : ℕ), p ∈(list.erase B pA) → prime p:=λ p Hp,a_2 p (mem_of_mem_erase Hp),
    have Hi2:= iff.elim_right (perm_cons pA) (Hi (list.erase B pA) a HA1 HB1),
    exact perm.trans Hi2 (perm.symm (perm_erase H9)),
end


import tactic -- hide
open function nat -- hide

/-
## The `rw` tactic

The next tactic to learn is the `rw` tactic (short for `rewrite`). If we have a proof $h$ of an equality
$a=b$, then `rw h` will replace all occurrences of $a$ in the goal with $b$. It also works with `↔` instead of `=`.
That is, if we have two equivalent statements, it will replace one with the other.

In the example at hand, we have a proof $h$ of the fact that $a=3$. We want to prove that $a+5=8$,
which we could do by substituting in the value of $a$. Try to erase the `sorry` and replace it with
`rw h,` and see if it works.
-/

/- Lemma : no-side-bar
If $a = 3$, then $a + 5 = 8$.
-/
lemma l1 (a : ℕ) (h : a = 3) : a + 5 = 8 :=
begin
  rw h,

end


import data.real.basic data.real.sqrt

namespace MAS114
namespace exercises_1
namespace Q38

noncomputable def r3 : ℝ := real.sqrt 3
noncomputable def r5 : ℝ := real.sqrt 5
noncomputable def r7 : ℝ := real.sqrt 7

lemma p3 : (3 : ℝ) ≥ 0 := by { norm_cast, exact dec_trivial }
lemma p5 : (5 : ℝ) ≥ 0 := by { norm_cast, exact dec_trivial }
lemma p7 : (7 : ℝ) ≥ 0 := by { norm_cast, exact dec_trivial }

lemma h3 : r3 * r3 = 3 := real.mul_self_sqrt p3
lemma h5 : r5 * r5 = 5 := real.mul_self_sqrt p5
lemma h7 : r7 * r7 = 7 := real.mul_self_sqrt p7

noncomputable def u := r3 + r5 + r7

noncomputable def v := (u ^ 7 - 60 * u^5 + 841 * u ^ 3 - 4950 * u) / 472

lemma u2 : u ^ 2 = 15 + 2 * r3 * r5 + 2 * r3 * r7 + 2 * r5 * r7 :=
calc
 u ^ 2 = r3 * r3 + r5 * r5 + r7 * r7 + 2 * r3 * r5 + 2 * r3 * r7 + 2 * r5 * r7 :
          by { dsimp[u], ring}
 ... = 3 + 5 + 7 + 2 * r3 * r5 + 2 * r3 * r7 + 2 * r5 * r7 :
          by { rw[h3, h5, h7] }
 ... = 15 + 2 * r3 * r5 + 2 * r3 * r7 + 2 * r5 * r7 : by { ring }

lemma v_sq : v * v = 3 * 5 * 7 := sorry

lemma v_irrational : ¬ ∃ v_Q : ℚ, v = v_Q := sorry

lemma u_irrational : ¬ ∃ u_Q : ℚ, u = u_Q := sorry

end Q38
end exercises_1
end MAS114


import BrownCs22.Library.Tactics

/-

# Welcome to the Lean section of HW1!

Some general guidelines, before we get started.

* When you're doing Lean homework assignments, including this one,
  do *not* edit any of the `import` statements above the
  opening comment. This will most likely break our autograder.

* Speaking of: when you submit this on Gradescope, you'll
  upload it to a separate assignment than the PDF with your other
  solutions. That's because we can autograde Lean, but not normal
  math! In the future, we hope to let you upload both files to the
  same assignment. But autograders are tricky and we haven't
  figured it out yet.

* Your goal in this assignment is to replace the `sorry`s in each
  part with completed proofs. If you can't finish a problem and
  want to submit the assignment half-complete, that's fine --
  but try to "finish" the proof by putting in more `sorry`s.

  For example, if the original problem looks like this:
-/

theorem example_1 (p : Prop) : p → p → p := by
  sorry

/-
  and you work on it, but get stuck at this stage and can't finish:

theorem example_1 (p : Prop) : p → p → p := by
  intro hp1
  intro hp2

  then you should "finish" it by writing `sorry` again:
-/

theorem example_1' (p : Prop) : p → p → p := by
  intro hp1
  intro hp2
  sorry

/-
  Notice that, with the `sorry`, `example_1` is highlighted in yellow.
  Without the sorry, there is a red error message.
  It's safest to submit a file with no red error messages,
  to avoid any unexpected autograder failures.
  The autograder will give you points if all of the warnings and errors are gone.

Let's get started!
-/

variable (p q r s : Prop)

/-

## Problem 1

Fill in the `sorry` in the proof below.
The elimination and introduction rules we talked about in Lecture 4
will be very helpful here!

-/

/- 3 points -/
theorem problem_1 : (p ∧ q ∧ r) → (p ∧ r) := by
  sorry

/-

## Problem 2

Consider what the theorem below is saying!
"If the truth of `p` implies the falsity of `q`,
 then `p` and `q` cannot both be true."

Does that seem like a reasonable statement?
What do the truth tables of `p → ¬ q` and `¬ (p ∧ q)` look like?
(You do not need to write an answer, but think about it for a moment.
 Try the `#truth_table` command if you want.)

Again, your task is to fill in the `sorry` below to prove this statement.

-/

/- 3 points -/
theorem problem_2 : (p → ¬ q) → ¬ (p ∧ q) := by
  sorry

/-
## Problem 3

This one's a little tricky! Let's reason through it in natural language.

We want to prove that, if we know `((p ∨ q) ∧ (p → r) ∧ (q → s))`,
then we know `r ∨ s`.
So suppose that we know `((p ∨ q) ∧ (p → r) ∧ (q → s))`.
Our goal is to show that `r ∨ s` follows.

From that long statement, we know three facts: `p ∨ q`, `p → r`, and `q → s`.
We'll reason by cases on `p ∨ q`.

First, if we know `p`, then we know `r`, because `p → r`.
And if we know `r` then we know `r ∨ s`.

Second, if we know `q`, then we know `s`, because `q → s`.
And if we know `s` then we know `r ∨ s`.

That completes our proof!

Your task: translate this argument to Lean.

-/

/- 4 points -/
theorem problem_3 : ((p ∨ q) ∧ (p → r) ∧ (q → s)) → (r ∨ s) := by
  sorry


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import order.well_founded_set
import algebra.big_operators.finprod
import ring_theory.valuation.basic
import algebra.module.pi
import ring_theory.power_series.basic

/-!
# Hahn Series

## Main Definitions
  * If `Γ` is ordered and `R` has zero, then `hahn_series Γ R` consists of
  formal series over `Γ` with coefficients in `R`, whose supports are partially well-ordered.
  * If `R` is a (commutative) additive monoid or group, then so is `hahn_series Γ R`.
  * If `R` is a (comm_)(semi)ring, then so is `hahn_series Γ R`.
  * `hahn_series.add_val Γ R` defines an `add_valuation` on `hahn_series Γ R` when `Γ` is linearly
    ordered.
  * A `hahn_series.summable_family` is a family of Hahn series such that the union of their supports
  is well-founded and only finitely many are nonzero at any given coefficient. They have a formal
  sum, `hahn_series.summable_family.hsum`, which can be bundled as a `linear_map` as
  `hahn_series.summable_family.lsum`. Note that this is different from `summable` in the valuation
  topology, because there are topologically summable families that do not satisfy the axioms of
  `hahn_series.summable_family`, and formally summable families whose sums do not converge
  topologically.

## TODO
  * Given `[linear_ordered_add_comm_group Γ]` and `[field R]`, define `field (hahn_series Γ R)`.
  * Build an API for the variable `X`
  * Define Laurent series

-/

open finset
open_locale big_operators classical
noncomputable theory

/-- If `Γ` is linearly ordered and `R` has zero, then `hahn_series Γ R` consists of
  formal series over `Γ` with coefficients in `R`, whose supports are well-founded. -/
@[ext]
structure hahn_series (Γ : Type*) (R : Type*) [partial_order Γ] [has_zero R] :=
(coeff : Γ → R)
(is_pwo_support' : (function.support coeff).is_pwo)

variables {Γ : Type*} {R : Type*}

namespace hahn_series

section zero
variables [partial_order Γ] [has_zero R]

/-- The support of a Hahn series is just the set of indices whose coefficients are nonzero.
  Notably, it is well-founded. -/
def support (x : hahn_series Γ R) : set Γ := function.support x.coeff

@[simp]
lemma is_pwo_support (x : hahn_series Γ R) : x.support.is_pwo := x.is_pwo_support'

@[simp]
lemma is_wf_support (x : hahn_series Γ R) : x.support.is_wf := x.is_pwo_support.is_wf

@[simp]
lemma mem_support (x : hahn_series Γ R) (a : Γ) : a ∈ x.support ↔ x.coeff a ≠ 0 := iff.refl _

instance : has_zero (hahn_series Γ R) :=
⟨{ coeff := 0,
   is_pwo_support' := by simp }⟩

instance : inhabited (hahn_series Γ R) := ⟨0⟩

instance [subsingleton R] : subsingleton (hahn_series Γ R) :=
⟨λ a b, a.ext b (subsingleton.elim _ _)⟩

@[simp]
lemma zero_coeff {a : Γ} : (0 : hahn_series Γ R).coeff a = 0 := rfl

@[simp]
lemma support_zero : support (0 : hahn_series Γ R) = ∅ := function.support_zero

@[simp]
lemma support_nonempty_iff {x : hahn_series Γ R} :
  x.support.nonempty ↔ x ≠ 0 :=
begin
  split,
  { rintro ⟨a, ha⟩ rfl,
    apply ha zero_coeff },
  { contrapose!,
    rw set.not_nonempty_iff_eq_empty,
    intro h,
    ext a,
    have ha := set.not_mem_empty a,
    rw [← h, mem_support, not_not] at ha,
    rw [ha, zero_coeff] }
end

/-- `single a r` is the Hahn series which has coefficient `r` at `a` and zero otherwise. -/
def single (a : Γ) : zero_hom R (hahn_series Γ R) :=
{ to_fun := λ r, { coeff := pi.single a r,
    is_pwo_support' := (set.is_pwo_singleton a).mono pi.support_single_subset },
  map_zero' := ext _ _ (pi.single_zero _) }

variables {a b : Γ} {r : R}

@[simp]
theorem single_coeff_same (a : Γ) (r : R) : (single a r).coeff a = r := pi.single_eq_same a r

@[simp]
theorem single_coeff_of_ne (h : b ≠ a) : (single a r).coeff b = 0 := pi.single_eq_of_ne h r

theorem single_coeff : (single a r).coeff b = if (b = a) then r else 0 :=
by { split_ifs with h; simp [h] }

@[simp]
lemma support_single_of_ne (h : r ≠ 0) : support (single a r) = {a} :=
pi.support_single_of_ne h

lemma support_single_subset : support (single a r) ⊆ {a} :=
pi.support_single_subset

lemma eq_of_mem_support_single {b : Γ} (h : b ∈ support (single a r)) : b = a :=
support_single_subset h

@[simp]
lemma single_eq_zero : (single a (0 : R)) = 0 := (single a).map_zero

instance [nonempty Γ] [nontrivial R] : nontrivial (hahn_series Γ R) :=
⟨begin
  obtain ⟨r, s, rs⟩ := exists_pair_ne R,
  inhabit Γ,
  refine ⟨single (arbitrary Γ) r, single (arbitrary Γ) s, λ con, rs _⟩,
  rw [← single_coeff_same (arbitrary Γ) r, con, single_coeff_same],
end⟩

lemma coeff_min_ne_zero {x : hahn_series Γ R} (hx : x ≠ 0) :
  x.coeff (x.is_wf_support.min (support_nonempty_iff.2 hx)) ≠ 0 :=
x.is_wf_support.min_mem (support_nonempty_iff.2 hx)

end zero

section addition

variable [partial_order Γ]

section add_monoid
variable [add_monoid R]

instance : has_add (hahn_series Γ R) :=
{ add := λ x y, { coeff := x.coeff + y.coeff,
                  is_pwo_support' := (x.is_pwo_support.union y.is_pwo_support).mono
                    (function.support_add _ _) } }

instance : add_monoid (hahn_series Γ R) :=
{ zero := 0,
  add := (+),
  add_assoc := λ x y z, by { ext, apply add_assoc },
  zero_add := λ x, by { ext, apply zero_add },
  add_zero := λ x, by { ext, apply add_zero } }

@[simp]
lemma add_coeff' {x y : hahn_series Γ R} :
  (x + y).coeff = x.coeff + y.coeff := rfl

lemma add_coeff {x y : hahn_series Γ R} {a : Γ} :
  (x + y).coeff a = x.coeff a + y.coeff a := rfl

lemma support_add_subset {x y : hahn_series Γ R} :
  support (x + y) ⊆ support x ∪ support y :=
λ a ha, begin
  rw [mem_support, add_coeff] at ha,
  rw [set.mem_union, mem_support, mem_support],
  contrapose! ha,
  rw [ha.1, ha.2, add_zero],
end

/-- `single` as an additive monoid/group homomorphism -/
@[simps] def single.add_monoid_hom (a : Γ) : R →+ (hahn_series Γ R) :=
{ map_add' := λ x y, by { ext b, by_cases h : b = a; simp [h] },
  ..single a }

/-- `coeff g` as an additive monoid/group homomorphism -/
@[simps] def coeff.add_monoid_hom (g : Γ) : (hahn_series Γ R) →+ R :=
{ to_fun := λ f, f.coeff g,
  map_zero' := zero_coeff,
  map_add' := λ x y, add_coeff }

end add_monoid

instance [add_comm_monoid R] : add_comm_monoid (hahn_series Γ R) :=
{ add_comm := λ x y, by { ext, apply add_comm }
  .. hahn_series.add_monoid }

section add_group
variable [add_group R]

instance : add_group (hahn_series Γ R) :=
{ neg := λ x, { coeff := λ a, - x.coeff a,
                is_pwo_support' := by { rw function.support_neg,
                  exact x.is_pwo_support }, },
  add_left_neg := λ x, by { ext, apply add_left_neg },
  .. hahn_series.add_monoid }

@[simp]
lemma neg_coeff' {x : hahn_series Γ R} : (- x).coeff = - x.coeff := rfl

lemma neg_coeff {x : hahn_series Γ R} {a : Γ} : (- x).coeff a = - x.coeff a := rfl

@[simp]
lemma support_neg {x : hahn_series Γ R} : (- x).support = x.support :=
by { ext, simp }

@[simp]
lemma sub_coeff' {x y : hahn_series Γ R} :
  (x - y).coeff = x.coeff - y.coeff := by { ext, simp [sub_eq_add_neg] }

lemma sub_coeff {x y : hahn_series Γ R} {a : Γ} :
  (x - y).coeff a = x.coeff a - y.coeff a := by simp

end add_group

instance [add_comm_group R] : add_comm_group (hahn_series Γ R) :=
{ .. hahn_series.add_comm_monoid,
  .. hahn_series.add_group }

end addition

section distrib_mul_action
variables [partial_order Γ] {V : Type*} [monoid R] [add_monoid V] [distrib_mul_action R V]

instance : has_scalar R (hahn_series Γ V) :=
⟨λ r x, { coeff := r • x.coeff,
          is_pwo_support' := x.is_pwo_support.mono (function.support_smul_subset_right r x.coeff) }⟩

@[simp]
lemma smul_coeff {r : R} {x : hahn_series Γ V} {a : Γ} : (r • x).coeff a = r • (x.coeff a) := rfl

instance : distrib_mul_action R (hahn_series Γ V) :=
{ smul := (•),
  one_smul := λ _, by { ext, simp },
  smul_zero := λ _, by { ext, simp },
  smul_add := λ _ _ _, by { ext, simp [smul_add] },
  mul_smul := λ _ _ _, by { ext, simp [mul_smul] } }

variables {S : Type*} [monoid S] [distrib_mul_action S V]

instance [has_scalar R S] [is_scalar_tower R S V] :
  is_scalar_tower R S (hahn_series Γ V) :=
⟨λ r s a, by { ext, simp }⟩

instance [smul_comm_class R S V] :
  smul_comm_class R S (hahn_series Γ V) :=
⟨λ r s a, by { ext, simp [smul_comm] }⟩

end distrib_mul_action

section module
variables [partial_order Γ] [semiring R] {V : Type*} [add_comm_monoid V] [module R V]

instance : module R (hahn_series Γ V) :=
{ zero_smul := λ _, by { ext, simp },
  add_smul := λ _ _ _, by { ext, simp [add_smul] },
  .. hahn_series.distrib_mul_action }

/-- `single` as a linear map -/
@[simps] def single.linear_map (a : Γ) : R →ₗ[R] (hahn_series Γ R) :=
{ map_smul' := λ r s, by { ext b, by_cases h : b = a; simp [h] },
  ..single.add_monoid_hom a }

/-- `coeff g` as a linear map -/
@[simps] def coeff.linear_map (g : Γ) : (hahn_series Γ R) →ₗ[R] R :=
{ map_smul' := λ r s, rfl,
  ..coeff.add_monoid_hom g }

end module

section multiplication

variable [ordered_cancel_add_comm_monoid Γ]

instance [has_zero R] [has_one R] : has_one (hahn_series Γ R) :=
⟨single 0 1⟩

@[simp]
lemma one_coeff [has_zero R] [has_one R] {a : Γ} :
  (1 : hahn_series Γ R).coeff a = if a = 0 then 1 else 0 := single_coeff

@[simp]
lemma single_zero_one [has_zero R] [has_one R] : (single 0 (1 : R)) = 1 := rfl

@[simp]
lemma support_one [semiring R] [nontrivial R] :
  support (1 : hahn_series Γ R) = {0} :=
support_single_of_ne one_ne_zero

instance [semiring R] : has_mul (hahn_series Γ R) :=
{ mul := λ x y, { coeff := λ a,
    ∑ ij in (add_antidiagonal x.is_pwo_support y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd,
    is_pwo_support' := begin
      have h : {a : Γ | ∑ (ij : Γ × Γ) in add_antidiagonal x.is_pwo_support
        y.is_pwo_support a, x.coeff ij.fst * y.coeff ij.snd ≠ 0} ⊆
        {a : Γ | (add_antidiagonal x.is_pwo_support y.is_pwo_support a).nonempty},
      { intros a ha,
        contrapose! ha,
        simp [not_nonempty_iff_eq_empty.1 ha] },
      exact is_pwo_support_add_antidiagonal.mono h,
    end, }, }

@[simp]
lemma mul_coeff [semiring R] {x y : hahn_series Γ R} {a : Γ} :
  (x * y).coeff a = ∑ ij in (add_antidiagonal x.is_pwo_support y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd := rfl

lemma mul_coeff_right' [semiring R] {x y : hahn_series Γ R} {a : Γ} {s : set Γ} (hs : s.is_pwo)
  (hys : y.support ⊆ s) :
  (x * y).coeff a = ∑ ij in (add_antidiagonal x.is_pwo_support hs a),
    x.coeff ij.fst * y.coeff ij.snd :=
begin
  rw mul_coeff,
  apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_right hys) _ (λ _ _, rfl),
  intros b hb,
  simp only [not_and, not_not, mem_sdiff, mem_add_antidiagonal,
      ne.def, set.mem_set_of_eq, mem_support] at hb,
  rw [(hb.2 hb.1.1 hb.1.2.1), mul_zero]
end

lemma mul_coeff_left' [semiring R] {x y : hahn_series Γ R} {a : Γ} {s : set Γ} (hs : s.is_pwo)
  (hxs : x.support ⊆ s) :
  (x * y).coeff a = ∑ ij in (add_antidiagonal hs y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd :=
begin
  rw mul_coeff,
  apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_left hxs) _ (λ _ _, rfl),
  intros b hb,
  simp only [not_and, not_not, mem_sdiff, mem_add_antidiagonal,
      ne.def, set.mem_set_of_eq, mem_support] at hb,
  rw [not_not.1 (λ con, hb.1.2.2 (hb.2 hb.1.1 con)), zero_mul],
end

instance [semiring R] : distrib (hahn_series Γ R) :=
{ left_distrib := λ x y z, begin
    ext a,
    have hwf := (y.is_pwo_support.union z.is_pwo_support),
    rw [mul_coeff_right' hwf, add_coeff, mul_coeff_right' hwf (set.subset_union_right _ _),
      mul_coeff_right' hwf (set.subset_union_left _ _)],
    { simp only [add_coeff, mul_add, sum_add_distrib] },
    { intro b,
      simp only [add_coeff, ne.def, set.mem_union_eq, set.mem_set_of_eq, mem_support],
      contrapose!,
      intro h,
      rw [h.1, h.2, add_zero], }
  end,
  right_distrib := λ x y z, begin
    ext a,
    have hwf := (x.is_pwo_support.union y.is_pwo_support),
    rw [mul_coeff_left' hwf, add_coeff, mul_coeff_left' hwf (set.subset_union_right _ _),
      mul_coeff_left' hwf (set.subset_union_left _ _)],
    { simp only [add_coeff, add_mul, sum_add_distrib] },
    { intro b,
      simp only [add_coeff, ne.def, set.mem_union_eq, set.mem_set_of_eq, mem_support],
      contrapose!,
      intro h,
      rw [h.1, h.2, add_zero], },
  end,
  .. hahn_series.has_mul,
  .. hahn_series.has_add }

lemma single_mul_coeff_add [semiring R] {r : R} {x : hahn_series Γ R} {a : Γ} {b : Γ} :
  ((single b r) * x).coeff (a + b) = r * x.coeff a :=
begin
  by_cases hr : r = 0,
  { simp [hr] },
  simp only [hr, smul_coeff, mul_coeff, support_single_of_ne, ne.def, not_false_iff, smul_eq_mul],
  by_cases hx : x.coeff a = 0,
  { simp only [hx, mul_zero],
    rw [sum_congr _ (λ _ _, rfl), sum_empty],
    ext ⟨a1, a2⟩,
    simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
      mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
    rintro h1 rfl h2,
    rw add_comm at h1,
    rw ← add_right_cancel h1 at hx,
    exact h2 hx, },
  transitivity ∑ (ij : Γ × Γ) in {(b, a)}, (single b r).coeff ij.fst * x.coeff ij.snd,
  { apply sum_congr _ (λ _ _, rfl),
    ext ⟨a1, a2⟩,
    simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
      mem_singleton, set.mem_set_of_eq],
    split,
    { rintro ⟨h1, rfl, h2⟩,
      rw add_comm at h1,
      refine ⟨rfl, add_right_cancel h1⟩ },
    { rintro ⟨rfl, rfl⟩,
      refine ⟨add_comm _ _, _⟩,
      simp [hx] } },
  { simp }
end

lemma mul_single_coeff_add [semiring R] {r : R} {x : hahn_series Γ R} {a : Γ} {b : Γ} :
  (x * (single b r)).coeff (a + b) = x.coeff a * r :=
begin
  by_cases hr : r = 0,
  { simp [hr] },
  simp only [hr, smul_coeff, mul_coeff, support_single_of_ne, ne.def, not_false_iff, smul_eq_mul],
  by_cases hx : x.coeff a = 0,
  { simp only [hx, zero_mul],
    rw [sum_congr _ (λ _ _, rfl), sum_empty],
    ext ⟨a1, a2⟩,
    simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
      mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
    rintro h1 h2 rfl,
    rw ← add_right_cancel h1 at hx,
    exact h2 hx, },
  transitivity ∑ (ij : Γ × Γ) in {(a,b)}, x.coeff ij.fst * (single b r).coeff ij.snd,
  { apply sum_congr _ (λ _ _, rfl),
    ext ⟨a1, a2⟩,
    simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
      mem_singleton, set.mem_set_of_eq],
    split,
    { rintro ⟨h1, h2, rfl⟩,
      refine ⟨add_right_cancel h1, rfl⟩ },
    { rintro ⟨rfl, rfl⟩,
      simp [hx] } },
  { simp }
end

@[simp]
lemma mul_single_zero_coeff [semiring R] {r : R} {x : hahn_series Γ R} {a : Γ} :
  (x * (single 0 r)).coeff a = x.coeff a * r  :=
by rw [← add_zero a, mul_single_coeff_add, add_zero]

lemma single_zero_mul_coeff [semiring R] {r : R} {x : hahn_series Γ R} {a : Γ} :
  ((single 0 r) * x).coeff a = r * x.coeff a :=
by rw [← add_zero a, single_mul_coeff_add, add_zero]

@[simp]
lemma single_zero_mul_eq_smul [semiring R] {r : R} {x : hahn_series Γ R} :
  (single 0 r) * x = r • x :=
by { ext, exact single_zero_mul_coeff }

theorem support_mul_subset_add_support [semiring R] {x y : hahn_series Γ R} :
  support (x * y) ⊆ support x + support y :=
begin
  apply set.subset.trans (λ x hx, _) support_add_antidiagonal_subset_add,
  { exact x.is_pwo_support },
  { exact y.is_pwo_support },
  contrapose! hx,
  simp only [not_nonempty_iff_eq_empty, ne.def, set.mem_set_of_eq] at hx,
  simp [hx],
end

@[simp]
lemma mul_coeff_min_add_min {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [semiring R]
  {x y : hahn_series Γ R} (hx : x ≠ 0) (hy : y ≠ 0) :
  (x * y).coeff (x.is_wf_support.min (support_nonempty_iff.2 hx) +
    y.is_wf_support.min (support_nonempty_iff.2 hy)) =
    (x.coeff (x.is_wf_support.min (support_nonempty_iff.2 hx))) *
    y.coeff (y.is_wf_support.min (support_nonempty_iff.2 hy)) :=
by rw [mul_coeff, finset.add_antidiagonal_min_add_min, finset.sum_singleton]

private lemma mul_assoc' [semiring R] (x y z : hahn_series Γ R) :
  x * y * z = x * (y * z) :=
begin
  ext b,
  rw [mul_coeff_left' (x.is_pwo_support.add y.is_pwo_support) support_mul_subset_add_support,
      mul_coeff_right' (y.is_pwo_support.add z.is_pwo_support) support_mul_subset_add_support],
  simp only [mul_coeff, add_coeff, sum_mul, mul_sum, sum_sigma'],
  refine sum_bij_ne_zero (λ a has ha0, ⟨⟨a.2.1, a.2.2 + a.1.2⟩, ⟨a.2.2, a.1.2⟩⟩) _ _ _ _,
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp only [true_and, set.image2_add, eq_self_iff_true, mem_add_antidiagonal, ne.def,
      set.image_prod, mem_sigma, set.mem_set_of_eq] at H1 H2 ⊢,
    obtain ⟨⟨rfl, ⟨H3, nz⟩⟩, ⟨rfl, nx, ny⟩⟩ := H1,
    refine ⟨⟨(add_assoc _ _ _).symm, nx, set.add_mem_add ny nz⟩, ny, nz⟩ },
  { rintros ⟨⟨i1,j1⟩, ⟨k1,l1⟩⟩ ⟨⟨i2,j2⟩, ⟨k2,l2⟩⟩ H1 H2 H3 H4 H5,
    simp only [set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal, ne.def,
      set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq] at H1 H3 H5,
    obtain ⟨⟨rfl, H⟩, rfl, rfl⟩ := H5,
    simp only [and_true, prod.mk.inj_iff, eq_self_iff_true, heq_iff_eq],
    exact add_right_cancel (H1.1.1.trans H3.1.1.symm) },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp only [exists_prop, set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal,
      sigma.exists, ne.def, set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq,
      prod.exists] at H1 H2 ⊢,
    obtain ⟨⟨rfl, nx, H⟩, rfl, ny, nz⟩ := H1,
    exact ⟨i + k, l, i, k, ⟨⟨add_assoc _ _ _, set.add_mem_add nx ny, nz⟩, rfl, nx, ny⟩,
      λ con, H2 ((mul_assoc _ _ _).symm.trans con), ⟨rfl, rfl⟩, rfl, rfl⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp [mul_assoc], }
end

instance [semiring R] : semiring (hahn_series Γ R) :=
{ zero := 0,
  one := 1,
  add := (+),
  mul := (*),
  zero_mul := λ _, by { ext, simp },
  mul_zero := λ _, by { ext, simp },
  one_mul := λ x, single_zero_mul_eq_smul.trans (one_smul _ _),
  mul_one := λ x, by { ext, exact mul_single_zero_coeff.trans (mul_one _) },
  mul_assoc := mul_assoc',
  .. hahn_series.add_comm_monoid,
  .. hahn_series.distrib }

instance [comm_semiring R] : comm_semiring (hahn_series Γ R) :=
{ mul_comm := λ x y, begin
    ext,
    simp_rw [mul_coeff, mul_comm],
    refine sum_bij (λ a ha, ⟨a.2, a.1⟩) _ (λ a ha, by simp) _ _,
    { intros a ha,
      simp only [mem_add_antidiagonal, ne.def, set.mem_set_of_eq] at ha ⊢,
      obtain ⟨h1, h2, h3⟩ := ha,
      refine ⟨_, h3, h2⟩,
      rw [add_comm, h1], },
    { rintros ⟨a1, a2⟩ ⟨b1, b2⟩ ha hb hab,
      rw prod.ext_iff at *,
      refine ⟨hab.2, hab.1⟩, },
    { intros a ha,
      refine ⟨a.swap, _, by simp⟩,
      simp only [prod.fst_swap, mem_add_antidiagonal, prod.snd_swap,
        ne.def, set.mem_set_of_eq] at ha ⊢,
      exact ⟨(add_comm _ _).trans ha.1, ha.2.2, ha.2.1⟩ }
  end,
  .. hahn_series.semiring }

instance [ring R] : ring (hahn_series Γ R) :=
{ .. hahn_series.semiring,
  .. hahn_series.add_comm_group }

instance [comm_ring R] : comm_ring (hahn_series Γ R) :=
{ .. hahn_series.comm_semiring,
  .. hahn_series.ring }

instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [integral_domain R] :
  integral_domain (hahn_series Γ R) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y xy, begin
    by_cases hx : x = 0,
    { left, exact hx },
    right,
    contrapose! xy,
    rw [hahn_series.ext_iff, function.funext_iff, not_forall],
    refine ⟨x.is_wf_support.min (support_nonempty_iff.2 hx) +
      y.is_wf_support.min (support_nonempty_iff.2 xy), _⟩,
    rw [mul_coeff_min_add_min, zero_coeff, mul_eq_zero],
    simp [coeff_min_ne_zero, hx, xy],
  end,
  .. hahn_series.nontrivial,
  .. hahn_series.comm_ring }

section semiring
variables [semiring R]

@[simp]
lemma single_mul_single {a b : Γ} {r s : R} :
  single a r * single b s = single (a + b) (r * s) :=
begin
  ext x,
  by_cases h : x = a + b,
  { rw [h, mul_single_coeff_add],
    simp },
  { rw [single_coeff_of_ne h, mul_coeff, sum_eq_zero],
    rintros ⟨y1, y2⟩ hy,
    obtain ⟨rfl, hy1, hy2⟩ := mem_add_antidiagonal.1 hy,
    rw [eq_of_mem_support_single hy1, eq_of_mem_support_single hy2] at h,
    exact (h rfl).elim }
end

/-- `C a` is the constant Hahn Series `a`. `C` is provided as a ring homomorphism. -/
@[simps] def C : R →+* (hahn_series Γ R) :=
{ to_fun := single 0,
  map_zero' := single_eq_zero,
  map_one' := rfl,
  map_add' := λ x y, by { ext a, by_cases h : a = 0; simp [h] },
  map_mul' := λ x y, by rw [single_mul_single, zero_add] }

@[simp]
lemma C_zero : C (0 : R) = (0 : hahn_series Γ R) := C.map_zero

@[simp]
lemma C_one : C (1 : R) = (1 : hahn_series Γ R) := C.map_one

lemma C_mul_eq_smul {r : R} {x : hahn_series Γ R} : C r * x = r • x :=
single_zero_mul_eq_smul

end semiring

section algebra
variables [comm_semiring R] {A : Type*} [semiring A] [algebra R A]

instance : algebra R (hahn_series Γ A) :=
{ to_ring_hom := C.comp (algebra_map R A),
  smul_def' := λ r x, by { ext, simp },
  commutes' := λ r x, by { ext, simp only [smul_coeff, single_zero_mul_eq_smul, ring_hom.coe_comp,
    ring_hom.to_fun_eq_coe, C_apply, function.comp_app, algebra_map_smul, mul_single_zero_coeff],
    rw [← algebra.commutes, algebra.smul_def], }, }

theorem C_eq_algebra_map : C = (algebra_map R (hahn_series Γ R)) := rfl

theorem algebra_map_apply {r : R} :
  algebra_map R (hahn_series Γ A) r = C (algebra_map R A r) := rfl

instance [nontrivial Γ] [nontrivial R] : nontrivial (subalgebra R (hahn_series Γ R)) :=
⟨⟨⊥, ⊤, begin
  rw [ne.def, set_like.ext_iff, not_forall],
  obtain ⟨a, ha⟩ := exists_ne (0 : Γ),
  refine ⟨single a 1, _⟩,
  simp only [algebra.mem_bot, not_exists, set.mem_range, iff_true, algebra.mem_top],
  intros x,
  rw [ext_iff, function.funext_iff, not_forall],
  refine ⟨a, _⟩,
  rw [single_coeff_same, algebra_map_apply, C_apply, single_coeff_of_ne ha],
  exact zero_ne_one
end⟩⟩

end algebra

end multiplication

section semiring
variables [semiring R]

/-- The ring `hahn_series ℕ R` is isomorphic to `power_series R`. -/
@[simps] def to_power_series : (hahn_series ℕ R) ≃+* power_series R :=
{ to_fun := λ f, power_series.mk f.coeff,
  inv_fun := λ f, ⟨λ n, power_series.coeff R n f, (nat.lt_wf.is_wf _).is_pwo⟩,
  left_inv := λ f, by { ext, simp },
  right_inv := λ f, by { ext, simp },
  map_add' := λ f g, by { ext, simp },
  map_mul' := λ f g, begin
    ext n,
    simp only [power_series.coeff_mul, power_series.coeff_mk, mul_coeff, is_pwo_support],
    classical,
    refine sum_filter_ne_zero.symm.trans
      ((sum_congr _ (λ _ _, rfl)).trans sum_filter_ne_zero),
    ext m,
    simp only [nat.mem_antidiagonal, and.congr_left_iff, mem_add_antidiagonal, ne.def,
      and_iff_left_iff_imp, mem_filter, mem_support],
    intros h1 h2,
    contrapose h1,
    rw ← decidable.or_iff_not_and_not at h1,
    cases h1; simp [h1]
  end }

lemma coeff_to_power_series {f : hahn_series ℕ R} {n : ℕ} :
  power_series.coeff R n f.to_power_series = f.coeff n :=
power_series.coeff_mk _ _

lemma coeff_to_power_series_symm {f : power_series R} {n : ℕ} :
  (hahn_series.to_power_series.symm f).coeff n = power_series.coeff R n f := rfl

end semiring

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

/-- The `R`-algebra `hahn_series ℕ A` is isomorphic to `power_series A`. -/
@[simps] def to_power_series_alg : (hahn_series ℕ A) ≃ₐ[R] power_series A :=
{ commutes' := λ r, begin
    ext n,
    simp only [algebra_map_apply, power_series.algebra_map_apply, ring_equiv.to_fun_eq_coe, C_apply,
      coeff_to_power_series],
    cases n,
    { simp only [power_series.coeff_zero_eq_constant_coeff, single_coeff_same],
      refl },
    { simp only [n.succ_ne_zero, ne.def, not_false_iff, single_coeff_of_ne],
      rw [power_series.coeff_C, if_neg n.succ_ne_zero] }
  end,
  .. to_power_series }

end algebra

section valuation

variables [linear_ordered_add_comm_group Γ] [integral_domain R] [nontrivial R]

instance : linear_ordered_comm_group (multiplicative Γ) :=
{ .. (infer_instance : linear_order (multiplicative Γ)),
  .. (infer_instance : ordered_comm_group (multiplicative Γ)) }

instance : linear_ordered_comm_group_with_zero (with_zero (multiplicative Γ)) :=
{ zero_le_one := with_zero.zero_le 1,
  .. (with_zero.ordered_comm_monoid),
  .. (infer_instance : linear_order (with_zero (multiplicative Γ))),
  .. (infer_instance : comm_group_with_zero (with_zero (multiplicative Γ))) }

variables (Γ) (R)

/-- The additive valuation on `hahn_series Γ R`, returning the smallest index at which
  a Hahn Series has a nonzero coefficient, or `⊤` for the 0 series.  -/
def add_val : add_valuation (hahn_series Γ R) (with_top Γ) :=
add_valuation.of (λ x, if h : x = (0 : hahn_series Γ R) then (⊤ : with_top Γ)
    else x.is_wf_support.min (support_nonempty_iff.2 h))
  (dif_pos rfl)
  ((dif_neg one_ne_zero).trans (by simp))
  (λ x y, begin
    by_cases hx : x = 0,
    { by_cases hy : y = 0; { simp [hx, hy] } },
    { by_cases hy : y = 0,
      { simp [hx, hy] },
      { simp only [hx, hy, support_nonempty_iff, dif_neg, not_false_iff, is_wf_support, min_le_iff],
        by_cases hxy : x + y = 0,
        { simp [hxy] },
        rw [dif_neg hxy, with_top.coe_le_coe, with_top.coe_le_coe, ← min_le_iff,
          ← set.is_wf.min_union],
        exact set.is_wf.min_le_min_of_subset support_add_subset, } },
  end)
  (λ x y, begin
    by_cases hx : x = 0,
    { simp [hx] },
    by_cases hy : y = 0,
    { simp [hy] },
    rw [dif_neg hx, dif_neg hy, dif_neg (mul_ne_zero hx hy),
      ← with_top.coe_add, with_top.coe_eq_coe],
    apply le_antisymm,
    { apply set.is_wf.min_le,
      rw [mem_support, mul_coeff_min_add_min],
      exact mul_ne_zero (coeff_min_ne_zero hx) (coeff_min_ne_zero hy) },
    { rw ← set.is_wf.min_add,
      exact set.is_wf.min_le_min_of_subset (support_mul_subset_add_support) },
  end)

variables {Γ} {R}

lemma add_val_apply {x : hahn_series Γ R} :
  add_val Γ R x = if h : x = (0 : hahn_series Γ R) then (⊤ : with_top Γ)
    else x.is_wf_support.min (support_nonempty_iff.2 h) :=
add_valuation.of_apply _

@[simp]
lemma add_val_apply_of_ne {x : hahn_series Γ R} (hx : x ≠ 0) :
  add_val Γ R x = x.is_wf_support.min (support_nonempty_iff.2 hx) :=
dif_neg hx

end valuation

section
variables (Γ) (R) [partial_order Γ] [add_comm_monoid R]

/-- An infinite family of Hahn series which has a formal coefficient-wise sum.
  The requirements for this are that the union of the supports of the series is well-founded,
  and that only finitely many series are nonzero at any given coefficient. -/
structure summable_family (α : Type*) :=
(to_fun : α → hahn_series Γ R)
(is_pwo_Union_support' : set.is_pwo (⋃ (a : α), (to_fun a).support))
(finite_co_support' : ∀ (g : Γ), ({a | (to_fun a).coeff g ≠ 0}).finite)

end

namespace summable_family
section add_comm_monoid

variables [partial_order Γ] [add_comm_monoid R] {α : Type*}

instance : has_coe_to_fun (summable_family Γ R α) :=
⟨λ _, (α → hahn_series Γ R), to_fun⟩

lemma is_pwo_Union_support (s : summable_family Γ R α) : set.is_pwo (⋃ (a : α), (s a).support) :=
s.is_pwo_Union_support'

lemma finite_co_support (s : summable_family Γ R α) (g : Γ) :
  (function.support (λ a, (s a).coeff g)).finite :=
s.finite_co_support' g

lemma coe_injective : @function.injective (summable_family Γ R α) (α → hahn_series Γ R) coe_fn
| ⟨f1, hU1, hf1⟩ ⟨f2, hU2, hf2⟩ h :=
begin
  change f1 = f2 at h,
  subst h,
end

@[ext]
lemma ext {s t : summable_family Γ R α} (h : ∀ (a : α), s a = t a) : s = t :=
coe_injective $ funext h

instance : has_add (summable_family Γ R α) :=
⟨λ x y, { to_fun := x + y,
    is_pwo_Union_support' := (x.is_pwo_Union_support.union y.is_pwo_Union_support).mono (begin
      rw ← set.Union_union_distrib,
      exact set.Union_subset_Union (λ a, support_add_subset)
    end),
    finite_co_support' := λ g, ((x.finite_co_support g).union (y.finite_co_support g)).subset begin
      intros a ha,
      change (x a).coeff g + (y a).coeff g ≠ 0 at ha,
      rw [set.mem_union, function.mem_support, function.mem_support],
      contrapose! ha,
      rw [ha.1, ha.2, add_zero]
    end }⟩

instance : has_zero (summable_family Γ R α) :=
⟨⟨0, by simp, by simp⟩⟩

instance : inhabited (summable_family Γ R α) := ⟨0⟩

@[simp]
lemma coe_add {s t : summable_family Γ R α} : ⇑(s + t) = s + t := rfl

lemma add_apply {s t : summable_family Γ R α} {a : α} : (s + t) a = s a + t a := rfl

@[simp]
lemma coe_zero : ((0 : summable_family Γ R α) : α → hahn_series Γ R) = 0 := rfl

lemma zero_apply {a : α} : (0 : summable_family Γ R α) a = 0 := rfl

instance : add_comm_monoid (summable_family Γ R α) :=
{ add := (+),
  zero := 0,
  zero_add := λ s, by { ext, apply zero_add },
  add_zero := λ s, by { ext, apply add_zero },
  add_comm := λ s t, by { ext, apply add_comm },
  add_assoc := λ r s t, by { ext, apply add_assoc } }

/-- The infinite sum of a `summable_family` of Hahn series. -/
def hsum (s : summable_family Γ R α) :
  hahn_series Γ R :=
{ coeff := λ g, ∑ᶠ i, (s i).coeff g,
  is_pwo_support' := s.is_pwo_Union_support.mono (λ g, begin
    contrapose,
    rw [set.mem_Union, not_exists, function.mem_support, not_not],
    simp_rw [mem_support, not_not],
    intro h,
    rw [finsum_congr h, finsum_zero],
  end) }

@[simp]
lemma hsum_coeff {s : summable_family Γ R α} {g : Γ} :
  s.hsum.coeff g = ∑ᶠ i, (s i).coeff g := rfl

lemma support_hsum_subset {s : summable_family Γ R α} :
  s.hsum.support ⊆ ⋃ (a : α), (s a).support :=
λ g hg, begin
  rw [mem_support, hsum_coeff, finsum_eq_sum _ (s.finite_co_support _)] at hg,
  obtain ⟨a, h1, h2⟩ := exists_ne_zero_of_sum_ne_zero hg,
  rw [set.mem_Union],
  exact ⟨a, h2⟩,
end

@[simp]
lemma hsum_add {s t : summable_family Γ R α} : (s + t).hsum = s.hsum + t.hsum :=
begin
  ext g,
  simp only [hsum_coeff, add_coeff, add_apply],
  exact finsum_add_distrib (s.finite_co_support _) (t.finite_co_support _)
end

end add_comm_monoid

section add_comm_group
variables [partial_order Γ] [add_comm_group R] {α : Type*} {s t : summable_family Γ R α} {a : α}

instance : add_comm_group (summable_family Γ R α) :=
{ neg := λ s, { to_fun := λ a, - s a,
    is_pwo_Union_support' := by { simp_rw [support_neg], exact s.is_pwo_Union_support' },
    finite_co_support' := λ g, by { simp only [neg_coeff', pi.neg_apply, ne.def, neg_eq_zero],
      exact s.finite_co_support g } },
  add_left_neg := λ a, by { ext, apply add_left_neg },
  .. summable_family.add_comm_monoid }

@[simp]
lemma coe_neg : ⇑(-s) = - s := rfl

lemma neg_apply : (-s) a = - (s a) := rfl

lemma coe_sub : ⇑(s - t) = s - t := rfl

lemma sub_apply : (s - t) a = s a - t a := rfl

end add_comm_group

section semiring

variables [ordered_cancel_add_comm_monoid Γ] [semiring R] {α : Type*}

instance : has_scalar (hahn_series Γ R) (summable_family Γ R α) :=
{ smul := λ x s, { to_fun := λ a, x * (s a),
    is_pwo_Union_support' := begin
      apply (x.is_pwo_support.add s.is_pwo_Union_support).mono,
      refine set.subset.trans (set.Union_subset_Union (λ a, support_mul_subset_add_support)) _,
      intro g,
      simp only [set.mem_Union, exists_imp_distrib],
      exact λ a ha, (set.add_subset_add (set.subset.refl _) (set.subset_Union _ a)) ha,
    end,
    finite_co_support' := λ g, begin
      refine ((add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g).finite_to_set.bUnion
        (λ ij hij, _)).subset (λ a ha, _),
      { exact λ ij hij, function.support (λ a, (s a).coeff ij.2) },
      { apply s.finite_co_support },
      { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support ha,
        simp only [exists_prop, set.mem_Union, mem_add_antidiagonal,
          mul_coeff, ne.def, mem_support, is_pwo_support, prod.exists],
        refine ⟨i, j, mem_coe.2 (mem_add_antidiagonal.2 ⟨rfl, hi, set.mem_Union.2 ⟨a, hj⟩⟩), hj⟩, }
    end } }

@[simp]
lemma smul_apply {x : hahn_series Γ R} {s : summable_family Γ R α} {a : α} :
  (x • s) a = x * (s a) := rfl

instance : module (hahn_series Γ R) (summable_family Γ R α) :=
{ smul := (•),
  smul_zero := λ x, ext (λ a, mul_zero _),
  zero_smul := λ x, ext (λ a, zero_mul _),
  one_smul := λ x, ext (λ a, one_mul _),
  add_smul := λ x y s, ext (λ a, add_mul _ _ _),
  smul_add := λ x s t, ext (λ a, mul_add _ _ _),
  mul_smul := λ x y s, ext (λ a, mul_assoc _ _ _) }

@[simp]
lemma hsum_smul {x : hahn_series Γ R} {s : summable_family Γ R α} :
  (x • s).hsum = x * s.hsum :=
begin
  ext g,
  simp only [mul_coeff, hsum_coeff, smul_apply],
  have h : ∀ i, (s i).support ⊆ ⋃ j, (s j).support := set.subset_Union _,
  refine (eq.trans (finsum_congr (λ a, _))
    (finsum_sum_comm (add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g)
    (λ i ij, x.coeff (prod.fst ij) * (s i).coeff ij.snd) _)).trans _,
  { refine sum_subset (add_antidiagonal_mono_right (set.subset_Union _ a)) _,
    rintro ⟨i, j⟩ hU ha,
    rw mem_add_antidiagonal at *,
    rw [not_not.1 (λ con, ha ⟨hU.1, hU.2.1, con⟩), mul_zero] },
  { rintro ⟨i, j⟩ hij,
    refine (s.finite_co_support j).subset _,
    simp_rw [function.support_subset_iff', function.mem_support, not_not],
    intros a ha,
    rw [ha, mul_zero] },
  { refine (sum_congr rfl _).trans (sum_subset (add_antidiagonal_mono_right _) _).symm,
    { rintro ⟨i, j⟩ hij,
      rw mul_finsum,
      apply s.finite_co_support, },
    { intros x hx,
      simp only [set.mem_Union, ne.def, mem_support],
      contrapose! hx,
      simp [hx] },
    { rintro ⟨i, j⟩ hU ha,
      rw mem_add_antidiagonal at *,
      rw [← hsum_coeff, not_not.1 (λ con, ha ⟨hU.1, hU.2.1, con⟩), mul_zero] } }
end

/-- The summation of a `summable_family` as a `linear_map`. -/
@[simps] def lsum : (summable_family Γ R α) →ₗ[hahn_series Γ R] (hahn_series Γ R) :=
⟨hsum, λ _ _, hsum_add, λ _ _, hsum_smul⟩

end semiring

section of_finsupp
variables [partial_order Γ] [add_comm_monoid R] {α : Type*}

/-- A family with only finitely many nonzero elements is summable. -/
def of_finsupp (f : α →₀ (hahn_series Γ R)) :
  summable_family Γ R α :=
{ to_fun := f,
  is_pwo_Union_support' := begin
      apply (f.support.is_pwo_sup (λ a, (f a).support) (λ a ha, (f a).is_pwo_support)).mono,
      intros g hg,
      obtain ⟨a, ha⟩ := set.mem_Union.1 hg,
      have haf : a ∈ f.support,
      { rw finsupp.mem_support_iff,
        contrapose! ha,
        rw [ha, support_zero],
        exact set.not_mem_empty _ },
      have h : (λ i, (f i).support) a ≤ _ := le_sup haf,
      exact h ha,
    end,
  finite_co_support' := λ g, begin
    refine f.support.finite_to_set.subset (λ a ha, _),
    simp only [coeff.add_monoid_hom_apply, mem_coe, finsupp.mem_support_iff,
    ne.def, function.mem_support],
    contrapose! ha,
    simp [ha]
  end }

@[simp]
lemma coe_of_finsupp {f : α →₀ (hahn_series Γ R)} : ⇑(summable_family.of_finsupp f) = f := rfl

@[simp]
lemma hsum_of_finsupp {f : α →₀ (hahn_series Γ R)} :
  (of_finsupp f).hsum = f.sum (λ a, id) :=
begin
  ext g,
  simp only [hsum_coeff, coe_of_finsupp, finsupp.sum, ne.def],
  simp_rw [← coeff.add_monoid_hom_apply, id.def],
  rw [add_monoid_hom.map_sum, finsum_eq_sum_of_support_subset],
  intros x h,
  simp only [coeff.add_monoid_hom_apply, mem_coe, finsupp.mem_support_iff, ne.def],
  contrapose! h,
  simp [h]
end

end of_finsupp

end summable_family

end hahn_series


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.defs
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Monoid.Lemmas
import Mathlib.Order.BoundedOrder

/-!
# Ordered monoids

This file provides the definitions of ordered monoids.

-/

open Function

universe u

variable {α : Type u} {β : Type _}

/-- An ordered commutative monoid is a commutative monoid
with a partial order such that `a ≤ b → c * a ≤ c * b` (multiplication is monotone)
-/
class OrderedCommMonoid (α : Type _) extends CommMonoid α, PartialOrder α where
  /-- Multiplication is monotone in an `OrderedCommMonoid`. -/
  protected mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b
#align ordered_comm_monoid OrderedCommMonoid

/-- An ordered (additive) commutative monoid is a commutative monoid
  with a partial order such that `a ≤ b → c + a ≤ c + b` (addition is monotone)
-/
class OrderedAddCommMonoid (α : Type _) extends AddCommMonoid α, PartialOrder α where
  /-- Addition is monotone in an `OrderedAddCommMonoid`. -/
  protected add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b
#align ordered_add_comm_monoid OrderedAddCommMonoid

attribute [to_additive] OrderedCommMonoid

section OrderedInstances

@[to_additive]
instance OrderedCommMonoid.to_covariantClass_left (M : Type _) [OrderedCommMonoid M] :
    CovariantClass M M (· * ·) (· ≤ ·) where
  elim := fun a _ _ bc ↦ OrderedCommMonoid.mul_le_mul_left _ _ bc a
#align ordered_comm_monoid.to_covariant_class_left OrderedCommMonoid.to_covariantClass_left
#align ordered_add_comm_monoid.to_covariant_class_left OrderedAddCommMonoid.to_covariantClass_left

/- This instance can be proven with `by apply_instance`.  However, `WithBot ℕ` does not
pick up a `CovariantClass M M (function.swap (*)) (≤)` instance without it (see PR mathlib#7940). -/
@[to_additive]
instance OrderedCommMonoid.to_covariantClass_right (M : Type _) [OrderedCommMonoid M] :
    CovariantClass M M (swap (· * ·)) (· ≤ ·) :=
  covariant_swap_mul_le_of_covariant_mul_le M
#align ordered_comm_monoid.to_covariant_class_right OrderedCommMonoid.to_covariantClass_right
#align ordered_add_comm_monoid.to_covariant_class_right OrderedAddCommMonoid.to_covariantClass_right

/- This is not an instance, to avoid creating a loop in the type-class system: in a
`LeftCancelSemigroup` with a `PartialOrder`, assuming `CovariantClass M M (*) (≤)` implies
`CovariantClass M M (*) (<)`, see `LeftCancelSemigroup.covariant_mul_lt_of_covariant_mul_le`. -/
@[to_additive]
theorem Mul.to_covariantClass_left (M : Type _) [Mul M] [PartialOrder M]
    [CovariantClass M M (· * ·) (· < ·)] :
    CovariantClass M M (· * ·) (· ≤ ·) :=
  ⟨covariant_le_of_covariant_lt _ _ _ CovariantClass.elim⟩
#align has_mul.to_covariant_class_left Mul.to_covariantClass_left
#align has_add.to_covariant_class_left Add.to_covariantClass_left

/- This is not an instance, to avoid creating a loop in the type-class system: in a
`RightCancelSemigroup` with a `PartialOrder`, assuming `CovariantClass M M (swap (*)) (<)`
implies `CovariantClass M M (swap (*)) (≤)`, see
`RightCancelSemigroup.covariant_swap_mul_lt_of_covariant_swap_mul_le`. -/
@[to_additive]
theorem Mul.to_covariantClass_right (M : Type _) [Mul M] [PartialOrder M]
    [CovariantClass M M (swap (· * ·)) (· < ·)] :
    CovariantClass M M (swap (· * ·)) (· ≤ ·) :=
  ⟨covariant_le_of_covariant_lt _ _ _ CovariantClass.elim⟩
#align has_mul.to_covariant_class_right Mul.to_covariantClass_right
#align has_add.to_covariant_class_right Add.to_covariantClass_right

end OrderedInstances

set_option linter.deprecated false in
@[deprecated] theorem bit0_pos [OrderedAddCommMonoid α] {a : α} (h : 0 < a) : 0 < bit0 a :=
  add_pos' h h
#align bit0_pos bit0_pos

/-- A linearly ordered additive commutative monoid. -/
class LinearOrderedAddCommMonoid (α : Type _) extends LinearOrder α, OrderedAddCommMonoid α
#align linear_ordered_add_comm_monoid LinearOrderedAddCommMonoid

/-- A linearly ordered commutative monoid. -/
@[to_additive]
class LinearOrderedCommMonoid (α : Type _) extends LinearOrder α, OrderedCommMonoid α
#align linear_ordered_comm_monoid LinearOrderedCommMonoid

attribute [to_additive existing] LinearOrderedCommMonoid.toOrderedCommMonoid

/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element.
  Instances should include number systems with an infinite element adjoined.` -/
class LinearOrderedAddCommMonoidWithTop (α : Type _) extends LinearOrderedAddCommMonoid α,
    Top α where
  /-- In a `LinearOrderedAddCommMonoidWithTop`, the `⊤` element is larger than any other element.-/
  protected le_top : ∀ x : α, x ≤ ⊤
  /-- In a `LinearOrderedAddCommMonoidWithTop`, the `⊤` element is invariant under addition. -/
  protected top_add' : ∀ x : α, ⊤ + x = ⊤
#align linear_ordered_add_comm_monoid_with_top LinearOrderedAddCommMonoidWithTop

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedAddCommMonoidWithTop.toOrderTop (α : Type u)
    [h : LinearOrderedAddCommMonoidWithTop α] : OrderTop α :=
  { h with }
#align linear_ordered_add_comm_monoid_with_top.to_order_top LinearOrderedAddCommMonoidWithTop.toOrderTop

section LinearOrderedAddCommMonoidWithTop

variable [LinearOrderedAddCommMonoidWithTop α] {a b : α}

@[simp]
theorem top_add (a : α) : ⊤ + a = ⊤ :=
  LinearOrderedAddCommMonoidWithTop.top_add' a
#align top_add top_add

@[simp]
theorem add_top (a : α) : a + ⊤ = ⊤ :=
  Trans.trans (add_comm _ _) (top_add _)
#align add_top add_top

end LinearOrderedAddCommMonoidWithTop


-- Suma_de_los_primeros_n_numeros_naturales.lean
-- Suma de los primeros n números naturales
-- José A. Alonso Jiménez
-- Sevilla, 18 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de los números naturales
--    0 + 1 + 2 + 3 + ··· + n
-- es n × (n + 1)/2
-- ---------------------------------------------------------------------

import data.nat.basic
import tactic
open nat

variable (n : ℕ)

set_option pp.structure_projections false

@[simp]
def suma : ℕ → ℕ
| 0     := 0
| (n+1) := suma n + (n+1)

-- 1ª demostración
example :
  2 * suma n = n * (n + 1) :=
begin
  induction n with n HI,
  { calc 2 * suma 0
         = 2 * 0       : congr_arg ((*) 2) suma.equations._eqn_1
     ... = 0           : mul_zero 2
     ... = 0 * (0 + 1) : zero_mul (0 + 1), },
  { calc 2 * suma (n + 1)
         = 2 * (suma n + (n + 1))    : congr_arg ((*) 2) (suma.equations._eqn_2 n)
     ... = 2 * suma n + 2 * (n + 1)  : mul_add 2 (suma n) (n + 1)
     ... = n * (n + 1) + 2 * (n + 1) : congr_arg2 (+) HI rfl
     ... = (n + 2) * (n + 1)         : (add_mul n 2 (n + 1)).symm
     ... = (n + 1) * (n + 2)         : mul_comm (n + 2) (n + 1) },
end

-- 2ª demostración
example :
  2 * suma n = n * (n + 1) :=
begin
  induction n with n HI,
  { calc 2 * suma 0
         = 2 * 0       : rfl
     ... = 0           : rfl
     ... = 0 * (0 + 1) : rfl, },
  { calc 2 * suma (n + 1)
         = 2 * (suma n + (n + 1))    : rfl
     ... = 2 * suma n + 2 * (n + 1)  : by ring
     ... = n * (n + 1) + 2 * (n + 1) : by simp [HI]
     ... = (n + 2) * (n + 1)         : by ring
     ... = (n + 1) * (n + 2)         : by ring, },
end

-- 3ª demostración
example :
  2 * suma n = n * (n + 1) :=
begin
  induction n with n HI,
  { simp, },
  { calc 2 * suma (n + 1)
         = 2 * (suma n + (n + 1))    : rfl
     ... = 2 * suma n + 2 * (n + 1)  : by ring
     ... = n * (n + 1) + 2 * (n + 1) : by simp [HI]
     ... = (n + 1) * (n + 2)         : by ring, },
end


/- LoVe Homework 10: Denotational Semantics -/

import .love10_denotational_semantics_demo

namespace LoVe

/- Denotational semantics are well suited to functional programming. In this
exercise, we will study some representations of functional programs in Lean and
their denotational semantics. -/

/- The `nondet` type represents functional programs that can perform
nondeterministic computations: A program can choose between many different
computation paths / return values. Returning no results at all is represented by
`fail`, and nondeterministic choice between two alternatives (identified by the
`bool` values `tt` and `ff`) is represented by `choice`. -/

inductive nondet (α : Type) : Type
| pure    : α → nondet
| fail {} : nondet
| choice  : (bool → nondet) → nondet

namespace nondet

/- Question 1: The `nondet` Monad -/

def bind {α β : Type} : nondet α → (α → nondet β) → nondet β
| (pure x)   f := f x
| fail       f := fail
| (choice k) f := choice (λb, bind (k b) f)

instance : has_pure nondet := { pure := @pure }
instance : has_bind nondet := { bind := @bind }

def starts_with : list ℕ → list ℕ → bool
| (x :: xs) []        := ff
| []        ys        := tt
| (x :: xs) (y :: ys) := (x = y) && starts_with xs ys

/- 1.2 (**optional**). Translate the `portmanteau` program from the `list` monad
to the `nondet` monad. -/

def nondet_portmanteau : list ℕ → list ℕ → nondet (list ℕ)
| []        ys := fail
| (x :: xs) ys :=
  choice (λb, if b then (if starts_with (x :: xs) ys then pure ys else fail)
    else nondet_portmanteau xs ys >>= λzs, pure (list.cons x zs))
    -- this line could also be `else (list.cons x <$> nondet_portmanteau xs ys)`

/- Question 2: Nondeterminism, Denotationally -/

def list_sem {α : Type} : nondet α → list α
| (pure x)   := [x]
| fail       := []
| (choice k) := list_sem (k ff) ++ list_sem (k tt)

/- Question 3 (**optional**). Nondeterminism, Operationally -/

/- We can define the following big-step operational semantics for `nondet`: -/

inductive big_step {α : Type} : nondet α → α → Prop
| pure {x : α} :
  big_step (pure x) x
| choice_l {k : bool → nondet α} {x : α} :
  big_step (k ff) x → big_step (choice k) x
| choice_r {k : bool → nondet α} {x : α} :
  big_step (k tt) x → big_step (choice k) x
-- there is no case for `fail`

notation mx `⟹` x := big_step mx x

/- 3.1 (**optional**). Prove the following lemma.

The lemma states that `choice` has the semantics of "angelic nondeterminism": If
there is a computational path that leads to some `x`, the `choice` operator will
produce this `x`. -/

lemma choice_existential {α : Type} (x : α) (k : bool → nondet α) :
  nondet.choice k ⟹ x ↔ ∃b, k b ⟹ x :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    { use ff,
      assumption },
    { use tt,
      assumption } },
  { intro h,
    cases h,
    cases h_w,
    { apply big_step.choice_l,
      assumption },
    { apply big_step.choice_r,
      assumption } }
end

/- 3.2 (**optional**). Prove the compatibility between denotational and
operational semantics. -/

theorem den_op_compat {α : Type} :
  ∀(x : α) (mx : nondet α), x ∈ list_sem mx ↔ mx ⟹ x
| x (pure x')  :=
  begin
    apply iff.intro,
    { intro h,
      cases h;
        cases h,
      exact big_step.pure },
    { intro h,
      cases h,
      apply iff.elim_right list.mem_singleton,
      refl }
  end
| x fail       :=
  begin
    apply iff.intro;
      intro h;
      cases h
  end
| x (choice k) :=
  begin
    apply iff.intro,
    { intro h,
      cases iff.elim_left list.mem_append h,
      { apply big_step.choice_l,
        apply iff.elim_left (den_op_compat x (k ff)),
        assumption },
      { apply big_step.choice_r,
        apply iff.elim_left (den_op_compat x (k tt)),
        assumption } },
    { intro h,
      cases h;
        apply iff.elim_right list.mem_append,
      { apply or.intro_left,
        apply iff.elim_right (den_op_compat x (k ff)),
        assumption },
      { apply or.intro_right,
        apply iff.elim_right (den_op_compat x (k tt)),
        assumption } }
  end

end nondet

end LoVe


theorem Ex015 (a b : Prop):(a → b) → a → a ∧ b :=
  assume H : (a → b),
  assume H1 : a,
  have A : b , from H H1,
  show a ∧ b, from and.intro H1 A