--
namespace hidden

/-
In this lecture we solve the problem of ensuring that
argument values to foldr are properly coordinated. In the
process we introduce *ad hoc* polymorphism (also called
"operator overloading") as distinct from the *parametric*
polymorphism (also called generics in Java and template
classes in C++) that we've been using all semester long.

- We introduce a new mechanism, typeclasses, which support
ad hoc polymorphism
- We see how instances of a given typeclass provide the
information needed to implement an overloaded operator for
a specified type of element
- We see how Lean's support for typeclasss enables lookup
and passing of typec lass *instances* as implicit arguments
- We then see how these ideas support the representation
of abstract algebraic structures.
- As an example, we formalize the abstract algebraic
structure known as a "monoid," as a typeclass, and we
define a typeclasses instance to establish the monoid
comprising the natural numbers under addition with 0
as a proven identity element.
-/

/-
As a first motivating example, suppose that we want
to abstract the concept of being an inhabited type.
A type is inhabited if it has at least one value, so
one way to show that a type is inhabited it to give
a particular value of that type.

For example, we could show that the bool, nat, and
string types are inhabited by creating instances of
the following polymorphic type, with bool, nat, and
string as values of α.

What this type says is that you can have an instance
of this type by applying the mk constructor to some
specific value of the α type.
-/
inductive inhabited''' (α : Type)
| mk (a : α) : inhabited'''

/-
We can thus "show" that bool, nat, and string are
all inhabited types by creating one instance of this
polymorphic type for each of the type values, bool,
nat, and string.
-/
example : inhabited''' bool := inhabited'''.mk tt
example : inhabited''' nat := inhabited'''.mk 0
example : inhabited''' string := inhabited'''.mk ""

/-
The next concept in line is new syntax for defining
a new type in the special case where the type has
just one constructor. In this case, we can use the
"structure" keyword instead of inductive. Then any
type arguments followed (in this example) by a :=
and then the definition of the *one* constructor
that is allowed when using "structure." First the
name is given, then :: then the *named fields* of
the type are listed. The essential benefit of using
"structure" is that Lean converts the field names
into "accessor" functions to retrieve the field
values from an instance of such a structure (a.k.a.,
"struct" in C and C++ or "record" in a relational
database). Here then is an example equivalent to
the preceding example except that "a" can now be
used as the name of a function that takes an
instance and returns the value of its "a" field.
-/
structure inhabited'' (α : Type)  :=
mk  :: (a : α)

def bool_inhab'' : inhabited'' bool := inhabited''.mk tt
def nat_inhab'' : inhabited'' nat := inhabited''.mk 0
def string_inhab'' : inhabited'' string := inhabited''.mk ""

open inhabited''

#eval a string_inhab''

/-
Lean also provides a nice "dot" notation for applying a
function to an object, so we can also write the following
equivalent expression
-/

#eval bool_inhab''.a    -- expect tt
#eval nat_inhab''.a     -- expect 0
#eval string_inhab''.a  -- expect ""

/-
Our next step is easy: When defining a structure type, you
can leave out the constructor name and :: and Lean will use
"mk" as a default constructor name
-/
example : inhabited'' bool := inhabited''.mk tt
structure inhabited' (α : Type) := (a : α)
example : inhabited' bool := inhabited'.mk tt

/-
With what we've done already, we can now write a
(parametrically) polymorphic function, "default,""
that returns a defaul value for any *type*. A type
is the argument to "default" and its return value
is a *value* of that type.

Of course not every type is inhabited, so not every
type can have a default value. We need a way to limit
the application of the default function to types for
which some value shows that the type is inhabited.

One way to impose this constraint on the type that
can be passed to the "default" function is to have
it take, as a second argument, an instance of the
type, (inhabited α), for whatever type, α, is given
as its first argument.
-/

def default''' (α : Type) (i : inhabited'' α): α := i.a

#reduce default''' bool bool_inhab''
#reduce default''' nat nat_inhab''
#reduce default''' string string_inhab''

/-
We can make these function applications expressions even
easier to read by making the first type argument implicit,
letting it be inferred from the second inhabited' argument.
-/
def default'' {α : Type} (i : inhabited'' α): α := i.a

#reduce default'' bool_inhab''
#reduce default'' nat_inhab''
#reduce default'' string_inhab''

/-
Now we turn the world on its head. What if we wanted to
keep the first *type* argument explicit and have the value
of the second, instance, argument implicit? How could a
value argument be passed implicitly? What we'd need is
a mechanism that could find an instance value based on
the type argument. Voila, typeclasses!
-/

/-
A typeclass is an ordinary structure type that supports
this kind of lookup operation. The mechanism allows us
to associate typeclass instances with types and to look
them up based on these types so that they can be passed
implicitly to functions that require them.

The following example continues our running example. We
append _ to the typename only to distinguish it from our
final solution, following this example.
-/

/-
The verbose way to tell Lean that a structure type should
support instance lookup is to annotate the "structure"
definition with @[class], as seen next.

-/
@[class] structure inhabited_ (α : Type) :=
(a : α)

/-
With inhabited_ defined as a class, we can now create
values of this type -- instances -- while also having
them entered into Lean's database of available instances
of this class.
-/
instance bool_inhab_ : inhabited_ bool := inhabited_.mk tt
instance nat_inhab_ : inhabited_ nat := inhabited_.mk 0
instance string_inhab_ : inhabited_ string := inhabited_.mk ""

/-
Finally now we can rewrite default so that it takes a
type argument explicitly and *implicitly* finds and
passes instances, if they've been defined, for the given
type argument values.
-/
def default (α : Type) [i : inhabited_ α] := i.a
/-
You can see here that α is an explicit type argument. The
square brackets ask Lean to find an implicitly pass an
instance of type inhabited_ α. If not instance for α
has been registered, then Lean will issue and error
message saying that it can't synthesize (find) the
required typeclass instance.
-/

#eval default bool    -- implicitly receives bool_inhab_
#eval default nat     -- implicitly receives nat_inhab_
#eval default string  -- implicitly receives string_inhab_
#eval default empty   -- OOPS. No instance for empty type
#eval default int     -- OOPS. No instance for int type

/-
As a final syntactic sugar, you can write "class <name>"
rather than @[class] structure <name>.
-/
class inhabited (α : Type) :=
(a : α)

/-
You don't even have to give instances names, since
they will be looked up and passed implicitly.
-/
instance : inhabited bool := inhabited.mk tt
instance : inhabited nat := inhabited.mk 0
instance : inhabited string := inhabited.mk ""

/-
A takeaway message is that we can now use the type
system to enforce conditions on the type values that
are passed to a function, restricting them only to
those type values for which metadata *for that type*
have been registered as typeclass instances.
-/

/-
We now show how these ideas can be used to solve the
problem we had with our initial type signature for
the right fold function: it is possible for clients
to pass inconsistent operator and identity element
arguments when they are passed separate. We can do
much better.

A key is to recognize that the same algebraic
structure: a binary operator on values of a type
and a bona fide identity element for that operator.
Algebraists call such a structure a monoid. We've
already seen that the natural numbers along with
addition and 0 are a monoid; as are the natural
numbers along with multiplication and 1; as well
as Booleans with and and tt; along with strings,
the append operation, and "".
-/

/-
Our solution is to define monoid as a typeclass,
with instances for each type of value on which
we can impose a monoid structure by providing
a correspond binary operation, identity element,
and proof that it really is an identity element.
-/

class monoid' (α : Type) :=
(op : α → α → α)
(id : α)
(pf : ∀ (a : α), op a id = a)

/-
OOPS! Initial version, given just above, left out
the requirement that op be associative. We fix that
in the following definition.
-/

class monoid (α : Type) :=
(op : α → α → α)
(assoc : ∀ a b c, op a (op b c) = op (op a b) c)
(id : α)
(pf : ∀ (a : α), op a id = a)

instance add_monoid : monoid nat :=
monoid.mk
  nat.add
  _       -- now need proof here; exercise
  0
  nat.add_zero

instance and_monoid : monoid bool :=
monoid.mk
  band
  _
  tt
  begin
    intros, cases a, repeat { apply rfl },
  end

instance append_monoid : monoid string :=
monoid.mk
  append
  _
  ""
  begin
    sorry
  end

/-
We are now completely positioned to write a
beautiful parametric and ad hoc polymorphic
foldr function that (1) takes a type (of list
value) implicitly, (2) looks up an instance,
if there is one for that type and passes it
implicitly, and (3) uses the field values
to access the operator and identity element
to be associated with that type.
-/

def foldr {α : Type} [m : monoid α] : list α → α
| [] := m.id
| (h::t) := let x:= m.op in x h (foldr t)

#eval foldr [tt,ff,tt]
#eval foldr [tt,tt,tt]
#eval foldr [1,2,3,4,5]
#eval foldr ["Hello", ", ", "Lean", "!"]

/-
We've now understood ad hoc polymorphism,
its use to to define typeclasses and instances
that enable implicit instance lookup, and to use
these capabilities to impose *constraints* on
the values of arguments passed as types: in this
case that the type has an overloaded definition
of a monoid algebraic structure for that type.
You can now read the definition of foldr as
saying "if you give me any type and if I can
find a monoid instance for that type, then I
will return a function that takes a list of
values of that type and reduces it to a single
value of that type using the operator and the
identity element found in that type instance."
With all this machinery in place, we now get
an elegant, easy to use foldr function that is
in effect overloaded to apply to values of at
least three different types. If you want to do
foldr operations on lists of values of other
types, just define monoid type instances for
them. Yay!
-/

end hidden


/-
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 order.hom.basic

/-!
# Orders on a sum type

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

