/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

Type class for encodable Types.
Note that every encodable Type is countable.
-/
import data.equiv.nat
import order.rel_iso
import order.directed

open option list nat function

/-- An encodable type is a "constructively countable" type. This is where
  we have an explicit injection `encode : α → nat` and a partial inverse
  `decode : nat → option α`. This makes the range of `encode` decidable,
  although it is not decidable if `α` is finite or not. -/
class encodable (α : Type*) :=
(encode : α → nat)
(decode [] : nat → option α)
(encodek : ∀ a, decode (encode a) = some a)

attribute [simp] encodable.encodek

namespace encodable
variables {α : Type*} {β : Type*}
universe u
open encodable

theorem encode_injective [encodable α] : function.injective (@encode α _)
| x y e := option.some.inj $ by rw [← encodek, e, encodek]

lemma surjective_decode_iget (α : Type*) [encodable α] [inhabited α] :
  surjective (λ n, (encodable.decode α n).iget) :=
λ x, ⟨encodable.encode x, by simp_rw [encodable.encodek]⟩

/- This is not set as an instance because this is usually not the best way
  to infer decidability. -/
def decidable_eq_of_encodable (α) [encodable α] : decidable_eq α
| a b := decidable_of_iff _ encode_injective.eq_iff

def of_left_injection [encodable α]
  (f : β → α) (finv : α → option β) (linv : ∀ b, finv (f b) = some b) : encodable β :=
⟨λ b, encode (f b),
 λ n, (decode α n).bind finv,
 λ b, by simp [encodable.encodek, linv]⟩

def of_left_inverse [encodable α]
  (f : β → α) (finv : α → β) (linv : ∀ b, finv (f b) = b) : encodable β :=
of_left_injection f (some ∘ finv) (λ b, congr_arg some (linv b))

/-- If `α` is encodable and `β ≃ α`, then so is `β` -/
def of_equiv (α) [encodable α] (e : β ≃ α) : encodable β :=
of_left_inverse e e.symm e.left_inv

@[simp] theorem encode_of_equiv {α β} [encodable α] (e : β ≃ α) (b : β) :
  @encode _ (of_equiv _ e) b = encode (e b) := rfl

@[simp] theorem decode_of_equiv {α β} [encodable α] (e : β ≃ α) (n : ℕ) :
  @decode _ (of_equiv _ e) n = (decode α n).map e.symm := rfl

instance nat : encodable nat :=
⟨id, some, λ a, rfl⟩

@[simp] theorem encode_nat (n : ℕ) : encode n = n := rfl
@[simp] theorem decode_nat (n : ℕ) : decode ℕ n = some n := rfl

instance empty : encodable empty :=
⟨λ a, a.rec _, λ n, none, λ a, a.rec _⟩

instance unit : encodable punit :=
⟨λ_, zero, λn, nat.cases_on n (some punit.star) (λ _, none), λ⟨⟩, by simp⟩

@[simp] theorem encode_star : encode punit.star = 0 := rfl

@[simp] theorem decode_unit_zero : decode punit 0 = some punit.star := rfl
@[simp] theorem decode_unit_succ (n) : decode punit (succ n) = none := rfl

instance option {α : Type*} [h : encodable α] : encodable (option α) :=
⟨λ o, option.cases_on o nat.zero (λ a, succ (encode a)),
 λ n, nat.cases_on n (some none) (λ m, (decode α m).map some),
 λ o, by cases o; dsimp; simp [encodek, nat.succ_ne_zero]⟩

@[simp] theorem encode_none [encodable α] : encode (@none α) = 0 := rfl
@[simp] theorem encode_some [encodable α] (a : α) :
  encode (some a) = succ (encode a) := rfl

@[simp] theorem decode_option_zero [encodable α] : decode (option α) 0 = some none := rfl
@[simp] theorem decode_option_succ [encodable α] (n) :
  decode (option α) (succ n) = (decode α n).map some := rfl

def decode2 (α) [encodable α] (n : ℕ) : option α :=
(decode α n).bind (option.guard (λ a, encode a = n))

theorem mem_decode2' [encodable α] {n : ℕ} {a : α} :
  a ∈ decode2 α n ↔ a ∈ decode α n ∧ encode a = n :=
by simp [decode2]; exact
⟨λ ⟨_, h₁, rfl, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨_, h₁, rfl, h₂⟩⟩

theorem mem_decode2 [encodable α] {n : ℕ} {a : α} :
  a ∈ decode2 α n ↔ encode a = n :=
mem_decode2'.trans (and_iff_right_of_imp $ λ e, e ▸ encodek _)

theorem decode2_is_partial_inv [encodable α] : is_partial_inv encode (decode2 α) :=
λ a n, mem_decode2

theorem decode2_inj [encodable α] {n : ℕ} {a₁ a₂ : α}
  (h₁ : a₁ ∈ decode2 α n) (h₂ : a₂ ∈ decode2 α n) : a₁ = a₂ :=
encode_injective $ (mem_decode2.1 h₁).trans (mem_decode2.1 h₂).symm

theorem encodek2 [encodable α] (a : α) : decode2 α (encode a) = some a :=
mem_decode2.2 rfl

def decidable_range_encode (α : Type*) [encodable α] : decidable_pred (set.range (@encode α _)) :=
λ x, decidable_of_iff (option.is_some (decode2 α x))
  ⟨λ h, ⟨option.get h, by rw [← decode2_is_partial_inv (option.get h), option.some_get]⟩,
  λ ⟨n, hn⟩, by rw [← hn, encodek2]; exact rfl⟩

def equiv_range_encode (α : Type*) [encodable α] : α ≃ set.range (@encode α _) :=
{ to_fun := λ a : α, ⟨encode a, set.mem_range_self _⟩,
  inv_fun := λ n, option.get (show is_some (decode2 α n.1),
    by cases n.2 with x hx; rw [← hx, encodek2]; exact rfl),
  left_inv := λ a, by dsimp;
    rw [← option.some_inj, option.some_get, encodek2],
  right_inv := λ ⟨n, x, hx⟩, begin
    apply subtype.eq,
    dsimp,
    conv {to_rhs, rw ← hx},
    rw [encode_injective.eq_iff, ← option.some_inj, option.some_get, ← hx, encodek2],
  end }

section sum
variables [encodable α] [encodable β]

def encode_sum : α ⊕ β → nat
| (sum.inl a) := bit0 $ encode a
| (sum.inr b) := bit1 $ encode b

def decode_sum (n : nat) : option (α ⊕ β) :=
match bodd_div2 n with
| (ff, m) := (decode α m).map sum.inl
| (tt, m) := (decode β m).map sum.inr
end

instance sum : encodable (α ⊕ β) :=
⟨encode_sum, decode_sum, λ s,
  by cases s; simp [encode_sum, decode_sum, encodek]; refl⟩

@[simp] theorem encode_inl (a : α) :
  @encode (α ⊕ β) _ (sum.inl a) = bit0 (encode a) := rfl
@[simp] theorem encode_inr (b : β) :
  @encode (α ⊕ β) _ (sum.inr b) = bit1 (encode b) := rfl
@[simp] theorem decode_sum_val (n : ℕ) :
  decode (α ⊕ β) n = decode_sum n := rfl

end sum

instance bool : encodable bool :=
of_equiv (unit ⊕ unit) equiv.bool_equiv_punit_sum_punit

@[simp] theorem encode_tt : encode tt = 1 := rfl
@[simp] theorem encode_ff : encode ff = 0 := rfl

@[simp] theorem decode_zero : decode bool 0 = some ff := rfl
@[simp] theorem decode_one : decode bool 1 = some tt := rfl

theorem decode_ge_two (n) (h : 2 ≤ n) : decode bool n = none :=
begin
  suffices : decode_sum n = none,
  { change (decode_sum n).map _ = none, rw this, refl },
  have : 1 ≤ div2 n,
  { rw [div2_val, nat.le_div_iff_mul_le],
    exacts [h, dec_trivial] },
  cases exists_eq_succ_of_ne_zero (ne_of_gt this) with m e,
  simp [decode_sum]; cases bodd n; simp [decode_sum]; rw e; refl
end

section sigma
variables {γ : α → Type*} [encodable α] [∀ a, encodable (γ a)]

def encode_sigma : sigma γ → ℕ
| ⟨a, b⟩ := mkpair (encode a) (encode b)

def decode_sigma (n : ℕ) : option (sigma γ) :=
let (n₁, n₂) := unpair n in
(decode α n₁).bind $ λ a, (decode (γ a) n₂).map $ sigma.mk a

instance sigma : encodable (sigma γ) :=
⟨encode_sigma, decode_sigma, λ ⟨a, b⟩,
  by simp [encode_sigma, decode_sigma, unpair_mkpair, encodek]⟩

@[simp] theorem decode_sigma_val (n : ℕ) : decode (sigma γ) n =
  (decode α n.unpair.1).bind (λ a, (decode (γ a) n.unpair.2).map $ sigma.mk a) :=
show decode_sigma._match_1 _ = _, by cases n.unpair; refl

@[simp] theorem encode_sigma_val (a b) : @encode (sigma γ) _ ⟨a, b⟩ =
  mkpair (encode a) (encode b) := rfl

end sigma

section prod
variables [encodable α] [encodable β]

