import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable (G : Type*) [graph G] :
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∈ G.E) ↔
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∉ G.E) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∈ G.E, from sorry,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∉ G.E, from sorry,
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V1 → (v1, v2) ∉ G.E, from sorry,
  have h4 : ∀ (v1 v2 : G), v1 ∈ V2 ∧ v2 ∈ V2 → (v1, v2) ∉ G.E, from sorry,
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∈ G.E, from sorry,
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h6 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∉ G.E, from sorry,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h7 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∈ G.E, from sorry,
  show (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∈ G.E) ↔
    (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1, v2) ∉ G.E), from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.lattice
import data.fintype.prod
import data.fintype.vector
import data.sym.sym2

/-!
# Symmetric powers of a finset

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

This file defines the symmetric powers of a finset as `finset (sym α n)` and `finset (sym2 α)`.

## Main declarations

* `finset.sym`: The symmetric power of a finset. `s.sym n` is all the multisets of cardinality `n`
  whose elements are in `s`.
* `finset.sym2`: The symmetric square of a finset. `s.sym2` is all the pairs whose elements are in
  `s`.

## TODO

`finset.sym` forms a Galois connection between `finset α` and `finset (sym α n)`. Similar for
`finset.sym2`.
-/

namespace finset
variables {α : Type*} [decidable_eq α] {s t : finset α} {a b : α}

lemma is_diag_mk_of_mem_diag {a : α × α} (h : a ∈ s.diag) : sym2.is_diag ⟦a⟧ :=
(sym2.is_diag_iff_proj_eq _).2 (mem_diag.1 h).2

lemma not_is_diag_mk_of_mem_off_diag {a : α × α} (h : a ∈ s.off_diag) : ¬ sym2.is_diag ⟦a⟧ :=
by { rw sym2.is_diag_iff_proj_eq, exact (mem_off_diag.1 h).2.2 }

section sym2
variables {m : sym2 α}

/-- Lifts a finset to `sym2 α`. `s.sym2` is the finset of all pairs with elements in `s`. -/
protected def sym2 (s : finset α) : finset (sym2 α) := (s ×ˢ s).image quotient.mk

@[simp] lemma mem_sym2_iff : m ∈ s.sym2 ↔ ∀ a ∈ m, a ∈ s :=
begin
  refine mem_image.trans
    ⟨_, λ h, ⟨m.out, mem_product.2 ⟨h _ m.out_fst_mem, h _ m.out_snd_mem⟩, m.out_eq⟩⟩,
  rintro ⟨⟨a, b⟩, h, rfl⟩,
  rw sym2.ball,
  rwa mem_product at h,
end

lemma mk_mem_sym2_iff : ⟦(a, b)⟧ ∈ s.sym2 ↔ a ∈ s ∧ b ∈ s := by rw [mem_sym2_iff, sym2.ball]

@[simp] lemma sym2_empty : (∅ : finset α).sym2 = ∅ := rfl

@[simp] lemma sym2_eq_empty : s.sym2 = ∅ ↔ s = ∅ :=
by rw [finset.sym2, image_eq_empty, product_eq_empty, or_self]

@[simp] lemma sym2_nonempty : s.sym2.nonempty ↔ s.nonempty :=
by rw [finset.sym2, nonempty.image_iff, nonempty_product, and_self]

alias sym2_nonempty ↔ _ nonempty.sym2

attribute [protected] nonempty.sym2

@[simp] lemma sym2_univ [fintype α] : (univ : finset α).sym2 = univ := rfl

@[simp] lemma sym2_singleton (a : α) : ({a} : finset α).sym2 = {sym2.diag a} :=
by rw [finset.sym2, singleton_product_singleton, image_singleton, sym2.diag]

@[simp] lemma diag_mem_sym2_iff : sym2.diag a ∈ s.sym2 ↔ a ∈ s := mk_mem_sym2_iff.trans $ and_self _

@[simp] lemma sym2_mono (h : s ⊆ t) : s.sym2 ⊆ t.sym2 :=
λ m he, mem_sym2_iff.2 $ λ a ha, h $ mem_sym2_iff.1 he _ ha

lemma image_diag_union_image_off_diag :
  s.diag.image quotient.mk ∪ s.off_diag.image quotient.mk = s.sym2 :=
by { rw [←image_union, diag_union_off_diag], refl }

end sym2

section sym
variables {n : ℕ} {m : sym α n}

/-- Lifts a finset to `sym α n`. `s.sym n` is the finset of all unordered tuples of cardinality `n`
with elements in `s`. -/
protected def sym (s : finset α) : Π n, finset (sym α n)
| 0       := {∅}
| (n + 1) := s.sup $ λ a, (sym n).image $ _root_.sym.cons a

@[simp] lemma sym_zero : s.sym 0 = {∅} := rfl
@[simp] lemma sym_succ : s.sym (n + 1) = s.sup (λ a, (s.sym n).image $ sym.cons a) := rfl

@[simp] lemma mem_sym_iff : m ∈ s.sym n ↔ ∀ a ∈ m, a ∈ s :=
begin
  induction n with n ih,
  { refine mem_singleton.trans ⟨_, λ _, sym.eq_nil_of_card_zero _⟩,
    rintro rfl,
    exact λ a ha, ha.elim },
  refine mem_sup.trans ⟨_, λ h, _⟩,
  { rintro ⟨a, ha, he⟩ b hb,
    rw mem_image at he,
    obtain ⟨m, he, rfl⟩ := he,
    rw sym.mem_cons at hb,
    obtain rfl | hb := hb,
    { exact ha },
    { exact ih.1 he _ hb } },
  { obtain ⟨a, m, rfl⟩ := m.exists_eq_cons_of_succ,
    exact ⟨a, h _ $ sym.mem_cons_self _ _,
      mem_image_of_mem _ $ ih.2 $ λ b hb, h _ $ sym.mem_cons_of_mem hb⟩ }
end

@[simp] lemma sym_empty (n : ℕ) : (∅ : finset α).sym (n + 1) = ∅ := rfl

lemma replicate_mem_sym (ha : a ∈ s) (n : ℕ) : sym.replicate n a ∈ s.sym n :=
mem_sym_iff.2 $ λ b hb, by rwa (sym.mem_replicate.1 hb).2

protected

@[simp] lemma sym_singleton (a : α) (n : ℕ) : ({a} : finset α).sym n = {sym.replicate n a} :=
eq_singleton_iff_unique_mem.2 ⟨replicate_mem_sym (mem_singleton.2 rfl) _,
  λ s hs, sym.eq_replicate_iff.2 $ λ b hb, eq_of_mem_singleton $ mem_sym_iff.1 hs _ hb⟩

lemma eq_empty_of_sym_eq_empty (h : s.sym n = ∅) : s = ∅ :=
begin
  rw ←not_nonempty_iff_eq_empty at ⊢ h,
  exact λ hs, h (hs.sym _),
end

@[simp] lemma sym_eq_empty : s.sym n = ∅ ↔ n ≠ 0 ∧ s = ∅ :=
begin
  cases n,
  { exact iff_of_false (singleton_ne_empty _) (λ h, (h.1 rfl).elim) },
  { refine ⟨λ h, ⟨n.succ_ne_zero, eq_empty_of_sym_eq_empty h⟩, _⟩,
    rintro ⟨_, rfl⟩,
    exact sym_empty _ }
end

@[simp] lemma sym_nonempty : (s.sym n).nonempty ↔ n = 0 ∨ s.nonempty :=
by simp_rw [nonempty_iff_ne_empty, ne.def, sym_eq_empty, not_and_distrib, not_ne_iff]

@[simp] lemma sym_univ [fintype α] (n : ℕ) : (univ : finset α).sym n = univ :=
eq_univ_iff_forall.2 $ λ s, mem_sym_iff.2 $ λ a _, mem_univ _

@[simp] lemma sym_mono (h : s ⊆ t) (n : ℕ): s.sym n ⊆ t.sym n :=
λ m hm, mem_sym_iff.2 $ λ a ha, h $ mem_sym_iff.1 hm _ ha

@[simp] lemma sym_inter (s t : finset α) (n : ℕ) : (s ∩ t).sym n = s.sym n ∩ t.sym n :=
by { ext m, simp only [mem_inter, mem_sym_iff, imp_and_distrib, forall_and_distrib] }

@[simp] lemma sym_union (s t : finset α) (n : ℕ) : s.sym n ∪ t.sym n ⊆ (s ∪ t).sym n :=
union_subset (sym_mono (subset_union_left s t) n) (sym_mono (subset_union_right s t) n)

lemma sym_fill_mem (a : α) {i : fin (n + 1)} {m : sym α (n - i)} (h : m ∈ s.sym (n - i)) :
  m.fill a i ∈ (insert a s).sym n :=
mem_sym_iff.2 $ λ b hb, mem_insert.2 $ (sym.mem_fill_iff.1 hb).imp and.right $ mem_sym_iff.1 h b

lemma sym_filter_ne_mem (a : α) (h : m ∈ s.sym n) :
  (m.filter_ne a).2 ∈ (s.erase a).sym (n - (m.filter_ne a).1) :=
mem_sym_iff.2 $ λ b H, mem_erase.2 $ (multiset.mem_filter.1 H).symm.imp ne.symm $ mem_sym_iff.1 h b

/-- If `a` does not belong to the finset `s`, then the `n`th symmetric power of `{a} ∪ s` is
  in 1-1 correspondence with the disjoint union of the `n - i`th symmetric powers of `s`,
  for `0 ≤ i ≤ n`. -/
@[simps] def sym_insert_equiv (h : a ∉ s) : (insert a s).sym n ≃ Σ i : fin (n + 1), s.sym (n - i) :=
{ to_fun := λ m, ⟨_, (m.1.filter_ne a).2, by convert sym_filter_ne_mem a m.2; rw erase_insert h⟩,
  inv_fun := λ m, ⟨m.2.1.fill a m.1, sym_fill_mem a m.2.2⟩,
  left_inv := λ m, subtype.ext $ m.1.fill_filter_ne a,
  right_inv := λ ⟨i, m, hm⟩, begin
    refine (_ : id.injective).sigma_map (λ i, _) _,
    { exact λ i, sym α (n - i) },
    swap, { exact λ _ _, id },
    swap, { exact subtype.coe_injective },
    refine eq.trans _ (sym.filter_ne_fill a _ _),
    exacts [rfl, h ∘ mem_sym_iff.1 hm a],
  end }

end sym
end finset


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
Ported by: Matej Penciak

! This file was ported from Lean 3 source module algebra.divisibility.basic
! 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.Hom.Group

/-!
# Divisibility

This file defines the basics of the divisibility relation in the context of `(Comm)` `Monoid`s.

## Main definitions

 * `semigroupDvd`

## Implementation notes

The divisibility relation is defined for all monoids, and as such, depends on the order of
  multiplication if the monoid is not commutative. There are two possible conventions for
  divisibility in the noncommutative context, and this relation follows the convention for ordinals,
  so `a | b` is defined as `∃ c, b = a * c`.

## Tags

divisibility, divides
-/

variable {α : Type _}

section Semigroup

variable [Semigroup α] {a b c : α}

/-- There are two possible conventions for divisibility, which coincide in a `CommMonoid`.
    This matches the convention for ordinals. -/
instance (priority := 100) semigroupDvd : Dvd α :=
  Dvd.mk fun a b => ∃ c, b = a * c
#align semigroup_has_dvd semigroupDvd

-- TODO: this used to not have `c` explicit, but that seems to be important
--       for use with tactics, similar to `Exists.intro`
theorem Dvd.intro (c : α) (h : a * c = b) : a ∣ b :=
  Exists.intro c h.symm
#align dvd.intro Dvd.intro

alias Dvd.intro ← dvd_of_mul_right_eq
#align dvd_of_mul_right_eq dvd_of_mul_right_eq

theorem exists_eq_mul_right_of_dvd (h : a ∣ b) : ∃ c, b = a * c :=
  h
#align exists_eq_mul_right_of_dvd exists_eq_mul_right_of_dvd

theorem Dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P :=
  Exists.elim H₁ H₂
#align dvd.elim Dvd.elim

attribute [local simp] mul_assoc mul_comm mul_left_comm

@[trans]
theorem dvd_trans : a ∣ b → b ∣ c → a ∣ c
  | ⟨d, h₁⟩, ⟨e, h₂⟩ => ⟨d * e, h₁ ▸ h₂.trans <| mul_assoc a d e⟩
#align dvd_trans dvd_trans

alias dvd_trans ← Dvd.dvd.trans

/-- Transitivity of `|` for use in `calc` blocks. -/
instance : IsTrans α Dvd.dvd :=
  ⟨fun _ _ _ => dvd_trans⟩

@[simp]
theorem dvd_mul_right (a b : α) : a ∣ a * b :=
  Dvd.intro b rfl
#align dvd_mul_right dvd_mul_right

theorem dvd_mul_of_dvd_left (h : a ∣ b) (c : α) : a ∣ b * c :=
  h.trans (dvd_mul_right b c)
#align dvd_mul_of_dvd_left dvd_mul_of_dvd_left

alias dvd_mul_of_dvd_left ← Dvd.dvd.mul_right

theorem dvd_of_mul_right_dvd (h : a * b ∣ c) : a ∣ c :=
  (dvd_mul_right a b).trans h
#align dvd_of_mul_right_dvd dvd_of_mul_right_dvd

section map_dvd

variable {M N : Type _} [Monoid M] [Monoid N]

theorem map_dvd {F : Type _} [MulHomClass F M N] (f : F) {a b} : a ∣ b → f a ∣ f b
  | ⟨c, h⟩ => ⟨f c, h.symm ▸ map_mul f a c⟩
#align map_dvd map_dvd

theorem MulHom.map_dvd (f : M →ₙ* N) {a b} : a ∣ b → f a ∣ f b :=
  _root_.map_dvd f
#align mul_hom.map_dvd MulHom.map_dvd