This file defines the disjoint sum and the linear (aka lexicographic) sum of two orders and provides
relation instances for `sum.lift_rel` and `sum.lex`.

We declare the disjoint sum of orders as the default set of instances. The linear order goes on a
type synonym.

## Main declarations

* `sum.has_le`, `sum.has_lt`: Disjoint sum of orders.
* `sum.lex.has_le`, `sum.lex.has_lt`: Lexicographic/linear sum of orders.

## Notation

* `α ⊕ₗ β`:  The linear sum of `α` and `β`.
-/

variables {α β γ δ : Type*}

namespace sum

/-! ### Unbundled relation classes -/

section lift_rel
variables (r : α → α → Prop) (s : β → β → Prop)

@[refl] lemma lift_rel.refl [is_refl α r] [is_refl β s] : ∀ x, lift_rel r s x x
| (inl a) := lift_rel.inl (refl _)
| (inr a) := lift_rel.inr (refl _)

instance [is_refl α r] [is_refl β s] : is_refl (α ⊕ β) (lift_rel r s) := ⟨lift_rel.refl _ _⟩

instance [is_irrefl α r] [is_irrefl β s] : is_irrefl (α ⊕ β) (lift_rel r s) :=
⟨by { rintro _ (⟨h⟩ | ⟨h⟩); exact irrefl _ h }⟩

@[trans] lemma lift_rel.trans [is_trans α r] [is_trans β s] :
  ∀ {a b c}, lift_rel r s a b → lift_rel r s b c → lift_rel r s a c
| _ _ _ (lift_rel.inl hab) (lift_rel.inl hbc) := lift_rel.inl $ trans hab hbc
| _ _ _ (lift_rel.inr hab) (lift_rel.inr hbc) := lift_rel.inr $ trans hab hbc

instance [is_trans α r] [is_trans β s] : is_trans (α ⊕ β) (lift_rel r s) :=
⟨λ _ _ _, lift_rel.trans _ _⟩

instance [is_antisymm α r] [is_antisymm β s] : is_antisymm (α ⊕ β) (lift_rel r s) :=
⟨by { rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩); rw antisymm hab hba }⟩

end lift_rel

section lex
variables (r : α → α → Prop) (s : β → β → Prop)

instance [is_refl α r] [is_refl β s] : is_refl (α ⊕ β) (lex r s) :=
⟨by { rintro (a | a), exacts [lex.inl (refl _), lex.inr (refl _)] }⟩

instance [is_irrefl α r] [is_irrefl β s] : is_irrefl (α ⊕ β) (lex r s) :=
⟨by { rintro _ (⟨h⟩ | ⟨h⟩); exact irrefl _ h }⟩

instance [is_trans α r] [is_trans β s] : is_trans (α ⊕ β) (lex r s) :=
⟨by { rintro _ _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hbc⟩ | ⟨hbc⟩),
  exacts [lex.inl (trans hab hbc), lex.sep _ _, lex.inr (trans hab hbc), lex.sep _ _] }⟩

instance [is_antisymm α r] [is_antisymm β s] : is_antisymm (α ⊕ β) (lex r s) :=
⟨by { rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩); rw antisymm hab hba }⟩

instance [is_total α r] [is_total β s] : is_total (α ⊕ β) (lex r s) :=
⟨λ a b, match a, b with
  | inl a, inl b := (total_of r a b).imp lex.inl lex.inl
  | inl a, inr b := or.inl (lex.sep _ _)
  | inr a, inl b := or.inr (lex.sep _ _)
  | inr a, inr b := (total_of s a b).imp lex.inr lex.inr
end⟩

instance [is_trichotomous α r] [is_trichotomous β s] : is_trichotomous (α ⊕ β) (lex r s) :=
⟨λ a b, match a, b with
  | inl a, inl b := (trichotomous_of r a b).imp3 lex.inl (congr_arg _) lex.inl
  | inl a, inr b := or.inl (lex.sep _ _)
  | inr a, inl b := or.inr (or.inr $ lex.sep _ _)
  | inr a, inr b := (trichotomous_of s a b).imp3 lex.inr (congr_arg _) lex.inr
end⟩

instance [is_well_order α r] [is_well_order β s] : is_well_order (α ⊕ β) (sum.lex r s) :=
{ wf := sum.lex_wf is_well_founded.wf is_well_founded.wf }

end lex

/-! ### Disjoint sum of two orders -/

section disjoint

instance [has_le α] [has_le β] : has_le (α ⊕ β) := ⟨lift_rel (≤) (≤)⟩
instance [has_lt α] [has_lt β] : has_lt (α ⊕ β) := ⟨lift_rel (<) (<)⟩

lemma le_def [has_le α] [has_le β] {a b : α ⊕ β} : a ≤ b ↔ lift_rel (≤) (≤) a b := iff.rfl
lemma lt_def [has_lt α] [has_lt β] {a b : α ⊕ β} : a < b ↔ lift_rel (<) (<) a b := iff.rfl

@[simp] lemma inl_le_inl_iff [has_le α] [has_le β] {a b : α} : (inl a : α ⊕ β) ≤ inl b ↔ a ≤ b :=
lift_rel_inl_inl

@[simp] lemma inr_le_inr_iff [has_le α] [has_le β] {a b : β} : (inr a : α ⊕ β) ≤ inr b ↔ a ≤ b :=
lift_rel_inr_inr

@[simp] lemma inl_lt_inl_iff [has_lt α] [has_lt β] {a b : α} : (inl a : α ⊕ β) < inl b ↔ a < b :=
lift_rel_inl_inl

@[simp] lemma inr_lt_inr_iff [has_lt α] [has_lt β] {a b : β} : (inr a : α ⊕ β) < inr b ↔ a < b :=
lift_rel_inr_inr

@[simp] lemma not_inl_le_inr [has_le α] [has_le β] {a : α} {b : β} : ¬ inl b ≤ inr a :=
not_lift_rel_inl_inr

@[simp] lemma not_inl_lt_inr [has_lt α] [has_lt β] {a : α} {b : β} : ¬ inl b < inr a :=
not_lift_rel_inl_inr

@[simp] lemma not_inr_le_inl [has_le α] [has_le β] {a : α} {b : β} : ¬ inr b ≤ inl a :=
not_lift_rel_inr_inl

@[simp] lemma not_inr_lt_inl [has_lt α] [has_lt β] {a : α} {b : β} : ¬ inr b < inl a :=
not_lift_rel_inr_inl

section preorder
variables [preorder α] [preorder β]

instance : preorder (α ⊕ β) :=
{ le_refl := λ _, refl _,
  le_trans := λ _ _ _, trans,
  lt_iff_le_not_le := λ a b, begin
    refine ⟨λ hab, ⟨hab.mono (λ _ _, le_of_lt) (λ _ _, le_of_lt), _⟩, _⟩,
    { rintro (⟨hba⟩ | ⟨hba⟩),
      { exact hba.not_lt (inl_lt_inl_iff.1 hab) },
      { exact hba.not_lt (inr_lt_inr_iff.1 hab) } },
    { rintro ⟨⟨hab⟩ | ⟨hab⟩, hba⟩,
      { exact lift_rel.inl (hab.lt_of_not_le $ λ h, hba $ lift_rel.inl h) },
      { exact lift_rel.inr (hab.lt_of_not_le $ λ h, hba $ lift_rel.inr h) } }
  end,
  .. sum.has_le, .. sum.has_lt }

lemma inl_mono : monotone (inl : α → α ⊕ β) := λ a b, lift_rel.inl
lemma inr_mono : monotone (inr : β → α ⊕ β) := λ a b, lift_rel.inr

end preorder

instance [partial_order α] [partial_order β] : partial_order (α ⊕ β) :=
{ le_antisymm := λ _ _, antisymm,
  .. sum.preorder }

instance no_min_order [has_lt α] [has_lt β] [no_min_order α] [no_min_order β] :
  no_min_order (α ⊕ β) :=
⟨λ a, match a with
| inl a := let ⟨b, h⟩ := exists_lt a in ⟨inl b, inl_lt_inl_iff.2 h⟩
| inr a := let ⟨b, h⟩ := exists_lt a in ⟨inr b, inr_lt_inr_iff.2 h⟩
end⟩

instance no_max_order [has_lt α] [has_lt β] [no_max_order α] [no_max_order β] :
  no_max_order (α ⊕ β) :=
⟨λ a, match a with
| inl a := let ⟨b, h⟩ := exists_gt a in ⟨inl b, inl_lt_inl_iff.2 h⟩
| inr a := let ⟨b, h⟩ := exists_gt a in ⟨inr b, inr_lt_inr_iff.2 h⟩
end⟩

@[simp] lemma no_min_order_iff [has_lt α] [has_lt β] :
  no_min_order (α ⊕ β) ↔ no_min_order α ∧ no_min_order β :=
⟨λ _, by exactI ⟨⟨λ a, begin
  obtain ⟨b | b, h⟩ := exists_lt (inl a : α ⊕ β),
  { exact ⟨b, inl_lt_inl_iff.1 h⟩ },
  { exact (not_inr_lt_inl h).elim }
end⟩, ⟨λ a, begin
  obtain ⟨b | b, h⟩ := exists_lt (inr a : α ⊕ β),
  { exact (not_inl_lt_inr h).elim },
  { exact ⟨b, inr_lt_inr_iff.1 h⟩ }
end⟩⟩, λ h, @sum.no_min_order _ _ _ _ h.1 h.2⟩

@[simp] lemma no_max_order_iff [has_lt α] [has_lt β] :
  no_max_order (α ⊕ β) ↔ no_max_order α ∧ no_max_order β :=