instance prod : encodable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem decode_prod_val (n : ℕ) : decode (α × β) n =
  (decode α n.unpair.1).bind (λ a, (decode β n.unpair.2).map $ prod.mk a) :=
show (decode (sigma (λ _, β)) n).map (equiv.sigma_equiv_prod α β) = _,
by simp; cases decode α n.unpair.1; simp;
   cases decode β n.unpair.2; refl

@[simp] theorem encode_prod_val (a b) : @encode (α × β) _ (a, b) =
  mkpair (encode a) (encode b) := rfl

end prod

section subtype
open subtype decidable
variable {P : α → Prop}
variable [encA : encodable α]
variable [decP : decidable_pred P]

include encA
def encode_subtype : {a : α // P a} → nat
| ⟨v, h⟩ := encode v

include decP
def decode_subtype (v : nat) : option {a : α // P a} :=
(decode α v).bind $ λ a,
if h : P a then some ⟨a, h⟩ else none

instance subtype : encodable {a : α // P a} :=
⟨encode_subtype, decode_subtype,
 λ ⟨v, h⟩, by simp [encode_subtype, decode_subtype, encodek, h]⟩

lemma subtype.encode_eq (a : subtype P) : encode a = encode a.val :=
by cases a; refl

end subtype

instance fin (n) : encodable (fin n) :=
of_equiv _ (equiv.fin_equiv_subtype _)

instance int : encodable ℤ :=
of_equiv _ equiv.int_equiv_nat

instance ulift [encodable α] : encodable (ulift α) :=
of_equiv _ equiv.ulift

instance plift [encodable α] : encodable (plift α) :=
of_equiv _ equiv.plift

noncomputable def of_inj [encodable β] (f : α → β) (hf : injective f) : encodable α :=
of_left_injection f (partial_inv f) (λ x, (partial_inv_of_injective hf _ _).2 rfl)

end encodable

section ulower
local attribute [instance, priority 100] encodable.decidable_range_encode

/--
`ulower α : Type 0` is an equivalent type in the lowest universe, given `encodable α`.
-/
@[derive decidable_eq, derive encodable]
def ulower (α : Type*) [encodable α] : Type :=
set.range (encodable.encode : α → ℕ)

end ulower

namespace ulower
variables (α : Type*) [encodable α]

/--
The equivalence between the encodable type `α` and `ulower α : Type 0`.
-/
def equiv : α ≃ ulower α :=
encodable.equiv_range_encode α

variables {α}

/--
Lowers an `a : α` into `ulower α`.
-/
def down (a : α) : ulower α := equiv α a

instance [inhabited α] : inhabited (ulower α) := ⟨down (default _)⟩

/--
Lifts an `a : ulower α` into `α`.
-/
def up (a : ulower α) : α := (equiv α).symm a

@[simp] lemma down_up {a : ulower α} : down a.up = a := equiv.right_inv _ _
@[simp] lemma up_down {a : α} : (down a).up = a := equiv.left_inv _ _

@[simp] lemma up_eq_up {a b : ulower α} : a.up = b.up ↔ a = b :=
equiv.apply_eq_iff_eq _

@[simp] lemma down_eq_down {a b : α} : down a = down b ↔ a = b :=
equiv.apply_eq_iff_eq _

@[ext] protected lemma ext {a b : ulower α} : a.up = b.up → a = b :=
up_eq_up.1

end ulower

/-
Choice function for encodable types and decidable predicates.
We provide the following API

choose      {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] : (∃ x, p x) → α :=
choose_spec {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] (ex : ∃ x, p x) :
  p (choose ex) :=
-/

namespace encodable
section find_a
variables {α : Type*} (p : α → Prop) [encodable α] [decidable_pred p]

private def good : option α → Prop
| (some a) := p a
| none     := false

private def decidable_good : decidable_pred (good p)
| n := by cases n; unfold good; apply_instance
local attribute [instance] decidable_good

open encodable
variable {p}

def choose_x (h : ∃ x, p x) : {a:α // p a} :=
have ∃ n, good p (decode α n), from
let ⟨w, pw⟩ := h in ⟨encode w, by simp [good, encodek, pw]⟩,
match _, nat.find_spec this : ∀ o, good p o → {a // p a} with
| some a, h := ⟨a, h⟩
end

def choose (h : ∃ x, p x) : α := (choose_x h).1

lemma choose_spec (h : ∃ x, p x) : p (choose h) := (choose_x h).2

end find_a

theorem axiom_of_choice {α : Type*} {β : α → Type*} {R : Π x, β x → Prop}
  [Π a, encodable (β a)] [∀ x y, decidable (R x y)]
  (H : ∀x, ∃y, R x y) : ∃f:Πa, β a, ∀x, R x (f x) :=
⟨λ x, choose (H x), λ x, choose_spec (H x)⟩

theorem skolem {α : Type*} {β : α → Type*} {P : Π x, β x → Prop}
  [c : Π a, encodable (β a)] [d : ∀ x y, decidable (P x y)] :
  (∀x, ∃y, P x y) ↔ ∃f : Π a, β a, (∀x, P x (f x)) :=
⟨axiom_of_choice, λ ⟨f, H⟩ x, ⟨_, H x⟩⟩

/-
There is a total ordering on the elements of an encodable type, induced by the map to ℕ.
-/

/-- The `encode` function, viewed as an embedding. -/
def encode' (α) [encodable α] : α ↪ nat :=
⟨encodable.encode, encodable.encode_injective⟩

instance {α} [encodable α] : is_trans _ (encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_trans
instance {α} [encodable α] : is_antisymm _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_antisymm
instance {α} [encodable α] : is_total _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_total

end encodable

namespace directed

open encodable

variables {α : Type*} {β : Type*} [encodable α] [inhabited α]

/-- Given a `directed r` function `f : α → β` defined on an encodable inhabited type,
construct a noncomputable sequence such that `r (f (x n)) (f (x (n + 1)))`
and `r (f a) (f (x (encode a + 1))`. -/
protected noncomputable def sequence {r : β → β → Prop} (f : α → β) (hf : directed r f) : ℕ → α
| 0       := default α
| (n + 1) :=
  let p := sequence n in
  match decode α n with
  | none     := classical.some (hf p p)
  | (some a) := classical.some (hf p a)
  end

lemma sequence_mono_nat {r : β → β → Prop} {f : α → β} (hf : directed r f) (n : ℕ) :
  r (f (hf.sequence f n)) (f (hf.sequence f (n+1))) :=
begin
  dsimp [directed.sequence],
  generalize eq : hf.sequence f n = p,
  cases h : decode α n with a,
  { exact (classical.some_spec (hf p p)).1 },
  { exact (classical.some_spec (hf p a)).1 }
end

lemma rel_sequence {r : β → β → Prop} {f : α → β} (hf : directed r f) (a : α) :
  r (f a) (f (hf.sequence f (encode a + 1))) :=
begin
  simp only [directed.sequence, encodek],
  exact (classical.some_spec (hf _ a)).2
end

variables [preorder β] {f : α → β} (hf : directed (≤) f)

lemma sequence_mono : monotone (f ∘ (hf.sequence f)) :=
monotone_of_monotone_nat $ hf.sequence_mono_nat

lemma le_sequence (a : α) : f a ≤ f (hf.sequence f (encode a + 1)) :=
hf.rel_sequence a

end directed

section quotient
open encodable quotient
variables {α : Type*} {s : setoid α} [@decidable_rel α (≈)] [encodable α]

/-- Representative of an equivalence class. This is a computable version of `quot.out` for a setoid
on an encodable type. -/
def quotient.rep (q : quotient s) : α :=
choose (exists_rep q)

theorem quotient.rep_spec (q : quotient s) : ⟦q.rep⟧ = q :=
choose_spec (exists_rep q)

/-- The quotient of an encodable space by a decidable equivalence relation is encodable. -/
def encodable_quotient : encodable (quotient s) :=
⟨λ q, encode q.rep,
 λ n, quotient.mk <$> decode α n,
 by rintros ⟨l⟩; rw encodek; exact congr_arg some ⟦l⟧.rep_spec⟩

end quotient


import data.real.basic
import tactic
import algebra.ring
import game.sets.sets_level10
import game.sets.sqrt2NotRational
import data.real.irrational

def embedded_irrationals : set ℝ := { x : ℝ | ¬ ∃ r : ℚ, x = (r : ℝ) }
def Irr : set ℝ := {x | ∀ r : ℚ, x ≠ ↑r}

lemma sqrt2_irrational : real.sqrt 2 ∈ Irr :=
begin
  intro h,
  intro j,
  --unfold real.sqrt at j,
  have Y := rational_not_sqrt_two,
  push_neg at Y,
  have I : (real.sqrt 2) ^ 2 = 2, simp,
  specialize Y (↑h),
  rw j at I,
  norm_cast at *,
end

lemma rat_minus_rat_eq_rat {a b: ℚ} : ∃c : ℚ, a - b = c :=
begin

end

lemma any_plus_irr_eq_irr {b : Irr} {a : ℚ}  : ((a : ℝ) + (b : ℝ)) ∈ Irr :=
begin
  intro j,
  intro k,
  have P : (b : ℝ) = (j : ℝ) - (a : ℝ),
  linarith,

end

theorem irrat_dense_in_R : dense_in_R embedded_irrationals :=
begin
  intros h j k,
  have x : 0 < j - h,
  simp,
  exact k,
  have y : 0 < (j - (real.sqrt 2)) - (h - (real.sqrt 2)),
  linarith,
  have p := archimedean_R ((j - real.sqrt 2) - (h - real.sqrt 2)),
  have t := p(y),
  cases t with n hn,
  cases hn with v hv,
  have v1 : 0 < (n : ℝ), simp, exact v,
  have g : 0 < (j - real.sqrt 2 - h + real.sqrt 2 - 1 / (n : ℝ)), linarith,
  have s : 0 < (n : ℝ) * (j - real.sqrt 2 - h + real.sqrt 2 - 1 / (n : ℝ)),
  revert g,
  revert v1,
  exact mul_pos,

  have F := has_ceiling ((n : ℝ) * (j - real.sqrt 2 - h + real.sqrt 2 - 1 / (n : ℝ))),
  cases F with m hm,
  cases hm with z hz,
  have J : j - real.sqrt 2 - h + real.sqrt 2 - 1 / (n : ℝ) = (j - real.sqrt 2) + (-h + real.sqrt 2)
   + (-1 / (n : ℝ)),
  ring,
  rw J at s,
  have P : (j - real.sqrt 2 + (-h + real.sqrt 2)) = ((j - real.sqrt 2) + (-h + real.sqrt 2)),
  linarith,

  rw P at s,
  rw add_assoc at s,
  rw left_distrib at s,
  rw left_distrib at s,
  field_simp at s,
  have L : - (n : ℝ) / (n : ℝ) = -1,
  ring,
  rw inv_mul_cancel,
  linarith,
  rw L at s,
  rw left_distrib at s,
  have I : j - real.sqrt 2 = j + (- real.sqrt 2),
  linarith,
  rw I at s,
  rw left_distrib at s,

  have D := has_ceiling (↑n * h - ↑n * real.sqrt 2),
  cases D with r hr,
  cases hr with b hb,
  have U : ↑r ≤ ↑n * h - ↑n * real.sqrt 2 + 1,
  linarith,
  use ((↑r / ↑n) + real.sqrt 2 : ℝ),
  split,
  unfold embedded_irrationals,
  push_neg,
  simp,
  intro e,
  have B := sqrt2_irrational,

  use ((↑r / ↑n) + real.sqrt 2 : ℝ),
  unfold set.Ioo,
  split,
  have duh2 : ↑n * (h - real.sqrt 2) = ↑n * h - ↑n * real.sqrt 2, linarith,
  have Y : (↑n * (h - real.sqrt 2)) * (1 / ↑n) < ↑r * (1 / ↑n),
  rw duh2,
  finish,

  rw mul_assoc at Y,
  rw mul_comm ↑n _ at Y,
  rw mul_assoc at Y,
  rw inv_prod_self at Y,
  swap,
  exact v,
  rw mul_one at Y,
  field_simp at Y,
  linarith,

  have HP : ↑r < (j - real.sqrt 2) * ↑n,
  linarith,
  have P : ↑r * (1 / ↑n) < ((j - real.sqrt 2) * ↑n) * (1 / ↑n),
  finish,

  rw mul_assoc at P,
  rw mul_comm ↑n _ at P,
  rw inv_prod_self at P,
  swap,
  exact v,
  rw mul_one at P,
  field_simp at P,
  linarith,

end


import data.real.basic
import data.real.nnreal

theorem USAMO_problem_5_1997 (a b c : nnreal) :
1 / (a^3 + b^3 +a*b*c) + 1 / (b^3 + c^3 +a*b*c) + 1 /(a^3 + c^3 + a*b*c) ≤ 1 /(a*b*c) := sorry


import propositional_logic.imp_elim -- hide

/-
# Propositional logic
## Level 5: Implication introduction

To prove $p \to q$ it to assume $p$ and derive $q$.

In Lean, if the target is `p → q`, typing `assume h : p` introduces `h : p` into the context
and replaces the target with one of proving `q`.

Here, we prove $(p \land q) \to p$.
-/

variables (p q : Prop) -- hide

example : (p ∧ q) → p :=
begin
  assume h : p ∧ q,
  show p, from h.left,
end

namespace hidden -- hide

/-
A useful result, `id` asserts that `s → s`, for any `s`.
-/

/- Axiom : id {p} :
p → p
-/

variable (s : Prop) -- hide

lemma id : s → s :=
begin
  assume h : s,
  show s, from h,
end

end hidden -- hide

namespace exlean -- hide

/-
In the fun example below, we prove $p \to (q \to p)$.
-/

example : p → (q → p) :=
begin
  assume h₁ : p,
  show q → p,
  assume h₂ : q,
  show p, from h₁,
end

/-
## Task

Prove the following result in Lean.
-/

/- Theorem : no-side-bar
Let $p$ and $q$ be propositions. Then $(p \land q) \to p$.
-/
theorem imp_intro_example : (p ∧ q) → p :=
begin
  assume h : p ∧ q,
  show p, from h.left,

end

end exlean -- hide


-- linear orders in the sense of nLab:
-- https://ncatlab.org/nlab/show/linear+order

import logic.definite_description
import logic.idecidable

/-!
 * Main classes
--/
--- `is_linear_comparable X r` means the binary relation `r` on `X` satisfies the comparison axiom, which is involved with a kind of totality.
class is_linear_comparable (α : Type*) (r : α → α → Prop) : Prop :=
  (linear_comparable : ∀ a b c, r a b → r c b ∨ r a c)

--- `is_connected X r` means the binary relation `r` on `X` is connected; that is, the comparability under `r` is a tight apartness relation on `X`.
class is_connected (α : Type*) (r : α → α → Prop) : Prop :=
  (connected : ∀ a b, ¬ r a b → ¬ r b a → a = b)

--- `is_strict_linear_order X r` means the binary relation `r` on `X` is a linear order in the sense of nLab (see https://ncatlab.org/nlab/show/linear+order).
class is_strict_linear_order (α : Type*) (r : α → α → Prop) extends is_strict_order α r, is_asymm α r, is_linear_comparable α r, is_connected α r : Prop

/-!
 * Lemmas
--/

-- trichotomous axiom and transitivity implies linearly comparability.
lemma is_linear_comparable_of_is_trichotomous_of_is_trans {α : Type*} (r : α → α → Prop) [is_trichotomous α r] [is_trans α r] : is_linear_comparable α r :=
  begin
    constructor,
    intros a b c hab,
    cases @trichotomous _ r _ a c with hac h,
    case or.inl {
      right; assumption
    },
    case or.inr {
      cases h with heq hca,
      case or.inl {
        rw heq at hab,
        left; assumption
      },
      case or.inr {
        have : r c b := trans hca hab,
        left; exact this
      }
    }
  end

-- Every trichotomous relation is connected
lemma is_connected_of_is_trichotomous {α : Type*} (r : α → α → Prop) [is_trichotomous α r] : is_connected α r :=
  begin
    constructor,
    intros a b hnab hnba,
    apply @eq_of_incomp α r _ a b,
    exact and.intro hnab hnba
  end

lemma is_incomp_trans_of_is_connected {α : Type*} (r : α → α → Prop) [hc : is_connected α r] : is_incomp_trans α r :=
  begin
    constructor,
    intros a b c hab hbc,
    have : a=b := @is_connected.connected _ _ hc _ _ hab.left hab.right,
    rw [this],
    assumption
  end

instance idecidable_of_is_trichotomous_of_is_asymm {α : Type*} (r : α → α → Prop) [is_trichotomous α r] [is_asymm α r] : idecidable_rel r :=
  begin
    intros a b,
    cases @trichotomous α r _ a b,
    case or.inl { constructor; left; assumption },
    case or.inr {
      constructor; right,
      cases h,
      case or.inl {
        cases h,
        intros h,
        exact absurd h (asymm h),
      },
      case or.inr { exact asymm h }
    }
  end

lemma is_trichotomous_of_is_connected {α : Type*} (r : α → α → Prop) [decr : idecidable_rel r] [is_connected α r] : is_trichotomous α r :=
  begin
    constructor,
    intros a b,
    cases (decr a b).is_either with _ hnab,
    case or.inl { left; assumption },
    case or.inr {
      cases (decr b a).is_either with _ hnba,
      case or.inl { right; right; assumption },
      case or.inr {
        right; left,
        exact is_connected.connected a b hnab hnba
      }
    }
  end

/-!
 * Main theorems
--/

instance is_strict_linear_order_of_is_strict_total_order {α : Type*} (r : α → α → Prop) [hsto : is_strict_total_order α r] : is_strict_linear_order α r :=
  {
    to_is_strict_order := hsto.to_is_strict_order,
    to_is_asymm := is_asymm_of_is_trans_of_is_irrefl,
    to_is_linear_comparable :=
      is_linear_comparable_of_is_trichotomous_of_is_trans r,
    to_is_connected :=
      is_connected_of_is_trichotomous r
  }

instance is_strict_total_order_of_is_strict_linear_order {α : Type*} (r : α → α → Prop) [idecidable_rel r] [hslo : is_strict_linear_order α r] : is_strict_total_order α r :=
  {
    to_is_strict_weak_order :=
      {
        to_is_strict_order := hslo.to_is_strict_order,
        to_is_incomp_trans := is_incomp_trans_of_is_connected r,
      },
    to_is_trichotomous := is_trichotomous_of_is_connected r
  }


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

import algebra.order.field
import algebra.smul_with_zero
import group_theory.group_action.group

/-!
# Ordered scalar product

In this file we define

* `ordered_smul R M` : an ordered additive commutative monoid `M` is an `ordered_smul`
  over an `ordered_semiring` `R` if the scalar product respects the order relation on the
  monoid and on the ring. There is a correspondence between this structure and convex cones,
  which is proven in `analysis/convex/cone.lean`.

## Implementation notes

* We choose to define `ordered_smul` as a `Prop`-valued mixin, so that it can be
  used for actions, modules, and algebras
  (the axioms for an "ordered algebra" are exactly that the algebra is ordered as a module).
* To get ordered modules and ordered vector spaces, it suffices to replace the
  `order_add_comm_monoid` and the `ordered_semiring` as desired.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered scalar, ordered smul, ordered action, ordered vector space
-/

/--
The ordered scalar product property is when an ordered additive commutative monoid
with a partial order has a scalar multiplication which is compatible with the order.
-/
@[protect_proj]
class ordered_smul (R M : Type*)
  [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] : Prop :=
(smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, a < b → 0 < c → c • a < c • b)
(lt_of_smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, c • a < c • b → 0 < c → a < b)

namespace order_dual

variables {R M : Type*}

instance [has_scalar R M] : has_scalar R Mᵒᵈ := ⟨λ k x, order_dual.rec (λ x', (k • x' : M)) x⟩

instance [has_zero R] [add_zero_class M] [h : smul_with_zero R M] : smul_with_zero R Mᵒᵈ :=
{ zero_smul := λ m, order_dual.rec (zero_smul _) m,
  smul_zero := λ r, order_dual.rec (smul_zero' _) r,
  ..order_dual.has_scalar }

instance [monoid R] [mul_action R M] : mul_action R Mᵒᵈ :=
{ one_smul := λ m, order_dual.rec (one_smul _) m,
  mul_smul := λ r, order_dual.rec mul_smul r,
  ..order_dual.has_scalar }

instance [monoid_with_zero R] [add_monoid M] [mul_action_with_zero R M] :
  mul_action_with_zero R Mᵒᵈ :=
{ ..order_dual.mul_action, ..order_dual.smul_with_zero }

instance [monoid_with_zero R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action R Mᵒᵈ :=
{ smul_add := λ k a, order_dual.rec (λ a' b, order_dual.rec (smul_add _ _) b) a,
  smul_zero := λ r, order_dual.rec smul_zero r }

instance [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M]
  [ordered_smul R M] :
  ordered_smul R Mᵒᵈ :=
{ smul_lt_smul_of_pos := λ a b, @ordered_smul.smul_lt_smul_of_pos R M _ _ _ _ b a,
  lt_of_smul_lt_smul_of_pos := λ a b,
    @ordered_smul.lt_of_smul_lt_smul_of_pos R M _ _ _ _ b a }

@[simp] lemma to_dual_smul [has_scalar R M] {c : R} {a : M} : to_dual (c • a) = c • to_dual a := rfl
@[simp] lemma of_dual_smul [has_scalar R M] {c : R} {a : Mᵒᵈ} : of_dual (c • a) = c • of_dual a :=
rfl

end order_dual

section ordered_smul

variables {R M : Type*}
  [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M]
  {a b : M} {c : R}

lemma smul_lt_smul_of_pos : a < b → 0 < c → c • a < c • b := ordered_smul.smul_lt_smul_of_pos

lemma smul_le_smul_of_nonneg (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c • a ≤ c • b :=
begin
  rcases h₁.eq_or_lt with rfl|hab,
  { refl },
  { rcases h₂.eq_or_lt with rfl|hc,
    { rw [zero_smul, zero_smul] },
    { exact (smul_lt_smul_of_pos hab hc).le } }
end

lemma smul_nonneg (hc : 0 ≤ c) (ha : 0 ≤ a) : 0 ≤ c • a :=
calc (0 : M) = c • (0 : M) : (smul_zero' M c).symm
         ... ≤ c • a : smul_le_smul_of_nonneg ha hc

lemma smul_nonpos_of_nonneg_of_nonpos (hc : 0 ≤ c) (ha : a ≤ 0) : c • a ≤ 0 :=
@smul_nonneg R Mᵒᵈ _ _ _ _ _ _ hc ha

lemma eq_of_smul_eq_smul_of_pos_of_le (h₁ : c • a = c • b) (hc : 0 < c) (hle : a ≤ b) :
  a = b :=
hle.lt_or_eq.resolve_left $ λ hlt, (smul_lt_smul_of_pos hlt hc).ne h₁

lemma lt_of_smul_lt_smul_of_nonneg (h : c • a < c • b) (hc : 0 ≤ c) : a < b :=
hc.eq_or_lt.elim (λ hc, false.elim $ lt_irrefl (0:M) $ by rwa [← hc, zero_smul, zero_smul] at h)
  (ordered_smul.lt_of_smul_lt_smul_of_pos h)

lemma smul_lt_smul_iff_of_pos (hc : 0 < c) : c • a < c • b ↔ a < b :=
⟨λ h, lt_of_smul_lt_smul_of_nonneg h hc.le, λ h, smul_lt_smul_of_pos h hc⟩

lemma smul_pos_iff_of_pos (hc : 0 < c) : 0 < c • a ↔ 0 < a :=
calc 0 < c • a ↔ c • 0 < c • a : by rw smul_zero'
           ... ↔ 0 < a         : smul_lt_smul_iff_of_pos hc

alias smul_pos_iff_of_pos ↔ _ smul_pos

lemma monotone_smul_left (hc : 0 ≤ c) : monotone (has_scalar.smul c : M → M) :=
λ a b h, smul_le_smul_of_nonneg h hc

lemma strict_mono_smul_left (hc : 0 < c) : strict_mono (has_scalar.smul c : M → M) :=
λ a b h, smul_lt_smul_of_pos h hc

end ordered_smul

/-- If `R` is a linear ordered semifield, then it suffices to verify only the first axiom of
`ordered_smul`. Moreover, it suffices to verify that `a < b` and `0 < c` imply
`c • a ≤ c • b`. We have no semifields in `mathlib`, so we use the assumption `∀ c ≠ 0, is_unit c`
instead. -/
lemma ordered_smul.mk'' {R M : Type*} [linear_ordered_semiring R] [ordered_add_comm_monoid M]
  [mul_action_with_zero R M] (hR : ∀ {c : R}, c ≠ 0 → is_unit c)
  (hlt : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a ≤ c • b) :
  ordered_smul R M :=
begin
  have hlt' : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a < c • b,
  { refine λ a b c hab hc, (hlt hab hc).lt_of_ne _,
    rw [ne.def, (hR hc.ne').smul_left_cancel],
    exact hab.ne },
  refine { smul_lt_smul_of_pos := hlt', .. },
  intros a b c h hc,
  rcases (hR hc.ne') with ⟨c, rfl⟩,
  rw [← inv_smul_smul c a, ← inv_smul_smul c b],
  refine hlt' h (pos_of_mul_pos_left _ hc.le),
  simp only [c.mul_inv, zero_lt_one]
end

/-- If `R` is a linear ordered field, then it suffices to verify only the first axiom of
`ordered_smul`. -/
lemma ordered_smul.mk' {k M : Type*} [linear_ordered_field k] [ordered_add_comm_monoid M]
  [mul_action_with_zero k M] (hlt : ∀ ⦃a b : M⦄ ⦃c : k⦄, a < b → 0 < c → c • a ≤ c • b) :
  ordered_smul k M :=
ordered_smul.mk'' (λ c hc, is_unit.mk0 _ hc) hlt

instance linear_ordered_semiring.to_ordered_smul {R : Type*} [linear_ordered_semiring R] :
  ordered_smul R R :=
{ smul_lt_smul_of_pos        := ordered_semiring.mul_lt_mul_of_pos_left,
  lt_of_smul_lt_smul_of_pos  := λ _ _ _ h hc, lt_of_mul_lt_mul_left h hc.le }

section field

variables {k M : Type*} [linear_ordered_field k]
  [ordered_add_comm_group M] [mul_action_with_zero k M] [ordered_smul k M]
  {a b : M} {c : k}

lemma smul_le_smul_iff_of_pos (hc : 0 < c) : c • a ≤ c • b ↔ a ≤ b :=
⟨λ h, inv_smul_smul₀ hc.ne' a ▸ inv_smul_smul₀ hc.ne' b ▸
  smul_le_smul_of_nonneg h (inv_nonneg.2 hc.le),
  λ h, smul_le_smul_of_nonneg h hc.le⟩

lemma smul_lt_iff_of_pos (hc : 0 < c) : c • a < b ↔ a < c⁻¹ • b :=
calc c • a < b ↔ c • a < c • c⁻¹ • b : by rw [smul_inv_smul₀ hc.ne']
... ↔ a < c⁻¹ • b : smul_lt_smul_iff_of_pos hc

lemma lt_smul_iff_of_pos (hc : 0 < c) : a < c • b ↔ c⁻¹ • a < b :=
calc a < c • b ↔ c • c⁻¹ • a < c • b : by rw [smul_inv_smul₀ hc.ne']
... ↔ c⁻¹ • a < b : smul_lt_smul_iff_of_pos hc

lemma smul_le_iff_of_pos (hc : 0 < c) : c • a ≤ b ↔ a ≤ c⁻¹ • b :=
calc c • a ≤ b ↔ c • a ≤ c • c⁻¹ • b : by rw [smul_inv_smul₀ hc.ne']
... ↔ a ≤ c⁻¹ • b : smul_le_smul_iff_of_pos hc

lemma le_smul_iff_of_pos (hc : 0 < c) : a ≤ c • b ↔ c⁻¹ • a ≤ b :=
calc a ≤ c • b ↔ c • c⁻¹ • a ≤ c • b : by rw [smul_inv_smul₀ hc.ne']
... ↔ c⁻¹ • a ≤ b : smul_le_smul_iff_of_pos hc

variables (M)

/-- Left scalar multiplication as an order isomorphism. -/
@[simps] def order_iso.smul_left {c : k} (hc : 0 < c) : M ≃o M :=
{ to_fun := λ b, c • b,
  inv_fun := λ b, c⁻¹ • b,
  left_inv := inv_smul_smul₀ hc.ne',
  right_inv := smul_inv_smul₀ hc.ne',
  map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_pos hc }

end field


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

! This file was ported from Lean 3 source module topology.instances.sign
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Sign
import Mathlib.Topology.Order.Basic

/-!
# Topology on `SignType`

This file gives `SignType` the discrete topology, and proves continuity results for `SignType.sign`
in an `OrderTopology`.

-/

instance : TopologicalSpace SignType :=
  ⊥

instance : DiscreteTopology SignType :=
  ⟨rfl⟩

variable {α : Type _} [Zero α] [TopologicalSpace α]

section PartialOrder

variable [PartialOrder α] [DecidableRel ((· < ·) : α → α → Prop)] [OrderTopology α]

theorem continuousAt_sign_of_pos {a : α} (h : 0 < a) : ContinuousAt SignType.sign a := by
  refine' (continuousAt_const : ContinuousAt (fun _ => (1 : SignType)) a).congr _
  rw [Filter.EventuallyEq, eventually_nhds_iff]
  exact ⟨{ x | 0 < x }, fun x hx => (sign_pos hx).symm, isOpen_lt' 0, h⟩
#align continuous_at_sign_of_pos continuousAt_sign_of_pos

theorem continuousAt_sign_of_neg {a : α} (h : a < 0) : ContinuousAt SignType.sign a := by
  refine' (continuousAt_const : ContinuousAt (fun x => (-1 : SignType)) a).congr _
  rw [Filter.EventuallyEq, eventually_nhds_iff]
  exact ⟨{ x | x < 0 }, fun x hx => (sign_neg hx).symm, isOpen_gt' 0, h⟩
#align continuous_at_sign_of_neg continuousAt_sign_of_neg

end PartialOrder

section LinearOrder

variable [LinearOrder α] [OrderTopology α]

theorem continuousAt_sign_of_ne_zero {a : α} (h : a ≠ 0) : ContinuousAt SignType.sign a := by
  rcases h.lt_or_lt with (h_neg | h_pos)
  · exact continuousAt_sign_of_neg h_neg
  · exact continuousAt_sign_of_pos h_pos
#align continuous_at_sign_of_ne_zero continuousAt_sign_of_ne_zero

end LinearOrder


import tactic.basic
import logic.equiv.basic
import data.subtype

-- Useful utilities.

class has_abs (α : Type*) := (abs : α → α)
export has_abs (abs)
notation `|`a`|` := abs a

namespace nat

theorem mul_ne_zero {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 :=
begin
  obtain ⟨a₂, ha₂⟩ := nat.exists_eq_succ_of_ne_zero ha,
  obtain ⟨b₂, hb₂⟩ := nat.exists_eq_succ_of_ne_zero hb,
  rw ha₂,
  rw hb₂,
  rw nat.succ_mul,
  rw nat.mul_succ,
  have b₂_ne_zero : b₂.succ ≠ 0 := nat.succ_ne_zero b₂,
  by_contradiction h,
  have b₂_eq_zero := nat.eq_zero_of_add_eq_zero_left h,
  exact b₂_ne_zero b₂_eq_zero
end

end nat

namespace int

lemma nonpos_of_mul_pos {a b : ℤ} (hb : 0 < b) (h : a * b ≤ 0) : a ≤ 0 :=
begin
  obtain ⟨n, hn⟩ := int.exists_eq_neg_of_nat h,
  obtain ⟨c, hc⟩ := int.eq_succ_of_zero_lt hb,
  rw hc at hn,
  by_contradiction ha,
  push_neg at ha,
  obtain ⟨m, hm⟩ := int.eq_succ_of_zero_lt ha,
  rw hm at hn,
  rw ← int.coe_nat_mul at hn,
  have : ↑(m.succ * c.succ) + ↑n = -↑n + ↑n, { rw hn },
  rw int.add_left_neg at this,
  rw ← int.coe_nat_add at this,
  change ↑(m.succ * c.succ + n) = ↑0 at this,
  rw int.coe_nat_eq_coe_nat_iff at this,
  have := nat.eq_zero_of_add_eq_zero_right this,
  tauto
end

lemma neg_or_neg_neg (a : ℤ) : a ≤ 0 ∨ -a ≤ 0 :=
begin
  convert int.le_total a 0 using 1,
  simp,
  split,
  { intro h,
    have := int.neg_le_neg h,
    rw int.neg_zero at this,
    rwa int.neg_neg at this },
  { intro h,
    have := int.neg_le_neg h,
    rwa int.neg_zero at this }
end

lemma sign_succ (a : ℕ) : sign ↑(a.succ) = 1 := rfl

lemma sign_neg_succ (a : ℕ) : sign -[1+ a] = -1 := rfl

lemma nat_abs_of_sign_mul : ∀ (a : ℤ), ↑(nat_abs a) = sign a * a
| (n+1:ℕ) := begin
  rw nat_abs_of_nat,
  rw sign_succ,
  rw int.one_mul
end
| 0       := rfl
| -[1+ n] := begin
  rw sign_neg_succ,
  rw ← int.neg_eq_neg_one_mul,
  refl
end

def abs (x : ℤ) : ℤ := if 0 ≤ x then x else -x
instance : has_abs ℤ := ⟨abs⟩

lemma abs_def (a : ℤ)
  : abs a = if 0 ≤ a then a else -a := rfl

end int

-- A representation of a rational.
structure rat_repr :=
(num : ℤ)
(denom : ℕ)
(pos : denom ≠ 0)

namespace rat_repr

def of_int (n : ℤ) : rat_repr := ⟨n, 1, nat.one_ne_zero⟩

instance : has_zero rat_repr := ⟨of_int 0⟩
instance : has_one rat_repr := ⟨of_int 1⟩
@[simp] lemma zero_def : (0 : rat_repr) = ⟨0, 1, nat.one_ne_zero⟩ := rfl -- works
@[simp] lemma one_def : (1 : rat_repr) = ⟨1, 1, nat.one_ne_zero⟩ := rfl

lemma denom_nonneg (p : rat_repr) : (0 : ℤ) ≤ ↑p.denom := int.zero_le_of_nat p.denom
lemma denom_pos (p : rat_repr) : 0 < p.denom :=
begin
  have := p.pos,
  cases p.denom,
  { exfalso, exact this rfl },
  exact nat.zero_lt_succ n
end
lemma coe_denom_pos (p : rat_repr) : (0 : ℤ) < ↑p.denom :=
  int.coe_nat_lt_coe_nat_of_lt p.denom_pos

-- Rational representations are equal if their cross-multiplication is equal.
def r (p q : rat_repr) : Prop :=
p.num * q.denom = q.num * p.denom

def r_refl : reflexive r :=
begin
  intro x,
  unfold r
end

def r_symm : symmetric r :=
begin
  intros x y h,
  unfold r at *,
  rw h,
end

def r_trans : transitive r :=
begin
  intros x y z h₁ h₂,
  unfold r at *,
  have : ↑y.denom ≠ (0 : ℤ),
  { rw ← int.coe_nat_zero,
    by_contradiction,
    exact y.pos (int.coe_nat_inj h) },
  refine int.eq_of_mul_eq_mul_left this _,
  rw [
    ← int.mul_assoc,
    int.mul_comm ↑y.denom,
    h₁,
    int.mul_assoc,
    ← int.mul_comm ↑z.denom,
    ← int.mul_assoc,
    h₂,
    int.mul_comm z.num,
    int.mul_assoc
  ]
end

instance setoid : setoid rat_repr := ⟨r, r_refl, r_symm, r_trans⟩

@[simp] lemma equiv_def (p q : rat_repr)
  : p ≈ q ↔ p.num * q.denom = q.num * p.denom
  := by refl

-- Negation

def neg (p : rat_repr) : rat_repr := ⟨-p.num, p.denom, p.pos⟩

instance : has_neg rat_repr := ⟨neg⟩

@[simp] lemma neg_def (p : rat_repr)
  : -p = ⟨-p.num, p.denom, p.pos⟩ := rfl

lemma neg_respects_r {a b : rat_repr} (h : a ≈ b) : -a ≈ -b :=
begin
  simp at *,
  rw ← int.neg_mul_eq_neg_mul,
  rw ← int.neg_mul_eq_neg_mul,
  rw h
end

@[simp] lemma neg_num_def (p : rat_repr)
  : (-p).num = -p.num := rfl

@[simp] lemma neg_denom_def (p : rat_repr)
  : (-p).denom = p.denom := rfl

-- Addition

def add (p q : rat_repr) : rat_repr :=
⟨p.num * q.denom + q.num * p.denom, p.denom * q.denom, nat.mul_ne_zero p.pos q.pos⟩

instance : has_add rat_repr := ⟨add⟩

def sub (p q : rat_repr) : rat_repr := p + -q
instance : has_sub rat_repr := ⟨sub⟩

@[simp] lemma add_def (p q : rat_repr)
  : p + q = ⟨p.num * q.denom + q.num * p.denom, p.denom * q.denom, nat.mul_ne_zero p.pos q.pos⟩
  := rfl

@[simp] lemma sub_def (p q : rat_repr) : p - q = p + -q := rfl

lemma add_respects_r {a₁ a₂ b₁ b₂ : rat_repr}
  (h₁ : a₁ ≈ b₁) (h₂ : a₂ ≈ b₂)
  : a₁ + a₂ ≈ b₁ + b₂ :=
begin
  simp at *,
  repeat { rw int.distrib_right },
  repeat { rw int.coe_nat_mul },
  have : a₁.num * ↑(a₂.denom) * (↑(b₁.denom) * ↑(b₂.denom)) = b₁.num * ↑(b₂.denom) * (↑(a₁.denom) * ↑(a₂.denom)),
  { rw int.mul_assoc,
    rw ← int.mul_assoc ↑a₂.denom,
    rw int.mul_comm ↑a₂.denom,
    rw int.mul_assoc ↑b₁.denom,
    rw ← int.mul_assoc,
    rw h₁,
    rw int.mul_assoc,
    rw int.mul_assoc,
    rw int.mul_comm ↑a₂.denom,
    rw ← int.mul_assoc ↑a₁.denom,
    rw int.mul_comm ↑a₁.denom,
    rw int.mul_assoc ↑b₂.denom },
  rw this,
  have : a₂.num * ↑(a₁.denom) * (↑(b₁.denom) * ↑(b₂.denom)) = b₂.num * ↑(b₁.denom) * (↑(a₁.denom) * ↑(a₂.denom)),
  { rw int.mul_comm ↑b₁.denom,
    rw int.mul_assoc,
    rw ← int.mul_assoc ↑a₁.denom,
    rw int.mul_comm ↑a₁.denom,
    rw int.mul_assoc ↑b₂.denom,
    rw ← int.mul_assoc,
    rw h₂,
    rw int.mul_assoc,
    rw int.mul_assoc,
    rw int.mul_comm ↑a₂.denom,
    rw ← int.mul_assoc ↑b₁.denom,
    rw int.mul_comm ↑a₁.denom },
  rw this
end

lemma sub_respects_r {a₁ a₂ b₁ b₂ : rat_repr}
  (h₁ : a₁ ≈ b₁) (h₂ : a₂ ≈ b₂)
  : a₁ - a₂ ≈ b₁ - b₂ :=
begin
  apply add_respects_r,
  assumption,
  apply neg_respects_r,
  assumption
end

def add_comm : ∀ a b : rat_repr, a + b = b + a :=
begin
  rintros ⟨num₁, denom₁, h₁⟩ ⟨num₂, denom₂, h₂⟩,
  simp,
  split,
  rw int.add_comm,
  rw nat.mul_comm
end

def add_assoc : ∀ a b c : rat_repr, a + b + c ≈ a + (b + c) :=
begin
  intros a b c,
  simp,
  congr' 1,
  { rw int.distrib_right,
    rw int.distrib_right,
    rw int.add_assoc,
    congr' 1,
    { rw int.mul_assoc,
      rw int.coe_nat_mul },
    { congr' 1,
      { rw int.mul_assoc,
        rw int.mul_assoc,
        rw int.mul_comm ↑a.denom },
      { rw int.coe_nat_mul,
        rw int.mul_comm ↑a.denom,
        rw int.mul_assoc } } },
  { rw nat.mul_assoc }
end

@[simp] lemma zero_add (a : rat_repr) : 0 + a = a :=
begin
  obtain ⟨num, denom, h⟩ := a,
  simp,
  split,
  { rw int.zero_mul,
    rw int.zero_add,
    change num * 1 = num,
    rw int.mul_one },
  { rw nat.one_mul }
end

@[simp] lemma add_zero (a : rat_repr) : a + 0 = a :=
begin
  rw add_comm,
  exact zero_add a
end

@[simp] lemma add_left_neg (a : rat_repr) : -a + a ≈ 0 :=
begin
  obtain ⟨num, denom, h⟩ := a,
  simp,
  rw int.zero_mul,
  change (-num * ↑denom + num * ↑denom) * 1 = 0,
  rw int.mul_one,
  rw ← int.distrib_right,
  rw int.add_left_neg,
  rw int.zero_mul
end

@[simp] lemma add_right_neg (a : rat_repr) : a + -a ≈ 0 :=
begin
  rw add_comm,
  exact add_left_neg a
end

-- Comparison
def le (a b : rat_repr) : Prop := (a - b).num ≤ 0
instance : has_le rat_repr := ⟨le⟩

@[simp] lemma le_def (a b : rat_repr)
  : a ≤ b ↔ (a - b).num ≤ 0 := by refl

/-
lemma le_zero_iff (a b : rat_repr)
  : a ≤ b ↔ a - b ≤ 0 :=
begin
  simp,
  change
    a.num * ↑(b.denom) + -b.num * ↑(a.denom) ≤ 0 ↔
    (a.num * ↑(b.denom) + -b.num * ↑(a.denom)) * 1 + 0 * ↑(a.denom * b.denom) ≤ 0,
  rw int.zero_mul,
  rw int.add_zero,
  rwa int.mul_one
end
-/

lemma le_respects_r {a₁ a₂ b₁ b₂ : rat_repr}
  (h₁ : a₁ ≈ b₁) (h₂ : a₂ ≈ b₂)
  (hle : a₁ ≤ a₂) : b₁ ≤ b₂ :=
begin
  simp at *,
  have := int.mul_le_mul_of_nonneg_right (int.mul_le_mul_of_nonneg_right hle b₁.denom_nonneg) b₂.denom_nonneg,
  rw [int.mul_assoc 0,
  int.zero_mul,
  int.distrib_right,
  int.distrib_right,
  int.mul_assoc,
  int.mul_assoc,
  int.mul_comm ↑a₂.denom,
  ← int.mul_assoc,
  ← int.mul_assoc,
  h₁,
  int.mul_assoc (-a₂.num),
  int.mul_assoc (-a₂.num),
  int.mul_comm (↑a₁.denom * ↑b₁.denom),
  ← int.mul_assoc,
  ← int.neg_mul_eq_neg_mul,
  h₂,
  int.neg_mul_eq_neg_mul,
  int.mul_assoc,
  int.mul_assoc,
  int.mul_comm ↑a₁.denom,
  ← int.mul_assoc,
  ← int.mul_assoc,
  int.mul_comm ↑a₁.denom,
  ← int.mul_assoc,
  int.mul_assoc (-b₂.num),
  int.mul_comm ↑a₂.denom,
  ← int.mul_assoc,
  int.mul_assoc,
  int.mul_assoc (-b₂.num * ↑(b₁.denom)),
  ← int.distrib_right ] at this,
  have : (0 : ℤ) < ↑(a₂.denom) * ↑(a₁.denom),
  { refine int.mul_pos _ _,
    apply int.coe_nat_lt_coe_nat_of_lt,
    apply denom_pos,
    apply int.coe_nat_lt_coe_nat_of_lt,
    apply denom_pos },
  refine int.nonpos_of_mul_pos this _,
  assumption
end

protected lemma le_refl : ∀ a : rat_repr, a ≤ a :=
begin
  rintro ⟨num, denom, pos⟩,
  simp,
  rw ← int.distrib_right,
  rw int.add_right_neg,
  rw int.zero_mul
end

protected lemma le_trans : ∀ {a b c : rat_repr}, a ≤ b → b ≤ c → a ≤ c :=
begin
  simp,
  intros a b c h₁ h₂,

  have h₁' := int.mul_nonpos_of_nonneg_of_nonpos b.denom_nonneg
    (int.mul_nonpos_of_nonneg_of_nonpos c.denom_nonneg h₁),
  rw [ int.mul_comm,
  int.mul_comm ↑c.denom,
  int.distrib_right,
  int.distrib_right,
  ← int.neg_mul_eq_neg_mul,
  ← int.neg_mul_eq_neg_mul,
  ← int.neg_mul_eq_neg_mul ] at h₁',

  have h₂' := int.mul_nonpos_of_nonneg_of_nonpos b.denom_nonneg
    (int.mul_nonpos_of_nonneg_of_nonpos a.denom_nonneg h₂),
  rw [ int.mul_comm,
  int.mul_comm ↑a.denom,
  int.distrib_right,
  int.distrib_right ] at h₂',

  rw [ int.mul_assoc,
  int.mul_assoc,
  ← int.mul_assoc ↑c.denom,
  int.mul_comm ↑c.denom,
  ← int.mul_assoc,
  ← int.mul_assoc,
  ← int.neg_neg (b.num * ↑a.denom * ↑c.denom * ↑b.denom) ] at h₂',

  have := int.add_nonpos h₁' h₂',
  rw [ int.add_assoc,
  int.add_neg_cancel_left,
  ← int.distrib_right ] at this,
  have := int.nonpos_of_mul_pos b.coe_denom_pos this,
  rw [int.mul_assoc,
  int.mul_assoc,
  int.mul_comm ↑b.denom,
  int.mul_comm ↑b.denom,
  ← int.mul_assoc,
  ← int.mul_assoc,
  ← int.distrib_right ] at this,
  exact int.nonpos_of_mul_pos b.coe_denom_pos this
end

-- The order on rational representations is only antisymmetric up to equivalence.
protected lemma le_antisymm : ∀ {a b : rat_repr}, a ≤ b → b ≤ a → a ≈ b :=
begin
  simp,
  intros a b h₁ h₂,
  have h₁' := int.neg_le_neg h₁,
  rw int.neg_zero at h₁',
  rw int.neg_add at h₁',
  rw int.neg_mul_eq_neg_mul at h₁',
  rw int.neg_mul_eq_neg_mul at h₁',
  rw int.neg_neg at h₁',
  rw int.add_comm at h₁',
  have := int.le_antisymm h₂ h₁',
  have : b.num * ↑(a.denom) + -a.num * ↑(b.denom) + a.num * ↑(b.denom) = a.num * ↑(b.denom),
  { rw this,
    rw int.zero_add },
  rw int.add_assoc at this,
  rw ← int.neg_mul_eq_neg_mul at this,
  rw int.add_left_neg at this,
  rw ← this,
  rw int.add_zero
end

protected lemma le_total : ∀ a b : rat_repr, a ≤ b ∨ b ≤ a :=
begin
  intros a b,
  simp,
  rw int.add_comm,
  rw ← int.neg_mul_eq_neg_mul,
  rw ← int.neg_mul_eq_neg_mul,
  convert int.neg_or_neg_neg (-(b.num * ↑a.denom) + a.num * ↑b.denom),
  rw int.neg_add,
  rw int.neg_neg
end

def lt (a b : rat_repr) : Prop := a ≤ b ∧ ¬ b ≤ a
instance : has_lt rat_repr := ⟨lt⟩

@[simp] lemma lt_def (a b : rat_repr)
  : a < b ↔ a ≤ b ∧ ¬ b ≤ a := by refl

instance : decidable_rel r := λ p q, int.decidable_eq _ _
instance : decidable_rel le := λ p q, int.decidable_le _ _
instance : decidable_rel lt := λ p q, and.decidable

-- Absolute value

def abs (a : rat_repr) : rat_repr := if 0 ≤ a.num then a else -a
instance : has_abs rat_repr := ⟨abs⟩

lemma abs_def (a : rat_repr)
  : abs a = if 0 ≤ a.num then a else -a := rfl

@[simp] lemma abs_num_def (a : rat_repr)
  : (abs a).num = (a.num).abs :=
begin
  rw abs_def,
  by_cases 0 ≤ a.num,
  { rw if_pos, rw int.abs_def, rw if_pos, assumption, assumption },
  { rw if_neg, rw int.abs_def, rw if_neg, simp, assumption, assumption }
end

@[simp] lemma abs_denom_def (a : rat_repr)
  : (abs a).denom = a.denom :=
begin
  rw abs_def,
  by_cases 0 ≤ a.num,
  { rwa if_pos },
  { rw if_neg, simp, assumption }
end

lemma r_respects_nonneg {a b : rat_repr}
  (h : a ≈ b) (hn : 0 ≤ a) : 0 ≤ b := le_respects_r rfl h hn

lemma r_respects_num_nonneg {a b : rat_repr}
  (h : a ≈ b) (hn : 0 ≤ a.num) : 0 ≤ b.num :=
begin
  have := r_respects_nonneg h _,
  { rw le_def at this,
    rw sub_def at this,
    rw zero_add at this,
    simp at this,
    exact int.nonneg_of_neg_nonpos this },
  rw le_def,
  rw sub_def,
  rw zero_add,
  simp,
  exact int.neg_nonpos_of_nonneg hn
end

lemma r_respects_num_neg {a b : rat_repr}
  (h : a ≈ b) (hn : a.num < 0) : b.num < 0 :=
begin
  revert hn,
  contrapose!,
  exact r_respects_num_nonneg h.symm
end

lemma abs_respects_r {a b : rat_repr}
  (h : a ≈ b) : abs a ≈ abs b :=
begin
  simp,
  by_cases hn : 0 ≤ a.num,
  { have := r_respects_num_nonneg h hn,
    rw int.abs_def,
    rw int.abs_def,
    rw if_pos,
    rw if_pos,
    repeat { assumption } },
  { push_neg at hn,
    have := r_respects_num_neg h hn,
    rw int.abs_def,
    rw int.abs_def,
    rw if_neg,
    rw if_neg,
    rw ← int.neg_mul_eq_neg_mul,
    rw ← int.neg_mul_eq_neg_mul,
    congr' 1,
    push_neg,
    assumption,
    push_neg,
    assumption }
end

lemma zero_of_num_zero {p : rat_repr} (h : p.num = 0) : p ≈ 0 :=
begin
  simp,
  rw [h, int.zero_mul, int.zero_mul]
end

lemma num_zero_of_zero {p : rat_repr} (h : p ≈ 0) : p.num = 0 :=
begin
  simp at h,
  rw int.zero_mul at h,
  rw ← h,
  change p.num = p.num * 1,
  rw int.mul_one
end

def mul (p q : rat_repr) : rat_repr :=
  ⟨p.num * q.num, p.denom * q.denom, nat.mul_ne_zero p.pos q.pos⟩
instance : has_mul rat_repr := ⟨mul⟩

@[simp] lemma mul_def {p q : rat_repr}
  : p * q = ⟨p.num * q.num, p.denom * q.denom, nat.mul_ne_zero p.pos q.pos⟩
  := rfl

lemma mul_respects_r {a₁ a₂ b₁ b₂ : rat_repr}
  (h₁ : a₁ ≈ b₁) (h₂ : a₂ ≈ b₂)
  : a₁ * a₂ ≈ b₁ * b₂ :=
begin
  simp at *,
  rw int.mul_assoc,
  rw int.mul_assoc,
  rw int.mul_comm a₂.num,
  rw int.mul_comm b₂.num,
  rw ← int.mul_assoc,
  rw ← int.mul_assoc,
  rw int.coe_nat_mul,
  rw int.coe_nat_mul,
  rw ← int.mul_assoc,
  rw ← int.mul_assoc,
  rw h₁,
  rw int.mul_assoc,
  rw int.mul_assoc,
  rw int.mul_assoc,
  rw int.mul_assoc,
  rw int.mul_comm ↑b₂.denom,
  rw h₂,
  rw int.mul_comm b₂.num,
end

end rat_repr

def nonzero_rat_repr := {p : rat_repr // p.num ≠ 0}

namespace nonzero_rat_repr

def inv (p : nonzero_rat_repr) : nonzero_rat_repr := ⟨
  ⟨p.val.num.sign * p.val.denom, p.val.num.nat_abs, begin
    intro h,
    exact p.property (int.eq_zero_of_nat_abs_eq_zero h)
  end⟩,
  begin
    intro h,
    dsimp at h,
    cases int.eq_zero_or_eq_zero_of_mul_eq_zero h with h₁ h₂,
    { exact p.property (int.eq_zero_of_sign_eq_zero h₁) },
    { change ↑p.val.denom = ↑0 at h₂,
      rw int.coe_nat_eq_coe_nat_iff at h₂,
      exact p.val.pos h₂ }
  end
⟩

@[simp] lemma inv_num_def (p : nonzero_rat_repr) :
  (inv p).val.num = p.val.num.sign * p.val.denom := rfl

@[simp] lemma inv_denom_def (p : nonzero_rat_repr) :
  (inv p).val.denom = p.val.num.nat_abs := rfl

def r (p q : nonzero_rat_repr) : Prop := p.val ≈ q.val

@[simp] lemma r_def (p q : nonzero_rat_repr)
  : r p q ↔ p.val ≈ q.val := by refl

instance setoid : setoid nonzero_rat_repr := subtype.setoid (λ p: rat_repr, p.num ≠ 0)

@[simp] lemma equiv_def (p q : nonzero_rat_repr)
  : p ≈ q ↔ p.val ≈ q.val := by refl

lemma inv_respects_r {p q : nonzero_rat_repr} (h : p ≈ q)
  : p.inv ≈ q.inv :=
begin
  rw equiv_def at *,
  rw rat_repr.equiv_def at *,
  rw inv_num_def at *,
  rw inv_num_def at *,
  rw inv_denom_def at *,
  rw inv_denom_def at *,
  rw int.nat_abs_of_sign_mul,
  rw int.nat_abs_of_sign_mul,
  rw int.mul_assoc,
  rw int.mul_comm,
  rw int.mul_comm q.val.num.sign,
  rw ← int.mul_assoc,
  rw int.mul_comm ↑p.val.denom,
  rw ← h,
  rw int.mul_comm p.val.num.sign,
  rw ← int.mul_assoc,
  congr' 1,
  rw int.mul_comm,
  rw int.mul_assoc q.val.num.sign,
  congr' 1,
  rw int.mul_comm
end

end nonzero_rat_repr

-- Rationals

def rat := quotient rat_repr.setoid
notation `ℚ` := rat

namespace rat

def of_int (n : ℤ) : ℚ := ⟦rat_repr.of_int n⟧

instance : has_zero ℚ := ⟨of_int 0⟩
instance : has_one ℚ := ⟨of_int 1⟩

def neg : ℚ → ℚ := quotient.lift (λ p, ⟦-p⟧)
  (λ a b h, quotient.sound (rat_repr.neg_respects_r h))
instance : has_neg ℚ := ⟨neg⟩

def add : ℚ → ℚ → ℚ := quotient.lift₂ (λ p q, ⟦p + q⟧)
  (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound (rat_repr.add_respects_r h₁ h₂))
instance : has_add ℚ := ⟨add⟩

def sub (p q : ℚ) : ℚ := p + -q
instance : has_sub ℚ := ⟨sub⟩

lemma add_comm : ∀ a b : ℚ, a + b = b + a :=
begin
  intros a b,
  apply quotient.induction_on₂ a b, clear a b,
  intros a b,
  change ⟦a + b⟧ = ⟦b + a⟧,
  rw rat_repr.add_comm
end

lemma add_assoc : ∀ a b c : ℚ, a + b + c = a + (b + c) :=
begin
  intros a b c,
  apply quotient.induction_on₃ a b c, clear a b c,
  intros a b c,
  exact quotient.sound (rat_repr.add_assoc a b c)
end

lemma zero_add (a : ℚ) : 0 + a = a :=
begin
  apply quotient.induction_on a, clear a,
  intro a,
  refine quotient.sound _,
  have : rat_repr.of_int 0 + a = a := rat_repr.zero_add a,
  rw this
end

lemma add_zero (a : ℚ) : a + 0 = a :=
begin
  rw add_comm,
  exact zero_add a
end

lemma add_left_neg (a : ℚ) : -a + a = 0 :=
begin
  apply quotient.induction_on a, clear a,
  intro a,
  refine quotient.sound _,
  change -a + a ≈ 0,
  exact rat_repr.add_left_neg a
end

lemma add_right_neg (a : ℚ) : a + -a = 0 :=
begin
  rw add_comm,
  exact add_left_neg a
end

private lemma le_respects_r :
  ∀ (a₁ a₂ b₁ b₂ : rat_repr), a₁ ≈ b₁ → a₂ ≈ b₂ → a₁.le a₂ = b₁.le b₂ :=
begin
  intros a₁ a₂ b₁ b₂ h₁ h₂,
  ext,
  split,
  { intro h, exact rat_repr.le_respects_r h₁ h₂ h },
  { intro h, exact rat_repr.le_respects_r h₁.symm h₂.symm h }
end

def le : ℚ → ℚ → Prop := quotient.lift₂ rat_repr.le le_respects_r
instance : has_le ℚ := ⟨le⟩
-- Even though ℚ and (quotient rat_repr.setoid) are defeq, we need to do this
-- for the type checker.
instance : has_le (quotient rat_repr.setoid) := ⟨le⟩

lemma le_def : ∀ p q : rat_repr, ⟦p⟧ ≤ ⟦q⟧ ↔ p ≤ q :=
begin
  intros p q,
  rw iff_eq_eq,
  revert p q,
  change ∀ p q : rat_repr, (quotient.lift₂ rat_repr.le le_respects_r ⟦p⟧ ⟦q⟧) = (p ≤ q),
  refine quotient.lift₂_mk _ _
end

def le_def₂ (a b : rat_repr) := ⟦a⟧ ≤ ⟦b⟧

instance : linear_order ℚ := {
  le := le,
  le_refl := begin
    intro a,
    apply quotient.induction_on a, clear a,
    intro a,
    rw le_def,
    exact rat_repr.le_refl a
  end,
  le_trans := begin
    intros a b c,
    apply quotient.induction_on₃ a b c, clear a b c,
    intros a b c h₁ h₂,
    rw le_def at *,
    exact rat_repr.le_trans h₁ h₂
  end,
  le_antisymm := begin
    intros a b,
    apply quotient.induction_on₂ a b, clear a b,
    intros a b h₁ h₂,
    rw le_def at *,
    refine quotient.sound _,
    exact rat_repr.le_antisymm h₁ h₂
  end,
  le_total := begin
    intros a b,
    apply quotient.induction_on₂ a b, clear a b,
    intros a b,
    rw le_def,
    rw le_def,
    exact rat_repr.le_total a b
  end,
  lt := (λ a b, a ≤ b ∧ ¬ b ≤ a),
  lt_iff_le_not_le := begin
    intros a b,
    apply quotient.induction_on₂ a b, clear a b,
    intros a b,
    repeat { rw le_def },
    change (a ≤ b ∧ ¬ b ≤ a) ↔ a ≤ b ∧ ¬b ≤ a,
    refl
  end,
  decidable_lt := begin
    intros a b,
    change decidable (a ≤ b ∧ ¬ b ≤ a),
    haveI : decidable (a ≤ b) := quotient.lift₂.decidable_pred _ _ a b,
    haveI : decidable (b ≤ a) := quotient.lift₂.decidable_pred _ _ b a,
    apply and.decidable
  end,
  decidable_le := quotient.lift₂.decidable_pred _ _,
  decidable_eq := quotient.decidable_eq,
}

def abs : ℚ → ℚ := quotient.lift (λ p, ⟦|p|⟧)
  (λ a b h, quotient.sound (rat_repr.abs_respects_r h))
instance : has_abs ℚ := ⟨abs⟩

def mul : ℚ → ℚ → ℚ := quotient.lift₂ (λ p q, ⟦p * q⟧)
  (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound (rat_repr.mul_respects_r h₁ h₂))
instance : has_mul ℚ := ⟨mul⟩

end rat

-- Nonzero rationals

def nonzero_rat := {p : ℚ // p ≠ 0}
notation `ℚ*` := nonzero_rat

-- Prefer nonzero_rat if possible.
def nonzero_rat_quot := quotient nonzero_rat_repr.setoid

namespace nonzero_rat_quot

def inv : nonzero_rat_quot → nonzero_rat_quot :=
  quotient.lift (quotient.mk ∘ nonzero_rat_repr.inv)
  (λ a b, quotient.sound ∘ nonzero_rat_repr.inv_respects_r)

end nonzero_rat_quot

namespace nonzero_rat

def nonzero_rat_of_nonzero_rat_repr (p : nonzero_rat_repr) : nonzero_rat :=
⟨⟦p.val⟧, λ h, p.property (rat_repr.num_zero_of_zero (quotient.exact h))⟩

def nonzero_rat_of_rat_repr (p : rat_repr) (h : p.num ≠ 0) : nonzero_rat :=
nonzero_rat_of_nonzero_rat_repr ⟨p, h⟩

noncomputable theory

instance : has_lift_t ℚ* ℚ := ⟨λ p, p.val⟩

def nonzero_rat_equiv : ℚ* ≃ nonzero_rat_quot := ⟨
  λ ⟨p, hp⟩, ⟦⟨quotient.out p, begin
    intro h,
    have := quotient.sound (rat_repr.zero_of_num_zero h),
    rw quotient.out_eq at this,
    exact hp this
  end⟩⟧,
  λ q, ⟨⟦q.out.val⟧, λ h, q.out.property (rat_repr.num_zero_of_zero (quotient.exact h))⟩,
  begin
    rintro ⟨q, hq⟩,
    dsimp,
    congr,
    unfold_coes,
    change ⟦(⟦⟨q.out, _⟩⟧ : nonzero_rat_quot).out.val⟧ = q,
    induction q,
    { apply quotient.sound,
      change ⟦q⟧ ≠ ⟦0⟧ at hq,
      change ⟦(⟨⟦q⟧.out, _⟩ : nonzero_rat_repr)⟧.out.val ≈ q,
      have hq₁ : q.num ≠ 0 := λ hz, hq (quotient.sound (rat_repr.zero_of_num_zero hz)),
      change ⟦(⟨⟦q⟧.out, _⟩ : nonzero_rat_repr)⟧.out.val ≈ (⟨q, hq₁⟩ : nonzero_rat_repr).val,
      rw ← nonzero_rat_repr.equiv_def,
      rw ← quotient.eq_mk_iff_out,
      apply quotient.sound,
      rw nonzero_rat_repr.equiv_def,
      dsimp,
      exact quotient.mk_out q },
    { refl }
  end,
  begin
    intro p,
    dsimp,
    unfold_coes,
    change (⟦⟨⟦(quotient.out p).val⟧.out, _⟩⟧ : quotient nonzero_rat_repr.setoid) = p,
    induction p,
    { apply quotient.sound,
      rw nonzero_rat_repr.equiv_def,
      dsimp only,
      transitivity (quotient.out ⟦p⟧).val,
      { apply quotient.mk_out },
      { rw ← nonzero_rat_repr.equiv_def,
        apply quotient.mk_out } },
    { refl }
  end,
⟩

def inv : ℚ* → ℚ* := equiv.conj nonzero_rat_equiv.symm nonzero_rat_quot.inv
instance : has_inv ℚ* := ⟨inv⟩

end nonzero_rat