theorem MonoidHom.map_dvd (f : M →* N) {a b} : a ∣ b → f a ∣ f b :=
  _root_.map_dvd f
#align monoid_hom.map_dvd MonoidHom.map_dvd

end map_dvd

end Semigroup

section Monoid

variable [Monoid α]

@[refl, simp]
theorem dvd_refl (a : α) : a ∣ a :=
  Dvd.intro 1 (mul_one a)
#align dvd_refl dvd_refl

theorem dvd_rfl : ∀ {a : α}, a ∣ a := fun {a} => dvd_refl a
#align dvd_rfl dvd_rfl

instance : IsRefl α (· ∣ ·) :=
  ⟨dvd_refl⟩

theorem one_dvd (a : α) : 1 ∣ a :=
  Dvd.intro a (one_mul a)
#align one_dvd one_dvd

end Monoid

section CommSemigroup

variable [CommSemigroup α] {a b c : α}

theorem Dvd.intro_left (c : α) (h : c * a = b) : a ∣ b :=
  Dvd.intro _ (by rw [mul_comm] at h; apply h)
#align dvd.intro_left Dvd.intro_left

alias Dvd.intro_left ← dvd_of_mul_left_eq
#align dvd_of_mul_left_eq dvd_of_mul_left_eq

theorem exists_eq_mul_left_of_dvd (h : a ∣ b) : ∃ c, b = c * a :=
  Dvd.elim h fun c => fun H1 : b = a * c => Exists.intro c (Eq.trans H1 (mul_comm a c))
#align exists_eq_mul_left_of_dvd exists_eq_mul_left_of_dvd

theorem dvd_iff_exists_eq_mul_left : a ∣ b ↔ ∃ c, b = c * a :=
  ⟨exists_eq_mul_left_of_dvd, by
    rintro ⟨c, rfl⟩
    exact ⟨c, mul_comm _ _⟩⟩
#align dvd_iff_exists_eq_mul_left dvd_iff_exists_eq_mul_left

theorem Dvd.elim_left {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P :=
  Exists.elim (exists_eq_mul_left_of_dvd h₁) fun c => fun h₃ : b = c * a => h₂ c h₃
#align dvd.elim_left Dvd.elim_left

@[simp]
theorem dvd_mul_left (a b : α) : a ∣ b * a :=
  Dvd.intro b (mul_comm a b)
#align dvd_mul_left dvd_mul_left

theorem dvd_mul_of_dvd_right (h : a ∣ b) (c : α) : a ∣ c * b := by
  rw [mul_comm]; exact h.mul_right _
#align dvd_mul_of_dvd_right dvd_mul_of_dvd_right

alias dvd_mul_of_dvd_right ← Dvd.dvd.mul_left

attribute [local simp] mul_assoc mul_comm mul_left_comm

theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d
  | a, _, c, _, ⟨e, rfl⟩, ⟨f, rfl⟩ => ⟨e * f, by simp⟩
#align mul_dvd_mul mul_dvd_mul

theorem dvd_of_mul_left_dvd (h : a * b ∣ c) : b ∣ c :=
  Dvd.elim h fun d ceq => Dvd.intro (a * d) (by simp [ceq])
#align dvd_of_mul_left_dvd dvd_of_mul_left_dvd

end CommSemigroup

section CommMonoid

variable [CommMonoid α] {a b : α}

theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c :=
  mul_dvd_mul (dvd_refl a) h
#align mul_dvd_mul_left mul_dvd_mul_left

theorem mul_dvd_mul_right (h : a ∣ b) (c : α) : a * c ∣ b * c :=
  mul_dvd_mul h (dvd_refl c)
#align mul_dvd_mul_right mul_dvd_mul_right

theorem pow_dvd_pow_of_dvd {a b : α} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
  | 0 => by rw [pow_zero, pow_zero]
  | n + 1 => by
    rw [pow_succ, pow_succ]
    exact mul_dvd_mul h (pow_dvd_pow_of_dvd h n)
#align pow_dvd_pow_of_dvd pow_dvd_pow_of_dvd

end CommMonoid


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import tactic.linarith

/-!
# Bitwise operations on natural numbers

In the first half of this file, we provide theorems for reasoning about natural numbers from their
bitwise properties. In the second half of this file, we show properties of the bitwise operations
`lor`, `land` and `lxor`, which are defined in core.

## Main results
* `eq_of_test_bit_eq`: two natural numbers are equal if they have equal bits at every position.
* `exists_most_significant_bit`: if `n ≠ 0`, then there is some position `i` that contains the most
  significant `1`-bit of `n`.
* `lt_of_test_bit`: if `n` and `m` are numbers and `i` is a position such that the `i`-th bit of
  of `n` is zero, the `i`-th bit of `m` is one, and all more significant bits are equal, then
  `n < m`.

## Future work

There is another way to express bitwise properties of natural number: `digits 2`. The two ways
should be connected.

## Keywords

bitwise, and, or, xor
-/

namespace nat

@[simp] lemma bit_ff : bit ff = bit0 := rfl
@[simp] lemma bit_tt : bit tt = bit1 := rfl

@[simp] lemma bit_eq_zero {n : ℕ} {b : bool} : n.bit b = 0 ↔ n = 0 ∧ b = ff :=
by { cases b; norm_num [bit0_eq_zero, nat.bit1_ne_zero] }

lemma zero_of_test_bit_eq_ff {n : ℕ} (h : ∀ i, test_bit n i = ff) : n = 0 :=
begin
  induction n using nat.binary_rec with b n hn,
  { refl },
  { have : b = ff := by simpa using h 0,
    rw [this, bit_ff, bit0_val, hn (λ i, by rw [←h (i + 1), test_bit_succ]), mul_zero] }
end

@[simp] lemma zero_test_bit (i : ℕ) : test_bit 0 i = ff :=
by simp [test_bit]

/-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/
lemma eq_of_test_bit_eq {n m : ℕ} (h : ∀ i, test_bit n i = test_bit m i) : n = m :=
begin
  induction n using nat.binary_rec with b n hn generalizing m,
  { simp only [zero_test_bit] at h,
    exact (zero_of_test_bit_eq_ff (λ i, (h i).symm)).symm },
  induction m using nat.binary_rec with b' m hm,
  { simp only [zero_test_bit] at h,
    exact zero_of_test_bit_eq_ff h },
  suffices h' : n = m,
  { rw [h', show b = b', by simpa using h 0] },
  exact hn (λ i, by convert h (i + 1) using 1; rw test_bit_succ)
end

lemma exists_most_significant_bit {n : ℕ} (h : n ≠ 0) :
  ∃ i, test_bit n i = tt ∧ ∀ j, i < j → test_bit n j = ff :=
begin
  induction n using nat.binary_rec with b n hn,
  { exact false.elim (h rfl) },
  by_cases h' : n = 0,
  { subst h',
    rw (show b = tt, by { revert h, cases b; simp }),
    refine ⟨0, ⟨by rw [test_bit_zero], λ j hj, _⟩⟩,
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (ne_of_gt hj),
    rw [test_bit_succ, zero_test_bit] },
  { obtain ⟨k, ⟨hk, hk'⟩⟩ := hn h',
    refine ⟨k + 1, ⟨by rw [test_bit_succ, hk], λ j hj, _⟩⟩,
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (show j ≠ 0, by linarith),
    exact (test_bit_succ _ _ _).trans (hk' _ (lt_of_succ_lt_succ hj)) }
end

lemma lt_of_test_bit {n m : ℕ} (i : ℕ) (hn : test_bit n i = ff) (hm : test_bit m i = tt)
  (hnm : ∀ j, i < j → test_bit n j = test_bit m j) : n < m :=
begin
  induction n using nat.binary_rec with b n hn' generalizing i m,
  { contrapose! hm,
    rw le_zero_iff at hm,
    simp [hm] },
  induction m using nat.binary_rec with b' m hm' generalizing i,
  { exact false.elim (bool.ff_ne_tt ((zero_test_bit i).symm.trans hm)) },
  by_cases hi : i = 0,
  { subst hi,
    simp only [test_bit_zero] at hn hm,
    have : n = m,
    { exact eq_of_test_bit_eq (λ i, by convert hnm (i + 1) dec_trivial using 1; rw test_bit_succ) },
    rw [hn, hm, this, bit_ff, bit_tt, bit0_val, bit1_val],
    exact lt_add_one _ },
  { obtain ⟨i', rfl⟩ := exists_eq_succ_of_ne_zero hi,
    simp only [test_bit_succ] at hn hm,
    have := hn' _ hn hm (λ j hj, by convert hnm j.succ (succ_lt_succ hj) using 1; rw test_bit_succ),
    cases b; cases b';
    simp only [bit_ff, bit_tt, bit0_val n, bit1_val n, bit0_val m, bit1_val m];
    linarith }
end

@[simp]
lemma test_bit_two_pow_self (n : ℕ) : test_bit (2 ^ n) n = tt :=
by rw [test_bit, shiftr_eq_div_pow, nat.div_self (pow_pos zero_lt_two n), bodd_one]

lemma test_bit_two_pow_of_ne {n m : ℕ} (hm : n ≠ m) : test_bit (2 ^ n) m = ff :=
begin
  rw [test_bit, shiftr_eq_div_pow],
  cases hm.lt_or_lt with hm hm,
  { rw [nat.div_eq_zero, bodd_zero],
    exact nat.pow_lt_pow_of_lt_right one_lt_two hm },
  { rw [pow_div hm.le zero_lt_two, ←nat.sub_add_cancel (nat.sub_pos_of_lt hm), pow_succ],
    simp }
end

lemma test_bit_two_pow (n m : ℕ) : test_bit (2 ^ n) m = (n = m) :=
begin
  by_cases n = m,
  { cases h,
    simp },
  { rw test_bit_two_pow_of_ne h,
    simp [h] }
end

/-- If `f` is a commutative operation on bools such that `f ff ff = ff`, then `bitwise f` is also
    commutative. -/
lemma bitwise_comm {f : bool → bool → bool} (hf : ∀ b b', f b b' = f b' b)
  (hf' : f ff ff = ff) (n m : ℕ) : bitwise f n m = bitwise f m n :=
suffices bitwise f = function.swap (bitwise f), by conv_lhs { rw this },
calc bitwise f = bitwise (function.swap f) : congr_arg _ $ funext $ λ _, funext $ hf _
     ...       = function.swap (bitwise f) : bitwise_swap hf'

lemma lor_comm (n m : ℕ) : lor n m = lor m n := bitwise_comm bool.bor_comm rfl n m
lemma land_comm (n m : ℕ) : land n m = land m n := bitwise_comm bool.band_comm rfl n m
lemma lxor_comm (n m : ℕ) : lxor n m = lxor m n := bitwise_comm bool.bxor_comm rfl n m

@[simp] lemma zero_lxor (n : ℕ) : lxor 0 n = n := by simp [lxor]
@[simp] lemma lxor_zero (n : ℕ) : lxor n 0 = n := by simp [lxor]

@[simp] lemma zero_land (n : ℕ) : land 0 n = 0 := by simp [land]
@[simp] lemma land_zero (n : ℕ) : land n 0 = 0 := by simp [land]

@[simp] lemma zero_lor (n : ℕ) : lor 0 n = n := by simp [lor]
@[simp] lemma lor_zero (n : ℕ) : lor n 0 = n := by simp [lor]

/-- Proving associativity of bitwise operations in general essentially boils down to a huge case
    distinction, so it is shorter to use this tactic instead of proving it in the general case. -/
meta def bitwise_assoc_tac : tactic unit :=
`[induction n using nat.binary_rec with b n hn generalizing m k,
  { simp },
  induction m using nat.binary_rec with b' m hm,
  { simp },
  induction k using nat.binary_rec with b'' k hk;
  simp [hn]]

lemma lxor_assoc (n m k : ℕ) : lxor (lxor n m) k = lxor n (lxor m k) := by bitwise_assoc_tac
lemma land_assoc (n m k : ℕ) : land (land n m) k = land n (land m k) := by bitwise_assoc_tac
lemma lor_assoc (n m k : ℕ) : lor (lor n m) k = lor n (lor m k) := by bitwise_assoc_tac

@[simp] lemma lxor_self (n : ℕ) : lxor n n = 0 :=
zero_of_test_bit_eq_ff $ λ i, by simp

lemma lxor_right_inj {n m m' : ℕ} (h : lxor n m = lxor n m') : m = m' :=
calc m = lxor n (lxor n m') : by simp [←lxor_assoc, ←h]
   ... = m' : by simp [←lxor_assoc]

lemma lxor_left_inj {n n' m : ℕ} (h : lxor n m = lxor n' m) : n = n' :=
by { rw [lxor_comm n m, lxor_comm n' m] at h, exact lxor_right_inj h }

lemma lxor_eq_zero {n m : ℕ} : lxor n m = 0 ↔ n = m :=
⟨by { rw ←lxor_self m, exact lxor_left_inj  }, by { rintro rfl, exact lxor_self _ }⟩

lemma lxor_trichotomy {a b c : ℕ} (h : lxor a (lxor b c) ≠ 0) :
  lxor b c < a ∨ lxor a c < b ∨ lxor a b < c :=
begin
  set v := lxor a (lxor b c) with hv,

  -- The xor of any two of `a`, `b`, `c` is the xor of `v` and the third.
  have hab : lxor a b = lxor c v,
  { rw hv, conv_rhs { rw lxor_comm, simp [lxor_assoc] } },
  have hac : lxor a c = lxor b v,
  { rw hv,
    conv_rhs { congr, skip, rw lxor_comm },
    rw [←lxor_assoc, ←lxor_assoc, lxor_self, zero_lxor, lxor_comm] },
  have hbc : lxor b c = lxor a v,
  { simp [hv, ←lxor_assoc] },

  -- If `i` is the position of the most significant bit of `v`, then at least one of `a`, `b`, `c`
  -- has a one bit at position `i`.
  obtain ⟨i, ⟨hi, hi'⟩⟩ := exists_most_significant_bit h,
  have : test_bit a i = tt ∨ test_bit b i = tt ∨ test_bit c i = tt,
  { contrapose! hi,
    simp only [eq_ff_eq_not_eq_tt, ne, test_bit_lxor] at ⊢ hi,
    rw [hi.1, hi.2.1, hi.2.2, bxor_ff, bxor_ff] },

  -- If, say, `a` has a one bit at position `i`, then `a xor v` has a zero bit at position `i`, but
  -- the same bits as `a` in positions greater than `j`, so `a xor v < a`.
  rcases this with h|h|h;
  [{ left, rw hbc }, { right, left, rw hac }, { right, right, rw hab }];
  exact lt_of_test_bit i (by simp [h, hi]) h (λ j hj, by simp [hi' _ hj])
end

end nat


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens
-/
import algebra.order.field.basic
import algebra.order.ring.char_zero
import data.nat.cast.basic

/-!
# Cast of naturals into fields

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

This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field.

## Main results

 * `nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
 * `nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n`
-/

namespace nat

variables {α : Type*}

@[simp] theorem cast_div [division_semiring α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
  ((m / n : ℕ) : α) = m / n :=
begin
  rcases n_dvd with ⟨k, rfl⟩,
  have : n ≠ 0, {rintro rfl, simpa using n_nonzero},
  rw [nat.mul_div_cancel_left _ this.bot_lt, mul_comm n k, cast_mul, mul_div_cancel _ n_nonzero],
end

lemma cast_div_div_div_cancel_right [division_semiring α] [char_zero α] {m n d : ℕ}
  (hn : d ∣ n) (hm : d ∣ m) :
  (↑(m / d) : α) / (↑(n / d) : α) = (m : α) / n :=
begin
  rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp hm], },
  replace hd : (d : α) ≠ 0, { norm_cast, assumption, },
  simp [hd, hm, hn, div_div_div_cancel_right _ hd],
end

section linear_ordered_semifield
variables [linear_ordered_semifield α]

/-- Natural division is always less than division in the field. -/
lemma cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n :=
begin
  cases n,
  { rw [cast_zero, div_zero, nat.div_zero, cast_zero] },
  rwa [le_div_iff, ←nat.cast_mul],
  exact nat.cast_le.2 (nat.div_mul_le_self m n.succ),
  { exact nat.cast_pos.2 n.succ_pos }
end

lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) :=
by { rw one_div, exact inv_pos_of_nat }

lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) :=
by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa }

lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) :=
by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa }

end linear_ordered_semifield
end nat


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic

namespace fin
variables {l m n : ℕ}

@[reducible] definition cast : m ≤ n → fin m → fin n | h ⟨i,hi⟩ := ⟨i, lt_of_lt_of_le hi h⟩

@[simp] lemma cast_mk (h : m ≤ n) (i : ℕ) (hi : i < m) : cast h ⟨i,hi⟩ = ⟨i, lt_of_lt_of_le hi h⟩ := rfl

@[simp] lemma cast_val (h : m ≤ n) : ∀ i, (cast h i).val = i.val | ⟨_,_⟩ := rfl

@[simp] lemma cast_refl : ∀ i, cast (le_refl n) i = i | ⟨_,_⟩ := rfl

@[simp] lemma cast_trans {l m n : ℕ} {{hlm : l ≤ m}} {{hmn : m ≤ n}} :
∀ i, cast hmn (cast hlm i) = cast (le_trans hlm hmn) i | ⟨_,_⟩ := rfl

lemma cast_inj {i j : fin m} {h : m ≤ n} : cast h i = cast h j → i = j :=
begin
intro hc,
apply eq_of_veq,
rw [← cast_val h, ← cast_val h],
apply veq_of_eq hc,
end

@[simp] lemma cast_irrel (i : fin m) (h h' : m ≤ n) :
cast h i = cast h' i := by apply eq_of_veq; simp

@[simp] lemma cast_zero {m n : ℕ} {h : m + 1 ≤ n + 1} : cast h 0 = 0 := rfl

private lemma push_lem : m ≤ n → (∀ {i : ℕ}, i < m → n - m + i < n) :=
λ hmn i hi,
calc n - m + i < n - m + m : nat.add_lt_add_left hi (n - m)
         ... = n : nat.sub_add_cancel hmn

@[reducible] definition push : m ≤ n → fin m → fin n :=
λ h ⟨i,hi⟩, ⟨n - m + i, push_lem h hi⟩

@[simp] lemma push_mk (h : m ≤ n) (i : ℕ) (hi : i < m) : push h ⟨i,hi⟩ = ⟨n - m + i, push_lem h hi⟩ := rfl

@[simp] lemma push_val (h : m ≤ n) : ∀ i, (push h i).val = (n - m) + i.val | ⟨_,_⟩ := rfl

@[simp] lemma push_refl : ∀ i, push (nat.le_refl n) i = i :=
λ ⟨i,hi⟩, eq_of_veq $
calc (n - n) + i
    = 0 + i : by rw nat.sub_self
... = i : by rw nat.zero_add

@[simp] lemma push_trans {l m n : ℕ} {{hlm : l ≤ m}} {{hmn : m ≤ n}} :
∀ i, push hmn (push hlm i) = push (le_trans hlm hmn) i :=
λ ⟨i,hi⟩, eq_of_veq $
have (n - m) + (m - l) = n - l, from
calc (n - m) + (m - l)
    = (n + (m - l)) - m : by rw nat.sub_add_comm hmn
... = ((n + m) - l) - m : by rw nat.add_sub_assoc hlm
... = ((n + m) - (l + m)) : by rw nat.sub_sub
... = n - l : by rw nat.add_sub_add_right,
calc (n - m) + ((m - l) + i)
    = (n - m) + (m - l) + i : by rw add_assoc
... = (n - l) + i : by rw this

lemma push_inj {{h : m ≤ n}} : ∀ {i j : fin m}, push h i = push h j → i = j
| ⟨i,hi⟩ ⟨j,hj⟩ hp :=
  have (n - m) + i = (n - m) + j, from veq_of_eq hp,
  eq_of_veq $ nat.add_left_cancel this

@[simp] lemma push_irrel (i : fin m) (h h' : m ≤ n) :
push h i = push h' i := by apply eq_of_veq; simp

lemma push_zero (h : m+1 ≤ n+1) : push h 0 = ⟨n-m, lt_of_le_of_lt (nat.sub_le n m) (nat.lt_succ_self n)⟩ :=
eq_of_veq $
calc ((n+1) - (m+1)) + 0
    = (n - m) + 0 : by rw nat.succ_sub_succ
... = n - m : by rw nat.add_zero

@[simp] lemma eq_rec_eq_cast :
Π {m n : ℕ} (h : m = n) (i : fin m), @eq.rec _ _ _ i _ h = cast (le_of_eq h) i
| _ ._ rfl i := by simp

end fin


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.basic
/-!
# Basic Translation Lemmas Between Functions Defined for Continued Fractions

## Summary

Some simple translation lemmas between the different definitions of functions defined in
`algebra.continued_fractions.basic`.
-/

namespace generalized_continued_fraction
open stream.seq as seq

section general
/-!
### Translations Between General Access Functions

Here we give some basic translations that hold by definition between the various methods that allow
us to access the numerators and denominators of a continued fraction.
-/

variables {α : Type*} {g : generalized_continued_fraction α} {n : ℕ}

lemma terminated_at_iff_s_terminated_at : g.terminated_at n ↔ g.s.terminated_at n := by refl

lemma terminated_at_iff_s_none : g.terminated_at n ↔ g.s.nth n = none := by refl

lemma part_num_none_iff_s_none : g.partial_numerators.nth n = none ↔ g.s.nth n = none :=
by cases s_nth_eq : (g.s.nth n); simp [partial_numerators, s_nth_eq]

lemma terminated_at_iff_part_num_none : g.terminated_at n ↔ g.partial_numerators.nth n = none :=
by rw [terminated_at_iff_s_none, part_num_none_iff_s_none]

lemma part_denom_none_iff_s_none : g.partial_denominators.nth n = none ↔ g.s.nth n = none :=
by cases s_nth_eq : (g.s.nth n); simp [partial_denominators, s_nth_eq]

lemma terminated_at_iff_part_denom_none : g.terminated_at n ↔ g.partial_denominators.nth n = none :=
by rw [terminated_at_iff_s_none, part_denom_none_iff_s_none]

lemma part_num_eq_s_a {gp : pair α} (s_nth_eq : g.s.nth n = some gp) :
  g.partial_numerators.nth n = some gp.a :=
by simp [partial_numerators, s_nth_eq]

lemma part_denom_eq_s_b {gp : pair α} (s_nth_eq : g.s.nth n = some gp) :
  g.partial_denominators.nth n = some gp.b :=
by simp [partial_denominators, s_nth_eq]

lemma exists_s_a_of_part_num {a : α} (nth_part_num_eq : g.partial_numerators.nth n = some a) :
  ∃ gp, g.s.nth n = some gp ∧ gp.a = a :=
by simpa [partial_numerators, seq.map_nth] using nth_part_num_eq

lemma exists_s_b_of_part_denom {b : α} (nth_part_denom_eq : g.partial_denominators.nth n = some b) :
  ∃ gp, g.s.nth n = some gp ∧ gp.b = b :=
by simpa [partial_denominators, seq.map_nth] using nth_part_denom_eq

end general

section with_division_ring
/-!
### Translations Between Computational Functions

Here we  give some basic translations that hold by definition for the computational methods of a
continued fraction.
-/

variables {K : Type*} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K]

lemma nth_cont_eq_succ_nth_cont_aux : g.continuants n = g.continuants_aux (n + 1) := rfl
lemma num_eq_conts_a : g.numerators n = (g.continuants n).a := rfl
lemma denom_eq_conts_b : g.denominators n = (g.continuants n).b := rfl
lemma convergent_eq_num_div_denom : g.convergents n = g.numerators n / g.denominators n := rfl
lemma convergent_eq_conts_a_div_conts_b :
  g.convergents n = (g.continuants n).a / (g.continuants n).b := rfl

lemma exists_conts_a_of_num {A : K} (nth_num_eq : g.numerators n = A) :
  ∃ conts, g.continuants n = conts ∧ conts.a = A :=
by simpa

lemma exists_conts_b_of_denom {B : K} (nth_denom_eq : g.denominators n = B) :
  ∃ conts, g.continuants n = conts ∧ conts.b = B :=
by simpa

@[simp]
lemma zeroth_continuant_aux_eq_one_zero : g.continuants_aux 0 = ⟨1, 0⟩ := rfl
@[simp]
lemma first_continuant_aux_eq_h_one : g.continuants_aux 1 = ⟨g.h, 1⟩ := rfl
@[simp]
lemma zeroth_continuant_eq_h_one : g.continuants 0 = ⟨g.h, 1⟩ := rfl
@[simp]
lemma zeroth_numerator_eq_h : g.numerators 0 = g.h := rfl
@[simp]
lemma zeroth_denominator_eq_one : g.denominators 0 = 1 := rfl
@[simp]
lemma zeroth_convergent_eq_h : g.convergents 0 = g.h :=
by simp [convergent_eq_num_div_denom, num_eq_conts_a, denom_eq_conts_b, div_one]

lemma second_continuant_aux_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.continuants_aux 2 = ⟨gp.b * g.h + gp.a, gp.b⟩ :=
by simp [zeroth_s_eq, continuants_aux, next_continuants, next_denominator, next_numerator]

lemma first_continuant_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.continuants 1 = ⟨gp.b * g.h + gp.a, gp.b⟩ :=
by simp [nth_cont_eq_succ_nth_cont_aux, (second_continuant_aux_eq zeroth_s_eq)]

lemma first_numerator_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.numerators 1 = gp.b * g.h + gp.a :=
by simp[num_eq_conts_a, (first_continuant_eq zeroth_s_eq)]

lemma first_denominator_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.denominators 1 = gp.b :=
by simp[denom_eq_conts_b, (first_continuant_eq zeroth_s_eq)]

@[simp]
lemma zeroth_convergent'_aux_eq_zero {s : seq $ pair K} : convergents'_aux s 0 = 0 := rfl
@[simp]
lemma zeroth_convergent'_eq_h : g.convergents' 0 = g.h := by simp [convergents']

lemma convergents'_aux_succ_none {s : seq (pair K)} (h : s.head = none) (n : ℕ) :
  convergents'_aux s (n + 1) = 0 :=
by rw [convergents'_aux, h, convergents'_aux._match_1]

end with_division_ring
end generalized_continued_fraction


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Std.Data.Nat.Lemmas

import Algdata.Data.Nat.Rec

/-!
# Bit operations on Nat
-/

universe u v

namespace Nat

/-!
## Utility functions and lemmas
-/

/-- Bit-wise folding operation -/
def foldBitsL {α : Type u} (f : α → Bool → α) (init : α) (n : Nat) : α :=
  n.recBase2 (motive:=λ _ => α) init (f init true) (λ n a => f a (n % 2 == 1))

def countBits (n : Nat) : Nat := n.foldBitsL (λ n b => n + b.toUInt64.val.val) 0

def toDigitsBase2 (n : Nat) (pre : String := "0b"): String := n.foldBitsL (λ s b => s ++ if b then "1" else "0") pre

-- test
example : countBits 0b1001010111 = 6 := rfl
example : toDigitsBase2 0x55 "pre" = "pre1010101" := rfl

theorem or_zero (n : Nat) : n ||| 0 = n := by
  dsimp [HOr.hOr, OrOp.or, Nat.lor]; unfold Nat.bitwise
  rw [Bool.false_or, Bool.or_false, if_pos rfl, if_pos rfl, if_pos rfl]
  by_cases n = 0
  case pos h => cases h; rw [if_pos rfl]
  case neg h => rw [if_neg h]

theorem or_one_eq_add_one (n : Nat) : n % 2 = 0 → n ||| 1 = n + 1 := by
  intro hn
  have hn2_neq_1: n % 2 ≠ 1 := λ h => absurd (Eq.trans hn.symm h) Nat.zero_ne_one
  conv =>
    lhs;
    dsimp [HOr.hOr, OrOp.or, Nat.lor]; unfold bitwise
    rw [if_neg Nat.one_ne_zero, Bool.false_or, if_pos rfl]
    zeta
    rw [decide_eq_false hn2_neq_1, Bool.false_or, decide_eq_true, if_pos rfl]
    change if n = 0 then 1 else ((n/2) ||| 0) + ((n/2) ||| 0) + 1
    rw [or_zero, ←Nat.mul_two]
    rw [Nat.div_mul_cancel ((Nat.dvd_iff_mod_eq_zero 2 n).mpr hn)]
  by_cases n = 0
  case pos h => cases h; rw [if_pos rfl]
  case neg h => rw [if_neg h]

theorem shiftLeft_one (n : Nat) : n <<< 1 = 2*n := rfl

theorem shiftLeft_one_or_one (n : Nat) : (n <<< 1) ||| 1 = 2*n + 1 := by
  rw [shiftLeft_one]
  apply or_one_eq_add_one
  exact Nat.mul_mod_right 2 n

def recBits {motive : Nat → Prop} (zero : motive 0) (one : motive 1) (shift : ∀ (n : Nat), motive (n >>> 1) → motive n) (n : Nat) : motive n := by
  induction n using recBase2
  case zero => exact zero
  case one => exact one
  case div2 n h_ind =>
    apply shift (n+2)
    have : (n+2) >>> 1 = n/2 + 1 := calc
      (n+2) >>> 1 = (n+2)/2 := Nat.shiftRight_one _
      _           = (n/2) + 1 := Nat.add_div_right _ (Nat.zero_lt_succ 1)
    exact this ▸ h_ind

/-!
## `Classical`-free variant of `Nat.log2`
-/

/--
A `Classical`-free version of `Nat.log2.
It also avoids the use of well-founded recursion by using `Nat.recComplete`.
As a result, Lean can realize the second equality in contrast to the first:
```lean
example : log2 0b1000 = 3 := rfl    -- error
example : log2'' 0b1000 = 3 := rfl  -- ok
```
-/
@[implemented_by Nat.log2]
def log2' (n : @& Nat) : Nat :=
  n.recBase2 (motive:=λ _=>Nat) 0 0 $ λ _ x => x+1

example : log2' 0x100 = 8 := rfl
example : log2' 0x1FF = 8 := rfl
example : log2' 0x200 = 9 := rfl

theorem log2'_eq (n : Nat) : log2' n = Nat.log2 n := by
  unfold log2'
  induction n using recBase2
  case zero => rfl
  case one => rfl
  case div2 n h_ind =>
    rw [recBase2_div2, h_ind]
    conv =>
      rhs; unfold log2; rw [if_pos (Nat.le_add_left 2 n), Nat.add_div_right n (Nat.zero_lt_succ 1)]

theorem log2'_mul2 (n : Nat) : log2' (2*n.succ) = (log2' n.succ) + 1 := by
  conv =>
    lhs; rw [Nat.mul_succ 2 n]; unfold log2'; rw [recBase2_div2]
    change log2' (2*n/2 + 1) + 1
    rw [Nat.mul_div_right n (Nat.zero_lt_succ 1)]

#print axioms Nat.log2'_mul2

theorem zero_or_one_of_log2' : ∀ (n : Nat), n.log2' = 0 → n = 0 ∨ n = 1
| 0, _ => Or.inl rfl
| 1, _ => Or.inr rfl
| _+2, h => by
  conv at h => unfold log2'; rw [recBase2_div2]
  cases h

theorem ge_two_of_log2' : ∀ (n : Nat), n.log2' > 0 → n ≥ 2
| 0, h => by unfold log2' at h; rw [recBase2_zero] at h; cases h
| 1, h => by unfold log2' at h; rw [recBase2_one] at h; cases h
| _+2, _ => by rw [Nat.add_comm]; exact Nat.le.intro rfl

end Nat


/-
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
-/
import algebra.group.with_one
import algebra.group.prod
import algebra.hom.equiv
import algebra.order.monoid_lemmas
import order.min_max
import order.hom.basic

/-!
# Ordered monoids

This file develops the basics of ordered monoids.

## Implementation details

Unfortunately, the number of `'` appended to lemmas in this file
may differ between the multiplicative and the additive version of a lemma.
The reason is that we did not want to change existing names in the library.
-/

set_option old_structure_cmd true
open function

universe u
variables {α : 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)
-/
@[protect_proj, ancestor comm_monoid partial_order]
class ordered_comm_monoid (α : Type*) extends comm_monoid α, partial_order α :=
(mul_le_mul_left       : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b)

/-- An ordered (additive) commutative monoid is a commutative monoid
  with a partial order such that `a ≤ b → c + a ≤ c + b` (addition is monotone)
-/
@[protect_proj, ancestor add_comm_monoid partial_order]
class ordered_add_comm_monoid (α : Type*) extends add_comm_monoid α, partial_order α :=
(add_le_add_left       : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b)

attribute [to_additive] ordered_comm_monoid

section ordered_instances

@[to_additive]
instance ordered_comm_monoid.to_covariant_class_left (M : Type*) [ordered_comm_monoid M] :
  covariant_class M M (*) (≤) :=
{ elim := λ a b c bc, ordered_comm_monoid.mul_le_mul_left _ _ bc a }

/- This instance can be proven with `by apply_instance`.  However, `with_bot ℕ` does not
pick up a `covariant_class M M (function.swap (*)) (≤)` instance without it (see PR #7940). -/
@[to_additive]
instance ordered_comm_monoid.to_covariant_class_right (M : Type*) [ordered_comm_monoid M] :
  covariant_class M M (swap (*)) (≤) :=
covariant_swap_mul_le_of_covariant_mul_le M

/- This is not an instance, to avoid creating a loop in the type-class system: in a
`left_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (*) (≤)`
implies `covariant_class M M (*) (<)` . -/
@[to_additive] lemma has_mul.to_covariant_class_left
  (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (*) (<)] :
  covariant_class M M (*) (≤) :=
{ elim := λ a b c bc, by
  { rcases eq_or_lt_of_le bc with rfl | bc,
    { exact rfl.le },
    { exact (mul_lt_mul_left' bc a).le } } }

/- This is not an instance, to avoid creating a loop in the type-class system: in a
`right_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (swap (*)) (<)`
implies `covariant_class M M (swap (*)) (≤)` . -/
@[to_additive] lemma has_mul.to_covariant_class_right
  (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (swap (*)) (<)] :
  covariant_class M M (swap (*)) (≤) :=
{ elim := λ a b c bc, by
  { rcases eq_or_lt_of_le bc with rfl | bc,
    { exact rfl.le },
    { exact (mul_lt_mul_right' bc a).le } } }

end ordered_instances

/-- An `ordered_comm_monoid` with one-sided 'division' in the sense that
if `a ≤ b`, there is some `c` for which `a * c = b`. This is a weaker version
of the condition on canonical orderings defined by `canonically_ordered_monoid`. -/
class has_exists_mul_of_le (α : Type u) [has_mul α] [has_le α] : Prop :=
(exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a * c)

/-- An `ordered_add_comm_monoid` with one-sided 'subtraction' in the sense that
if `a ≤ b`, then there is some `c` for which `a + c = b`. This is a weaker version
of the condition on canonical orderings defined by `canonically_ordered_add_monoid`. -/
class has_exists_add_of_le (α : Type u) [has_add α] [has_le α] : Prop :=
(exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a + c)

attribute [to_additive] has_exists_mul_of_le

export has_exists_mul_of_le (exists_mul_of_le)

export has_exists_add_of_le (exists_add_of_le)

/-- A linearly ordered additive commutative monoid. -/
@[protect_proj, ancestor linear_order ordered_add_comm_monoid]
class linear_ordered_add_comm_monoid (α : Type*)
  extends linear_order α, ordered_add_comm_monoid α.

/-- A linearly ordered commutative monoid. -/
@[protect_proj, ancestor linear_order ordered_comm_monoid, to_additive]
class linear_ordered_comm_monoid (α : Type*)
  extends linear_order α, ordered_comm_monoid α.

/-- Typeclass for expressing that the `0` of a type is less or equal to its `1`. -/
class zero_le_one_class (α : Type*) [has_zero α] [has_one α] [has_le α] :=
(zero_le_one : (0 : α) ≤ 1)

@[simp] lemma zero_le_one [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
zero_le_one_class.zero_le_one

/- `zero_le_one` with an explicit type argument. -/
lemma zero_le_one' (α) [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
zero_le_one

lemma zero_le_two [preorder α] [has_one α] [add_zero_class α] [zero_le_one_class α]
  [covariant_class α α (+) (≤)] : (0 : α) ≤ 2 :=
add_nonneg zero_le_one zero_le_one

lemma one_le_two [has_le α] [has_one α] [add_zero_class α] [zero_le_one_class α]
  [covariant_class α α (+) (≤)] : (1 : α) ≤ 2 :=
calc 1 = 1 + 0 : (add_zero 1).symm
   ... ≤ 1 + 1 : add_le_add_left zero_le_one _

lemma one_le_two' [has_le α] [has_one α] [add_zero_class α] [zero_le_one_class α]
  [covariant_class α α (swap (+)) (≤)] : (1 : α) ≤ 2 :=
calc 1 = 0 + 1 : (zero_add 1).symm
   ... ≤ 1 + 1 : add_le_add_right zero_le_one _

/-- A linearly ordered commutative monoid with a zero element. -/
class linear_ordered_comm_monoid_with_zero (α : Type*)
  extends linear_ordered_comm_monoid α, comm_monoid_with_zero α :=
(zero_le_one : (0 : α) ≤ 1)

@[priority 100]
instance linear_ordered_comm_monoid_with_zero.zero_le_one_class
  [h : linear_ordered_comm_monoid_with_zero α] : zero_le_one_class α :=
{ ..h }

/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element.
  Instances should include number systems with an infinite element adjoined.` -/
@[protect_proj, ancestor linear_ordered_add_comm_monoid has_top]
class linear_ordered_add_comm_monoid_with_top (α : Type*)
  extends linear_ordered_add_comm_monoid α, has_top α :=
(le_top : ∀ x : α, x ≤ ⊤)
(top_add' : ∀ x : α, ⊤ + x = ⊤)

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_add_comm_monoid_with_top.to_order_top (α : Type u)
  [h : linear_ordered_add_comm_monoid_with_top α] : order_top α :=
{ ..h }

section linear_ordered_add_comm_monoid_with_top
variables [linear_ordered_add_comm_monoid_with_top α] {a b : α}

@[simp]
lemma top_add (a : α) : ⊤ + a = ⊤ := linear_ordered_add_comm_monoid_with_top.top_add' a

@[simp]
lemma add_top (a : α) : a + ⊤ = ⊤ :=
trans (add_comm _ _) (top_add _)

end linear_ordered_add_comm_monoid_with_top

/-- Pullback an `ordered_comm_monoid` under an injective map.
See note [reducible non-instances]. -/
@[reducible, to_additive function.injective.ordered_add_comm_monoid
"Pullback an `ordered_add_comm_monoid` under an injective map."]
def function.injective.ordered_comm_monoid [ordered_comm_monoid α] {β : Type*}
  [has_one β] [has_mul β] [has_pow β ℕ]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  ordered_comm_monoid β :=
{ mul_le_mul_left := λ a b ab c, show f (c * a) ≤ f (c * b), by
  { rw [mul, mul], apply mul_le_mul_left', exact ab },
  ..partial_order.lift f hf,
  ..hf.comm_monoid f one mul npow }

/-- Pullback a `linear_ordered_comm_monoid` under an injective map.
See note [reducible non-instances]. -/
@[reducible, to_additive function.injective.linear_ordered_add_comm_monoid
"Pullback an `ordered_add_comm_monoid` under an injective map."]
def function.injective.linear_ordered_comm_monoid [linear_ordered_comm_monoid α] {β : Type*}
  [has_one β] [has_mul β] [has_pow β ℕ]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  linear_ordered_comm_monoid β :=
{ .. hf.ordered_comm_monoid f one mul npow,
  .. linear_order.lift f hf }

lemma bit0_pos [ordered_add_comm_monoid α] {a : α} (h : 0 < a) : 0 < bit0 a :=
add_pos' h h

namespace units

@[to_additive]
instance [monoid α] [preorder α] : preorder αˣ :=
preorder.lift (coe : αˣ → α)

@[simp, norm_cast, to_additive]
theorem coe_le_coe [monoid α] [preorder α] {a b : αˣ} :
  (a : α) ≤ b ↔ a ≤ b := iff.rfl

@[simp, norm_cast, to_additive]
theorem coe_lt_coe [monoid α] [preorder α] {a b : αˣ} :
  (a : α) < b ↔ a < b := iff.rfl

@[to_additive]
instance [monoid α] [partial_order α] : partial_order αˣ :=
partial_order.lift coe units.ext

@[to_additive]
instance [monoid α] [linear_order α] : linear_order αˣ :=
linear_order.lift coe units.ext

@[simp, norm_cast, to_additive]
theorem max_coe [monoid α] [linear_order α] {a b : αˣ} :
  (↑(max a b) : α) = max a b :=
by by_cases b ≤ a; simp [max_def, h]

@[simp, norm_cast, to_additive]
theorem min_coe [monoid α] [linear_order α] {a b : αˣ} :
  (↑(min a b) : α) = min a b :=
by by_cases a ≤ b; simp [min_def, h]

end units

namespace with_zero

local attribute [semireducible] with_zero

instance [preorder α] : preorder (with_zero α) := with_bot.preorder

instance [partial_order α] : partial_order (with_zero α) := with_bot.partial_order

instance [preorder α] : order_bot (with_zero α) := with_bot.order_bot

lemma zero_le [preorder α] (a : with_zero α) : 0 ≤ a := bot_le

lemma zero_lt_coe [preorder α] (a : α) : (0 : with_zero α) < a := with_bot.bot_lt_coe a

lemma zero_eq_bot [preorder α] : (0 : with_zero α) = ⊥ := rfl

@[simp, norm_cast] lemma coe_lt_coe [preorder α] {a b : α} : (a : with_zero α) < b ↔ a < b :=
with_bot.coe_lt_coe

@[simp, norm_cast] lemma coe_le_coe [preorder α] {a b : α} : (a : with_zero α) ≤ b ↔ a ≤ b :=
with_bot.coe_le_coe

instance [lattice α] : lattice (with_zero α) := with_bot.lattice

instance [linear_order α] : linear_order (with_zero α) := with_bot.linear_order

instance covariant_class_mul_le {α : Type u} [has_mul α] [preorder α]
  [covariant_class α α (*) (≤)] :
  covariant_class (with_zero α) (with_zero α) (*) (≤) :=
begin
  refine ⟨λ a b c hbc, _⟩,
  induction a using with_zero.rec_zero_coe, { exact zero_le _ },
  induction b using with_zero.rec_zero_coe, { exact zero_le _ },
  rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩,
  rw [← coe_mul, ← coe_mul, coe_le_coe],
  exact mul_le_mul_left' hbc' a
end

instance contravariant_class_mul_lt {α : Type u} [has_mul α] [partial_order α]
  [contravariant_class α α (*) (<)] :
  contravariant_class (with_zero α) (with_zero α) (*) (<) :=
begin
  refine ⟨λ a b c h, _⟩,
  have := ((zero_le _).trans_lt h).ne',
  lift a to α using left_ne_zero_of_mul this,
  lift c to α using right_ne_zero_of_mul this,
  induction b using with_zero.rec_zero_coe,
  exacts [zero_lt_coe _, coe_lt_coe.mpr (lt_of_mul_lt_mul_left' $ coe_lt_coe.mp h)]
end

@[simp] lemma le_max_iff [linear_order α] {a b c : α} :
  (a : with_zero α) ≤ max b c ↔ a ≤ max b c :=
by simp only [with_zero.coe_le_coe, le_max_iff]

@[simp] lemma min_le_iff [linear_order α] {a b c : α} :
   min (a : with_zero α) b ≤ c ↔ min a b ≤ c :=
by simp only [with_zero.coe_le_coe, min_le_iff]

instance [ordered_comm_monoid α] : ordered_comm_monoid (with_zero α) :=
{ mul_le_mul_left := λ _ _, mul_le_mul_left',
  ..with_zero.comm_monoid_with_zero,
  ..with_zero.partial_order }

protected lemma covariant_class_add_le [add_zero_class α] [preorder α]
  [covariant_class α α (+) (≤)] (h : ∀ a : α, 0 ≤ a) :
  covariant_class (with_zero α) (with_zero α) (+) (≤) :=
begin
  refine ⟨λ a b c hbc, _⟩,
  induction a using with_zero.rec_zero_coe,
  { rwa [zero_add, zero_add] },
  induction b using with_zero.rec_zero_coe,
  { rw [add_zero],
    induction c using with_zero.rec_zero_coe,
    { rw [add_zero], exact le_rfl },
    { rw [← coe_add, coe_le_coe],
      exact le_add_of_nonneg_right (h _) } },
  { rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩,
    rw [← coe_add, ← coe_add, coe_le_coe],
    exact add_le_add_left hbc' a }
end

/-
Note 1 : the below is not an instance because it requires `zero_le`. It seems
like a rather pathological definition because α already has a zero.
Note 2 : there is no multiplicative analogue because it does not seem necessary.
Mathematicians might be more likely to use the order-dual version, where all
elements are ≤ 1 and then 1 is the top element.
-/

/--
If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`.
See note [reducible non-instances].
-/
@[reducible] protected def ordered_add_comm_monoid [ordered_add_comm_monoid α]
  (zero_le : ∀ a : α, 0 ≤ a) : ordered_add_comm_monoid (with_zero α) :=
{ add_le_add_left := @add_le_add_left _ _ _ (with_zero.covariant_class_add_le zero_le),
  ..with_zero.partial_order,
  ..with_zero.add_comm_monoid, .. }

end with_zero

/-- A canonically ordered additive monoid is an ordered commutative additive monoid
  in which the ordering coincides with the subtractibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a + c`.
  This is satisfied by the natural numbers, for example, but not
  the integers or other nontrivial `ordered_add_comm_group`s. -/
@[protect_proj, ancestor ordered_add_comm_monoid has_bot]
class canonically_ordered_add_monoid (α : Type*) extends ordered_add_comm_monoid α, has_bot α :=
(bot_le : ∀ x : α, ⊥ ≤ x)
(exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a + c)
(le_self_add : ∀ a b : α, a ≤ a + b)

@[priority 100]  -- see Note [lower instance priority]
instance canonically_ordered_add_monoid.to_order_bot (α : Type u)
  [h : canonically_ordered_add_monoid α] : order_bot α :=
{ ..h }

/-- A canonically ordered monoid is an ordered commutative monoid
  in which the ordering coincides with the divisibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a * c`.
  Examples seem rare; it seems more likely that the `order_dual`
  of a naturally-occurring lattice satisfies this than the lattice
  itself (for example, dual of the lattice of ideals of a PID or
  Dedekind domain satisfy this; collections of all things ≤ 1 seem to
  be more natural that collections of all things ≥ 1).
-/
@[protect_proj, ancestor ordered_comm_monoid has_bot, to_additive]
class canonically_ordered_monoid (α : Type*) extends ordered_comm_monoid α, has_bot α :=
(bot_le : ∀ x : α, ⊥ ≤ x)
(exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a * c)
(le_self_mul : ∀ a b : α, a ≤ a * b)

@[priority 100, to_additive]  -- see Note [lower instance priority]
instance canonically_ordered_monoid.to_order_bot (α : Type u)
  [h : canonically_ordered_monoid α] : order_bot α :=
{ ..h }

@[priority 100, to_additive]  -- see Note [lower instance priority]
instance canonically_ordered_monoid.has_exists_mul_of_le (α : Type u)
  [h : canonically_ordered_monoid α] : has_exists_mul_of_le α :=
{ ..h }

section canonically_ordered_monoid

variables [canonically_ordered_monoid α] {a b c d : α}

@[to_additive] lemma le_self_mul : a ≤ a * c := canonically_ordered_monoid.le_self_mul _ _
@[to_additive] lemma le_mul_self : a ≤ b * a := by { rw mul_comm, exact le_self_mul }

@[to_additive] lemma self_le_mul_right (a b : α) : a ≤ a * b := le_self_mul
@[to_additive] lemma self_le_mul_left (a b : α) : a ≤ b * a := le_mul_self

@[to_additive]
lemma le_iff_exists_mul : a ≤ b ↔ ∃ c, b = a * c :=
⟨exists_mul_of_le, by { rintro ⟨c, rfl⟩, exact le_self_mul }⟩

@[to_additive]
lemma le_iff_exists_mul' : a ≤ b ↔ ∃ c, b = c * a :=
by simpa only [mul_comm _ a] using le_iff_exists_mul

@[simp, to_additive zero_le] lemma one_le (a : α) : 1 ≤ a :=
le_iff_exists_mul.mpr ⟨a, (one_mul _).symm⟩

@[to_additive] lemma bot_eq_one : (⊥ : α) = 1 :=
le_antisymm bot_le (one_le ⊥)

@[simp, to_additive] lemma mul_eq_one_iff : a * b = 1 ↔ a = 1 ∧ b = 1 :=
mul_eq_one_iff' (one_le _) (one_le _)

@[simp, to_additive] lemma le_one_iff_eq_one : a ≤ 1 ↔ a = 1 :=
iff.intro
  (assume h, le_antisymm h (one_le a))
  (assume h, h ▸ le_refl a)

@[to_additive] lemma one_lt_iff_ne_one : 1 < a ↔ a ≠ 1 :=
iff.intro ne_of_gt $ assume hne, lt_of_le_of_ne (one_le _) hne.symm

@[to_additive] lemma eq_one_or_one_lt : a = 1 ∨ 1 < a :=
(one_le a).eq_or_lt.imp_left eq.symm

@[to_additive] lemma exists_one_lt_mul_of_lt (h : a < b) : ∃ c (hc : 1 < c), a * c = b :=
begin
  obtain ⟨c, hc⟩ := le_iff_exists_mul.1 h.le,
  refine ⟨c, one_lt_iff_ne_one.2 _, hc.symm⟩,
  rintro rfl,
  simpa [hc, lt_irrefl] using h
end

@[to_additive] lemma le_mul_left (h : a ≤ c) : a ≤ b * c :=
calc a = 1 * a : by simp
  ... ≤ b * c : mul_le_mul' (one_le _) h

@[to_additive] lemma le_mul_right (h : a ≤ b) : a ≤ b * c :=
calc a = a * 1 : by simp
  ... ≤ b * c : mul_le_mul' h (one_le _)

@[to_additive]
lemma lt_iff_exists_mul [covariant_class α α (*) (<)] : a < b ↔ ∃ c > 1, b = a * c :=
begin
  simp_rw [lt_iff_le_and_ne, and_comm, le_iff_exists_mul, ← exists_and_distrib_left, exists_prop],
  apply exists_congr, intro c,
  rw [and.congr_left_iff, gt_iff_lt], rintro rfl,
  split,
  { rw [one_lt_iff_ne_one], apply mt, rintro rfl, rw [mul_one] },
  { rw [← (self_le_mul_right a c).lt_iff_ne], apply lt_mul_of_one_lt_right' }
end

instance with_zero.has_exists_add_of_le {α} [has_add α] [preorder α] [has_exists_add_of_le α] :
  has_exists_add_of_le (with_zero α) :=
⟨λ a b, begin
  apply with_zero.cases_on a,
  { exact λ _, ⟨b, (zero_add b).symm⟩ },
  apply with_zero.cases_on b,
  { exact λ b' h, (with_bot.not_coe_le_bot _ h).elim },
  rintro a' b' h,
  obtain ⟨c, rfl⟩ := exists_add_of_le (with_zero.coe_le_coe.1 h),
  exact ⟨c, rfl⟩,
end⟩

-- This instance looks absurd: a monoid already has a zero
/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/
instance with_zero.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] :
  canonically_ordered_add_monoid (with_zero α) :=
{ le_self_add := λ a b, begin
    apply with_zero.cases_on a,
    { exact bot_le },
    apply with_zero.cases_on b,
    { exact λ b', le_rfl },
    { exact λ a' b', with_zero.coe_le_coe.2 le_self_add }
  end,
  .. with_zero.order_bot,
  .. with_zero.ordered_add_comm_monoid zero_le, ..with_zero.has_exists_add_of_le }

end canonically_ordered_monoid

lemma pos_of_gt {M : Type*} [canonically_ordered_add_monoid M] {n m : M} (h : n < m) : 0 < m :=
lt_of_le_of_lt (zero_le _) h

/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid
    whose ordering is a linear order. -/
@[protect_proj, ancestor canonically_ordered_add_monoid linear_order]
class canonically_linear_ordered_add_monoid (α : Type*)
      extends canonically_ordered_add_monoid α, linear_order α

/-- A canonically linear-ordered monoid is a canonically ordered monoid
    whose ordering is a linear order. -/
@[protect_proj, ancestor canonically_ordered_monoid linear_order, to_additive]
class canonically_linear_ordered_monoid (α : Type*)
      extends canonically_ordered_monoid α, linear_order α

section canonically_linear_ordered_monoid
variables [canonically_linear_ordered_monoid α]

@[priority 100, to_additive]  -- see Note [lower instance priority]
instance canonically_linear_ordered_monoid.semilattice_sup : semilattice_sup α :=
{ ..linear_order.to_lattice }

instance with_zero.canonically_linear_ordered_add_monoid
  (α : Type*) [canonically_linear_ordered_add_monoid α] :
    canonically_linear_ordered_add_monoid (with_zero α) :=
{ .. with_zero.canonically_ordered_add_monoid,
  .. with_zero.linear_order }

@[to_additive]
lemma min_mul_distrib (a b c : α) : min a (b * c) = min a (min a b * min a c) :=
begin
  cases le_total a b with hb hb,
  { simp [hb, le_mul_right] },
  { cases le_total a c with hc hc,
    { simp [hc, le_mul_left] },
    { simp [hb, hc] } }
end

@[to_additive]
lemma min_mul_distrib' (a b c : α) : min (a * b) c = min (min a c * min b c) c :=
by simpa [min_comm _ c] using min_mul_distrib c a b

@[simp, to_additive]
lemma one_min (a : α) : min 1 a = 1 :=
min_eq_left (one_le a)

@[simp, to_additive]
lemma min_one (a : α) : min a 1 = 1 :=
min_eq_right (one_le a)

/-- In a linearly ordered monoid, we are happy for `bot_eq_one` to be a `@[simp]` lemma. -/
@[simp, to_additive
  "In a linearly ordered monoid, we are happy for `bot_eq_zero` to be a `@[simp]` lemma"]
lemma bot_eq_one' : (⊥ : α) = 1 :=
bot_eq_one

end canonically_linear_ordered_monoid

/-- An ordered cancellative additive commutative monoid
is an additive commutative monoid with a partial order,
in which addition is cancellative and monotone. -/
@[protect_proj, ancestor add_cancel_comm_monoid partial_order]
class ordered_cancel_add_comm_monoid (α : Type u)
      extends add_cancel_comm_monoid α, partial_order α :=
(add_le_add_left       : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b)
(le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c)

/-- An ordered cancellative commutative monoid
is a commutative monoid with a partial order,
in which multiplication is cancellative and monotone. -/
@[protect_proj, ancestor cancel_comm_monoid partial_order, to_additive]
class ordered_cancel_comm_monoid (α : Type u)
      extends cancel_comm_monoid α, partial_order α :=
(mul_le_mul_left       : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b)
(le_of_mul_le_mul_left : ∀ a b c : α, a * b ≤ a * c → b ≤ c)

section ordered_cancel_comm_monoid
variables [ordered_cancel_comm_monoid α] {a b c d : α}

@[to_additive]
lemma ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c :=
λ a b c h, lt_of_le_not_le
  (ordered_cancel_comm_monoid.le_of_mul_le_mul_left a b c h.le) $
  mt (λ h, ordered_cancel_comm_monoid.mul_le_mul_left _ _ h _) (not_le_of_gt h)

@[to_additive]
instance ordered_cancel_comm_monoid.to_contravariant_class_left
  (M : Type*) [ordered_cancel_comm_monoid M] :
  contravariant_class M M (*) (<) :=
{ elim := λ a b c, ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left _ _ _ }

/- This instance can be proven with `by apply_instance`.  However, by analogy with the
instance `ordered_cancel_comm_monoid.to_covariant_class_right` above, I imagine that without
this instance, some Type would not have a `contravariant_class M M (function.swap (*)) (<)`
instance. -/
@[to_additive]
instance ordered_cancel_comm_monoid.to_contravariant_class_right
  (M : Type*) [ordered_cancel_comm_monoid M] :
  contravariant_class M M (swap (*)) (<) :=
contravariant_swap_mul_lt_of_contravariant_mul_lt M

@[priority 100, to_additive]    -- see Note [lower instance priority]
instance ordered_cancel_comm_monoid.to_ordered_comm_monoid : ordered_comm_monoid α :=
{ ..‹ordered_cancel_comm_monoid α› }

/-- Pullback an `ordered_cancel_comm_monoid` under an injective map.
See note [reducible non-instances]. -/
@[reducible, to_additive function.injective.ordered_cancel_add_comm_monoid
"Pullback an `ordered_cancel_add_comm_monoid` under an injective map."]
def function.injective.ordered_cancel_comm_monoid {β : Type*}
  [has_one β] [has_mul β] [has_pow β ℕ]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  ordered_cancel_comm_monoid β :=
{ le_of_mul_le_mul_left := λ a b c (bc : f (a * b) ≤ f (a * c)),
    (mul_le_mul_iff_left (f a)).mp (by rwa [← mul, ← mul]),
  ..hf.left_cancel_semigroup f mul,
  ..hf.ordered_comm_monoid f one mul npow }

end ordered_cancel_comm_monoid

/-! Some lemmas about types that have an ordering and a binary operation, with no
  rules relating them. -/
@[to_additive]
lemma fn_min_mul_fn_max {β} [linear_order α] [comm_semigroup β] (f : α → β) (n m : α) :
  f (min n m) * f (max n m) = f n * f m :=
by { cases le_total n m with h h; simp [h, mul_comm] }

@[to_additive]
lemma min_mul_max [linear_order α] [comm_semigroup α] (n m : α) :
  min n m * max n m = n * m :=
fn_min_mul_fn_max id n m

/-- A linearly ordered cancellative additive commutative monoid
is an additive commutative monoid with a decidable linear order
in which addition is cancellative and monotone. -/
@[protect_proj, ancestor ordered_cancel_add_comm_monoid linear_ordered_add_comm_monoid]
class linear_ordered_cancel_add_comm_monoid (α : Type u)
  extends ordered_cancel_add_comm_monoid α, linear_ordered_add_comm_monoid α

/-- A linearly ordered cancellative commutative monoid
is a commutative monoid with a linear order
in which multiplication is cancellative and monotone. -/
@[protect_proj, ancestor ordered_cancel_comm_monoid linear_ordered_comm_monoid, to_additive]
class linear_ordered_cancel_comm_monoid (α : Type u)
  extends ordered_cancel_comm_monoid α, linear_ordered_comm_monoid α

section covariant_class_mul_le
variables [linear_order α]

section has_mul
variable [has_mul α]

section left
variable [covariant_class α α (*) (≤)]

@[to_additive] lemma min_mul_mul_left (a b c : α) : min (a * b) (a * c) = a * min b c :=
(monotone_id.const_mul' a).map_min.symm

@[to_additive]
lemma max_mul_mul_left (a b c : α) : max (a * b) (a * c) = a * max b c :=
(monotone_id.const_mul' a).map_max.symm

@[to_additive]
lemma lt_or_lt_of_mul_lt_mul [covariant_class α α (function.swap (*)) (≤)]
  {a b m n : α} (h : m * n < a * b) :
  m < a ∨ n < b :=
by { contrapose! h, exact mul_le_mul' h.1 h.2 }

@[to_additive]
lemma mul_lt_mul_iff_of_le_of_le
  [covariant_class α α (function.swap (*)) (<)]
  [covariant_class α α (*) (<)]
  [covariant_class α α (function.swap (*)) (≤)]
  {a b c d : α} (ac : a ≤ c) (bd : b ≤ d) :
  a * b < c * d ↔ (a < c) ∨ (b < d) :=
begin
  refine ⟨lt_or_lt_of_mul_lt_mul, λ h, _⟩,
  cases h with ha hb,
  { exact mul_lt_mul_of_lt_of_le ha bd },
  { exact mul_lt_mul_of_le_of_lt ac hb }
end

end left

section right
variable [covariant_class α α (function.swap (*)) (≤)]

@[to_additive]
lemma min_mul_mul_right (a b c : α) : min (a * c) (b * c) = min a b * c :=
(monotone_id.mul_const' c).map_min.symm

@[to_additive]
lemma max_mul_mul_right (a b c : α) : max (a * c) (b * c) = max a b * c :=
(monotone_id.mul_const' c).map_max.symm

end right

end has_mul

variable [mul_one_class α]

@[to_additive]
lemma min_le_mul_of_one_le_right [covariant_class α α (*) (≤)] {a b : α} (hb : 1 ≤ b) :
  min a b ≤ a * b :=
min_le_iff.2 $ or.inl $ le_mul_of_one_le_right' hb

@[to_additive]
lemma min_le_mul_of_one_le_left [covariant_class α α (function.swap (*)) (≤)] {a b : α}
  (ha : 1 ≤ a) : min a b ≤ a * b :=
min_le_iff.2 $ or.inr $ le_mul_of_one_le_left' ha

@[to_additive]
lemma max_le_mul_of_one_le [covariant_class α α (*) (≤)]
  [covariant_class α α (function.swap (*)) (≤)] {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) :
  max a b ≤ a * b :=
max_le_iff.2 ⟨le_mul_of_one_le_right' hb, le_mul_of_one_le_left' ha⟩

end covariant_class_mul_le

section linear_ordered_cancel_comm_monoid
variables [linear_ordered_cancel_comm_monoid α]

/-- Pullback a `linear_ordered_cancel_comm_monoid` under an injective map.
See note [reducible non-instances]. -/
@[reducible, to_additive function.injective.linear_ordered_cancel_add_comm_monoid
"Pullback a `linear_ordered_cancel_add_comm_monoid` under an injective map."]
def function.injective.linear_ordered_cancel_comm_monoid {β : Type*}
  [has_one β] [has_mul β] [has_pow β ℕ]
  (f : β → α) (hf : function.injective f) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  linear_ordered_cancel_comm_monoid β :=
{ ..hf.linear_ordered_comm_monoid f one mul npow,
  ..hf.ordered_cancel_comm_monoid f one mul npow }

end linear_ordered_cancel_comm_monoid

/-! ### Order dual -/

namespace order_dual

@[to_additive] instance [h : has_mul α] : has_mul αᵒᵈ := h
@[to_additive] instance [h : has_one α] : has_one αᵒᵈ := h
@[to_additive] instance [h : semigroup α] : semigroup αᵒᵈ := h
@[to_additive] instance [h : comm_semigroup α] : comm_semigroup αᵒᵈ := h
@[to_additive] instance [h : mul_one_class α] : mul_one_class αᵒᵈ := h
@[to_additive] instance [h : monoid α] : monoid αᵒᵈ := h
@[to_additive] instance [h : comm_monoid α] : comm_monoid αᵒᵈ := h
@[to_additive] instance [h : left_cancel_monoid α] : left_cancel_monoid αᵒᵈ := h
@[to_additive] instance [h : right_cancel_monoid α] : right_cancel_monoid αᵒᵈ := h
@[to_additive] instance [h : cancel_monoid α] : cancel_monoid αᵒᵈ := h
@[to_additive] instance [h : cancel_comm_monoid α] : cancel_comm_monoid αᵒᵈ := h
instance [h : mul_zero_class α] : mul_zero_class αᵒᵈ := h
instance [h : mul_zero_one_class α] : mul_zero_one_class αᵒᵈ := h
instance [h : monoid_with_zero α] : monoid_with_zero αᵒᵈ := h
instance [h : comm_monoid_with_zero α] : comm_monoid_with_zero αᵒᵈ := h
instance [h : cancel_comm_monoid_with_zero α] : cancel_comm_monoid_with_zero αᵒᵈ := h

@[to_additive]
instance contravariant_class_mul_le [has_le α] [has_mul α] [c : contravariant_class α α (*) (≤)] :
  contravariant_class αᵒᵈ αᵒᵈ (*) (≤) :=
⟨c.1.flip⟩

@[to_additive]
instance covariant_class_mul_le [has_le α] [has_mul α] [c : covariant_class α α (*) (≤)] :
  covariant_class αᵒᵈ αᵒᵈ (*) (≤) :=
⟨c.1.flip⟩

@[to_additive] instance contravariant_class_swap_mul_le [has_le α] [has_mul α]
  [c : contravariant_class α α (swap (*)) (≤)] :
  contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) :=
⟨c.1.flip⟩

@[to_additive]
instance covariant_class_swap_mul_le [has_le α] [has_mul α]
  [c : covariant_class α α (swap (*)) (≤)] :
  covariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) :=
⟨c.1.flip⟩

@[to_additive]
instance contravariant_class_mul_lt [has_lt α] [has_mul α] [c : contravariant_class α α (*) (<)] :
  contravariant_class αᵒᵈ αᵒᵈ (*) (<) :=
⟨c.1.flip⟩

@[to_additive]
instance covariant_class_mul_lt [has_lt α] [has_mul α] [c : covariant_class α α (*) (<)] :
  covariant_class αᵒᵈ αᵒᵈ (*) (<) :=
⟨c.1.flip⟩

@[to_additive] instance contravariant_class_swap_mul_lt [has_lt α] [has_mul α]
  [c : contravariant_class α α (swap (*)) (<)] :
  contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) :=
⟨c.1.flip⟩

@[to_additive]
instance covariant_class_swap_mul_lt [has_lt α] [has_mul α]
  [c : covariant_class α α (swap (*)) (<)] :
  covariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) :=
⟨c.1.flip⟩

@[to_additive]
instance [ordered_comm_monoid α] : ordered_comm_monoid αᵒᵈ :=
{ mul_le_mul_left := λ a b h c, mul_le_mul_left' h c,
  .. order_dual.partial_order α,
  .. order_dual.comm_monoid }

@[to_additive ordered_cancel_add_comm_monoid.to_contravariant_class]
instance ordered_cancel_comm_monoid.to_contravariant_class [ordered_cancel_comm_monoid α] :
  contravariant_class αᵒᵈ αᵒᵈ has_mul.mul has_le.le :=
{ elim := λ a b c bc, (ordered_cancel_comm_monoid.le_of_mul_le_mul_left a c b (dual_le.mp bc)) }

@[to_additive]
instance [ordered_cancel_comm_monoid α] : ordered_cancel_comm_monoid αᵒᵈ :=
{ le_of_mul_le_mul_left := λ a b c : α, le_of_mul_le_mul_left',
  .. order_dual.ordered_comm_monoid, .. order_dual.cancel_comm_monoid }

@[to_additive]
instance [linear_ordered_cancel_comm_monoid α] :
  linear_ordered_cancel_comm_monoid αᵒᵈ :=
{ .. order_dual.linear_order α,
  .. order_dual.ordered_cancel_comm_monoid }

@[to_additive]
instance [linear_ordered_comm_monoid α] :
  linear_ordered_comm_monoid αᵒᵈ :=
{ .. order_dual.linear_order α,
  .. order_dual.ordered_comm_monoid }

end order_dual

namespace prod

variables {M N : Type*}

@[to_additive]
instance [ordered_comm_monoid α] [ordered_comm_monoid β] : ordered_comm_monoid (α × β) :=
{ mul_le_mul_left := λ a b h c, ⟨mul_le_mul_left' h.1 _, mul_le_mul_left' h.2 _⟩,
  .. prod.comm_monoid, .. prod.partial_order _ _ }

@[to_additive]
instance [ordered_cancel_comm_monoid M] [ordered_cancel_comm_monoid N] :
  ordered_cancel_comm_monoid (M × N) :=
{ le_of_mul_le_mul_left := λ a b c h, ⟨le_of_mul_le_mul_left' h.1, le_of_mul_le_mul_left' h.2⟩,
  .. prod.cancel_comm_monoid, .. prod.ordered_comm_monoid }

@[to_additive] instance [has_le α] [has_le β] [has_mul α] [has_mul β] [has_exists_mul_of_le α]
  [has_exists_mul_of_le β] : has_exists_mul_of_le (α × β) :=
⟨λ a b h, let ⟨c, hc⟩ := exists_mul_of_le h.1, ⟨d, hd⟩ := exists_mul_of_le h.2 in
  ⟨(c, d), ext hc hd⟩⟩

@[to_additive] instance [canonically_ordered_monoid α] [canonically_ordered_monoid β] :
  canonically_ordered_monoid (α × β) :=
{ le_self_mul := λ a b, ⟨le_self_mul, le_self_mul⟩,
  ..prod.ordered_comm_monoid, ..prod.order_bot _ _, ..prod.has_exists_mul_of_le }

end prod

/-! ### `with_bot`/`with_top`-/

namespace with_top

section has_one

variables [has_one α]

@[to_additive] instance : has_one (with_top α) := ⟨(1 : α)⟩

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : α) : with_top α) = 1 := rfl

@[simp, norm_cast, to_additive] lemma coe_eq_one {a : α} : (a : with_top α) = 1 ↔ a = 1 :=
coe_eq_coe

@[simp, to_additive] protected lemma map_one {β} (f : α → β) :
  (1 : with_top α).map f = (f 1 : with_top β) := rfl

@[simp, norm_cast, to_additive] theorem one_eq_coe {a : α} : 1 = (a : with_top α) ↔ a = 1 :=
trans eq_comm coe_eq_one

@[simp, to_additive] theorem top_ne_one : ⊤ ≠ (1 : with_top α) .
@[simp, to_additive] theorem one_ne_top : (1 : with_top α) ≠ ⊤ .

instance [has_zero α] [has_le α] [zero_le_one_class α] : zero_le_one_class (with_top α) :=
⟨some_le_some.2 zero_le_one⟩

end has_one

section has_add
variables [has_add α] {a b c d : with_top α} {x y : α}

instance : has_add (with_top α) := ⟨λ o₁ o₂, o₁.bind $ λ a, o₂.map $ (+) a⟩

@[norm_cast] lemma coe_add : ((x + y : α) : with_top α) = x + y := rfl
@[norm_cast] lemma coe_bit0 : ((bit0 x : α) : with_top α) = bit0 x := rfl
@[norm_cast] lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_top α) = bit1 a := rfl

@[simp] lemma top_add (a : with_top α) : ⊤ + a = ⊤ := rfl
@[simp] lemma add_top (a : with_top α) : a + ⊤ = ⊤ := by cases a; refl

@[simp] lemma add_eq_top : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
by cases a; cases b; simp [none_eq_top, some_eq_coe, ←with_top.coe_add, ←with_zero.coe_add]

lemma add_ne_top : a + b ≠ ⊤ ↔ a ≠ ⊤ ∧ b ≠ ⊤ := add_eq_top.not.trans not_or_distrib

lemma add_lt_top [partial_order α] {a b : with_top α} : a + b < ⊤ ↔ a < ⊤ ∧ b < ⊤ :=
by simp_rw [lt_top_iff_ne_top, add_ne_top]

lemma add_eq_coe : ∀ {a b : with_top α} {c : α},
  a + b = c ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = c
| none b c := by simp [none_eq_top]
| (some a) none c := by simp [none_eq_top]
| (some a) (some b) c :=
    by simp only [some_eq_coe, ← coe_add, coe_eq_coe, exists_and_distrib_left, exists_eq_left]

@[simp] lemma add_coe_eq_top_iff {x : with_top α} {y : α} : x + y = ⊤ ↔ x = ⊤ :=
by { induction x using with_top.rec_top_coe; simp [← coe_add, -with_zero.coe_add] }

@[simp] lemma coe_add_eq_top_iff {y : with_top α} : ↑x + y = ⊤ ↔ y = ⊤ :=
by { induction y using with_top.rec_top_coe; simp [← coe_add, -with_zero.coe_add] }

instance covariant_class_add_le [has_le α] [covariant_class α α (+) (≤)] :
  covariant_class (with_top α) (with_top α) (+) (≤) :=
⟨λ a b c h, begin
  cases a; cases c; try { exact le_top },
  rcases le_coe_iff.1 h with ⟨b, rfl, h'⟩,
  exact coe_le_coe.2 (add_le_add_left (coe_le_coe.1 h) _)
end⟩

instance covariant_class_swap_add_le [has_le α] [covariant_class α α (swap (+)) (≤)] :
  covariant_class (with_top α) (with_top α) (swap (+)) (≤) :=
⟨λ a b c h, begin
  cases a; cases c; try { exact le_top },
  rcases le_coe_iff.1 h with ⟨b, rfl, h'⟩,
  exact coe_le_coe.2 (add_le_add_right (coe_le_coe.1 h) _)
end⟩

instance contravariant_class_add_lt [has_lt α] [contravariant_class α α (+) (<)] :
  contravariant_class (with_top α) (with_top α) (+) (<) :=
⟨λ a b c h, begin
  induction a using with_top.rec_top_coe, { exact (not_none_lt _ h).elim },
  induction b using with_top.rec_top_coe, { exact (not_none_lt _ h).elim },
  induction c using with_top.rec_top_coe,
  { exact coe_lt_top _ },
  { exact coe_lt_coe.2 (lt_of_add_lt_add_left $ coe_lt_coe.1 h) }
end⟩

instance contravariant_class_swap_add_lt [has_lt α] [contravariant_class α α (swap (+)) (<)] :
  contravariant_class (with_top α) (with_top α) (swap (+)) (<) :=
⟨λ a b c h, begin
  cases a; cases b; try { exact (not_none_lt _ h).elim },
  cases c,
  { exact coe_lt_top _ },
  { exact coe_lt_coe.2 (lt_of_add_lt_add_right $ coe_lt_coe.1 h) }
end⟩

protected lemma le_of_add_le_add_left [has_le α] [contravariant_class α α (+) (≤)] (ha : a ≠ ⊤)
  (h : a + b ≤ a + c) : b ≤ c :=
begin
  lift a to α using ha,
  induction c using with_top.rec_top_coe, { exact le_top },
  induction b using with_top.rec_top_coe, { exact (not_top_le_coe _ h).elim },
  simp only [← coe_add, coe_le_coe] at h ⊢,
  exact le_of_add_le_add_left h
end

protected lemma le_of_add_le_add_right [has_le α] [contravariant_class α α (swap (+)) (≤)]
  (ha : a ≠ ⊤) (h : b + a ≤ c + a) : b ≤ c :=
begin
  lift a to α using ha,
  cases c,
  { exact le_top },
  cases b,
  { exact (not_top_le_coe _ h).elim },
  { exact coe_le_coe.2 (le_of_add_le_add_right $ coe_le_coe.1 h) }
end

protected lemma add_lt_add_left [has_lt α] [covariant_class α α (+) (<)] (ha : a ≠ ⊤) (h : b < c) :
  a + b < a + c :=
begin
  lift a to α using ha,
  rcases lt_iff_exists_coe.1 h with ⟨b, rfl, h'⟩,
  cases c,
  { exact coe_lt_top _ },
  { exact coe_lt_coe.2 (add_lt_add_left (coe_lt_coe.1 h) _) }
end

protected lemma add_lt_add_right [has_lt α] [covariant_class α α (swap (+)) (<)]
  (ha : a ≠ ⊤) (h : b < c) :
  b + a < c + a :=
begin
  lift a to α using ha,
  rcases lt_iff_exists_coe.1 h with ⟨b, rfl, h'⟩,
  cases c,
  { exact coe_lt_top _ },
  { exact coe_lt_coe.2 (add_lt_add_right (coe_lt_coe.1 h) _) }
end

protected lemma add_le_add_iff_left [has_le α] [covariant_class α α (+) (≤)]
  [contravariant_class α α (+) (≤)]
  (ha : a ≠ ⊤) : a + b ≤ a + c ↔ b ≤ c :=
⟨with_top.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩

protected lemma add_le_add_iff_right [has_le α] [covariant_class α α (swap (+)) (≤)]
  [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) : b + a ≤ c + a ↔ b ≤ c :=
⟨with_top.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩

protected lemma add_lt_add_iff_left [has_lt α] [covariant_class α α (+) (<)]
  [contravariant_class α α (+) (<)] (ha : a ≠ ⊤) : a + b < a + c ↔ b < c :=
⟨lt_of_add_lt_add_left, with_top.add_lt_add_left ha⟩

protected lemma add_lt_add_iff_right [has_lt α] [covariant_class α α (swap (+)) (<)]
  [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊤) : b + a < c + a ↔ b < c :=
⟨lt_of_add_lt_add_right, with_top.add_lt_add_right ha⟩

protected lemma add_lt_add_of_le_of_lt [preorder α] [covariant_class α α (+) (<)]
  [covariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
(with_top.add_lt_add_left ha hcd).trans_le $ add_le_add_right hab _

protected lemma add_lt_add_of_lt_of_le [preorder α] [covariant_class α α (+) (≤)]
  [covariant_class α α (swap (+)) (<)] (hc : c ≠ ⊤) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
(with_top.add_lt_add_right hc hab).trans_le $ add_le_add_left hcd _

end has_add

instance [add_semigroup α] : add_semigroup (with_top α) :=
{ add_assoc := begin
    repeat { refine with_top.rec_top_coe _ _; try { intro }};
    simp [←with_top.coe_add, add_assoc]
  end,
  ..with_top.has_add }

instance [add_comm_semigroup α] : add_comm_semigroup (with_top α) :=
{ add_comm :=
  begin
    repeat { refine with_top.rec_top_coe _ _; try { intro }};
    simp [←with_top.coe_add, add_comm]
  end,
  ..with_top.add_semigroup }

instance [add_zero_class α] : add_zero_class (with_top α) :=
{ zero_add :=
  begin
    refine with_top.rec_top_coe _ _,
    { simp },
    { intro,
      rw [←with_top.coe_zero, ←with_top.coe_add, zero_add] }
  end,
  add_zero :=
  begin
    refine with_top.rec_top_coe _ _,
    { simp },
    { intro,
      rw [←with_top.coe_zero, ←with_top.coe_add, add_zero] }
  end,
  ..with_top.has_zero,
  ..with_top.has_add }

instance [add_monoid α] : add_monoid (with_top α) :=
{ ..with_top.add_zero_class,
  ..with_top.has_zero,
  ..with_top.add_semigroup }

instance [add_comm_monoid α] : add_comm_monoid (with_top α) :=
{ ..with_top.add_monoid, ..with_top.add_comm_semigroup }

instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_top α) :=
{ add_le_add_left :=
    begin
      rintros a b h (_|c), { simp [none_eq_top] },
      rcases b with (_|b), { simp [none_eq_top] },
      rcases le_coe_iff.1 h with ⟨a, rfl, h⟩,
      simp only [some_eq_coe, ← coe_add, coe_le_coe] at h ⊢,
      exact add_le_add_left h c
    end,
  ..with_top.partial_order, ..with_top.add_comm_monoid }

instance [linear_ordered_add_comm_monoid α] :
  linear_ordered_add_comm_monoid_with_top (with_top α) :=
{ top_add' := with_top.top_add,
  ..with_top.order_top,
  ..with_top.linear_order,
  ..with_top.ordered_add_comm_monoid,
  ..option.nontrivial }

instance [has_le α] [has_add α] [has_exists_add_of_le α] : has_exists_add_of_le (with_top α) :=
⟨λ a b, match a, b with
  | ⊤, ⊤ := by simp
  | (a : α), ⊤ := λ _, ⟨⊤, rfl⟩
  | (a : α), (b : α) := λ h, begin
      obtain ⟨c, rfl⟩ := exists_add_of_le (with_top.coe_le_coe.1 h),
      exact ⟨c, rfl⟩
    end
  | ⊤, (b : α) := λ h, (not_top_le_coe _ h).elim
end⟩

instance [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_top α) :=
{ le_self_add := λ a b, match a, b with
  | ⊤, ⊤ := le_rfl
  | (a : α), ⊤ := le_top
  | (a : α), (b : α) := with_top.coe_le_coe.2 le_self_add
  | ⊤, (b : α) := le_rfl
  end,
  ..with_top.order_bot, ..with_top.ordered_add_comm_monoid, ..with_top.has_exists_add_of_le }

instance [canonically_linear_ordered_add_monoid α] :
  canonically_linear_ordered_add_monoid (with_top α) :=
{ ..with_top.canonically_ordered_add_monoid, ..with_top.linear_order }

/-- Coercion from `α` to `with_top α` as an `add_monoid_hom`. -/
def coe_add_hom [add_monoid α] : α →+ with_top α :=
⟨coe, rfl, λ _ _, rfl⟩

@[simp] lemma coe_coe_add_hom [add_monoid α] : ⇑(coe_add_hom : α →+ with_top α) = coe := rfl

@[simp] lemma zero_lt_top [ordered_add_comm_monoid α] : (0 : with_top α) < ⊤ :=
coe_lt_top 0

@[simp, norm_cast] lemma zero_lt_coe [ordered_add_comm_monoid α] (a : α) :
  (0 : with_top α) < a ↔ 0 < a :=
coe_lt_coe

/-- A version of `with_top.map` for `one_hom`s. -/
@[to_additive "A version of `with_top.map` for `zero_hom`s", simps { fully_applied := ff }]
protected def _root_.one_hom.with_top_map {M N : Type*} [has_one M] [has_one N] (f : one_hom M N) :
  one_hom (with_top M) (with_top N) :=
{ to_fun := with_top.map f,
  map_one' := by rw [with_top.map_one, map_one, coe_one] }

/-- A version of `with_top.map` for `add_hom`s. -/
@[simps { fully_applied := ff }] protected def _root_.add_hom.with_top_map
  {M N : Type*} [has_add M] [has_add N] (f : add_hom M N) :
  add_hom (with_top M) (with_top N) :=
{ to_fun := with_top.map f,
  map_add' := λ x y, match x, y with
    ⊤, y := by rw [top_add, map_top, top_add],
    x, ⊤ := by rw [add_top, map_top, add_top],
    (x : M), (y : M) := by simp only [← coe_add, map_coe, map_add]
  end }

/-- A version of `with_top.map` for `add_monoid_hom`s. -/
@[simps { fully_applied := ff }] protected def _root_.add_monoid_hom.with_top_map
  {M N : Type*} [add_zero_class M] [add_zero_class N] (f : M →+ N) :
  with_top M →+ with_top N :=
{ to_fun := with_top.map f,
  .. f.to_zero_hom.with_top_map, .. f.to_add_hom.with_top_map }

end with_top

namespace with_bot

@[to_additive] instance [has_one α] : has_one (with_bot α) := with_top.has_one
instance [has_add α] : has_add (with_bot α) := with_top.has_add
instance [add_semigroup α] : add_semigroup (with_bot α) := with_top.add_semigroup
instance [add_comm_semigroup α] : add_comm_semigroup (with_bot α) := with_top.add_comm_semigroup
instance [add_zero_class α] : add_zero_class (with_bot α) := with_top.add_zero_class
instance [add_monoid α] : add_monoid (with_bot α) := with_top.add_monoid
instance [add_comm_monoid α] : add_comm_monoid (with_bot α) := with_top.add_comm_monoid

instance [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] :
  zero_le_one_class (with_bot α) :=
⟨some_le_some.2 zero_le_one⟩

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`
@[to_additive]
lemma coe_one [has_one α] : ((1 : α) : with_bot α) = 1 := rfl

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`
@[to_additive]
lemma coe_eq_one [has_one α] {a : α} : (a : with_bot α) = 1 ↔ a = 1 :=
with_top.coe_eq_one

@[to_additive] protected lemma map_one {β} [has_one α] (f : α → β) :
  (1 : with_bot α).map f = (f 1 : with_bot β) := rfl

section has_add
variables [has_add α] {a b c d : with_bot α} {x y : α}

-- `norm_cast` proves those lemmas, because `with_top`/`with_bot` are reducible
lemma coe_add (a b : α) : ((a + b : α) : with_bot α) = a + b := rfl
lemma coe_bit0 : ((bit0 x : α) : with_bot α) = bit0 x := rfl
lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_bot α) = bit1 a := rfl

@[simp] lemma bot_add (a : with_bot α) : ⊥ + a = ⊥ := rfl
@[simp] lemma add_bot (a : with_bot α) : a + ⊥ = ⊥ := by cases a; refl

@[simp] lemma add_eq_bot : a + b = ⊥ ↔ a = ⊥ ∨ b = ⊥ := with_top.add_eq_top
lemma add_ne_bot : a + b ≠ ⊥ ↔ a ≠ ⊥ ∧ b ≠ ⊥ := with_top.add_ne_top

lemma bot_lt_add [partial_order α] {a b : with_bot α} : ⊥ < a + b ↔ ⊥ < a ∧ ⊥ < b :=
@with_top.add_lt_top αᵒᵈ _ _ _ _

lemma add_eq_coe : a + b = x ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = x := with_top.add_eq_coe

@[simp] lemma add_coe_eq_bot_iff : a + y = ⊥ ↔ a = ⊥ := with_top.add_coe_eq_top_iff
@[simp] lemma coe_add_eq_bot_iff : ↑x + b = ⊥ ↔ b = ⊥ := with_top.coe_add_eq_top_iff

variables [preorder α]

instance covariant_class_add_le [covariant_class α α (+) (≤)] :
  covariant_class (with_bot α) (with_bot α) (+) (≤) :=
@order_dual.covariant_class_add_le (with_top αᵒᵈ) _ _ _

instance covariant_class_swap_add_le [covariant_class α α (swap (+)) (≤)] :
  covariant_class (with_bot α) (with_bot α) (swap (+)) (≤) :=
@order_dual.covariant_class_swap_add_le (with_top αᵒᵈ) _ _ _

instance contravariant_class_add_lt [contravariant_class α α (+) (<)] :
  contravariant_class (with_bot α) (with_bot α) (+) (<) :=
@order_dual.contravariant_class_add_lt (with_top αᵒᵈ) _ _ _

instance contravariant_class_swap_add_lt [contravariant_class α α (swap (+)) (<)] :
  contravariant_class (with_bot α) (with_bot α) (swap (+)) (<) :=
@order_dual.contravariant_class_swap_add_lt (with_top αᵒᵈ) _ _ _

protected lemma le_of_add_le_add_left [contravariant_class α α (+) (≤)] (ha : a ≠ ⊥)
  (h : a + b ≤ a + c) : b ≤ c :=
@with_top.le_of_add_le_add_left αᵒᵈ _ _ _ _ _ _ ha h

protected lemma le_of_add_le_add_right [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥)
  (h : b + a ≤ c + a) : b ≤ c :=
@with_top.le_of_add_le_add_right αᵒᵈ _ _ _ _ _ _ ha h

protected lemma add_lt_add_left [covariant_class α α (+) (<)] (ha : a ≠ ⊥) (h : b < c) :
  a + b < a + c :=
@with_top.add_lt_add_left αᵒᵈ _ _ _ _ _ _ ha h

protected lemma add_lt_add_right [covariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) (h : b < c) :
  b + a < c + a :=
@with_top.add_lt_add_right αᵒᵈ _ _ _ _ _ _ ha h

protected lemma add_le_add_iff_left [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)]
  (ha : a ≠ ⊥) : a + b ≤ a + c ↔ b ≤ c :=
⟨with_bot.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩

protected lemma add_le_add_iff_right [covariant_class α α (swap (+)) (≤)]
  [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥) : b + a ≤ c + a ↔ b ≤ c :=
⟨with_bot.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩

protected lemma add_lt_add_iff_left [covariant_class α α (+) (<)] [contravariant_class α α (+) (<)]
  (ha : a ≠ ⊥) : a + b < a + c ↔ b < c :=
⟨lt_of_add_lt_add_left, with_bot.add_lt_add_left ha⟩

protected lemma add_lt_add_iff_right [covariant_class α α (swap (+)) (<)]
  [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) : b + a < c + a ↔ b < c :=
⟨lt_of_add_lt_add_right, with_bot.add_lt_add_right ha⟩

protected lemma add_lt_add_of_le_of_lt [covariant_class α α (+) (<)]
  [covariant_class α α (swap (+)) (≤)] (hb : b ≠ ⊥) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_le_of_lt αᵒᵈ _ _ _ _ _ _ _ _ hb hab hcd

protected lemma add_lt_add_of_lt_of_le [covariant_class α α (+) (≤)]
  [covariant_class α α (swap (+)) (<)] (hd : d ≠ ⊥) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_le αᵒᵈ _ _ _ _ _ _ _ _ hd hab hcd

end has_add

instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_bot α) :=
{ add_le_add_left := λ a b h c, add_le_add_left h c,
  ..with_bot.partial_order,
  ..with_bot.add_comm_monoid }

instance [linear_ordered_add_comm_monoid α] : linear_ordered_add_comm_monoid (with_bot α) :=
{ ..with_bot.linear_order, ..with_bot.ordered_add_comm_monoid }

end with_bot

/-! ### `additive`/`multiplicative` -/

section type_tags

instance : Π [has_le α], has_le (multiplicative α) := id
instance : Π [has_le α], has_le (additive α) := id
instance : Π [has_lt α], has_lt (multiplicative α) := id
instance : Π [has_lt α], has_lt (additive α) := id
instance : Π [preorder α], preorder (multiplicative α) := id
instance : Π [preorder α], preorder (additive α) := id
instance : Π [partial_order α], partial_order (multiplicative α) := id
instance : Π [partial_order α], partial_order (additive α) := id
instance : Π [linear_order α], linear_order (multiplicative α) := id
instance : Π [linear_order α], linear_order (additive α) := id
instance [has_le α] : Π [order_bot α], order_bot (multiplicative α) := id
instance [has_le α] : Π [order_bot α], order_bot (additive α) := id
instance [has_le α] : Π [order_top α], order_top (multiplicative α) := id
instance [has_le α] : Π [order_top α], order_top (additive α) := id
instance [has_le α] : Π [bounded_order α], bounded_order (multiplicative α) := id
instance [has_le α] : Π [bounded_order α], bounded_order (additive α) := id

instance [ordered_add_comm_monoid α] : ordered_comm_monoid (multiplicative α) :=
{ mul_le_mul_left := @ordered_add_comm_monoid.add_le_add_left α _,
  ..multiplicative.partial_order,
  ..multiplicative.comm_monoid }

instance [ordered_comm_monoid α] : ordered_add_comm_monoid (additive α) :=
{ add_le_add_left := @ordered_comm_monoid.mul_le_mul_left α _,
  ..additive.partial_order,
  ..additive.add_comm_monoid }

instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) :=
{ le_of_mul_le_mul_left := @ordered_cancel_add_comm_monoid.le_of_add_le_add_left α _,
  ..multiplicative.left_cancel_semigroup,
  ..multiplicative.ordered_comm_monoid }

instance [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) :=
{ le_of_add_le_add_left := @ordered_cancel_comm_monoid.le_of_mul_le_mul_left α _,
  ..additive.add_left_cancel_semigroup,
  ..additive.ordered_add_comm_monoid }

instance [linear_ordered_add_comm_monoid α] : linear_ordered_comm_monoid (multiplicative α) :=
{ ..multiplicative.linear_order,
  ..multiplicative.ordered_comm_monoid }

instance [linear_ordered_comm_monoid α] : linear_ordered_add_comm_monoid (additive α) :=
{ ..additive.linear_order,
  ..additive.ordered_add_comm_monoid }

instance [has_add α] [has_le α] [has_exists_add_of_le α] :
  has_exists_mul_of_le (multiplicative α) :=
⟨@exists_add_of_le α _ _ _⟩

instance [has_mul α] [has_le α] [has_exists_mul_of_le α] : has_exists_add_of_le (additive α) :=
⟨@exists_mul_of_le α _ _ _⟩

instance [canonically_ordered_add_monoid α] : canonically_ordered_monoid (multiplicative α) :=
{ le_self_mul := @le_self_add α _,
  ..multiplicative.ordered_comm_monoid, ..multiplicative.order_bot,
  ..multiplicative.has_exists_mul_of_le }

instance [canonically_ordered_monoid α] : canonically_ordered_add_monoid (additive α) :=
{ le_self_add := @le_self_mul α _,
  ..additive.ordered_add_comm_monoid, ..additive.order_bot, ..additive.has_exists_add_of_le }

instance [canonically_linear_ordered_add_monoid α] :
  canonically_linear_ordered_monoid (multiplicative α) :=
{ ..multiplicative.canonically_ordered_monoid, ..multiplicative.linear_order }

instance [canonically_linear_ordered_monoid α] :
  canonically_linear_ordered_add_monoid (additive α) :=
{ ..additive.canonically_ordered_add_monoid, ..additive.linear_order }

namespace additive

variables [preorder α]

@[simp] lemma of_mul_le {a b : α} : of_mul a ≤ of_mul b ↔ a ≤ b := iff.rfl

@[simp] lemma of_mul_lt {a b : α} : of_mul a < of_mul b ↔ a < b := iff.rfl

@[simp] lemma to_mul_le {a b : additive α} : to_mul a ≤ to_mul b ↔ a ≤ b := iff.rfl

@[simp] lemma to_mul_lt {a b : additive α} : to_mul a < to_mul b ↔ a < b := iff.rfl

end additive

namespace multiplicative

variables [preorder α]

@[simp] lemma of_add_le {a b : α} : of_add a ≤ of_add b ↔ a ≤ b := iff.rfl

@[simp] lemma of_add_lt {a b : α} : of_add a < of_add b ↔ a < b := iff.rfl

@[simp] lemma to_add_le {a b : multiplicative α} : to_add a ≤ to_add b ↔ a ≤ b := iff.rfl

@[simp] lemma to_add_lt {a b : multiplicative α} : to_add a < to_add b ↔ a < b := iff.rfl

end multiplicative

end type_tags

namespace with_zero

local attribute [semireducible] with_zero
variables [has_add α]

/-- Making an additive monoid multiplicative then adding a zero is the same as adding a bottom
element then making it multiplicative. -/
def to_mul_bot : with_zero (multiplicative α) ≃* multiplicative (with_bot α) :=
by exact mul_equiv.refl _

@[simp] lemma to_mul_bot_zero :
  to_mul_bot (0 : with_zero (multiplicative α)) = multiplicative.of_add ⊥ := rfl
@[simp] lemma to_mul_bot_coe (x : multiplicative α) :
  to_mul_bot ↑x = multiplicative.of_add (x.to_add : with_bot α) := rfl
@[simp] lemma to_mul_bot_symm_bot :
  to_mul_bot.symm (multiplicative.of_add (⊥ : with_bot α)) = 0 := rfl
@[simp] lemma to_mul_bot_coe_of_add (x : α) :
  to_mul_bot.symm (multiplicative.of_add (x : with_bot α)) = multiplicative.of_add x := rfl

variables [preorder α] (a b : with_zero (multiplicative α))

lemma to_mul_bot_strict_mono : strict_mono (@to_mul_bot α _) := λ x y, id
@[simp] lemma to_mul_bot_le : to_mul_bot a ≤ to_mul_bot b ↔ a ≤ b := iff.rfl
@[simp] lemma to_mul_bot_lt : to_mul_bot a < to_mul_bot b ↔ a < b := iff.rfl

end with_zero

/-- The order embedding sending `b` to `a * b`, for some fixed `a`.
See also `order_iso.mul_left` when working in an ordered group. -/
@[to_additive "The order embedding sending `b` to `a + b`, for some fixed `a`.
  See also `order_iso.add_left` when working in an additive ordered group.", simps]
def order_embedding.mul_left
  {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (*) (<)] (m : α) : α ↪o α :=
order_embedding.of_strict_mono (λ n, m * n) (λ a b w, mul_lt_mul_left' w m)

/-- The order embedding sending `b` to `b * a`, for some fixed `a`.
See also `order_iso.mul_right` when working in an ordered group. -/
@[to_additive "The order embedding sending `b` to `b + a`, for some fixed `a`.
  See also `order_iso.add_right` when working in an additive ordered group.", simps]
def order_embedding.mul_right
  {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (swap (*)) (<)] (m : α) :
  α ↪o α :=
order_embedding.of_strict_mono (λ n, n * m) (λ a b w, mul_lt_mul_right' w m)