⟨λ _, by exactI ⟨⟨λ a, begin
  obtain ⟨b | b, h⟩ := exists_gt (inl a : α ⊕ β),
  { exact ⟨b, inl_lt_inl_iff.1 h⟩ },
  { exact (not_inl_lt_inr h).elim }
end⟩, ⟨λ a, begin
  obtain ⟨b | b, h⟩ := exists_gt (inr a : α ⊕ β),
  { exact (not_inr_lt_inl h).elim },
  { exact ⟨b, inr_lt_inr_iff.1 h⟩ }
end⟩⟩, λ h, @sum.no_max_order _ _ _ _ h.1 h.2⟩

instance densely_ordered [has_lt α] [has_lt β] [densely_ordered α] [densely_ordered β] :
  densely_ordered (α ⊕ β) :=
⟨λ a b h, match a, b, h with
| inl a, inl b, lift_rel.inl h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inl c), lift_rel.inl ha, lift_rel.inl hb⟩
| inr a, inr b, lift_rel.inr h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inr c), lift_rel.inr ha, lift_rel.inr hb⟩
end⟩

@[simp] lemma densely_ordered_iff [has_lt α] [has_lt β] :
  densely_ordered (α ⊕ β) ↔ densely_ordered α ∧ densely_ordered β :=
⟨λ _, by exactI ⟨⟨λ a b h, begin
  obtain ⟨c | c, ha, hb⟩ := @exists_between (α ⊕ β) _ _ _ _ (inl_lt_inl_iff.2 h),
  { exact ⟨c, inl_lt_inl_iff.1 ha, inl_lt_inl_iff.1 hb⟩ },
  { exact (not_inl_lt_inr ha).elim }
end⟩, ⟨λ a b h, begin
  obtain ⟨c | c, ha, hb⟩ := @exists_between (α ⊕ β) _ _ _ _ (inr_lt_inr_iff.2 h),
  { exact (not_inl_lt_inr hb).elim },
  { exact ⟨c, inr_lt_inr_iff.1 ha, inr_lt_inr_iff.1 hb⟩ }
end⟩⟩, λ h, @sum.densely_ordered _ _ _ _ h.1 h.2⟩

@[simp] lemma swap_le_swap_iff [has_le α] [has_le β] {a b : α ⊕ β} : a.swap ≤ b.swap ↔ a ≤ b :=
lift_rel_swap_iff

@[simp] lemma swap_lt_swap_iff [has_lt α] [has_lt β] {a b : α ⊕ β} : a.swap < b.swap ↔ a < b :=
lift_rel_swap_iff

end disjoint

/-! ### Linear sum of two orders -/

namespace lex

notation α ` ⊕ₗ `:30 β:29 := _root_.lex (α ⊕ β)

--TODO: Can we make `inlₗ`, `inrₗ` `local notation`?

/-- Lexicographical `sum.inl`. Only used for pattern matching. -/
@[pattern] abbreviation _root_.sum.inlₗ (x : α) : α ⊕ₗ β := to_lex (sum.inl x)

/-- Lexicographical `sum.inr`. Only used for pattern matching. -/
@[pattern] abbreviation _root_.sum.inrₗ (x : β) : α ⊕ₗ β := to_lex (sum.inr x)

/-- The linear/lexicographical `≤` on a sum. -/
instance has_le [has_le α] [has_le β] : has_le (α ⊕ₗ β) := ⟨lex (≤) (≤)⟩

/-- The linear/lexicographical `<` on a sum. -/
instance has_lt [has_lt α] [has_lt β] : has_lt (α ⊕ₗ β) := ⟨lex (<) (<)⟩

@[simp] lemma to_lex_le_to_lex [has_le α] [has_le β] {a b : α ⊕ β} :
  to_lex a ≤ to_lex b ↔ lex (≤) (≤) a b := iff.rfl

@[simp] lemma to_lex_lt_to_lex [has_lt α] [has_lt β] {a b : α ⊕ β} :
  to_lex a < to_lex b ↔ lex (<) (<) a b := iff.rfl

lemma le_def [has_le α] [has_le β] {a b : α ⊕ₗ β} : a ≤ b ↔ lex (≤) (≤) (of_lex a) (of_lex b) :=
iff.rfl

lemma lt_def [has_lt α] [has_lt β] {a b : α ⊕ₗ β} : a < b ↔ lex (<) (<) (of_lex a) (of_lex b) :=
iff.rfl

@[simp] lemma inl_le_inl_iff [has_le α] [has_le β] {a b : α} :
  to_lex (inl a : α ⊕ β) ≤ to_lex (inl b) ↔ a ≤ b :=
lex_inl_inl

@[simp] lemma inr_le_inr_iff [has_le α] [has_le β] {a b : β} :
  to_lex (inr a : α ⊕ β) ≤ to_lex (inr b) ↔ a ≤ b :=
lex_inr_inr

@[simp] lemma inl_lt_inl_iff [has_lt α] [has_lt β] {a b : α} :
  to_lex (inl a : α ⊕ β) < to_lex (inl b) ↔ a < b :=
lex_inl_inl

@[simp] lemma inr_lt_inr_iff [has_lt α] [has_lt β] {a b : β} :
  to_lex (inr a : α ⊕ₗ β) < to_lex (inr b) ↔ a < b :=
lex_inr_inr

@[simp] lemma inl_le_inr [has_le α] [has_le β] (a : α) (b : β) : to_lex (inl a) ≤ to_lex (inr b) :=
lex.sep _ _

@[simp] lemma inl_lt_inr [has_lt α] [has_lt β] (a : α) (b : β) : to_lex (inl a) < to_lex (inr b) :=
lex.sep _ _

@[simp] lemma not_inr_le_inl [has_le α] [has_le β] {a : α} {b : β} :
  ¬ to_lex (inr b) ≤ to_lex (inl a) :=
lex_inr_inl

@[simp] lemma not_inr_lt_inl [has_lt α] [has_lt β] {a : α} {b : β} :
  ¬ to_lex (inr b) < to_lex (inl a) :=
lex_inr_inl

section preorder
variables [preorder α] [preorder β]

instance preorder : preorder (α ⊕ₗ β) :=
{ le_refl := refl_of (lex (≤) (≤)),
  le_trans := λ _ _ _, trans_of (lex (≤) (≤)),
  lt_iff_le_not_le := λ a b, begin
    refine ⟨λ hab, ⟨hab.mono (λ _ _, le_of_lt) (λ _ _, le_of_lt), _⟩, _⟩,
    { rintro (⟨hba⟩ | ⟨hba⟩ | ⟨b, a⟩),
      { exact hba.not_lt (inl_lt_inl_iff.1 hab) },
      { exact hba.not_lt (inr_lt_inr_iff.1 hab) },
      { exact not_inr_lt_inl hab } },
    { rintro ⟨⟨hab⟩ | ⟨hab⟩ | ⟨a, b⟩, hba⟩,
      { exact lex.inl (hab.lt_of_not_le $ λ h, hba $ lex.inl h) },
      { exact lex.inr (hab.lt_of_not_le $ λ h, hba $ lex.inr h) },
      { exact lex.sep _ _} }
  end,
  .. lex.has_le, .. lex.has_lt }

lemma to_lex_mono : monotone (@to_lex (α ⊕ β)) := λ a b h, h.lex
lemma to_lex_strict_mono : strict_mono (@to_lex (α ⊕ β)) := λ a b h, h.lex

lemma inl_mono : monotone (to_lex ∘ inl : α → α ⊕ₗ β) := to_lex_mono.comp inl_mono
lemma inr_mono : monotone (to_lex ∘ inr : β → α ⊕ₗ β) := to_lex_mono.comp inr_mono

lemma inl_strict_mono : strict_mono (to_lex ∘ inl : α → α ⊕ₗ β) :=
to_lex_strict_mono.comp inl_strict_mono

lemma inr_strict_mono : strict_mono (to_lex ∘ inr : β → α ⊕ₗ β) :=
to_lex_strict_mono.comp inr_strict_mono

end preorder

instance partial_order [partial_order α] [partial_order β] : partial_order (α ⊕ₗ β) :=
{ le_antisymm := λ _ _, antisymm_of (lex (≤) (≤)),
  .. lex.preorder }

instance linear_order [linear_order α] [linear_order β] : linear_order (α ⊕ₗ β) :=
{ le_total := total_of (lex (≤) (≤)),
  decidable_le := lex.decidable_rel,
  decidable_eq := sum.decidable_eq _ _,
  .. lex.partial_order }

/-- The lexicographical bottom of a sum is the bottom of the left component. -/
instance order_bot [has_le α] [order_bot α] [has_le β] : order_bot (α ⊕ₗ β) :=
{ bot := inl ⊥,
  bot_le := begin
    rintro (a | b),
    { exact lex.inl bot_le },
    { exact lex.sep _ _ }
  end }

@[simp] lemma inl_bot [has_le α] [order_bot α] [has_le β]: to_lex (inl ⊥ : α ⊕ β) = ⊥ := rfl

/-- The lexicographical top of a sum is the top of the right component. -/
instance order_top [has_le α] [has_le β] [order_top β] : order_top (α ⊕ₗ β) :=
{ top := inr ⊤,
  le_top := begin
    rintro (a | b),
    { exact lex.sep _ _ },
    { exact lex.inr le_top }
  end }

@[simp] lemma inr_top [has_le α] [has_le β] [order_top β] : to_lex (inr ⊤ : α ⊕ β) = ⊤ := rfl

instance bounded_order [has_le α] [has_le β] [order_bot α] [order_top β] :
  bounded_order (α ⊕ₗ β) :=
{ .. lex.order_bot, .. lex.order_top }

instance no_min_order [has_lt α] [has_lt β] [no_min_order α] [no_min_order β] :
  no_min_order (α ⊕ₗ β) :=
⟨λ a, match a with
| inl a := let ⟨b, h⟩ := exists_lt a in ⟨to_lex (inl b), inl_lt_inl_iff.2 h⟩
| inr a := let ⟨b, h⟩ := exists_lt a in ⟨to_lex (inr b), inr_lt_inr_iff.2 h⟩
end⟩

instance no_max_order [has_lt α] [has_lt β] [no_max_order α] [no_max_order β] :
  no_max_order (α ⊕ₗ β) :=
⟨λ a, match a with
| inl a := let ⟨b, h⟩ := exists_gt a in ⟨to_lex (inl b), inl_lt_inl_iff.2 h⟩
| inr a := let ⟨b, h⟩ := exists_gt a in ⟨to_lex (inr b), inr_lt_inr_iff.2 h⟩
end⟩

instance no_min_order_of_nonempty [has_lt α] [has_lt β] [no_min_order α] [nonempty α] :
  no_min_order (α ⊕ₗ β) :=
⟨λ a, match a with
| inl a := let ⟨b, h⟩ := exists_lt a in ⟨to_lex (inl b), inl_lt_inl_iff.2 h⟩
| inr a := ⟨to_lex (inl $ classical.arbitrary α), inl_lt_inr _ _⟩
end⟩

instance no_max_order_of_nonempty [has_lt α] [has_lt β] [no_max_order β] [nonempty β] :
  no_max_order (α ⊕ₗ β) :=
⟨λ a, match a with
| inl a := ⟨to_lex (inr $ classical.arbitrary β), inl_lt_inr _ _⟩
| inr a := let ⟨b, h⟩ := exists_gt a in ⟨to_lex (inr b), inr_lt_inr_iff.2 h⟩
end⟩

instance densely_ordered_of_no_max_order [has_lt α] [has_lt β] [densely_ordered α]
  [densely_ordered β] [no_max_order α] :
  densely_ordered (α ⊕ₗ β) :=
⟨λ a b h, match a, b, h with
| inl a, inl b, lex.inl h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inl c), inl_lt_inl_iff.2 ha, inl_lt_inl_iff.2 hb⟩
| inl a, inr b, lex.sep _ _ := let ⟨c, h⟩ := exists_gt a in
                    ⟨to_lex (inl c), inl_lt_inl_iff.2 h, inl_lt_inr _ _⟩
| inr a, inr b, lex.inr h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inr c), inr_lt_inr_iff.2 ha, inr_lt_inr_iff.2 hb⟩
end⟩

instance densely_ordered_of_no_min_order [has_lt α] [has_lt β] [densely_ordered α]
  [densely_ordered β] [no_min_order β] :
  densely_ordered (α ⊕ₗ β) :=
⟨λ a b h, match a, b, h with
| inl a, inl b, lex.inl h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inl c), inl_lt_inl_iff.2 ha, inl_lt_inl_iff.2 hb⟩
| inl a, inr b, lex.sep _ _ := let ⟨c, h⟩ := exists_lt b in
                    ⟨to_lex (inr c), inl_lt_inr _ _, inr_lt_inr_iff.2 h⟩
| inr a, inr b, lex.inr h := let ⟨c, ha, hb⟩ := exists_between h in
                    ⟨to_lex (inr c), inr_lt_inr_iff.2 ha, inr_lt_inr_iff.2 hb⟩
end⟩

end lex
end sum

/-! ### Order isomorphisms -/

open order_dual sum

namespace order_iso
variables [has_le α] [has_le β] [has_le γ] (a : α) (b : β) (c : γ)

/-- `equiv.sum_comm` promoted to an order isomorphism. -/
@[simps apply] def sum_comm (α β : Type*) [has_le α] [has_le β] : α ⊕ β ≃o β ⊕ α :=
{ map_rel_iff' := λ a b, swap_le_swap_iff,
  ..equiv.sum_comm α β }

@[simp] lemma sum_comm_symm (α β : Type*) [has_le α] [has_le β] :
  (order_iso.sum_comm α β).symm = order_iso.sum_comm β α := rfl

/-- `equiv.sum_assoc` promoted to an order isomorphism. -/
def sum_assoc (α β γ : Type*) [has_le α] [has_le β] [has_le γ] : (α ⊕ β) ⊕ γ ≃o α ⊕ β ⊕ γ :=
{ map_rel_iff' := by { rintro ((a | a) | a) ((b | b) | b); simp },
  ..equiv.sum_assoc α β γ }

@[simp] lemma sum_assoc_apply_inl_inl : sum_assoc α β γ (inl (inl a)) = inl a := rfl
@[simp] lemma sum_assoc_apply_inl_inr : sum_assoc α β γ (inl (inr b)) = inr (inl b) := rfl
@[simp] lemma sum_assoc_apply_inr : sum_assoc α β γ (inr c) = inr (inr c) := rfl
@[simp] lemma sum_assoc_symm_apply_inl : (sum_assoc α β γ).symm (inl a) = inl (inl a) := rfl
@[simp] lemma sum_assoc_symm_apply_inr_inl : (sum_assoc α β γ).symm (inr (inl b)) = inl (inr b) :=
rfl
@[simp] lemma sum_assoc_symm_apply_inr_inr : (sum_assoc α β γ).symm (inr (inr c)) = inr c := rfl

/-- `order_dual` is distributive over `⊕` up to an order isomorphism. -/
def sum_dual_distrib (α β : Type*) [has_le α] [has_le β] : (α ⊕ β)ᵒᵈ ≃o αᵒᵈ ⊕ βᵒᵈ :=
{ map_rel_iff' := begin
  rintro (a | a) (b | b),
  { change inl (to_dual a) ≤ inl (to_dual b) ↔ to_dual (inl a) ≤ to_dual (inl b),
    simp only [to_dual_le_to_dual, inl_le_inl_iff] },
  { exact iff_of_false not_inl_le_inr not_inr_le_inl },
  { exact iff_of_false not_inr_le_inl not_inl_le_inr },
  { change inr (to_dual a) ≤ inr (to_dual b) ↔ to_dual (inr a) ≤ to_dual (inr b),
    simp only [to_dual_le_to_dual, inr_le_inr_iff] }
end,
  ..equiv.refl _ }

@[simp] lemma sum_dual_distrib_inl :
  sum_dual_distrib α β (to_dual (inl a)) = inl (to_dual a) := rfl

@[simp] lemma sum_dual_distrib_inr :
  sum_dual_distrib α β (to_dual (inr b)) = inr (to_dual b) := rfl

@[simp] lemma sum_dual_distrib_symm_inl :
  (sum_dual_distrib α β).symm (inl (to_dual a)) = to_dual (inl a) := rfl

@[simp] lemma sum_dual_distrib_symm_inr  :
  (sum_dual_distrib α β).symm (inr (to_dual b)) = to_dual (inr b) := rfl

/-- `equiv.sum_assoc` promoted to an order isomorphism. -/
def sum_lex_assoc (α β γ : Type*) [has_le α] [has_le β] [has_le γ] : (α ⊕ₗ β) ⊕ₗ γ ≃o α ⊕ₗ β ⊕ₗ γ :=
{ map_rel_iff' := λ a b, ⟨λ h, match a, b, h with
    | inlₗ (inlₗ a), inlₗ (inlₗ b), lex.inl h := lex.inl $ lex.inl h
    | inlₗ (inlₗ a), inlₗ (inrₗ b), lex.sep _ _ := lex.inl $ lex.sep _ _
    | inlₗ (inlₗ a),        inrₗ b, lex.sep _ _ := lex.sep _ _
    | inlₗ (inrₗ a), inlₗ (inrₗ b), lex.inr (lex.inl h) := lex.inl $ lex.inr h
    | inlₗ (inrₗ a),        inrₗ b, lex.inr (lex.sep _ _) := lex.sep _ _
    |       inrₗ a,        inrₗ b, lex.inr (lex.inr h) := lex.inr h
    end, λ h, match a, b, h with
    | inlₗ (inlₗ a), inlₗ (inlₗ b), lex.inl (lex.inl h) := lex.inl h
    | inlₗ (inlₗ a), inlₗ (inrₗ b), lex.inl (lex.sep _ _) := lex.sep _ _
    | inlₗ (inlₗ a),        inrₗ b, lex.sep _ _ := lex.sep _ _
    | inlₗ (inrₗ a), inlₗ (inrₗ b), lex.inl (lex.inr h) := lex.inr $ lex.inl h
    | inlₗ (inrₗ a),        inrₗ b, lex.sep _ _ := lex.inr $ lex.sep _ _
    |       inrₗ a,        inrₗ b, lex.inr h  := lex.inr $ lex.inr h
    end⟩,
  ..equiv.sum_assoc α β γ }

@[simp] lemma sum_lex_assoc_apply_inl_inl :
  sum_lex_assoc α β γ (to_lex $ inl $ to_lex $ inl a) = to_lex (inl a) := rfl

@[simp] lemma sum_lex_assoc_apply_inl_inr :
  sum_lex_assoc α β γ (to_lex $ inl $ to_lex $ inr b) = to_lex (inr $ to_lex $ inl b) := rfl

@[simp] lemma sum_lex_assoc_apply_inr :
  sum_lex_assoc α β γ (to_lex $ inr c) = to_lex (inr $ to_lex $ inr c) := rfl

@[simp] lemma sum_lex_assoc_symm_apply_inl :
  (sum_lex_assoc α β γ).symm (inl a) = inl (inl a) := rfl

@[simp] lemma sum_lex_assoc_symm_apply_inr_inl :
  (sum_lex_assoc α β γ).symm (inr (inl b)) = inl (inr b) := rfl

@[simp] lemma sum_lex_assoc_symm_apply_inr_inr :
  (sum_lex_assoc α β γ).symm (inr (inr c)) = inr c := rfl

/-- `order_dual` is antidistributive over `⊕ₗ` up to an order isomorphism. -/
def sum_lex_dual_antidistrib (α β : Type*) [has_le α] [has_le β] : (α ⊕ₗ β)ᵒᵈ ≃o βᵒᵈ ⊕ₗ αᵒᵈ :=
{ map_rel_iff' := begin
  rintro (a | a) (b | b), simp,
  { change to_lex (inr $ to_dual a) ≤ to_lex (inr $ to_dual b) ↔
      to_dual (to_lex $ inl a) ≤ to_dual (to_lex $ inl b),
    simp only [to_dual_le_to_dual, lex.inl_le_inl_iff, lex.inr_le_inr_iff] },
  { exact iff_of_false lex.not_inr_le_inl lex.not_inr_le_inl },
  { exact iff_of_true (lex.inl_le_inr _ _) (lex.inl_le_inr _ _) },
  { change to_lex (inl $ to_dual a) ≤ to_lex (inl $ to_dual b) ↔
      to_dual (to_lex $ inr a) ≤ to_dual (to_lex $ inr b),
    simp only [to_dual_le_to_dual, lex.inl_le_inl_iff, lex.inr_le_inr_iff] }
end,
  ..equiv.sum_comm α β }

@[simp] lemma sum_lex_dual_antidistrib_inl :
  sum_lex_dual_antidistrib α β (to_dual (inl a)) = inr (to_dual a) := rfl

@[simp] lemma sum_lex_dual_antidistrib_inr :
  sum_lex_dual_antidistrib α β (to_dual (inr b)) = inl (to_dual b) := rfl

@[simp] lemma sum_lex_dual_antidistrib_symm_inl :
  (sum_lex_dual_antidistrib α β).symm (inl (to_dual b)) = to_dual (inr b) := rfl

@[simp] lemma sum_lex_dual_antidistrib_symm_inr :
  (sum_lex_dual_antidistrib α β).symm (inr (to_dual a)) = to_dual (inl a) := rfl

end order_iso

variable [has_le α]

namespace with_bot

/-- `with_bot α` is order-isomorphic to `punit ⊕ₗ α`, by sending `⊥` to `punit.star` and `↑a` to
`a`. -/
def order_iso_punit_sum_lex : with_bot α ≃o punit ⊕ₗ α :=
⟨(equiv.option_equiv_sum_punit α).trans $ (equiv.sum_comm _ _).trans to_lex,
  by rintro (a | _) (b | _); simp; exact not_coe_le_bot _⟩

@[simp] lemma order_iso_punit_sum_lex_bot :
  @order_iso_punit_sum_lex α _ ⊥ = to_lex (inl punit.star) := rfl

@[simp] lemma order_iso_punit_sum_lex_coe (a : α) :
  order_iso_punit_sum_lex (↑a) = to_lex (inr a) := rfl

@[simp] lemma order_iso_punit_sum_lex_symm_inl (x : punit) :
  (@order_iso_punit_sum_lex α _).symm (to_lex $ inl x) = ⊥ := rfl

@[simp] lemma order_iso_punit_sum_lex_symm_inr (a : α) :
  order_iso_punit_sum_lex.symm (to_lex $ inr a) = a := rfl

end with_bot

namespace with_top

/-- `with_top α` is order-isomorphic to `α ⊕ₗ punit`, by sending `⊤` to `punit.star` and `↑a` to
`a`. -/
def order_iso_sum_lex_punit : with_top α ≃o α ⊕ₗ punit :=
⟨(equiv.option_equiv_sum_punit α).trans to_lex,
  by rintro (a | _) (b | _); simp; exact not_top_le_coe _⟩

@[simp] lemma order_iso_sum_lex_punit_top :
  @order_iso_sum_lex_punit α _ ⊤ = to_lex (inr punit.star) := rfl

@[simp] lemma order_iso_sum_lex_punit_coe (a : α) :
  order_iso_sum_lex_punit (↑a) = to_lex (inl a) := rfl

@[simp] lemma order_iso_sum_lex_punit_symm_inr (x : punit) :
  (@order_iso_sum_lex_punit α _).symm (to_lex $ inr x) = ⊤ := rfl

@[simp] lemma order_iso_sum_lex_punit_symm_inl (a : α) :
  order_iso_sum_lex_punit.symm (to_lex $ inl a) = a := rfl

end with_top


/-
Copyright (c) 2018 Louis Carlin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Louis Carlin, Mario Carneiro

Euclidean domains and Euclidean algorithm (extended to come)
A lot is based on pre-existing code in mathlib for natural number gcds
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.basic
import Mathlib.algebra.field
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-- A `euclidean_domain` is an `integral_domain` with a division and a remainder, satisfying
  `b * (a / b) + a % b = a`. The definition of a euclidean domain usually includes a valuation
  function `R → ℕ`. This definition is slightly generalised to include a well founded relation
  `r` with the property that `r (a % b) b`, instead of a valuation.  -/
class euclidean_domain (R : Type u) extends comm_ring R, nontrivial R where
  quotient : R → R → R
  quotient_zero : ∀ (a : R), quotient a 0 = 0
  remainder : R → R → R
  quotient_mul_add_remainder_eq : ∀ (a b : R), b * quotient a b + remainder a b = a
  r : R → R → Prop
  r_well_founded : well_founded r
  remainder_lt : ∀ (a : R) {b : R}, b ≠ 0 → r (remainder a b) b
  mul_left_not_lt : ∀ (a : R) {b : R}, b ≠ 0 → ¬r (a * b) a

namespace euclidean_domain

protected instance has_div {R : Type u} [euclidean_domain R] : Div R :=
  { div := euclidean_domain.quotient }

protected instance has_mod {R : Type u} [euclidean_domain R] : Mod R :=
  { mod := euclidean_domain.remainder }

theorem div_add_mod {R : Type u} [euclidean_domain R] (a : R) (b : R) : b * (a / b) + a % b = a :=
  euclidean_domain.quotient_mul_add_remainder_eq a b

theorem mod_add_div {R : Type u} [euclidean_domain R] (a : R) (b : R) : a % b + b * (a / b) = a :=
  Eq.trans (add_comm (a % b) (b * (a / b))) (div_add_mod a b)

theorem mod_eq_sub_mul_div {R : Type u_1} [euclidean_domain R] (a : R) (b : R) :
    a % b = a - b * (a / b) :=
  Eq.trans (Eq.symm (add_sub_cancel' (b * (a / b)) (a % b)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (b * (a / b) + a % b - b * (a / b) = a - b * (a / b)))
          (div_add_mod a b)))
      (Eq.refl (a - b * (a / b))))

theorem mod_lt {R : Type u} [euclidean_domain R] (a : R) {b : R} :
    b ≠ 0 → euclidean_domain.r (a % b) b :=
  euclidean_domain.remainder_lt

theorem mul_right_not_lt {R : Type u} [euclidean_domain R] {a : R} (b : R) (h : a ≠ 0) :
    ¬euclidean_domain.r (a * b) b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬euclidean_domain.r (a * b) b)) (mul_comm a b)))
    (mul_left_not_lt b h)

theorem mul_div_cancel_left {R : Type u} [euclidean_domain R] {a : R} (b : R) (a0 : a ≠ 0) :
    a * b / a = b :=
  sorry

theorem mul_div_cancel {R : Type u} [euclidean_domain R] (a : R) {b : R} (b0 : b ≠ 0) :
    a * b / b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b / b = a)) (mul_comm a b))) (mul_div_cancel_left a b0)

@[simp] theorem mod_zero {R : Type u} [euclidean_domain R] (a : R) : a % 0 = a := sorry

@[simp] theorem mod_eq_zero {R : Type u} [euclidean_domain R] {a : R} {b : R} : a % b = 0 ↔ b ∣ a :=
  sorry

@[simp] theorem mod_self {R : Type u} [euclidean_domain R] (a : R) : a % a = 0 :=
  iff.mpr mod_eq_zero (dvd_refl a)

theorem dvd_mod_iff {R : Type u} [euclidean_domain R] {a : R} {b : R} {c : R} (h : c ∣ b) :
    c ∣ a % b ↔ c ∣ a :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (c ∣ a % b ↔ c ∣ a))
        (propext (dvd_add_iff_right (dvd_mul_of_dvd_left h (a / b))))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (c ∣ b * (a / b) + a % b ↔ c ∣ a)) (div_add_mod a b)))
      (iff.refl (c ∣ a)))

theorem lt_one {R : Type u} [euclidean_domain R] (a : R) : euclidean_domain.r a 1 → a = 0 := sorry

theorem val_dvd_le {R : Type u} [euclidean_domain R] (a : R) (b : R) :
    b ∣ a → a ≠ 0 → ¬euclidean_domain.r a b :=
  sorry

@[simp] theorem mod_one {R : Type u} [euclidean_domain R] (a : R) : a % 1 = 0 :=
  iff.mpr mod_eq_zero (one_dvd a)

@[simp] theorem zero_mod {R : Type u} [euclidean_domain R] (b : R) : 0 % b = 0 :=
  iff.mpr mod_eq_zero (dvd_zero b)

@[simp] theorem div_zero {R : Type u} [euclidean_domain R] (a : R) : a / 0 = 0 :=
  euclidean_domain.quotient_zero a

@[simp] theorem zero_div {R : Type u} [euclidean_domain R] {a : R} : 0 / a = 0 := sorry

@[simp] theorem div_self {R : Type u} [euclidean_domain R] {a : R} (a0 : a ≠ 0) : a / a = 1 := sorry

theorem eq_div_of_mul_eq_left {R : Type u} [euclidean_domain R] {a : R} {b : R} {c : R} (hb : b ≠ 0)
    (h : a * b = c) : a = c / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = c / b)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = a * b / b)) (mul_div_cancel a hb))) (Eq.refl a))

theorem eq_div_of_mul_eq_right {R : Type u} [euclidean_domain R] {a : R} {b : R} {c : R}
    (ha : a ≠ 0) (h : a * b = c) : b = c / a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b = c / a)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b = a * b / a)) (mul_div_cancel_left b ha))) (Eq.refl b))

theorem mul_div_assoc {R : Type u} [euclidean_domain R] (x : R) {y : R} {z : R} (h : z ∣ y) :
    x * y / z = x * (y / z) :=
  sorry

theorem gcd.induction {R : Type u} [euclidean_domain R] {P : R → R → Prop} (a : R) (b : R) :
    (∀ (x : R), P 0 x) → (∀ (a b : R), a ≠ 0 → P (b % a) a → P a b) → P a b :=
  sorry

/-- `gcd a b` is a (non-unique) element such that `gcd a b ∣ a` `gcd a b ∣ b`, and for
  any element `c` such that `c ∣ a` and `c ∣ b`, then `c ∣ gcd a b` -/
def gcd {R : Type u} [euclidean_domain R] [DecidableEq R] : R → R → R := sorry

@[simp] theorem gcd_zero_left {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) :
    gcd 0 a = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd 0 a = a)) (gcd.equations._eqn_1 0))) (if_pos rfl)

@[simp] theorem gcd_zero_right {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) :
    gcd a 0 = a :=
  sorry

theorem gcd_val {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) :
    gcd a b = gcd (b % a) a :=
  sorry

theorem gcd_dvd {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) :
    gcd a b ∣ a ∧ gcd a b ∣ b :=
  sorry

theorem gcd_dvd_left {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) :
    gcd a b ∣ a :=
  and.left (gcd_dvd a b)

theorem gcd_dvd_right {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) :
    gcd a b ∣ b :=
  and.right (gcd_dvd a b)

protected theorem gcd_eq_zero_iff {R : Type u} [euclidean_domain R] [DecidableEq R] {a : R}
    {b : R} : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
  sorry

theorem dvd_gcd {R : Type u} [euclidean_domain R] [DecidableEq R] {a : R} {b : R} {c : R} :
    c ∣ a → c ∣ b → c ∣ gcd a b :=
  sorry

theorem gcd_eq_left {R : Type u} [euclidean_domain R] [DecidableEq R] {a : R} {b : R} :
    gcd a b = a ↔ a ∣ b :=
  sorry

@[simp] theorem gcd_one_left {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) :
    gcd 1 a = 1 :=
  iff.mpr gcd_eq_left (one_dvd a)

@[simp] theorem gcd_self {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) : gcd a a = a :=
  iff.mpr gcd_eq_left (dvd_refl a)

/--
An implementation of the extended GCD algorithm.
At each step we are computing a triple `(r, s, t)`, where `r` is the next value of the GCD
algorithm, to compute the greatest common divisor of the input (say `x` and `y`), and `s` and `t`
are the coefficients in front of `x` and `y` to obtain `r` (i.e. `r = s * x + t * y`).
The function `xgcd_aux` takes in two triples, and from these recursively computes the next triple:
```
xgcd_aux (r, s, t) (r', s', t') = xgcd_aux (r' % r, s' - (r' / r) * s, t' - (r' / r) * t) (r, s, t)
```
-/
def xgcd_aux {R : Type u} [euclidean_domain R] [DecidableEq R] :
    R → R → R → R → R → R → R × R × R :=
  sorry

@[simp] theorem xgcd_zero_left {R : Type u} [euclidean_domain R] [DecidableEq R] {s : R} {t : R}
    {r' : R} {s' : R} {t' : R} : xgcd_aux 0 s t r' s' t' = (r', s', t') :=
  sorry

theorem xgcd_aux_rec {R : Type u} [euclidean_domain R] [DecidableEq R] {r : R} {s : R} {t : R}
    {r' : R} {s' : R} {t' : R} (h : r ≠ 0) :
    xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - r' / r * s) (t' - r' / r * t) r s t :=
  sorry

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) : R × R :=
  prod.snd (xgcd_aux x 1 0 y 0 1)

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) : R :=
  prod.fst (xgcd x y)

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) : R :=
  prod.snd (xgcd x y)

@[simp] theorem gcd_a_zero_left {R : Type u} [euclidean_domain R] [DecidableEq R] {s : R} :
    gcd_a 0 s = 0 :=
  sorry

@[simp] theorem gcd_b_zero_left {R : Type u} [euclidean_domain R] [DecidableEq R] {s : R} :
    gcd_b 0 s = 1 :=
  sorry

@[simp] theorem xgcd_aux_fst {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R)
    (s : R) (t : R) (s' : R) (t' : R) : prod.fst (xgcd_aux x s t y s' t') = gcd x y :=
  sorry

theorem xgcd_aux_val {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) :
    xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) :=
  sorry

theorem xgcd_val {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) :
    xgcd x y = (gcd_a x y, gcd_b x y) :=
  Eq.symm prod.mk.eta

theorem xgcd_aux_P {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) {r : R}
    {r' : R} {s : R} {t : R} {s' : R} {t' : R} :
    P a b (r, s, t) → P a b (r', s', t') → P a b (xgcd_aux r s t r' s' t') :=
  sorry

theorem gcd_eq_gcd_ab {R : Type u} [euclidean_domain R] [DecidableEq R] (a : R) (b : R) :
    gcd a b = a * gcd_a a b + b * gcd_b a b :=
  sorry

protected instance integral_domain (R : Type u_1) [e : euclidean_domain R] : integral_domain R :=
  integral_domain.mk Add.add euclidean_domain.add_assoc 0 euclidean_domain.zero_add
    euclidean_domain.add_zero euclidean_domain.neg euclidean_domain.sub
    euclidean_domain.add_left_neg euclidean_domain.add_comm Mul.mul euclidean_domain.mul_assoc
    euclidean_domain.one euclidean_domain.one_mul euclidean_domain.mul_one
    euclidean_domain.left_distrib euclidean_domain.right_distrib euclidean_domain.mul_comm
    euclidean_domain.exists_pair_ne sorry

/-- `lcm a b` is a (non-unique) element such that `a ∣ lcm a b` `b ∣ lcm a b`, and for
  any element `c` such that `a ∣ c` and `b ∣ c`, then `lcm a b ∣ c` -/
def lcm {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) : R := x * y / gcd x y

theorem dvd_lcm_left {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) :
    x ∣ lcm x y :=
  sorry

theorem dvd_lcm_right {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) :
    y ∣ lcm x y :=
  sorry

theorem lcm_dvd {R : Type u} [euclidean_domain R] [DecidableEq R] {x : R} {y : R} {z : R}
    (hxz : x ∣ z) (hyz : y ∣ z) : lcm x y ∣ z :=
  sorry

@[simp] theorem lcm_dvd_iff {R : Type u} [euclidean_domain R] [DecidableEq R] {x : R} {y : R}
    {z : R} : lcm x y ∣ z ↔ x ∣ z ∧ y ∣ z :=
  sorry

@[simp] theorem lcm_zero_left {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) :
    lcm 0 x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (lcm 0 x = 0)) (lcm.equations._eqn_1 0 x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 * x / gcd 0 x = 0)) (zero_mul x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 / gcd 0 x = 0)) zero_div)) (Eq.refl 0)))

@[simp] theorem lcm_zero_right {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) :
    lcm x 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (lcm x 0 = 0)) (lcm.equations._eqn_1 x 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x * 0 / gcd x 0 = 0)) (mul_zero x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 / gcd x 0 = 0)) zero_div)) (Eq.refl 0)))

@[simp] theorem lcm_eq_zero_iff {R : Type u} [euclidean_domain R] [DecidableEq R] {x : R} {y : R} :
    lcm x y = 0 ↔ x = 0 ∨ y = 0 :=
  sorry

@[simp] theorem gcd_mul_lcm {R : Type u} [euclidean_domain R] [DecidableEq R] (x : R) (y : R) :
    gcd x y * lcm x y = x * y :=
  sorry

end euclidean_domain

protected instance int.euclidean_domain : euclidean_domain ℤ :=
  euclidean_domain.mk Add.add comm_ring.add_assoc 0 comm_ring.zero_add comm_ring.add_zero Neg.neg
    comm_ring.sub comm_ring.add_left_neg comm_ring.add_comm Mul.mul comm_ring.mul_assoc 1
    comm_ring.one_mul comm_ring.mul_one comm_ring.left_distrib comm_ring.right_distrib
    comm_ring.mul_comm nontrivial.exists_pair_ne Div.div int.div_zero Mod.mod sorry
    (fun (a b : ℤ) => int.nat_abs a < int.nat_abs b) sorry sorry sorry

protected instance field.to_euclidean_domain {K : Type u} [field K] : euclidean_domain K :=
  euclidean_domain.mk Add.add field.add_assoc 0 field.zero_add field.add_zero Neg.neg field.sub
    field.add_left_neg field.add_comm Mul.mul field.mul_assoc 1 field.one_mul field.mul_one
    field.left_distrib field.right_distrib field.mul_comm field.exists_pair_ne Div.div sorry
    (fun (a b : K) => a - a * b / b) sorry (fun (a b : K) => a = 0 ∧ b ≠ 0) sorry sorry sorry

end Mathlib


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

! This file was ported from Lean 3 source module algebra.punit_instances
! leanprover-community/mathlib commit 6cb77a8eaff0ddd100e87b1591c6d3ad319514ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Basic
import Mathlib.Algebra.GCDMonoid.Basic
import Mathlib.Algebra.GroupRingAction.Basic
import Mathlib.GroupTheory.GroupAction.Defs
import Mathlib.Order.CompleteBooleanAlgebra

/-!
# Instances on PUnit

This file collects facts about algebraic structures on the one-element type, e.g. that it is a
commutative ring.
-/

namespace PUnit

@[to_additive]
instance commGroup: CommGroup PUnit where
  mul _ _ := unit
  one := unit
  inv _ := unit
  div _ _ := unit
  npow _ _ := unit
  zpow _ _ := unit
  mul_assoc := by intros; rfl
  one_mul := by intros; rfl
  mul_one := by intros; rfl
  mul_left_inv := by intros; rfl
  mul_comm := by intros; rfl

@[to_additive (attr := simp)]
theorem one_eq : (1 : PUnit) = unit :=
  rfl
#align punit.one_eq PUnit.one_eq
#align punit.zero_eq PUnit.zero_eq

@[to_additive (attr := simp)]
theorem mul_eq : x * y = unit :=
  rfl
#align punit.mul_eq PUnit.mul_eq
#align punit.add_eq PUnit.add_eq

-- `sub_eq` simplifies `PUnit.sub_eq`, but the latter is eligible for `dsimp`
@[to_additive (attr := simp, nolint simpNF)]
theorem div_eq : x / y = unit :=
  rfl
#align punit.div_eq PUnit.div_eq
#align punit.sub_eq PUnit.sub_eq

-- `neg_eq` simplifies `PUnit.neg_eq`, but the latter is eligible for `dsimp`
@[to_additive (attr := simp, nolint simpNF)]
theorem inv_eq : x⁻¹ = unit :=
  rfl
#align punit.inv_eq PUnit.inv_eq
#align punit.neg_eq PUnit.neg_eq

instance commRing: CommRing PUnit where
  __ := PUnit.commGroup
  __ := PUnit.addCommGroup
  left_distrib := by intros; rfl
  right_distrib := by intros; rfl
  zero_mul := by intros; rfl
  mul_zero := by intros; rfl
  natCast _ := unit

instance cancelCommMonoidWithZero: CancelCommMonoidWithZero PUnit := by
  refine' { PUnit.commRing with .. }; intros; exact Subsingleton.elim _ _

instance normalizedGCDMonoid: NormalizedGCDMonoid PUnit where
  gcd _ _ := unit
  lcm _ _ := unit
  normUnit _ := 1
  normUnit_zero := rfl
  normUnit_mul := by intros; rfl
  normUnit_coe_units := by intros; rfl
  gcd_dvd_left _ _ := ⟨unit, Subsingleton.elim _ _⟩
  gcd_dvd_right _ _ := ⟨unit, Subsingleton.elim _ _⟩
  dvd_gcd {_ _} _ _ _ := ⟨unit, Subsingleton.elim _ _⟩
  gcd_mul_lcm _ _ := ⟨1, Subsingleton.elim _ _⟩
  lcm_zero_left := by intros; rfl
  lcm_zero_right := by intros; rfl
  normalize_gcd := by intros; rfl
  normalize_lcm := by intros; rfl

--porting notes: simpNF lint: simp can prove this @[simp]
theorem gcd_eq : gcd x y = unit :=
  rfl
#align punit.gcd_eq PUnit.gcd_eq

--porting notes: simpNF lint: simp can prove this @[simp]
theorem lcm_eq : lcm x y = unit :=
  rfl
#align punit.lcm_eq PUnit.lcm_eq

@[simp]
theorem norm_unit_eq {x: PUnit} : normUnit x = 1 :=
  rfl
#align punit.norm_unit_eq PUnit.norm_unit_eq

instance canonicallyOrderedAddMonoid: CanonicallyOrderedAddMonoid PUnit := by
  refine'
    { PUnit.commRing, PUnit.completeBooleanAlgebra with
      exists_add_of_le := fun {_ _} _ => ⟨unit, Subsingleton.elim _ _⟩.. } <;>
    intros <;>
    trivial

instance linearOrderedCancelAddCommMonoid: LinearOrderedCancelAddCommMonoid PUnit where
  __ := PUnit.canonicallyOrderedAddMonoid
  __ := PUnit.linearOrder
  le_of_add_le_add_left _ _ _ _ := trivial
  add_le_add_left := by intros; rfl

instance : LinearOrderedAddCommMonoidWithTop PUnit :=
  { PUnit.completeBooleanAlgebra, PUnit.linearOrderedCancelAddCommMonoid with
    top_add' := fun _ => rfl }

@[to_additive]
instance smul : SMul R PUnit :=
  ⟨fun _ _ => unit⟩

@[to_additive (attr := simp)]

@[to_additive]
instance : IsCentralScalar R PUnit :=
  ⟨fun _ _ => rfl⟩

@[to_additive]
instance : SMulCommClass R S PUnit :=
  ⟨fun _ _ _ => rfl⟩

@[to_additive]
instance [SMul R S] : IsScalarTower R S PUnit :=
  ⟨fun _ _ _ => rfl⟩

instance smulWithZero [Zero R] : SMulWithZero R PUnit := by
  refine' { PUnit.smul with .. } <;> intros <;> exact Subsingleton.elim _ _

instance mulAction [Monoid R] : MulAction R PUnit := by
  refine' { PUnit.smul with .. } <;> intros <;> exact Subsingleton.elim _ _

instance distribMulAction [Monoid R] : DistribMulAction R PUnit := by
  refine' { PUnit.mulAction with .. } <;> intros <;> exact Subsingleton.elim _ _

instance mulDistribMulAction [Monoid R] : MulDistribMulAction R PUnit := by
  refine' { PUnit.mulAction with .. } <;> intros <;> exact Subsingleton.elim _ _

instance mulSemiringAction [Semiring R] : MulSemiringAction R PUnit :=
  { PUnit.distribMulAction, PUnit.mulDistribMulAction with }

instance mulActionWithZero [MonoidWithZero R] : MulActionWithZero R PUnit :=
  { PUnit.mulAction, PUnit.smulWithZero with }

instance module [Semiring R] : Module R PUnit := by
  refine' { PUnit.distribMulAction with .. } <;> intros <;> exact Subsingleton.elim _ _

end PUnit


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Ken Lee, Chris Hughes
-/
import tactic.ring
import algebra.ring.basic

/-!
# Coprime elements of a ring

## Main definitions

* `is_coprime x y`: that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime.

See also `ring_theory.coprime.lemmas` for further development of coprime elements.
-/

open_locale classical

universes u v

section comm_semiring

variables {R : Type u} [comm_semiring R] (x y z : R)

/-- The proposition that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime. -/
@[simp] def is_coprime : Prop :=
∃ a b, a * x + b * y = 1

variables {x y z}

theorem is_coprime.symm (H : is_coprime x y) : is_coprime y x :=
let ⟨a, b, H⟩ := H in ⟨b, a, by rw [add_comm, H]⟩

theorem is_coprime_comm : is_coprime x y ↔ is_coprime y x :=
⟨is_coprime.symm, is_coprime.symm⟩

theorem is_coprime_self : is_coprime x x ↔ is_unit x :=
⟨λ ⟨a, b, h⟩, is_unit_of_mul_eq_one x (a + b) $ by rwa [mul_comm, add_mul],
λ h, let ⟨b, hb⟩ := is_unit_iff_exists_inv'.1 h in ⟨b, 0, by rwa [zero_mul, add_zero]⟩⟩

theorem is_coprime_zero_left : is_coprime 0 x ↔ is_unit x :=
⟨λ ⟨a, b, H⟩, is_unit_of_mul_eq_one x b $ by rwa [mul_zero, zero_add, mul_comm] at H,
λ H, let ⟨b, hb⟩ := is_unit_iff_exists_inv'.1 H in ⟨1, b, by rwa [one_mul, zero_add]⟩⟩

theorem is_coprime_zero_right : is_coprime x 0 ↔ is_unit x :=
is_coprime_comm.trans is_coprime_zero_left

lemma not_coprime_zero_zero [nontrivial R] : ¬ is_coprime (0 : R) 0 :=
mt is_coprime_zero_right.mp not_is_unit_zero

/-- If a 2-vector `p` satisfies `is_coprime (p 0) (p 1)`, then `p ≠ 0`. -/
lemma is_coprime.ne_zero [nontrivial R] {p : fin 2 → R} (h : is_coprime (p 0) (p 1)) : p ≠ 0 :=
by { rintro rfl, exact not_coprime_zero_zero h }

theorem is_coprime_one_left : is_coprime 1 x :=
⟨1, 0, by rw [one_mul, zero_mul, add_zero]⟩

theorem is_coprime_one_right : is_coprime x 1 :=
⟨0, 1, by rw [one_mul, zero_mul, zero_add]⟩

theorem is_coprime.dvd_of_dvd_mul_right (H1 : is_coprime x z) (H2 : x ∣ y * z) : x ∣ y :=
let ⟨a, b, H⟩ := H1 in by { rw [← mul_one y, ← H, mul_add, ← mul_assoc, mul_left_comm],
exact dvd_add (dvd_mul_left _ _) (H2.mul_left _) }

theorem is_coprime.dvd_of_dvd_mul_left (H1 : is_coprime x y) (H2 : x ∣ y * z) : x ∣ z :=
let ⟨a, b, H⟩ := H1 in by { rw [← one_mul z, ← H, add_mul, mul_right_comm, mul_assoc b],
exact dvd_add (dvd_mul_left _ _) (H2.mul_left _) }

theorem is_coprime.mul_left (H1 : is_coprime x z) (H2 : is_coprime y z) : is_coprime (x * y) z :=
let ⟨a, b, h1⟩ := H1, ⟨c, d, h2⟩ := H2 in
⟨a * c, a * x * d + b * c * y + b * d * z,
calc  a * c * (x * y) + (a * x * d + b * c * y + b * d * z) * z
    = (a * x + b * z) * (c * y + d * z) : by ring
... = 1 : by rw [h1, h2, mul_one]⟩

theorem is_coprime.mul_right (H1 : is_coprime x y) (H2 : is_coprime x z) : is_coprime x (y * z) :=
by { rw is_coprime_comm at H1 H2 ⊢, exact H1.mul_left H2 }

theorem is_coprime.mul_dvd (H : is_coprime x y) (H1 : x ∣ z) (H2 : y ∣ z) : x * y ∣ z :=
begin
  obtain ⟨a, b, h⟩ := H,
  rw [← mul_one z, ← h, mul_add],
  apply dvd_add,
  { rw [mul_comm z, mul_assoc],
    exact (mul_dvd_mul_left _ H2).mul_left _ },
  { rw [mul_comm b, ← mul_assoc],
    exact (mul_dvd_mul_right H1 _).mul_right _ }
end

theorem is_coprime.of_mul_left_left (H : is_coprime (x * y) z) : is_coprime x z :=
let ⟨a, b, h⟩ := H in ⟨a * y, b, by rwa [mul_right_comm, mul_assoc]⟩

theorem is_coprime.of_mul_left_right (H : is_coprime (x * y) z) : is_coprime y z :=
by { rw mul_comm at H, exact H.of_mul_left_left }

theorem is_coprime.of_mul_right_left (H : is_coprime x (y * z)) : is_coprime x y :=
by { rw is_coprime_comm at H ⊢, exact H.of_mul_left_left }

theorem is_coprime.of_mul_right_right (H : is_coprime x (y * z)) : is_coprime x z :=
by { rw mul_comm at H, exact H.of_mul_right_left }

theorem is_coprime.mul_left_iff : is_coprime (x * y) z ↔ is_coprime x z ∧ is_coprime y z :=
⟨λ H, ⟨H.of_mul_left_left, H.of_mul_left_right⟩, λ ⟨H1, H2⟩, H1.mul_left H2⟩

theorem is_coprime.mul_right_iff : is_coprime x (y * z) ↔ is_coprime x y ∧ is_coprime x z :=
by rw [is_coprime_comm, is_coprime.mul_left_iff, is_coprime_comm, @is_coprime_comm _ _ z]

theorem is_coprime.of_coprime_of_dvd_left (h : is_coprime y z) (hdvd : x ∣ y) : is_coprime x z :=
begin
  obtain ⟨d, rfl⟩ := hdvd,
  exact is_coprime.of_mul_left_left h
end

theorem is_coprime.of_coprime_of_dvd_right (h : is_coprime z y) (hdvd : x ∣ y) : is_coprime z x :=
(h.symm.of_coprime_of_dvd_left hdvd).symm

theorem is_coprime.is_unit_of_dvd (H : is_coprime x y) (d : x ∣ y) : is_unit x :=
let ⟨k, hk⟩ := d in is_coprime_self.1 $ is_coprime.of_mul_right_left $
show is_coprime x (x * k), from hk ▸ H

theorem is_coprime.is_unit_of_dvd' {a b x : R} (h : is_coprime a b) (ha : x ∣ a) (hb : x ∣ b) :
  is_unit x :=
(h.of_coprime_of_dvd_left ha).is_unit_of_dvd hb

theorem is_coprime.map (H : is_coprime x y) {S : Type v} [comm_semiring S] (f : R →+* S) :
  is_coprime (f x) (f y) :=
let ⟨a, b, h⟩ := H in ⟨f a, f b, by rw [← f.map_mul, ← f.map_mul, ← f.map_add, h, f.map_one]⟩

variables {x y z}

lemma is_coprime.of_add_mul_left_left (h : is_coprime (x + y * z) y) : is_coprime x y :=
let ⟨a, b, H⟩ := h in ⟨a, a * z + b, by simpa only [add_mul, mul_add,
    add_assoc, add_comm, add_left_comm, mul_assoc, mul_comm, mul_left_comm] using H⟩

lemma is_coprime.of_add_mul_right_left (h : is_coprime (x + z * y) y) : is_coprime x y :=
by { rw mul_comm at h, exact h.of_add_mul_left_left }

lemma is_coprime.of_add_mul_left_right (h : is_coprime x (y + x * z)) : is_coprime x y :=
by { rw is_coprime_comm at h ⊢, exact h.of_add_mul_left_left }

lemma is_coprime.of_add_mul_right_right (h : is_coprime x (y + z * x)) : is_coprime x y :=
by { rw mul_comm at h, exact h.of_add_mul_left_right }

lemma is_coprime.of_mul_add_left_left (h : is_coprime (y * z + x) y) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_left_left }

lemma is_coprime.of_mul_add_right_left (h : is_coprime (z * y + x) y) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_right_left }

lemma is_coprime.of_mul_add_left_right (h : is_coprime x (x * z + y)) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_left_right }

lemma is_coprime.of_mul_add_right_right (h : is_coprime x (z * x + y)) : is_coprime x y :=
by { rw add_comm at h, exact h.of_add_mul_right_right }

end comm_semiring

namespace is_coprime

section comm_ring

variables {R : Type u} [comm_ring R]

lemma add_mul_left_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (x + y * z) y :=
@of_add_mul_left_left R _ _ _ (-z) $
by simpa only [mul_neg_eq_neg_mul_symm, add_neg_cancel_right] using h

lemma add_mul_right_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (x + z * y) y :=
by { rw mul_comm, exact h.add_mul_left_left z }

lemma add_mul_left_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + x * z) :=
by { rw is_coprime_comm, exact h.symm.add_mul_left_left z }

lemma add_mul_right_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + z * x) :=
by { rw is_coprime_comm, exact h.symm.add_mul_right_left z }

lemma mul_add_left_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (y * z + x) y :=
by { rw add_comm, exact h.add_mul_left_left z }

lemma mul_add_right_left {x y : R} (h : is_coprime x y) (z : R) : is_coprime (z * y + x) y :=
by { rw add_comm, exact h.add_mul_right_left z }

lemma mul_add_left_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (x * z + y) :=
by { rw add_comm, exact h.add_mul_left_right z }

lemma mul_add_right_right {x y : R} (h : is_coprime x y) (z : R) : is_coprime x (z * x + y) :=
by { rw add_comm, exact h.add_mul_right_right z }

lemma add_mul_left_left_iff {x y z : R} : is_coprime (x + y * z) y ↔ is_coprime x y :=
⟨of_add_mul_left_left, λ h, h.add_mul_left_left z⟩

lemma add_mul_right_left_iff {x y z : R} : is_coprime (x + z * y) y ↔ is_coprime x y :=
⟨of_add_mul_right_left, λ h, h.add_mul_right_left z⟩

lemma add_mul_left_right_iff {x y z : R} : is_coprime x (y + x * z) ↔ is_coprime x y :=
⟨of_add_mul_left_right, λ h, h.add_mul_left_right z⟩

lemma add_mul_right_right_iff {x y z : R} : is_coprime x (y + z * x) ↔ is_coprime x y :=
⟨of_add_mul_right_right, λ h, h.add_mul_right_right z⟩

lemma mul_add_left_left_iff {x y z : R} : is_coprime (y * z + x) y ↔ is_coprime x y :=
⟨of_mul_add_left_left, λ h, h.mul_add_left_left z⟩

lemma mul_add_right_left_iff {x y z : R} : is_coprime (z * y + x) y ↔ is_coprime x y :=
⟨of_mul_add_right_left, λ h, h.mul_add_right_left z⟩

lemma mul_add_left_right_iff {x y z : R} : is_coprime x (x * z + y) ↔ is_coprime x y :=
⟨of_mul_add_left_right, λ h, h.mul_add_left_right z⟩

lemma mul_add_right_right_iff {x y z : R} : is_coprime x (z * x + y) ↔ is_coprime x y :=
⟨of_mul_add_right_right, λ h, h.mul_add_right_right z⟩

lemma neg_left {x y : R} (h : is_coprime x y) : is_coprime (-x) y :=
begin
  obtain ⟨a, b, h⟩ := h,
  use [-a, b],
  rwa neg_mul_neg,
end

lemma neg_left_iff (x y : R) : is_coprime (-x) y ↔ is_coprime x y :=
⟨λ h, neg_neg x ▸ h.neg_left, neg_left⟩

lemma neg_right {x y : R} (h : is_coprime x y) : is_coprime x (-y) :=
h.symm.neg_left.symm

lemma neg_right_iff (x y : R) : is_coprime x (-y) ↔ is_coprime x y :=
⟨λ h, neg_neg y ▸ h.neg_right, neg_right⟩

lemma neg_neg {x y : R} (h : is_coprime x y) : is_coprime (-x) (-y) :=
h.neg_left.neg_right

lemma neg_neg_iff (x y : R) : is_coprime (-x) (-y) ↔ is_coprime x y :=
(neg_left_iff _ _).trans (neg_right_iff _ _)

end comm_ring

lemma sq_add_sq_ne_zero {R : Type*} [linear_ordered_comm_ring R] {a b : R} (h : is_coprime a b) :
  a ^ 2 + b ^ 2 ≠ 0 :=
begin
  intros h',
  obtain ⟨ha, hb⟩ := (add_eq_zero_iff' (sq_nonneg a) (sq_nonneg b)).mp h',
  obtain rfl := pow_eq_zero ha,
  obtain rfl := pow_eq_zero hb,
  exact not_coprime_zero_zero h
end

end is_coprime