import logic.misc
import tactic.unirewrite

namespace list

open list

--- `propext`-free version of `list.map_map`
lemma map_map_safe {α β γ : Type _} (g : β → γ) (f : α → β) (l : list α) : map g (map f l) = map (g∘ f) l :=
  begin
    induction l with a tl h_ind,
    case nil { refl },
    case cons {
      dunfold map,
      rw [h_ind]
    }
  end

--- The result of `map f` is the same as that of `map g` provided `f` and `g` are pointwisely the same.
lemma map_equiv {α β : Type _} {f g : α → β} {l : list α} : (∀ x, f x = g x) → l.map f = l.map g :=
  begin
    intros hfg,
    induction l with a tl h_ind,
    case nil { refl },
    case cons {
      dunfold map,
      rw [hfg,h_ind]
    }
  end

--- `map f` is injective provided so is `f`.
lemma inj_of_map_inj {α β : Type _} {f : α → β} : function.injective f → function.injective (map f) :=
  begin
    intros hf l₁,
    induction l₁ with a tl₁ h_ind,
    case nil {
      intros l₂ h; cases l₂ with b tl₂,
      case nil { refl },
      case cons { dsimp [map] at h; injection h }
    },
    case cons {
      intros l₂ h; cases l₂ with b tl₂,
      case nil { dsimp [map] at h; injection h },
      case cons {
        dsimp [map] at h,
        let hfeq := cons.inj h,
        rw [hf hfeq.left, h_ind hfeq.right]
      }
    }
  end

--- `filter` after `map` yields `map` of `filter`.
lemma filter_of_map {α β : Type _} {f : α → β} {p : β → Prop} [decidable_pred p] {l : list α} : filter p (l.map f) = map f (l.filter (p∘ f)) :=
  begin
    induction l with a tl h_ind,
    case nil { refl },
    case cons {
      dsimp [list.map,list.filter],
      refine dite (p (f a)) _ _,
      show p (f a) → _, {
        intros hpfa,
        repeat { rw [if_pos hpfa] },
        dsimp [map],
        rw [h_ind]
      },
      show ¬p (f a) → _, {
        intros hnpfa,
        repeat { rw [if_neg hnpfa] },
        rw [h_ind]
      }
    }
  end

--- `propext`-free version of `list.partition_eq_filter_filter`
lemma partition_eq_filter_filter_safe {α : Type _} (p : α → Prop) [decidable_pred p] (l : list α) : l.partition p = (l.filter p, l.filter (not∘ p)) :=
  begin
    induction l with a tl h_ind,
    case nil { refl },
    case cons {
      dunfold partition filter,
      rw [h_ind],
      dunfold partition._match_1,
      refine dite (p a) _ _,
      show p a → _, {
        intros hpa,
        rw [if_pos hpa, if_pos hpa, if_neg (not_not_intro hpa)]
      },
      show ¬p a → _, {
        intros hnpa,
        rw [if_neg hnpa, if_neg hnpa, if_pos hnpa]
      }
    }
  end

@[simp]
lemma nil_union {α : Type _} [decidable_eq α] {l : list α} : [] ∪ l = l :=
  rfl

@[simp]
lemma cons_union {α : Type _} [decidable_eq α] {a : α} {l₁ l₂ : list α} : (a :: l₁) ∪ l₂ = ite (a ∈ l₁ ∪ l₂) (l₁ ∪ l₂) (a :: (l₁ ∪ l₂)) :=
  rfl

/-!
 * Lemmas around `list.mem`.
--/

--- `propext` free version of list.mem_append
@[simp]
lemma mem_append' {α : Sort _} {a : α} {s t : list α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t :=
  begin
    induction s with x xs h_ind,
    case list.nil {
      by calc
        a ∈ nil ++ t
            ↔ a ∈ t : by rw [list.nil_append]
        ... ↔ (a ∈ nil) ∨ a∈ t : iff.symm (or_disproof_left (not_mem_nil a))
    },
    case list.cons {
      dsimp [mem_cons_eq],
      by calc
        a = x ∨ a ∈ xs ++ t
            ↔ a = x ∨ a ∈ xs ∨ a ∈ t : or_congr (iff.refl (a=x)) h_ind
        ... ↔ (a = x ∨ a ∈ xs) ∨ a ∈ t : iff.symm (or_assoc _ _)
    }
  end

--- Membership relation in a list after `list.filter`.
lemma mem_filter {α : Sort _} {as : list α} {p : α → Prop} [decidable_pred p] : ∀ a, a ∈ as.filter p ↔ (a ∈ as ∧ p a) :=
  begin
    intros x,
    induction as with a as h_ind,
    case list.nil {
      dunfold filter,
      by calc
        x ∈ []
            ↔ false : mem_nil_iff x
        ... ↔ false ∧ p x : iff.symm (false_and _)
        ... ↔ (x ∈ []) ∧ p x
              : and_congr (iff.symm (mem_nil_iff _)) (iff.refl _)
    },
    case list.cons {
      dunfold filter,
      by_cases p a,
      focus /- CASE: p a -/ {
        rw [ite_eval_true h],
        dsimp [mem_cons_eq],
        by calc
          x = a ∨ x ∈ as.filter p
              ↔ (x = a ∧ p x) ∨ (x ∈ as ∧ p x)
                : or_congr (iff.symm ∘ and_iff_left_of_imp $ by intro hx; rw [hx]; assumption) h_ind
          ... ↔ (x = a ∨ x ∈ as) ∧ p x : iff.symm or_and_distrib
      },
      focus /- CASE: ¬p a -/ {
        rw [ite_eval_false h],
        dsimp [mem_cons_eq],
        have : ¬(x = a ∧ p x), {
          intros hx,
          rw [←hx.left] at h,
          exact h hx.right
        },
        by calc
          x ∈ filter p as
              ↔ x ∈ as ∧ p x : h_ind
          ... ↔ _ : iff.symm (or_false _)
          ... ↔ false ∨ (x ∈ as ∧ p x) : or.comm
          ... ↔ (x = a ∧ p x) ∨ (x ∈ as ∧ p x) : or_congr (iff.symm (iff_false_intro this)) (iff.refl _)
          ... ↔ (x = a ∨ x ∈ as) ∧ p x : iff.symm or_and_distrib
      }
    }
  end

lemma mem_of_insert_self {α : Type _} [decidable_eq α] {l : list α} : ∀ x, x ∈ l.insert x :=
  begin
    intros x,
    dunfold list.insert,
    apply ite_pred_iff.mp,
    exact ⟨id, (λ _, mem_cons_self x _)⟩
  end

lemma mem_of_insert_to_mem {α : Type _} [decidable_eq α] {x : α} {l : list α} : x ∈ l → ∀ y, x ∈ l.insert y :=
  begin
    intros hx y,
    dunfold list.insert,
    apply ite_pred_iff.mp,
    exact ⟨(λ _, hx), (λ _, mem_cons_of_mem _ hx)⟩
  end

--- A term is a member of the union of two lists if and only if it is a member of either of the operands.
lemma mem_union_iff {α : Type _} [decidable_eq α] {l₁ l₂ : list α} {x : α} : x ∈ l₁ ∨ x ∈ l₂ ↔ x ∈ (l₁ ∪ l₂) :=
  begin
    split,
    show x∈ l₁ ∨ x∈ l₂ → x∈ (l₁ ∪ l₂), {
      intros hx,
      dsimp [has_union.union, list.union] at *,
      cases hx,
      case or.inl /- x ∈ l₁ -/ {
        induction l₁ with a tl h_ind,
        case nil { exfalso; exact not_mem_nil x hx },
        dsimp [has_insert.insert] at *,
        cases hx,
        case or.inl /- x = a -/ {
          rw [hx], exact mem_of_insert_self _
        },
        case or.inr /- x ∈ tl -/ {
          exact mem_of_insert_to_mem (h_ind hx) _
        }
      },
      case or.inr /- x ∈ l₂ -/ {
        induction l₁ with a tl h_ind,
        case nil { exact hx },
        dunfold foldr; dsimp [has_insert.insert],
        exact mem_of_insert_to_mem h_ind _
      }
    },
    show x ∈ (l₁ ∪ l₂) → x ∈ l₁ ∨ x ∈ l₂, {
      intros hx,
      induction l₁ with a tl h_ind,
      case nil { exact or.inr hx },
      case cons {
        rw [cons_union] at hx,
        cases whether_of_ite hx,
        case or.inl {
          exact (h_ind h).elim (or.inl ∘ mem_cons_of_mem a) or.inr
        },
        case or.inr {
          apply or.assoc.mpr,
          exact or.imp_right h_ind h,
        }
      }
    }
  end

--- Special case of `cons_union` with `nodup` the first operand.
lemma not_mem_cons_union {α : Type _} [decidable_eq α] {a : α} {l₁ l₂ : list α} : a ∉ l₁ → (a :: l₁) ∪ l₂ = ite (a ∈ l₂) (l₁ ∪ l₂) (a :: (l₁ ∪ l₂)) :=
  begin
    intros hal₁,
    rw [list.cons_union],
    refine if_congr _ rfl rfl,
    calc
      a ∈ l₁ ∪ l₂
          ↔ a ∈ l₁ ∨ a ∈ l₂ : mem_union_iff.symm
      ... ↔ a ∈ l₂ : or_iff_right_of_imp (false.elim ∘ hal₁)
  end

--- `map f` respects the membership relation.
lemma mem_map_of_mem {α β : Type _} {f : α → β} : ∀ (x : α) (l : list α), x ∈ l → f x ∈ l.map f
| x [] h := false.elim $ not_mem_nil x h
| x (a::tl) h :=
  or.elim h
    (λ ha, or.inl (congr rfl ha))
    (λ htl, or.inr (mem_map_of_mem x tl htl))

--- `map f` reflects the membership relation provided `f` is injective.
lemma mem_of_mem_map {α β : Type _} {f : α → β} : function.injective f → ∀ (x : α) (l : list α), f x ∈ l.map f → x ∈ l :=
  begin
    intros hf x l hfx,
    induction l with a tl h_ind,
    case nil { exact (not_mem_nil x hfx).elim },
    case cons {
      exact or.elim hfx (λ h, or.inl (hf h)) (λ h, mem_cons_of_mem _ (h_ind h))
    }
  end

--- If `y` lies outside of the image of a function `f`, then it cannot be a member of any lists of the form `map f l`.
lemma not_mem_map_of_offimage {α β : Type _} {f : α → β} (y : β) : (∀ x, f x ≠ y) → ∀ {l : list α}, y ∉ l.map f
| _ [] := not_mem_nil y
| hy (a::as) :=
  λ h, or.elim h (λ h, hy a h.symm) (not_mem_map_of_offimage hy)

--- If `y` is a member of `map f l`, then `y` can be written in the form `y = f x` with `x ∈ l`.
lemma inverse_of_mem_map {α β : Type _} {f : α → β} {y : β} (l : list α) : y ∈ map f l → ∃ x, y = f x ∧ x ∈ l :=
  begin
    induction l with a tl h_ind,
    case nil {
      intro hy,
      exfalso; exact not_mem_nil _ hy
    },
    case cons {
      dunfold map,
      intros hy,
      cases hy,
      case or.inl { exact ⟨a,hy,list.mem_cons_self a _⟩ },
      case or.inr {
        refine exists_imp_exists _ (h_ind hy),
        intros x; refine and_implies id (mem_cons_of_mem a)
      }
    }
  end

--- If `list` has no member, then it is `nil`.
lemma is_nil_of_no_mem {α : Sort _} : ∀ {l : list α}, (∀ x, x ∉ l) → l = []
| [] _ := rfl
| (a::as) h := false.elim (h a (mem_cons_self a as))

--- Every member of `list.filter p l` should be a member of `l`.
lemma not_mem_filter {α : Sort _} {as : list α} {p : α → Prop} [decidable_pred p] : ∀ a, a ∉ as → a ∉ as.filter p :=
  begin
    intros a ha hfilt,
    exact ha ((mem_filter a).mp hfilt).left
  end

--- Any subset of `list.nil` is itself `list.nil`.
lemma subset_nil {α : Sort _} {l : list α} : l.subset [] → l = [] :=
  begin
    cases l with a as,
    case nil {
      intros; refl
    },
    case cons {
      intros hsub,
      have : a ∈ [], from hsub (or.inl rfl),
      exfalso; exact not_mem_nil a this
    },
  end

--- `map f` commutes with `union` provided `f` is injective.
lemma union_of_map_inj {α β: Type _} [decidable_eq α] [decidable_eq β] {f : α → β} {l₁ l₂ : list α} : function.injective f → map f (l₁ ∪ l₂) = (map f l₁) ∪ (map f l₂) :=
  begin
    intros hinj,
    induction l₁ with a tl h_ind,
    case nil { refl },
    case cons {
      dunfold map,
      rw [cons_union, cons_union],
      refine dite (a ∈ tl ∪ l₂) _ _,
      show (a ∈ tl ∪ l₂) → _, {
        intros ha,
        rw [if_pos ha],
        have : f a ∈ map f tl ∪ map f l₂,
          by rw [←h_ind]; exact mem_map_of_mem a _ ha,
        rw [if_pos this],
        exact h_ind
      },
      show (a ∉ tl ∪ l₂) → _, {
        intros hna,
        rw [if_neg hna],
        have : f a ∉ map f tl ∪ map f l₂, {
          intro hfa,
          exfalso; apply hna,
          rw [←h_ind] at hfa,
          apply mem_of_mem_map hinj _ _ hfa
        },
        rw [if_neg this],
        dunfold map,
        rw [h_ind]
      }
    }
  end

/-!
 * No duplicates; based on `list.nodup` in `mathlib`.
--/

--- Guarantees that each entry in a list appears at most once.
inductive nodup {α : Sort _} : list α → Prop
| nil : nodup []
| cons : ∀ {a : α} {l : list α}, (a ∉ l) → nodup l → nodup (a :: l)

lemma nodup_head {α : Sort _} {a : α} {l : list α} : (a :: l).nodup → a ∉ l :=
  λ h, by cases h; assumption

lemma nodup_tail {α : Sort _} {a : α} {l : list α} : (a :: l).nodup → l.nodup :=
  λ h, by cases h; assumption

lemma nodup_tail_of_sub {α : Sort _} {a : α} {l₁ l₂ : list α} : (a::l₁).nodup → (a::l₁ ⊆ a::l₂) → (l₁ ⊆ l₂) :=
  begin
    intros hnodup₁ h x hx,
    cases h (mem_cons_of_mem _ hx) with hxa hxl₂,
    case or.inl /- x = a -/ {
      cases hnodup₁ with _ _ hal₁ _,
      exact false.elim (hal₁ (hxa▸hx)),
    },
    case or.inr /- x ∈ l₂ -/ {
      exact hxl₂
    }
  end

--- `l.nodup` implise `(l.filter p).nodup` for any decidable predicator `p`.
lemma nodup_filter {α : Sort _} {p : α → Prop} [decidable_pred p] : ∀ {l}, nodup l → nodup (l.filter p)
| _ nodup.nil := nodup.nil
|(a :: as) (nodup.cons ha has) :=
  begin
    dunfold filter,
    by_cases (p a),
    focus /- p a -/ {
      rw [ite_eval_true h],
      exact nodup.cons (not_mem_filter a ha) (nodup_filter has),
    },
    focus /- ¬p a -/ {
      rw [ite_eval_false h],
      exact nodup_filter has
    }
  end

--- The union of two lists without duplicates has no duplicate members.
lemma nodup_union {α : Type _} [decidable_eq α] {l₁ l₂ : list α} : l₁.nodup → l₂.nodup → (l₁ ∪ l₂).nodup :=
  begin
    intros hnodup₁ hnodup₂,
    induction l₁ with a tl h_ind,
    case nil { rw [nil_union]; exact hnodup₂ },
    case cons {
      rw [cons_union],
      apply ite_pred_iff.mp; split,
      show a ∈ tl ∪ l₂ → _, {
        intros ha,
        exact h_ind (nodup_tail hnodup₁)
      },
      show a ∉ tl ∪ l₂ → _, {
        intros ha,
        exact nodup.cons ha (h_ind (nodup_tail hnodup₁))
      }
    }
  end

--- `union` is exactly `append` as soon as the first operand is `nodup`
lemma nodup.disjoint_union {α : Type _} [decidable_eq α] {l₁ l₂ : list α} : l₁.nodup → (∀ x, x ∈ l₁ → x∉ l₂) → l₁ ∪ l₂ = l₁ ++ l₂ :=
  begin
    intros hnodup₁ hdisj,
    induction l₁ with a tl h_ind,
    case nil { refl },
    case cons {
      rw [not_mem_cons_union (nodup_head hnodup₁)],
      rw [if_neg (hdisj a (mem_cons_self a _))],
      have : ∀ x, x ∈ tl → x ∉ l₂,
        from λ x hx, hdisj x (mem_cons_of_mem a hx),
      rw [h_ind (nodup_tail hnodup₁) this],
      refl
    }
  end

#print axioms nodup.disjoint_union

--- `map f` reflects `nodup`.
lemma nodup_of_nodup_map {α β : Type _} {f : α → β} : ∀ {l : list α}, nodup (l.map f) → nodup l
| [] _ := nodup.nil
| (a::tl) hfnodup :=
  begin
    refine nodup.cons _ (nodup_of_nodup_map (nodup_tail hfnodup)),
    dsimp [map] at hfnodup,
    cases hfnodup with _ _ hfatl _,
    exact mt (mem_map_of_mem a tl) hfatl
  end

--- `map f` respects `nodup`.
lemma nodup_map_of_nodup {α β : Type _} {f : α → β} : function.injective f → ∀ {l}, nodup l → nodup (l.map f)
| _ [] _ := nodup.nil
| hf (a::tl) hnodup :=
  begin
    refine nodup.cons _ (nodup_map_of_nodup hf (nodup_tail hnodup)),
    cases hnodup with _ _ hatl _,
    intros hfatl,
    exact hatl (mem_of_mem_map hf _ _ hfatl)
  end

/-!
 * Permutation on lists; based on `list.perm` in `mathlib`.
--/

inductive perm {α : Sort _} : list α → list α → Prop
| nil {} : perm [] []
| cons {a : α} {l₁ l₂ : list α} : perm l₁ l₂ → perm (a::l₁) (a::l₂)
| head {a b : α} {l : list α} : perm (a :: b :: l) (b :: a :: l)
| trans {l₁ l₂ l₃ : list α} : perm l₂ l₃ → perm l₁ l₂ → perm l₁ l₃

attribute [trans] perm.trans

namespace perm

@[refl]
protected
lemma rfl {α : Sort _} : ∀ (l : list α), perm l l
| [] := perm.nil
| (a::as) := perm.cons (rfl as)

@[symm]
protected
lemma symm {α : Sort _} {l₁ l₂ : list α} (hperm : perm l₁ l₂) : perm l₂ l₁ :=
  @perm.rec_on α (λ l₁ l₂, perm l₂ l₁) l₁ l₂ hperm
    perm.nil
    (λ _ _ _ _ h, perm.cons h)
    (λ _ _ _ , perm.head)
    (λ l₁ l₂ l₃ _ _ h₂ h₁, perm.trans h₁ h₂)

protected
lemma eq_nil {α : Type _} {l : list α} (hperm : perm l []) : l = [] :=
  @perm.rec_on α (λl₁ l₂, l₂ = [] → l₁ = []) l [] hperm
    (λ_, rfl)
    (λ _ _ _ _ _ h, list.no_confusion h)
    (λ _ _ _ h, list.no_confusion h)
    (λ _ _ _ _ _ h_ind₁ h_ind₂, h_ind₂ ∘ h_ind₁)
    rfl

--- If a `l : list α` is `perm` to a singleton `[a]`, then `l = [a]`.
protected
lemma eq_singleton {α : Type _} {l : list α} {a : α} (hperm : perm l [a]) : l = [a] :=
  @perm.rec_on α (λ l₁ l₂, l₂ = [a] → l₁ = [a]) l [a] hperm
    (λ h, list.no_confusion h)
    (λ b l₁ l₂ hp h_ind h,
      begin
        let h₂ := list.cons.inj h,
        rw [h₂.right] at hp,
        have : l₁ = [] := hp.eq_nil,
        rw [h₂.left, this]
      end
    )
    (λ b c l h, list.no_confusion (list.cons.inj h).right)
    (λ _ _ _ _ _ h_ind₁ h_ind₂, h_ind₂ ∘ h_ind₁)
    rfl

protected
lemma middle {α : Type _} {a : α} {l₁ l₂ : list α} : perm (l₁ ++ (a :: l₂)) (a :: (l₁ ++ l₂)) :=
  begin
    induction l₁ with b tl h_ind,
    case nil { refl },
    case cons {
      dsimp [list.append],
      exact perm.trans perm.head h_ind.cons
    }
  end

--- The relation `perm` yields the equality of lengths.
protected
lemma length {α : Type _} {l₁ l₂ : list α} : l₁.perm l₂ → l₁.length = l₂.length :=
  begin
    intros hperm,
    induction hperm with _ _ _ _ h_ind a b _ _ _ _ _ _ hfyz hfxy,
    case nil { refl },
    case cons { dunfold length, rw [h_ind] },
    case head { dunfold length, refl },
    case trans { exact eq.trans hfxy hfyz }
  end

--- `map f` repsects the relation `perm`.
protected
lemma map {α β : Type _} {l₁ l₂ : list α} (f : α → β) (hperm : perm l₁ l₂) : perm (l₁.map f) (l₂.map f) :=
  begin
    induction hperm with a tl₁ tl₂ hperm_tl h_ind a b tl lx ly lz hyz hxy hfyz hfxy,
    case nil { exact perm.nil },
    case cons { dunfold map, exact perm.cons h_ind },
    case head { dunfold map, exact perm.head },
    case trans { exact perm.trans hfyz hfxy }
  end

--- `perm l₁ l₂` implies that `l₂` contains `l₁`.
protected
lemma subset {α : Sort _} {l₁ l₂ : list α} (hperm : perm l₁ l₂) : l₁.subset l₂ :=
  @perm.rec_on α (λ l₁ l₂, ∀ a, a ∈ l₁ → a ∈ l₂) l₁ l₂ hperm
    /- perm.nil -/ (λ _, id)
    /- perm.cons -/ (
      λ _ l₁ l₂ _ h_ind a hl₁, or.imp_right (h_ind a) hl₁
    )
    /- perm.head -/ (
      λ a b l x h_ind,
        or.assoc.mp ((or_congr or.comm (iff.refl _)).mpr (or.assoc.mpr h_ind))
    )
    /- perm.trans -/ (
      λ l₁ l₂ l₃ _ _ hleft hright a, hleft a ∘ hright a
    )

--- `perm l₁ l₂` implies that their membership relations are equivalent.
protected
lemma mem_iff {α : Sort _} {l₁ l₂ : list α} (hperm : perm l₁ l₂) : ∀ a, a ∈ l₁ ↔ a ∈ l₂ :=
  λ _, ⟨λ h, hperm.subset h, λ h, hperm.symm.subset h⟩

--- `perm` implies an implication of "non-membership" relation.
protected
lemma not_mem {α : Sort _} {l₁ l₂ : list α} (hperm : perm l₁ l₂) : ∀ a, a ∉ l₁ → a ∉ l₂ :=
  λ _ hl₁ hl₂, hl₁ (perm.subset hperm.symm hl₂)

--- `append` of `partition` yields the original `list` up to permutation.
protected
lemma append_partition {α : Type _} (p : α → Prop) [decidable_pred p] (l : list α) : perm (function.uncurry list.append (l.partition p)) l :=
  begin
    rw [partition_eq_filter_filter_safe],
    dsimp [function.uncurry],
    induction l with a tl h_ind,
    case nil { refl },
    case cons {
      dunfold filter,
      refine dite (p a) _ _,
      show p a → _, {
        intros hpa,
        rw [if_pos hpa, if_neg (not_not_intro hpa)],
        dunfold list.append,
        exact perm.cons h_ind
      },
      show ¬p a → _, {
        intros hnpa,
        rw [if_neg hnpa, if_pos hnpa],
        exact perm.trans (perm.cons h_ind) perm.middle
      }
    }
  end

end perm

--- Membership relation `x ∈ l` is equivalent to `perm` with a list that has `x` as a head.
lemma mem_perm_head {α : Sort _} {a : α} {l : list α} : (a ∈ l) ↔ (∃ l', perm l (a::l')) :=
  begin
    split,
    show a ∈ l → _, {
      induction l with b bs h_ind,
      case list.nil {
        exact false.elim ∘ (mem_nil_iff a).mp
      },
      intros ha,
      rw [mem_cons_eq] at ha,
      cases ha,
      case or.inl { rw [ha]; exact ⟨bs,perm.rfl _⟩ },
      case or.inr {
        cases h_ind ha with l'' hperm,
        existsi b::l'',
        exact perm.trans perm.head (perm.cons hperm)
      }
    },
    show _ → a ∈ l, {
      intros hhead,
      cases hhead with l' hperm,
      exact hperm.symm.subset (or.inl rfl)
    }
  end

lemma perm_nodup {α : Sort _} {l₁ l₂ : list α} (hperm : perm l₁ l₂) : l₁.nodup → l₂.nodup :=
  @perm.rec_on α (λ l₁ l₂, l₁.nodup → l₂.nodup) l₁ l₂ hperm
    /- nodup.nil -/ id
    /- nodup.cons -/ (
      λ a lt₁ lt₂ htperm h_ind hlt₁,
        nodup.cons
          (perm.not_mem htperm a (nodup_head hlt₁))
          (h_ind (nodup_tail hlt₁))
    )
    /- nodup.head -/ (
      λ a b lt h_ind,
        begin
          cases h_ind with _ _ hhead h_ind; cases h_ind with _ _ hhead' h_ind,
          constructor,
          show b ∉ a :: lt, {
            intros hb,
            exact hb.elim (λ h, hhead (or.inl h.symm)) (λ h, hhead' h)
          },
          show (a :: lt).nodup, {
            exact nodup.cons (mt or.inr hhead) h_ind,
          }
        end
    )
    /- nodup.trans -/ (
      λ _ _ _ _ _ h₂ h₁, h₂ ∘ h₁
    )

--- `perm l₁ l₂` is derived from the equivalence of the membership relations provided both `l₁` and `l₂` are `list.nodup`.
theorem nodup_perm_of_mem {α : Sort _} {l₁ l₂ : list α} : l₁.nodup → l₂.nodup → (∀ x, x ∈ l₁ ↔ x ∈ l₂) → perm l₁ l₂ :=
  begin
    intros hnodup₁ hnodup₂ hiff,
    revert l₂,
    induction l₁ with a tl₁ h_ind,
    case list.nil {
      intros _ _ hiff,
      rw [is_nil_of_no_mem (λ x, not_mem_nil x ∘ (hiff x).mpr)]
    },
    case list.cons {
      intros l₂ hnodup₂ hiff,
      have : a ∈ l₂ := (hiff a).mp (mem_cons_self _ _),
      cases mem_perm_head.mp this with l' hperm,
      refine perm.trans hperm.symm (perm.cons _),
      apply h_ind (nodup_tail hnodup₁) (nodup_tail $ perm_nodup hperm hnodup₂),
      intros x,
      split,
      show x ∈ tl₁ → x ∈ l', {
        suffices : a::tl₁ ⊆ a::l', {
          apply nodup_tail_of_sub hnodup₁ this,
        },
        calc
          a::tl₁ ⊆ l₂ : λ y, (hiff y).mp
          ...    ⊆ a::l' : hperm.subset
      },
      show x ∈ l' → x ∈ tl₁, {
        suffices : a::l' ⊆ a::tl₁, {
          apply nodup_tail_of_sub (perm_nodup hperm hnodup₂) this,
        },
        calc
          a::l' ⊆ l₂ : hperm.symm.subset
          ...   ⊆ a::tl₁ : λ y, (hiff y).mpr
      }
    }
  end

end list


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/
import analysis.seminorm
import order.closure

/-!
# Balanced Core and Balanced Hull

## Main definitions

* `balanced_core`: The largest balanced subset of a set `s`.
* `balanced_hull`: The smallest balanced superset of a set `s`.

## Main statements

* `balanced_core_eq_Inter`: Characterization of the balanced core as an intersection over subsets.
* `nhds_basis_closed_balanced`: The closed balanced sets form a basis of the neighborhood filter.

## Implementation details

The balanced core and hull are implemented differently: for the core we take the obvious definition
of the union over all balanced sets that are contained in `s`, whereas for the hull, we take the
union over `r • s`, for `r` the scalars with `∥r∥ ≤ 1`. We show that `balanced_hull` has the
defining properties of a hull in `balanced.hull_minimal` and `subset_balanced_hull`.
For the core we need slightly stronger assumptions to obtain a characterization as an intersection,
this is `balanced_core_eq_Inter`.

## References

* [Bourbaki, *Topological Vector Spaces*][bourbaki1987]

## Tags

balanced
-/

open set
open_locale pointwise topological_space filter

variables {𝕜 E ι : Type*}

section balanced_hull

section semi_normed_ring
variables [semi_normed_ring 𝕜]

section has_scalar
variables [has_scalar 𝕜 E]

variables (𝕜)

/-- The largest balanced subset of `s`.-/
def balanced_core (s : set E) := ⋃₀ {t : set E | balanced 𝕜 t ∧ t ⊆ s}

/-- Helper definition to prove `balanced_core_eq_Inter`-/
def balanced_core_aux (s : set E) := ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s

/-- The smallest balanced superset of `s`.-/
def balanced_hull (s : set E) := ⋃ (r : 𝕜) (hr : ∥r∥ ≤ 1), r • s

variables {𝕜}

lemma balanced_core_subset (s : set E) : balanced_core 𝕜 s ⊆ s :=
begin
  refine sUnion_subset (λ t ht, _),
  simp only [mem_set_of_eq] at ht,
  exact ht.2,
end

lemma balanced_core_emptyset : balanced_core 𝕜 (∅ : set E) = ∅ :=
set.eq_empty_of_subset_empty (balanced_core_subset _)

lemma balanced_core_mem_iff {s : set E} {x : E} : x ∈ balanced_core 𝕜 s ↔
  ∃ t : set E, balanced 𝕜 t ∧ t ⊆ s ∧ x ∈ t :=
by simp_rw [balanced_core, mem_sUnion, mem_set_of_eq, exists_prop, and_assoc]

lemma smul_balanced_core_subset (s : set E) {a : 𝕜} (ha : ∥a∥ ≤ 1) :
  a • balanced_core 𝕜 s ⊆ balanced_core 𝕜 s :=
begin
  rw subset_def,
  intros x hx,
  rw mem_smul_set at hx,
  rcases hx with ⟨y, hy, hx⟩,
  rw balanced_core_mem_iff at hy,
  rcases hy with ⟨t, ht1, ht2, hy⟩,
  rw ←hx,
  refine ⟨t, _, ht1 a ha (smul_mem_smul_set hy)⟩,
  rw mem_set_of_eq,
  exact ⟨ht1, ht2⟩,
end

lemma balanced_core_balanced (s : set E) : balanced 𝕜 (balanced_core 𝕜 s) :=
λ _, smul_balanced_core_subset s

/-- The balanced core of `t` is maximal in the sense that it contains any balanced subset
`s` of `t`.-/
lemma balanced.subset_core_of_subset {s t : set E} (hs : balanced 𝕜 s) (h : s ⊆ t):
  s ⊆ balanced_core 𝕜 t :=
begin
  refine subset_sUnion_of_mem _,
  rw [mem_set_of_eq],
  exact ⟨hs, h⟩,
end

lemma balanced_core_aux_mem_iff (s : set E) (x : E) : x ∈ balanced_core_aux 𝕜 s ↔
  ∀ (r : 𝕜) (hr : 1 ≤ ∥r∥), x ∈ r • s :=
by rw [balanced_core_aux, set.mem_Inter₂]

lemma balanced_hull_mem_iff (s : set E) (x : E) : x ∈ balanced_hull 𝕜 s ↔
  ∃ (r : 𝕜) (hr : ∥r∥ ≤ 1), x ∈ r • s :=
by rw [balanced_hull, set.mem_Union₂]

/-- The balanced core of `s` is minimal in the sense that it is contained in any balanced superset
`t` of `s`. -/
lemma balanced.hull_subset_of_subset {s t : set E} (ht : balanced 𝕜 t) (h : s ⊆ t) :
  balanced_hull 𝕜 s ⊆ t :=
begin
  intros x hx,
  rcases (balanced_hull_mem_iff _ _).mp hx with ⟨r, hr, hx⟩,
  rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩,
  rw ←hx,
  exact balanced_mem ht (h hy) hr,
end

end has_scalar

section add_comm_monoid

variables [add_comm_monoid E] [module 𝕜 E]

lemma balanced_core_nonempty_iff {s : set E} : (balanced_core 𝕜 s).nonempty ↔ (0 : E) ∈ s :=
begin
  split; intro h,
  { cases h with x hx,
    have h' : balanced 𝕜 (balanced_core 𝕜 s) := balanced_core_balanced s,
    have h'' := h' 0 (has_le.le.trans norm_zero.le zero_le_one),
    refine mem_of_subset_of_mem (subset.trans h'' (balanced_core_subset s)) _,
    exact mem_smul_set.mpr ⟨x, hx, zero_smul _ _⟩ },
  refine nonempty_of_mem (mem_of_subset_of_mem _ (mem_singleton 0)),
  exact balanced.subset_core_of_subset zero_singleton_balanced (singleton_subset_iff.mpr h),
end

lemma balanced_core_zero_mem {s : set E} (hs: (0 : E) ∈ s) : (0 : E) ∈ balanced_core 𝕜 s :=
balanced_core_mem_iff.mpr
  ⟨{0}, zero_singleton_balanced, singleton_subset_iff.mpr hs, mem_singleton 0⟩

variables (𝕜)

lemma subset_balanced_hull [norm_one_class 𝕜] {s : set E} : s ⊆ balanced_hull 𝕜 s :=
λ _ hx, (balanced_hull_mem_iff _ _).mpr ⟨1, norm_one.le, mem_smul_set.mp ⟨_, hx, one_smul _ _⟩⟩

variables {𝕜}

lemma balanced_hull.balanced (s : set E) : balanced 𝕜 (balanced_hull 𝕜 s) :=
begin
  intros a ha,
  simp_rw [balanced_hull, smul_set_Union₂, subset_def, mem_Union₂],
  intros x hx,
  rcases hx with ⟨r, hr, hx⟩,
  use [a • r],
  split,
  { rw smul_eq_mul,
    refine has_le.le.trans (semi_normed_ring.norm_mul _ _) _,
    refine mul_le_one ha (norm_nonneg r) hr },
  rw smul_assoc,
  exact hx,
end

end add_comm_monoid

end semi_normed_ring

section normed_field

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]

@[simp] lemma balanced_core_aux_empty : balanced_core_aux 𝕜 (∅ : set E) = ∅ :=
begin
  rw [balanced_core_aux, set.Inter₂_eq_empty_iff],
  intros _,
  simp only [smul_set_empty, mem_empty_eq, not_false_iff, exists_prop, and_true],
  exact ⟨1, norm_one.ge⟩,
end

lemma balanced_core_aux_subset (s : set E) : balanced_core_aux 𝕜 s ⊆ s :=
begin
  rw subset_def,
  intros x hx,
  rw balanced_core_aux_mem_iff at hx,
  have h := hx 1 norm_one.ge,
  rw one_smul at h,
  exact h,
end

lemma balanced_core_aux_balanced {s : set E} (h0 : (0 : E) ∈ balanced_core_aux 𝕜 s):
  balanced 𝕜 (balanced_core_aux 𝕜 s) :=
begin
  intros a ha x hx,
  rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩,
  by_cases (a = 0),
  { simp[h] at hx,
    rw ←hx,
    exact h0 },
  rw [←hx, balanced_core_aux_mem_iff],
  rw balanced_core_aux_mem_iff at hy,
  intros r hr,
  have h'' : 1 ≤ ∥a⁻¹ • r∥ :=
  begin
    rw smul_eq_mul,
    simp only [norm_mul, norm_inv],
    exact one_le_mul_of_one_le_of_one_le (one_le_inv (norm_pos_iff.mpr h) ha) hr,
  end,
  have h' := hy (a⁻¹ • r) h'',
  rw smul_assoc at h',
  exact (mem_inv_smul_set_iff₀ h _ _).mp h',
end

lemma balanced_core_aux_maximal {s t : set E} (h : t ⊆ s) (ht : balanced 𝕜 t) :
  t ⊆ balanced_core_aux 𝕜 s :=
begin
  intros x hx,
  rw balanced_core_aux_mem_iff,
  intros r hr,
  rw mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one hr)),
  refine h (balanced_mem ht hx _),
  rw norm_inv,
  exact inv_le_one hr,
end

lemma balanced_core_subset_balanced_core_aux {s : set E} :
  balanced_core 𝕜 s ⊆ balanced_core_aux 𝕜 s :=
balanced_core_aux_maximal (balanced_core_subset s) (balanced_core_balanced s)

lemma balanced_core_eq_Inter {s : set E} (hs : (0 : E) ∈ s) :
  balanced_core 𝕜 s = ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s :=
begin
  rw ←balanced_core_aux,
  refine subset_antisymm balanced_core_subset_balanced_core_aux _,
  refine balanced.subset_core_of_subset (balanced_core_aux_balanced _) (balanced_core_aux_subset s),
  refine mem_of_subset_of_mem balanced_core_subset_balanced_core_aux (balanced_core_zero_mem hs),
end

lemma subset_balanced_core {U V : set E} (hV' : (0 : E) ∈ V)
  (hUV : ∀ (a : 𝕜) (ha : ∥a∥ ≤ 1), a • U ⊆ V) :
  U ⊆ balanced_core 𝕜 V :=
begin
  rw balanced_core_eq_Inter hV',
  refine set.subset_Inter₂ (λ a ha, _),
  rw [←one_smul 𝕜 U, ←mul_inv_cancel (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one ha)),
    ←smul_eq_mul, smul_assoc],
  refine set.smul_set_mono (hUV a⁻¹ _),
  rw [norm_inv],
  exact inv_le_one ha,
end

end normed_field

end balanced_hull

/-! ### Topological properties -/

section topology

variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [has_continuous_smul 𝕜 E]

lemma balanced_core_is_closed {U : set E} (hU : is_closed U) : is_closed (balanced_core 𝕜 U) :=
begin
  by_cases h : (0 : E) ∈ U,
  { rw balanced_core_eq_Inter h,
    refine is_closed_Inter (λ a, _),
    refine is_closed_Inter (λ ha, _),
    have ha' := lt_of_lt_of_le zero_lt_one ha,
    rw norm_pos_iff at ha',
    refine is_closed_map_smul_of_ne_zero ha' U hU },
  convert is_closed_empty,
  contrapose! h,
  exact balanced_core_nonempty_iff.mp (set.ne_empty_iff_nonempty.mp h),
end

lemma balanced_core_mem_nhds_zero {U : set E} (hU : U ∈ 𝓝 (0 : E)) :
  balanced_core 𝕜 U ∈ 𝓝 (0 : E) :=
begin
  -- Getting neighborhoods of the origin for `0 : 𝕜` and `0 : E`
  have h : filter.tendsto (λ (x : 𝕜 × E), x.fst • x.snd) (𝓝 (0,0)) (𝓝 ((0 : 𝕜) • (0 : E))) :=
  continuous_iff_continuous_at.mp has_continuous_smul.continuous_smul (0, 0),
  rw [smul_zero] at h,
  have h' := filter.has_basis.prod (@metric.nhds_basis_ball 𝕜 _ 0) (filter.basis_sets (𝓝 (0 : E))),
  simp_rw [←nhds_prod_eq, id.def] at h',
  have h'' := filter.tendsto.basis_left h h' U hU,
  rcases h'' with ⟨x, hx, h''⟩,
  cases normed_field.exists_norm_lt 𝕜 hx.left with y hy,
  have hy' : y ≠ 0 := norm_pos_iff.mp hy.1,
  let W := y • x.snd,
  rw ←filter.exists_mem_subset_iff,
  refine ⟨W, (set_smul_mem_nhds_zero_iff hy').mpr hx.2, _⟩,
  -- It remains to show that `W ⊆ balanced_core 𝕜 U`
  refine subset_balanced_core (mem_of_mem_nhds hU) (λ a ha, _),
  refine set.subset.trans (λ z hz, _) (set.maps_to'.mp h''),
  rw [set.image_prod, set.image2_smul],
  rw set.mem_smul_set at hz,
  rcases hz with ⟨z', hz', hz⟩,
  rw [←hz, set.mem_smul],
  refine ⟨a • y, y⁻¹ • z', _, _, _⟩,
  { rw [algebra.id.smul_eq_mul, mem_ball_zero_iff, norm_mul, ←one_mul x.fst],
    exact mul_lt_mul' ha hy.2 hy.1.le zero_lt_one },
  { convert set.smul_mem_smul_set hz',
    rw [←smul_assoc y⁻¹ y x.snd, smul_eq_mul, inv_mul_cancel hy', one_smul] },
  rw [smul_assoc, ←smul_assoc y y⁻¹ z', smul_eq_mul, mul_inv_cancel hy', one_smul],
end

variables (𝕜)

lemma nhds_basis_closed_balanced [regular_space E] : (𝓝 (0 : E)).has_basis
  (λ (s : set E), s ∈ 𝓝 (0 : E) ∧ is_closed s ∧ balanced 𝕜 s) id :=
begin
  refine (closed_nhds_basis 0).to_has_basis (λ s hs, _) (λ s hs, ⟨s, ⟨hs.1, hs.2.1⟩, rfl.subset⟩),
  refine ⟨balanced_core 𝕜 s, ⟨balanced_core_mem_nhds_zero hs.1, _⟩, balanced_core_subset s⟩,
  refine ⟨balanced_core_is_closed hs.2, balanced_core_balanced s⟩
end

end topology


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

! This file was ported from Lean 3 source module topology.instances.rat
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.Basic
import Mathbin.Topology.Algebra.Order.Archimedean
import Mathbin.Topology.Instances.Int
import Mathbin.Topology.Instances.Nat
import Mathbin.Topology.Instances.Real

/-!
# Topology on the ratonal numbers

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

The structure of a metric space on `ℚ` is introduced in this file, induced from `ℝ`.
-/

open Metric Set Filter

namespace Rat

-- without the `by exact` this is noncomputable
instance : MetricSpace ℚ :=
  MetricSpace.induced coe Rat.cast_injective Real.metricSpace

/- warning: rat.dist_eq -> Rat.dist_eq is a dubious translation:
lean 3 declaration is
  forall (x : Rat) (y : Rat), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toHasDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) x y) (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.hasNeg Real.hasSup) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))) y)))
but is expected to have type
  forall (x : Rat) (y : Rat), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) x y) (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.instNegReal Real.instSupReal) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.instSubReal) (Rat.cast.{0} Real Real.ratCast x) (Rat.cast.{0} Real Real.ratCast y)))
Case conversion may be inaccurate. Consider using '#align rat.dist_eq Rat.dist_eqₓ'. -/
theorem dist_eq (x y : ℚ) : dist x y = |x - y| :=
  rfl
#align rat.dist_eq Rat.dist_eq

/- warning: rat.dist_cast -> Rat.dist_cast is a dubious translation:
lean 3 declaration is
  forall (x : Rat) (y : Rat), Eq.{1} Real (Dist.dist.{0} Real (PseudoMetricSpace.toHasDist.{0} Real Real.pseudoMetricSpace) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))) y)) (Dist.dist.{0} Rat (PseudoMetricSpace.toHasDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) x y)
but is expected to have type
  forall (x : Rat) (y : Rat), Eq.{1} Real (Dist.dist.{0} Real (PseudoMetricSpace.toDist.{0} Real Real.pseudoMetricSpace) (Rat.cast.{0} Real Real.ratCast x) (Rat.cast.{0} Real Real.ratCast y)) (Dist.dist.{0} Rat (PseudoMetricSpace.toDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) x y)
Case conversion may be inaccurate. Consider using '#align rat.dist_cast Rat.dist_castₓ'. -/
@[norm_cast, simp]
theorem dist_cast (x y : ℚ) : dist (x : ℝ) y = dist x y :=
  rfl
#align rat.dist_cast Rat.dist_cast

/- warning: rat.uniform_continuous_coe_real -> Rat.uniformContinuous_coe_real is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} Rat Real (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))))
but is expected to have type
  UniformContinuous.{0, 0} Rat Real (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) (Rat.cast.{0} Real Real.ratCast)
Case conversion may be inaccurate. Consider using '#align rat.uniform_continuous_coe_real Rat.uniformContinuous_coe_realₓ'. -/
theorem uniformContinuous_coe_real : UniformContinuous (coe : ℚ → ℝ) :=
  uniformContinuous_comap
#align rat.uniform_continuous_coe_real Rat.uniformContinuous_coe_real

/- warning: rat.uniform_embedding_coe_real -> Rat.uniformEmbedding_coe_real is a dubious translation:
lean 3 declaration is
  UniformEmbedding.{0, 0} Rat Real (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))))
but is expected to have type
  UniformEmbedding.{0, 0} Rat Real (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) (Rat.cast.{0} Real Real.ratCast)
Case conversion may be inaccurate. Consider using '#align rat.uniform_embedding_coe_real Rat.uniformEmbedding_coe_realₓ'. -/
theorem uniformEmbedding_coe_real : UniformEmbedding (coe : ℚ → ℝ) :=
  uniformEmbedding_comap Rat.cast_injective
#align rat.uniform_embedding_coe_real Rat.uniformEmbedding_coe_real

/- warning: rat.dense_embedding_coe_real -> Rat.denseEmbedding_coe_real is a dubious translation:
lean 3 declaration is
  DenseEmbedding.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))))
but is expected to have type
  DenseEmbedding.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) (Rat.cast.{0} Real Real.ratCast)
Case conversion may be inaccurate. Consider using '#align rat.dense_embedding_coe_real Rat.denseEmbedding_coe_realₓ'. -/
theorem denseEmbedding_coe_real : DenseEmbedding (coe : ℚ → ℝ) :=
  uniformEmbedding_coe_real.DenseEmbedding Rat.denseRange_cast
#align rat.dense_embedding_coe_real Rat.denseEmbedding_coe_real

/- warning: rat.embedding_coe_real -> Rat.embedding_coe_real is a dubious translation:
lean 3 declaration is
  Embedding.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))))
but is expected to have type
  Embedding.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) (Rat.cast.{0} Real Real.ratCast)
Case conversion may be inaccurate. Consider using '#align rat.embedding_coe_real Rat.embedding_coe_realₓ'. -/
theorem embedding_coe_real : Embedding (coe : ℚ → ℝ) :=
  denseEmbedding_coe_real.toEmbedding
#align rat.embedding_coe_real Rat.embedding_coe_real

/- warning: rat.continuous_coe_real -> Rat.continuous_coe_real is a dubious translation:
lean 3 declaration is
  Continuous.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Rat Real (HasLiftT.mk.{1, 1} Rat Real (CoeTCₓ.coe.{1, 1} Rat Real (Rat.castCoe.{0} Real Real.hasRatCast))))
but is expected to have type
  Continuous.{0, 0} Rat Real (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (UniformSpace.toTopologicalSpace.{0} Real (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) (Rat.cast.{0} Real Real.ratCast)
Case conversion may be inaccurate. Consider using '#align rat.continuous_coe_real Rat.continuous_coe_realₓ'. -/
theorem continuous_coe_real : Continuous (coe : ℚ → ℝ) :=
  uniformContinuous_coe_real.Continuous
#align rat.continuous_coe_real Rat.continuous_coe_real

end Rat

/- warning: nat.dist_cast_rat -> Nat.dist_cast_rat is a dubious translation:
lean 3 declaration is
  forall (x : Nat) (y : Nat), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toHasDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Rat (HasLiftT.mk.{1, 1} Nat Rat (CoeTCₓ.coe.{1, 1} Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (StrictOrderedRing.toRing.{0} Rat (LinearOrderedRing.toStrictOrderedRing.{0} Rat Rat.linearOrderedRing))))))))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Rat (HasLiftT.mk.{1, 1} Nat Rat (CoeTCₓ.coe.{1, 1} Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (StrictOrderedRing.toRing.{0} Rat (LinearOrderedRing.toStrictOrderedRing.{0} Rat Rat.linearOrderedRing))))))))) y)) (Dist.dist.{0} Nat Nat.hasDist x y)
but is expected to have type
  forall (x : Nat) (y : Nat), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))) x) (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))) y)) (Dist.dist.{0} Nat Nat.instDistNat x y)
Case conversion may be inaccurate. Consider using '#align nat.dist_cast_rat Nat.dist_cast_ratₓ'. -/
@[norm_cast, simp]
theorem Nat.dist_cast_rat (x y : ℕ) : dist (x : ℚ) y = dist x y := by
  rw [← Nat.dist_cast_real, ← Rat.dist_cast] <;> congr 1 <;> norm_cast
#align nat.dist_cast_rat Nat.dist_cast_rat

/- warning: nat.uniform_embedding_coe_rat -> Nat.uniformEmbedding_coe_rat is a dubious translation:
lean 3 declaration is
  UniformEmbedding.{0, 0} Nat Rat Nat.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Rat (HasLiftT.mk.{1, 1} Nat Rat (CoeTCₓ.coe.{1, 1} Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (StrictOrderedRing.toRing.{0} Rat (LinearOrderedRing.toStrictOrderedRing.{0} Rat Rat.linearOrderedRing))))))))))
but is expected to have type
  UniformEmbedding.{0, 0} Nat Rat instUniformSpaceNat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))))
Case conversion may be inaccurate. Consider using '#align nat.uniform_embedding_coe_rat Nat.uniformEmbedding_coe_ratₓ'. -/
theorem Nat.uniformEmbedding_coe_rat : UniformEmbedding (coe : ℕ → ℚ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one <| by simpa using Nat.pairwise_one_le_dist
#align nat.uniform_embedding_coe_rat Nat.uniformEmbedding_coe_rat

/- warning: nat.closed_embedding_coe_rat -> Nat.closedEmbedding_coe_rat is a dubious translation:
lean 3 declaration is
  ClosedEmbedding.{0, 0} Nat Rat Nat.topologicalSpace (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Rat (HasLiftT.mk.{1, 1} Nat Rat (CoeTCₓ.coe.{1, 1} Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (StrictOrderedRing.toRing.{0} Rat (LinearOrderedRing.toStrictOrderedRing.{0} Rat Rat.linearOrderedRing))))))))))
but is expected to have type
  ClosedEmbedding.{0, 0} Nat Rat instTopologicalSpaceNat (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))))
Case conversion may be inaccurate. Consider using '#align nat.closed_embedding_coe_rat Nat.closedEmbedding_coe_ratₓ'. -/
theorem Nat.closedEmbedding_coe_rat : ClosedEmbedding (coe : ℕ → ℚ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one <| by simpa using Nat.pairwise_one_le_dist
#align nat.closed_embedding_coe_rat Nat.closedEmbedding_coe_rat

/- warning: int.dist_cast_rat -> Int.dist_cast_rat is a dubious translation:
lean 3 declaration is
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toHasDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Rat (HasLiftT.mk.{1, 1} Int Rat (CoeTCₓ.coe.{1, 1} Int Rat (Int.castCoe.{0} Rat Rat.hasIntCast))) x) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Rat (HasLiftT.mk.{1, 1} Int Rat (CoeTCₓ.coe.{1, 1} Int Rat (Int.castCoe.{0} Rat Rat.hasIntCast))) y)) (Dist.dist.{0} Int Int.hasDist x y)
but is expected to have type
  forall (x : Int) (y : Int), Eq.{1} Real (Dist.dist.{0} Rat (PseudoMetricSpace.toDist.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Int.cast.{0} Rat Rat.instIntCastRat x) (Int.cast.{0} Rat Rat.instIntCastRat y)) (Dist.dist.{0} Int Int.instDistInt x y)
Case conversion may be inaccurate. Consider using '#align int.dist_cast_rat Int.dist_cast_ratₓ'. -/
@[norm_cast, simp]
theorem Int.dist_cast_rat (x y : ℤ) : dist (x : ℚ) y = dist x y := by
  rw [← Int.dist_cast_real, ← Rat.dist_cast] <;> congr 1 <;> norm_cast
#align int.dist_cast_rat Int.dist_cast_rat

/- warning: int.uniform_embedding_coe_rat -> Int.uniformEmbedding_coe_rat is a dubious translation:
lean 3 declaration is
  UniformEmbedding.{0, 0} Int Rat Int.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Rat (HasLiftT.mk.{1, 1} Int Rat (CoeTCₓ.coe.{1, 1} Int Rat (Int.castCoe.{0} Rat Rat.hasIntCast))))
but is expected to have type
  UniformEmbedding.{0, 0} Int Rat instUniformSpaceInt (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Int.cast.{0} Rat Rat.instIntCastRat)
Case conversion may be inaccurate. Consider using '#align int.uniform_embedding_coe_rat Int.uniformEmbedding_coe_ratₓ'. -/
theorem Int.uniformEmbedding_coe_rat : UniformEmbedding (coe : ℤ → ℚ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one <| by simpa using Int.pairwise_one_le_dist
#align int.uniform_embedding_coe_rat Int.uniformEmbedding_coe_rat

/- warning: int.closed_embedding_coe_rat -> Int.closedEmbedding_coe_rat is a dubious translation:
lean 3 declaration is
  ClosedEmbedding.{0, 0} Int Rat Int.topologicalSpace (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Rat (HasLiftT.mk.{1, 1} Int Rat (CoeTCₓ.coe.{1, 1} Int Rat (Int.castCoe.{0} Rat Rat.hasIntCast))))
but is expected to have type
  ClosedEmbedding.{0, 0} Int Rat instTopologicalSpaceInt (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (Int.cast.{0} Rat Rat.instIntCastRat)
Case conversion may be inaccurate. Consider using '#align int.closed_embedding_coe_rat Int.closedEmbedding_coe_ratₓ'. -/
theorem Int.closedEmbedding_coe_rat : ClosedEmbedding (coe : ℤ → ℚ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one <| by simpa using Int.pairwise_one_le_dist
#align int.closed_embedding_coe_rat Int.closedEmbedding_coe_rat

namespace Rat

instance : NoncompactSpace ℚ :=
  Int.closedEmbedding_coe_rat.NoncompactSpace

/- warning: rat.uniform_continuous_add -> Rat.uniformContinuous_add is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} (Prod.{0, 0} Rat Rat) Rat (Prod.uniformSpace.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (fun (p : Prod.{0, 0} Rat Rat) => HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.hasAdd) (Prod.fst.{0, 0} Rat Rat p) (Prod.snd.{0, 0} Rat Rat p))
but is expected to have type
  UniformContinuous.{0, 0} (Prod.{0, 0} Rat Rat) Rat (instUniformSpaceProd.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (fun (p : Prod.{0, 0} Rat Rat) => HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.instAddRat) (Prod.fst.{0, 0} Rat Rat p) (Prod.snd.{0, 0} Rat Rat p))
Case conversion may be inaccurate. Consider using '#align rat.uniform_continuous_add Rat.uniformContinuous_addₓ'. -/
-- TODO(Mario): Find a way to use rat_add_continuous_lemma
theorem uniformContinuous_add : UniformContinuous fun p : ℚ × ℚ => p.1 + p.2 :=
  Rat.uniformEmbedding_coe_real.to_uniformInducing.uniformContinuous_iff.2 <| by
    simp only [(· ∘ ·), Rat.cast_add] <;>
      exact
        real.uniform_continuous_add.comp
          (rat.uniform_continuous_coe_real.prod_map Rat.uniformContinuous_coe_real)
#align rat.uniform_continuous_add Rat.uniformContinuous_add

/- warning: rat.uniform_continuous_neg -> Rat.uniformContinuous_neg is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (Neg.neg.{0} Rat Rat.hasNeg)
but is expected to have type
  UniformContinuous.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Neg.neg.{0} Rat Rat.instNegRat)
Case conversion may be inaccurate. Consider using '#align rat.uniform_continuous_neg Rat.uniformContinuous_negₓ'. -/
theorem uniformContinuous_neg : UniformContinuous (@Neg.neg ℚ _) :=
  Metric.uniformContinuous_iff.2 fun ε ε0 =>
    ⟨_, ε0, fun a b h => by rw [dist_comm] at h <;> simpa [Rat.dist_eq] using h⟩
#align rat.uniform_continuous_neg Rat.uniformContinuous_neg

instance : UniformAddGroup ℚ :=
  UniformAddGroup.mk' Rat.uniformContinuous_add Rat.uniformContinuous_neg

instance : TopologicalAddGroup ℚ := by infer_instance

instance : OrderTopology ℚ :=
  induced_orderTopology _ (fun x y => Rat.cast_lt) (@exists_rat_btwn _ _ _)

/- warning: rat.uniform_continuous_abs -> Rat.uniformContinuous_abs is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (Abs.abs.{0} Rat (Neg.toHasAbs.{0} Rat Rat.hasNeg Rat.hasSup))
but is expected to have type
  UniformContinuous.{0, 0} Rat Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Abs.abs.{0} Rat (Neg.toHasAbs.{0} Rat Rat.instNegRat Rat.instSupRat))
Case conversion may be inaccurate. Consider using '#align rat.uniform_continuous_abs Rat.uniformContinuous_absₓ'. -/
theorem uniformContinuous_abs : UniformContinuous (abs : ℚ → ℚ) :=
  Metric.uniformContinuous_iff.2 fun ε ε0 =>
    ⟨ε, ε0, fun a b h =>
      lt_of_le_of_lt (by simpa [Rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩
#align rat.uniform_continuous_abs Rat.uniformContinuous_abs

/- warning: rat.continuous_mul -> Rat.continuous_mul is a dubious translation:
lean 3 declaration is
  Continuous.{0, 0} (Prod.{0, 0} Rat Rat) Rat (Prod.topologicalSpace.{0, 0} Rat Rat (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)))) (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace))) (fun (p : Prod.{0, 0} Rat Rat) => HMul.hMul.{0, 0, 0} Rat Rat Rat (instHMul.{0} Rat Rat.hasMul) (Prod.fst.{0, 0} Rat Rat p) (Prod.snd.{0, 0} Rat Rat p))
but is expected to have type
  Continuous.{0, 0} (Prod.{0, 0} Rat Rat) Rat (instTopologicalSpaceProd.{0, 0} Rat Rat (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)))) (UniformSpace.toTopologicalSpace.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat))) (fun (p : Prod.{0, 0} Rat Rat) => HMul.hMul.{0, 0, 0} Rat Rat Rat (instHMul.{0} Rat Rat.instMulRat) (Prod.fst.{0, 0} Rat Rat p) (Prod.snd.{0, 0} Rat Rat p))
Case conversion may be inaccurate. Consider using '#align rat.continuous_mul Rat.continuous_mulₓ'. -/
theorem continuous_mul : Continuous fun p : ℚ × ℚ => p.1 * p.2 :=
  Rat.embedding_coe_real.continuous_iff.2 <| by
    simp [(· ∘ ·)] <;>
      exact real.continuous_mul.comp (rat.continuous_coe_real.prod_map Rat.continuous_coe_real)
#align rat.continuous_mul Rat.continuous_mul

instance : TopologicalRing ℚ :=
  { Rat.topologicalAddGroup with continuous_mul := Rat.continuous_mul }

/- warning: rat.totally_bounded_Icc -> Rat.totallyBounded_Icc is a dubious translation:
lean 3 declaration is
  forall (a : Rat) (b : Rat), TotallyBounded.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.metricSpace)) (Set.Icc.{0} Rat Rat.preorder a b)
but is expected to have type
  forall (a : Rat) (b : Rat), TotallyBounded.{0} Rat (PseudoMetricSpace.toUniformSpace.{0} Rat (MetricSpace.toPseudoMetricSpace.{0} Rat Rat.instMetricSpaceRat)) (Set.Icc.{0} Rat Rat.instPreorderRat a b)
Case conversion may be inaccurate. Consider using '#align rat.totally_bounded_Icc Rat.totallyBounded_Iccₓ'. -/
theorem totallyBounded_Icc (a b : ℚ) : TotallyBounded (Icc a b) := by
  simpa only [preimage_cast_Icc] using
    totallyBounded_preimage Rat.uniformEmbedding_coe_real (totallyBounded_Icc a b)
#align rat.totally_bounded_Icc Rat.totallyBounded_Icc

end Rat


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Lu-Ming Zhang
-/
import combinatorics.simple_graph.basic
import combinatorics.simple_graph.connectivity
import data.rel
import linear_algebra.matrix.trace
import linear_algebra.matrix.symmetric

/-!
# Adjacency Matrices

This module defines the adjacency matrix of a graph, and provides theorems connecting graph
properties to computational properties of the matrix.

## Main definitions

* `matrix.is_adj_matrix`: `A : matrix V V α` is qualified as an "adjacency matrix" if
  (1) every entry of `A` is `0` or `1`,
  (2) `A` is symmetric,
  (3) every diagonal entry of `A` is `0`.

* `matrix.is_adj_matrix.to_graph`: for `A : matrix V V α` and `h : A.is_adj_matrix`,
  `h.to_graph` is the simple graph induced by `A`.

* `matrix.compl`: for `A : matrix V V α`, `A.compl` is supposed to be
  the adjacency matrix of the complement graph of the graph induced by `A`.

* `simple_graph.adj_matrix`: the adjacency matrix of a `simple_graph`.

* `simple_graph.adj_matrix_pow_apply_eq_card_walk`: each entry of the `n`th power of
  a graph's adjacency matrix counts the number of length-`n` walks between the corresponding
  pair of vertices.

-/

open_locale big_operators matrix
open finset matrix simple_graph

variables {V α β : Type*}

namespace matrix

/-- `A : matrix V V α` is qualified as an "adjacency matrix" if
    (1) every entry of `A` is `0` or `1`,
    (2) `A` is symmetric,
    (3) every diagonal entry of `A` is `0`. -/
structure is_adj_matrix [has_zero α] [has_one α] (A : matrix V V α) : Prop :=
(zero_or_one : ∀ i j, (A i j) = 0 ∨ (A i j) = 1 . obviously)
(symm : A.is_symm . obviously)
(apply_diag : ∀ i, A i i = 0 . obviously)

namespace is_adj_matrix

variables {A : matrix V V α}

@[simp]
lemma apply_diag_ne [mul_zero_one_class α] [nontrivial α] (h : is_adj_matrix A) (i : V) :
  ¬ A i i = 1 :=
by simp [h.apply_diag i]

@[simp]
lemma apply_ne_one_iff [mul_zero_one_class α] [nontrivial α] (h : is_adj_matrix A) (i j : V) :
  ¬ A i j = 1 ↔ A i j = 0 :=
by { obtain (h|h) := h.zero_or_one i j; simp [h] }

@[simp]
lemma apply_ne_zero_iff [mul_zero_one_class α] [nontrivial α] (h : is_adj_matrix A) (i j : V) :
  ¬ A i j = 0 ↔ A i j = 1 :=
by rw [←apply_ne_one_iff h, not_not]

/-- For `A : matrix V V α` and `h : is_adj_matrix A`,
    `h.to_graph` is the simple graph whose adjacency matrix is `A`. -/
@[simps]
def to_graph [mul_zero_one_class α] [nontrivial α] (h : is_adj_matrix A) :
  simple_graph V :=
{ adj := λ i j, A i j = 1,
  symm := λ i j hij, by rwa h.symm.apply i j,
  loopless := λ i, by simp [h] }

instance [mul_zero_one_class α] [nontrivial α] [decidable_eq α] (h : is_adj_matrix A) :
  decidable_rel h.to_graph.adj :=
by { simp only [to_graph], apply_instance }

end is_adj_matrix

/-- For `A : matrix V V α`, `A.compl` is supposed to be the adjacency matrix of
    the complement graph of the graph induced by `A.adj_matrix`. -/
def compl [has_zero α] [has_one α] [decidable_eq α] [decidable_eq V] (A : matrix V V α) :
  matrix V V α :=
λ i j, ite (i = j) 0 (ite (A i j = 0) 1 0)

section compl

variables [decidable_eq α] [decidable_eq V] (A : matrix V V α)

@[simp]
lemma compl_apply_diag [has_zero α] [has_one α] (i : V) :
  A.compl i i = 0 :=
by simp [compl]

@[simp]
lemma compl_apply [has_zero α] [has_one α] (i j : V) :
  A.compl i j = 0 ∨ A.compl i j = 1 :=
by { unfold compl, split_ifs; simp, }

@[simp]
lemma is_symm_compl [has_zero α] [has_one α] (h : A.is_symm) :
  A.compl.is_symm :=
by { ext, simp [compl, h.apply, eq_comm], }

@[simp]
lemma is_adj_matrix_compl [has_zero α] [has_one α] (h : A.is_symm) :
  is_adj_matrix A.compl :=
{ symm := by simp [h] }

namespace is_adj_matrix

variable {A}

@[simp]
lemma compl [has_zero α] [has_one α] (h : is_adj_matrix A) :
  is_adj_matrix A.compl :=
is_adj_matrix_compl A h.symm

lemma to_graph_compl_eq [mul_zero_one_class α] [nontrivial α] (h : is_adj_matrix A) :
  h.compl.to_graph = (h.to_graph)ᶜ :=
begin
  ext v w,
  cases h.zero_or_one v w with h h;
  by_cases hvw : v = w;
  simp [matrix.compl, h, hvw]
end

end is_adj_matrix

end compl

end matrix

open matrix

namespace simple_graph

variables (G : simple_graph V) [decidable_rel G.adj]
variables (α)

/-- `adj_matrix G α` is the matrix `A` such that `A i j = (1 : α)` if `i` and `j` are
  adjacent in the simple graph `G`, and otherwise `A i j = 0`. -/
def adj_matrix [has_zero α] [has_one α] : matrix V V α
| i j := if (G.adj i j) then 1 else 0

variable {α}

@[simp]
lemma adj_matrix_apply (v w : V) [has_zero α] [has_one α] :
  G.adj_matrix α v w = if (G.adj v w) then 1 else 0 := rfl

@[simp]
theorem transpose_adj_matrix [has_zero α] [has_one α] :
  (G.adj_matrix α)ᵀ = G.adj_matrix α :=
by { ext, simp [adj_comm] }

@[simp]
lemma is_symm_adj_matrix [has_zero α] [has_one α] :
  (G.adj_matrix α).is_symm :=
transpose_adj_matrix G

variable (α)

/-- The adjacency matrix of `G` is an adjacency matrix. -/
@[simp]
lemma is_adj_matrix_adj_matrix [has_zero α] [has_one α] :
  (G.adj_matrix α).is_adj_matrix :=
{ zero_or_one := λ i j, by by_cases G.adj i j; simp [h] }

/-- The graph induced by the adjacency matrix of `G` is `G` itself. -/
lemma to_graph_adj_matrix_eq [mul_zero_one_class α] [nontrivial α] :
  (G.is_adj_matrix_adj_matrix α).to_graph = G :=
begin
  ext,
  simp only [is_adj_matrix.to_graph_adj, adj_matrix_apply, ite_eq_left_iff, zero_ne_one],
  apply not_not,
end

variables {α} [fintype V]

@[simp]
lemma adj_matrix_dot_product [non_assoc_semiring α] (v : V) (vec : V → α) :
  dot_product (G.adj_matrix α v) vec = ∑ u in G.neighbor_finset v, vec u :=
by simp [neighbor_finset_eq_filter, dot_product, sum_filter]

@[simp]
lemma dot_product_adj_matrix [non_assoc_semiring α] (v : V) (vec : V → α) :
  dot_product vec (G.adj_matrix α v) = ∑ u in G.neighbor_finset v, vec u :=
by simp [neighbor_finset_eq_filter, dot_product, sum_filter, finset.sum_apply]

@[simp]
lemma adj_matrix_mul_vec_apply [non_assoc_semiring α] (v : V) (vec : V → α) :
  ((G.adj_matrix α).mul_vec vec) v = ∑ u in G.neighbor_finset v, vec u :=
by rw [mul_vec, adj_matrix_dot_product]

@[simp]
lemma adj_matrix_vec_mul_apply [non_assoc_semiring α] (v : V) (vec : V → α) :
  ((G.adj_matrix α).vec_mul vec) v = ∑ u in G.neighbor_finset v, vec u :=
begin
  rw [← dot_product_adj_matrix, vec_mul],
  refine congr rfl _, ext,
  rw [← transpose_apply (adj_matrix α G) x v, transpose_adj_matrix],
end

@[simp]
lemma adj_matrix_mul_apply [non_assoc_semiring α] (M : matrix V V α) (v w : V) :
  (G.adj_matrix α ⬝ M) v w = ∑ u in G.neighbor_finset v, M u w :=
by simp [mul_apply, neighbor_finset_eq_filter, sum_filter]

@[simp]

variable (α)

@[simp] theorem trace_adj_matrix [add_comm_monoid α] [has_one α] :
  matrix.trace (G.adj_matrix α) = 0 :=
by simp [matrix.trace]

variable {α}

theorem adj_matrix_mul_self_apply_self [non_assoc_semiring α] (i : V) :
  ((G.adj_matrix α) ⬝ (G.adj_matrix α)) i i = degree G i :=
by simp [degree]

variable {G}

@[simp]
lemma adj_matrix_mul_vec_const_apply [semiring α] {a : α} {v : V} :
  (G.adj_matrix α).mul_vec (function.const _ a) v = G.degree v * a :=
by simp [degree]

lemma adj_matrix_mul_vec_const_apply_of_regular [semiring α] {d : ℕ} {a : α}
  (hd : G.is_regular_of_degree d) {v : V} :
  (G.adj_matrix α).mul_vec (function.const _ a) v = (d * a) :=
by simp [hd v]

theorem adj_matrix_pow_apply_eq_card_walk [decidable_eq V] [semiring α] (n : ℕ) (u v : V) :
  (G.adj_matrix α ^ n) u v = fintype.card {p : G.walk u v | p.length = n} :=
begin
  rw card_set_walk_length_eq,
  induction n with n ih generalizing u v,
  { obtain rfl | h := eq_or_ne u v; simp [finset_walk_length, *] },
  { nth_rewrite 0 [nat.succ_eq_one_add],
    simp only [pow_add, pow_one, finset_walk_length, ih, mul_eq_mul, adj_matrix_mul_apply],
    rw finset.card_bUnion,
    { norm_cast,
      rw set.sum_indicator_subset _ (subset_univ (G.neighbor_finset u)),
      congr' 2,
      ext x,
      split_ifs with hux; simp [hux], },
    /- Disjointness for card_bUnion -/
    { intros x hx y hy hxy p hp,
      split_ifs at hp with hx hy;
      simp only [inf_eq_inter, empty_inter, inter_empty, not_mem_empty, mem_inter, mem_map,
        function.embedding.coe_fn_mk, exists_prop] at hp;
      try { simpa using hp },
      obtain ⟨⟨qx, hql, hqp⟩, ⟨rx, hrl, hrp⟩⟩ := hp,
      unify_equations hqp hrp,
      exact absurd rfl hxy, } },
end

end simple_graph

namespace matrix.is_adj_matrix
variables [mul_zero_one_class α] [nontrivial α]
variables {A : matrix V V α} (h : is_adj_matrix A)

/-- If `A` is qualified as an adjacency matrix,
    then the adjacency matrix of the graph induced by `A` is itself. -/
lemma adj_matrix_to_graph_eq [decidable_eq α] :
  h.to_graph.adj_matrix α = A :=
begin
  ext i j,
  obtain (h'|h') := h.zero_or_one i j; simp [h'],
end

end matrix.is_adj_matrix


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Yury Kudryashov
-/
import data.real.sqrt
import tactic.interval_cases
import ring_theory.algebraic
import data.rat.sqrt
import ring_theory.int.basic
/-!
# Irrational real numbers

In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
`rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.

We also provide dot-style constructors like `irrational.add_rat`, `irrational.rat_sub` etc.
-/

open rat real multiplicity

/-- A real number is irrational if it is not equal to any rational number. -/
def irrational (x : ℝ) := x ∉ set.range (coe : ℚ → ℝ)

lemma irrational_iff_ne_rational (x : ℝ) : irrational x ↔ ∀ a b : ℤ, x ≠ a / b :=
by simp only [irrational, rat.forall, cast_mk, not_exists, set.mem_range, cast_coe_int, cast_div,
  eq_comm]

/-- A transcendental real number is irrational. -/
lemma transcendental.irrational {r : ℝ} (tr : transcendental ℚ r) :
  irrational r :=
by { rintro ⟨a, rfl⟩, exact tr (is_algebraic_algebra_map a) }

/-!
### Irrationality of roots of integer and rational numbers
-/

/-- If `x^n`, `n > 0`, is integer and is not the `n`-th power of an integer, then
`x` is irrational. -/
theorem irrational_nrt_of_notint_nrt {x : ℝ} (n : ℕ) (m : ℤ)
  (hxr : x ^ n = m) (hv : ¬ ∃ y : ℤ, x = y) (hnpos : 0 < n) :
  irrational x :=
begin
  rintros ⟨⟨N, D, P, C⟩, rfl⟩,
  rw [← cast_pow] at hxr,
  have c1 : ((D : ℤ) : ℝ) ≠ 0,
  { rw [int.cast_ne_zero, int.coe_nat_ne_zero], exact ne_of_gt P },
  have c2 : ((D : ℤ) : ℝ) ^ n ≠ 0 := pow_ne_zero _ c1,
  rw [num_denom', cast_pow, cast_mk, div_pow, div_eq_iff_mul_eq c2,
      ← int.cast_pow, ← int.cast_pow, ← int.cast_mul, int.cast_inj] at hxr,
  have hdivn : ↑D ^ n ∣ N ^ n := dvd.intro_left m hxr,
  rw [← int.dvd_nat_abs, ← int.coe_nat_pow, int.coe_nat_dvd, int.nat_abs_pow,
    nat.pow_dvd_pow_iff hnpos] at hdivn,
  obtain rfl : D = 1 := by rw [← nat.gcd_eq_right hdivn, C.gcd_eq_one],
  refine hv ⟨N, _⟩,
  rw [num_denom', int.coe_nat_one, mk_eq_div, int.cast_one, div_one, cast_coe_int]
end

/-- If `x^n = m` is an integer and `n` does not divide the `multiplicity p m`, then `x`
is irrational. -/
theorem irrational_nrt_of_n_not_dvd_multiplicity {x : ℝ} (n : ℕ) {m : ℤ} (hm : m ≠ 0) (p : ℕ)
  [hp : fact p.prime] (hxr : x ^ n = m)
  (hv : (multiplicity (p : ℤ) m).get (finite_int_iff.2 ⟨hp.1.ne_one, hm⟩) % n ≠ 0) :
  irrational x :=
begin
  rcases nat.eq_zero_or_pos n with rfl | hnpos,
  { rw [eq_comm, pow_zero, ← int.cast_one, int.cast_inj] at hxr,
    simpa [hxr, multiplicity.one_right (mt is_unit_iff_dvd_one.1
      (mt int.coe_nat_dvd.1 hp.1.not_dvd_one)), nat.zero_mod] using hv },
  refine irrational_nrt_of_notint_nrt _ _ hxr _ hnpos,
  rintro ⟨y, rfl⟩,
  rw [← int.cast_pow, int.cast_inj] at hxr, subst m,
  have : y ≠ 0, { rintro rfl, rw zero_pow hnpos at hm, exact hm rfl },
  erw [multiplicity.pow' (nat.prime_iff_prime_int.1 hp.1)
    (finite_int_iff.2 ⟨hp.1.ne_one, this⟩), nat.mul_mod_right] at hv,
  exact hv rfl
end

theorem irrational_sqrt_of_multiplicity_odd (m : ℤ) (hm : 0 < m)
  (p : ℕ) [hp : fact p.prime]
  (Hpv : (multiplicity (p : ℤ) m).get
    (finite_int_iff.2 ⟨hp.1.ne_one, (ne_of_lt hm).symm⟩) % 2 = 1) :
  irrational (sqrt m) :=
@irrational_nrt_of_n_not_dvd_multiplicity _ 2 _ (ne.symm (ne_of_lt hm)) p hp
  (sq_sqrt (int.cast_nonneg.2 $ le_of_lt hm))
  (by rw Hpv; exact one_ne_zero)

theorem nat.prime.irrational_sqrt {p : ℕ} (hp : nat.prime p) : irrational (sqrt p) :=
@irrational_sqrt_of_multiplicity_odd p (int.coe_nat_pos.2 hp.pos) p ⟨hp⟩ $
by simp [multiplicity_self (mt is_unit_iff_dvd_one.1 (mt int.coe_nat_dvd.1 hp.not_dvd_one) : _)];
  refl

/-- **Irrationality of the Square Root of 2** -/
theorem irrational_sqrt_two : irrational (sqrt 2) :=
by simpa using nat.prime_two.irrational_sqrt

theorem irrational_sqrt_rat_iff (q : ℚ) : irrational (sqrt q) ↔
  rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q :=
if H1 : rat.sqrt q * rat.sqrt q = q
then iff_of_false (not_not_intro ⟨rat.sqrt q,
  by rw [← H1, cast_mul, sqrt_mul_self (cast_nonneg.2 $ rat.sqrt_nonneg q),
         sqrt_eq, abs_of_nonneg (rat.sqrt_nonneg q)]⟩) (λ h, h.1 H1)
else if H2 : 0 ≤ q
then iff_of_true (λ ⟨r, hr⟩, H1 $ (exists_mul_self _).1 ⟨r,
  by rwa [eq_comm, sqrt_eq_iff_mul_self_eq (cast_nonneg.2 H2), ← cast_mul, rat.cast_inj] at hr;
  rw [← hr]; exact real.sqrt_nonneg _⟩) ⟨H1, H2⟩
else iff_of_false (not_not_intro ⟨0,
  by rw cast_zero; exact (sqrt_eq_zero_of_nonpos (rat.cast_nonpos.2 $ le_of_not_le H2)).symm⟩)
  (λ h, H2 h.2)

instance (q : ℚ) : decidable (irrational (sqrt q)) :=
decidable_of_iff' _ (irrational_sqrt_rat_iff q)

/-!
### Dot-style operations on `irrational`

#### Coercion of a rational/integer/natural number is not irrational
-/

namespace irrational

variable {x : ℝ}

/-!
#### Irrational number is not equal to a rational/integer/natural number
-/

theorem ne_rat (h : irrational x) (q : ℚ) : x ≠ q := λ hq, h ⟨q, hq.symm⟩

theorem ne_int (h : irrational x) (m : ℤ) : x ≠ m :=
by { rw ← rat.cast_coe_int, exact h.ne_rat _ }

theorem ne_nat (h : irrational x) (m : ℕ) : x ≠ m := h.ne_int m

theorem ne_zero (h : irrational x) : x ≠ 0 := by exact_mod_cast h.ne_nat 0

theorem ne_one (h : irrational x) : x ≠ 1 := by simpa only [nat.cast_one] using h.ne_nat 1

end irrational

@[simp] lemma rat.not_irrational (q : ℚ) : ¬irrational q := λ h, h ⟨q, rfl⟩

@[simp] lemma int.not_irrational (m : ℤ) : ¬irrational m := λ h, h.ne_int m rfl

@[simp] lemma nat.not_irrational (m : ℕ) : ¬irrational m := λ h, h.ne_nat m rfl

namespace irrational

variables (q : ℚ) {x y : ℝ}

/-!
#### Addition of rational/integer/natural numbers
-/

/-- If `x + y` is irrational, then at least one of `x` and `y` is irrational. -/
theorem add_cases : irrational (x + y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx + ry, cast_add rx ry⟩
end

theorem of_rat_add (h : irrational (q + x)) : irrational x :=
h.add_cases.resolve_left q.not_irrational

theorem rat_add (h : irrational x) : irrational (q + x) :=
of_rat_add (-q) $ by rwa [cast_neg, neg_add_cancel_left]

theorem of_add_rat : irrational (x + q) → irrational x :=
add_comm ↑q x ▸ of_rat_add q

theorem add_rat (h : irrational x) : irrational (x + q) :=
add_comm ↑q x ▸ h.rat_add q

theorem of_int_add (m : ℤ) (h : irrational (m + x)) : irrational x :=
by { rw ← cast_coe_int at h, exact h.of_rat_add m }

theorem of_add_int (m : ℤ) (h : irrational (x + m)) : irrational x :=
of_int_add m $ add_comm x m ▸ h

theorem int_add (h : irrational x) (m : ℤ) : irrational (m + x) :=
by { rw ← cast_coe_int, exact h.rat_add m }

theorem add_int (h : irrational x) (m : ℤ) : irrational (x + m) :=
add_comm ↑m x ▸ h.int_add m

theorem of_nat_add (m : ℕ) (h : irrational (m + x)) : irrational x := h.of_int_add m

theorem of_add_nat (m : ℕ) (h : irrational (x + m)) : irrational x := h.of_add_int m

theorem nat_add (h : irrational x) (m : ℕ) : irrational (m + x) := h.int_add m

theorem add_nat (h : irrational x) (m : ℕ) : irrational (x + m) := h.add_int m

/-!
#### Negation
-/

theorem of_neg (h : irrational (-x)) : irrational x :=
λ ⟨q, hx⟩, h ⟨-q, by rw [cast_neg, hx]⟩

protected theorem neg (h : irrational x) : irrational (-x) :=
of_neg $ by rwa neg_neg

/-!
#### Subtraction of rational/integer/natural numbers
-/

theorem sub_rat (h : irrational x) : irrational (x - q) :=
by simpa only [sub_eq_add_neg, cast_neg] using h.add_rat (-q)

theorem rat_sub (h : irrational x) : irrational (q - x) :=
by simpa only [sub_eq_add_neg] using h.neg.rat_add q

theorem of_sub_rat (h : irrational (x - q)) : irrational x :=
(of_add_rat (-q) $ by simpa only [cast_neg, sub_eq_add_neg] using h)

theorem of_rat_sub (h : irrational (q - x)) : irrational x :=
of_neg (of_rat_add q (by simpa only [sub_eq_add_neg] using h))

theorem sub_int (h : irrational x) (m : ℤ) : irrational (x - m) :=
by simpa only [rat.cast_coe_int] using h.sub_rat m

theorem int_sub (h : irrational x) (m : ℤ) : irrational (m - x) :=
by simpa only [rat.cast_coe_int] using h.rat_sub m

theorem of_sub_int (m : ℤ) (h : irrational (x - m)) : irrational x :=
of_sub_rat m $ by rwa rat.cast_coe_int

theorem of_int_sub (m : ℤ) (h : irrational (m - x)) : irrational x :=
of_rat_sub m $ by rwa rat.cast_coe_int

theorem sub_nat (h : irrational x) (m : ℕ) : irrational (x - m) := h.sub_int m

theorem nat_sub (h : irrational x) (m : ℕ) : irrational (m - x) := h.int_sub m

theorem of_sub_nat (m : ℕ) (h : irrational (x - m)) : irrational x := h.of_sub_int m

theorem of_nat_sub (m : ℕ) (h : irrational (m - x)) : irrational x := h.of_int_sub m

/-!
#### Multiplication by rational numbers
-/

theorem mul_cases : irrational (x * y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx * ry, cast_mul rx ry⟩
end

theorem of_mul_rat (h : irrational (x * q)) : irrational x :=
h.mul_cases.resolve_right q.not_irrational

theorem mul_rat (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x * q) :=
of_mul_rat q⁻¹ $ by rwa [mul_assoc, ← cast_mul, mul_inv_cancel hq, cast_one, mul_one]

theorem of_rat_mul : irrational (q * x) → irrational x :=
mul_comm x q ▸ of_mul_rat q

theorem rat_mul (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (q * x) :=
mul_comm x q ▸ h.mul_rat hq

theorem of_mul_int (m : ℤ) (h : irrational (x * m)) : irrational x :=
of_mul_rat m $ by rwa cast_coe_int

theorem of_int_mul (m : ℤ) (h : irrational (m * x)) : irrational x :=
of_rat_mul m $ by rwa cast_coe_int

theorem mul_int (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (x * m) :=
by { rw ← cast_coe_int, refine h.mul_rat _, rwa int.cast_ne_zero }

theorem int_mul (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (m * x) :=
mul_comm x m ▸ h.mul_int hm

theorem of_mul_nat (m : ℕ) (h : irrational (x * m)) : irrational x := h.of_mul_int m

theorem of_nat_mul (m : ℕ) (h : irrational (m * x)) : irrational x := h.of_int_mul m

theorem mul_nat (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (x * m) :=
h.mul_int $ int.coe_nat_ne_zero.2 hm

theorem nat_mul (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (m * x) :=
h.int_mul $ int.coe_nat_ne_zero.2 hm

/-!
#### Inverse
-/

theorem of_inv (h : irrational x⁻¹) : irrational x :=
λ ⟨q, hq⟩, h $ hq ▸ ⟨q⁻¹, q.cast_inv⟩

protected theorem inv (h : irrational x) : irrational x⁻¹ :=
of_inv $ by rwa inv_inv

/-!
#### Division
-/

theorem div_cases (h : irrational (x / y)) : irrational x ∨ irrational y :=
h.mul_cases.imp id of_inv

theorem of_rat_div (h : irrational (q / x)) : irrational x :=
(h.of_rat_mul q).of_inv

theorem of_div_rat (h : irrational (x / q)) : irrational x :=
h.div_cases.resolve_right q.not_irrational

theorem rat_div (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (q / x) := h.inv.rat_mul hq

theorem div_rat (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x / q) :=
by { rw [div_eq_mul_inv, ← cast_inv], exact h.mul_rat (inv_ne_zero hq) }

theorem of_int_div (m : ℤ) (h : irrational (m / x)) : irrational x :=
h.div_cases.resolve_left m.not_irrational

theorem of_div_int (m : ℤ) (h : irrational (x / m)) : irrational x :=
h.div_cases.resolve_right m.not_irrational

theorem int_div (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (m / x) :=
h.inv.int_mul hm

theorem div_int (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (x / m) :=
by { rw ← cast_coe_int, refine h.div_rat _, rwa int.cast_ne_zero }

theorem of_nat_div (m : ℕ) (h : irrational (m / x)) : irrational x := h.of_int_div m

theorem of_div_nat (m : ℕ) (h : irrational (x / m)) : irrational x := h.of_div_int m

theorem nat_div (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (m / x) := h.inv.nat_mul hm

theorem div_nat (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (x / m) :=
h.div_int $ by rwa int.coe_nat_ne_zero

theorem of_one_div (h : irrational (1 / x)) : irrational x :=
of_rat_div 1 $ by rwa [cast_one]

/-!
#### Natural and integerl power
-/

theorem of_mul_self (h : irrational (x * x)) : irrational x :=
h.mul_cases.elim id id

theorem of_pow : ∀ n : ℕ, irrational (x^n) → irrational x
| 0 := λ h, by { rw pow_zero at h, exact (h ⟨1, cast_one⟩).elim }
| (n+1) := λ h, by { rw pow_succ at h, exact h.mul_cases.elim id (of_pow n) }

theorem of_zpow : ∀ m : ℤ, irrational (x^m) → irrational x
| (n:ℕ) := λ h, by { rw zpow_coe_nat at h, exact h.of_pow _ }
| -[1+n] := λ h, by { rw zpow_neg_succ_of_nat at h, exact h.of_inv.of_pow _ }

end irrational

section polynomial

open polynomial
open_locale polynomial

variables (x : ℝ) (p : ℤ[X])

lemma one_lt_nat_degree_of_irrational_root (hx : irrational x) (p_nonzero : p ≠ 0)
  (x_is_root : aeval x p = 0) : 1 < p.nat_degree :=
begin
  by_contra rid,
  rcases exists_eq_X_add_C_of_nat_degree_le_one (not_lt.1 rid) with ⟨a, b, rfl⟩, clear rid,
  have : (a : ℝ) * x = -b, by simpa [eq_neg_iff_add_eq_zero] using x_is_root,
  rcases em (a = 0) with (rfl|ha),
  { obtain rfl : b = 0, by simpa,
    simpa using p_nonzero },
  { rw [mul_comm, ← eq_div_iff_mul_eq, eq_comm] at this,
    refine hx ⟨-b / a, _⟩,
    assumption_mod_cast, assumption_mod_cast }
end

end polynomial

section
variables {q : ℚ} {m : ℤ} {n : ℕ} {x : ℝ}

open irrational

/-!
### Simplification lemmas about operations
-/

@[simp] theorem irrational_rat_add_iff : irrational (q + x) ↔ irrational x :=
⟨of_rat_add q, rat_add q⟩

@[simp] theorem irrational_int_add_iff : irrational (m + x) ↔ irrational x :=
⟨of_int_add m, λ h, h.int_add m⟩

@[simp] theorem irrational_nat_add_iff : irrational (n + x) ↔ irrational x :=
⟨of_nat_add n, λ h, h.nat_add n⟩

@[simp] theorem irrational_add_rat_iff : irrational (x + q) ↔ irrational x :=
⟨of_add_rat q, add_rat q⟩

@[simp] theorem irrational_add_int_iff : irrational (x + m) ↔ irrational x :=
⟨of_add_int m, λ h, h.add_int m⟩

@[simp] theorem irrational_add_nat_iff : irrational (x + n) ↔ irrational x :=
⟨of_add_nat n, λ h, h.add_nat n⟩

@[simp] theorem irrational_rat_sub_iff : irrational (q - x) ↔ irrational x :=
⟨of_rat_sub q, rat_sub q⟩

@[simp] theorem irrational_int_sub_iff : irrational (m - x) ↔ irrational x :=
⟨of_int_sub m, λ h, h.int_sub m⟩

@[simp] theorem irrational_nat_sub_iff : irrational (n - x) ↔ irrational x :=
⟨of_nat_sub n, λ h, h.nat_sub n⟩

@[simp] theorem irrational_sub_rat_iff : irrational (x - q) ↔ irrational x :=
⟨of_sub_rat q, sub_rat q⟩

@[simp] theorem irrational_sub_int_iff : irrational (x - m) ↔ irrational x :=
⟨of_sub_int m, λ h, h.sub_int m⟩

@[simp] theorem irrational_sub_nat_iff : irrational (x - n) ↔ irrational x :=
⟨of_sub_nat n, λ h, h.sub_nat n⟩

@[simp] theorem irrational_neg_iff : irrational (-x) ↔ irrational x :=
⟨of_neg, irrational.neg⟩

@[simp] theorem irrational_inv_iff : irrational x⁻¹ ↔ irrational x :=
⟨of_inv, irrational.inv⟩

@[simp] theorem irrational_rat_mul_iff : irrational (q * x) ↔ q ≠ 0 ∧ irrational x :=
⟨λ h, ⟨rat.cast_ne_zero.1 $ left_ne_zero_of_mul h.ne_zero, h.of_rat_mul q⟩, λ h, h.2.rat_mul h.1⟩

@[simp] theorem irrational_mul_rat_iff : irrational (x * q) ↔ q ≠ 0 ∧ irrational x :=
by rw [mul_comm, irrational_rat_mul_iff]

@[simp] theorem irrational_int_mul_iff : irrational (m * x) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_rat_mul_iff, int.cast_ne_zero]

@[simp] theorem irrational_mul_int_iff : irrational (x * m) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_mul_rat_iff, int.cast_ne_zero]

@[simp] theorem irrational_nat_mul_iff : irrational (n * x) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_rat_mul_iff, nat.cast_ne_zero]

@[simp] theorem irrational_mul_nat_iff : irrational (x * n) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_mul_rat_iff, nat.cast_ne_zero]

@[simp] theorem irrational_rat_div_iff : irrational (q / x) ↔ q ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_rat_iff : irrational (x / q) ↔ q ≠ 0 ∧ irrational x :=
by rw [div_eq_mul_inv, ← cast_inv, irrational_mul_rat_iff, ne.def, inv_eq_zero]

@[simp] theorem irrational_int_div_iff : irrational (m / x) ↔ m ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_int_iff : irrational (x / m) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_div_rat_iff, int.cast_ne_zero]

@[simp] theorem irrational_nat_div_iff : irrational (n / x) ↔ n ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_nat_iff : irrational (x / n) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_div_rat_iff, nat.cast_ne_zero]

/-- There is an irrational number `r` between any two reals `x < r < y`. -/
theorem exists_irrational_btwn {x y : ℝ} (h : x < y) :
  ∃ r, irrational r ∧ x < r ∧ r < y :=
let ⟨q, ⟨hq1, hq2⟩⟩ := (exists_rat_btwn ((sub_lt_sub_iff_right (real.sqrt 2)).mpr h)) in
  ⟨q + real.sqrt 2, irrational_sqrt_two.rat_add _,
    sub_lt_iff_lt_add.mp hq1, lt_sub_iff_add_lt.mp hq2⟩

end


import data.list.basic

-- Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as you can now
-- with tactic proofs, using also rw and simp as appropriate.
section ex1
  -- Almost all of these can be proven by `safe` or `solve_iff`:
  meta def solve_iff : tactic unit :=
  `[ apply iff.intro, repeat { safe } ]
  -- So I only left out the ones that couldn't.

  -- chapter 3 automated away

  section chapter4
    -- ex. 1 automated away

    section ex2
      variables (α : Type) (p q : α → Prop)
      variable r : Prop

      example : α → ((∀ x : α, r) ↔ r) := begin
      intro,
        apply iff.intro,
          safe,
          have : r, from a_1 a, -- is it fine to rely on auto-generated names?
          repeat { safe }
      end
    end ex2

    section ex3
      variables (men : Type) (barber : men)
      variable  (shaves : men → men → Prop)

      example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
        false := begin
          have h', from h barber,
          safe
        end
    end ex3

    -- ex. 4 contains no proofs

    section ex5
      variables (α : Type) (p q : α → Prop)
      variable a : α
      include a -- use non-emptiness of α in tactic proofs
      variable r : Prop

      example : r → (∃ x : α, r) := begin
        intro,
        apply exists.intro,
        repeat { assumption }
      end

      example : (∃ x, p x → r) ↔ (∀ x, p x) → r := begin
        apply iff.intro,
        safe,
        safe,
        show false, from a_2 a
      end
      example : (∃ x, r → p x) ↔ (r → ∃ x, p x) := begin
        apply iff.intro,
        safe,
        safe,
        show false, from a_2 a
      end
    end ex5

    -- ex. 6 automated away

    -- ex. 7 automated away
  end chapter4
end ex1

-- Use tactic combinators to obtain a one line proof of the following:
section ex2
  example (p q r: Prop) (hp: p) :
    (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
  by simp * -- was i supposed to do something more low-level here? :)
end ex2


import tactic

-- notation for products

-- enter the product namespace

namespace prod

variables (X Y : Type)

-- Notation for product is `×`, `\times` in VS Code
#check X × Y -- Type.

-- notation for elements

variables (x : X) (y : Y)

/-! ## The Data -/

-- this is notation for `prod.mk`, the function which constructs
-- an element of X × Y from an element of `X` and an eleent of `Y`
#check (x, y) -- X × Y

-- The projections are called `fst` and `snd`.

#check prod.fst
#check prod.snd

-- but "dot notation" `a.1` and `a.2` are used more often if `a : X × Y`
-- The
#check prod
--#print prefix prod
#check @mk

/-! ## The proofs that it satisfies the axioms for product -/

-- this one is true by definition but actually
-- using definitional equality is in some
-- sense cheating the system
example : (x, y).1 = x :=
begin
  refl
end

-- this one is true by something
example (a : X × Y) : (a.1, a.2) = a :=
begin
  apply mk.eta, -- this axiom is called "eta conversion"
end

/-! ## the universal property -/

#check @prod.rec

-- universal property
example : ∀ (T : Type) (f : T → X) (g : T → Y),
∃! h : T → X × Y, prod.fst ∘ h = f ∧ prod.snd ∘ h = g :=
begin
  intros,
  use [λ t, (f t, g t)],
  -- tidy works now
  split,
    split,
      refl,
    refl,
  rintro j ⟨rfl,rfl⟩,
  funext t,
  apply mk.eta.symm,
end

end prod


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group_with_zero.basic
import algebra.group.units
import tactic.nontriviality
import tactic.assert_exists

/-!
# Lemmas about units in a `monoid_with_zero` or a `group_with_zero`.

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

We also define `ring.inverse`, a globally defined function on any ring
(in fact any `monoid_with_zero`), which inverts units and sends non-units to zero.
-/

variables {α M₀ G₀ M₀' G₀' F F' : Type*}

variables [monoid_with_zero M₀]

namespace units

/-- An element of the unit group of a nonzero monoid with zero represented as an element
    of the monoid is nonzero. -/
@[simp] lemma ne_zero [nontrivial M₀] (u : M₀ˣ) :
  (u : M₀) ≠ 0 :=
left_ne_zero_of_mul_eq_one u.mul_inv

-- We can't use `mul_eq_zero` + `units.ne_zero` in the next two lemmas because we don't assume
-- `nonzero M₀`.

@[simp] lemma mul_left_eq_zero (u : M₀ˣ) {a : M₀} : a * u = 0 ↔ a = 0 :=
⟨λ h, by simpa using mul_eq_zero_of_left h ↑u⁻¹, λ h, mul_eq_zero_of_left h u⟩

@[simp] lemma mul_right_eq_zero (u : M₀ˣ) {a : M₀} : ↑u * a = 0 ↔ a = 0 :=
⟨λ h, by simpa using mul_eq_zero_of_right ↑u⁻¹ h, mul_eq_zero_of_right u⟩

end units

namespace is_unit

lemma ne_zero [nontrivial M₀] {a : M₀} (ha : is_unit a) : a ≠ 0 := let ⟨u, hu⟩ :=
ha in hu ▸ u.ne_zero

lemma mul_right_eq_zero {a b : M₀} (ha : is_unit a) : a * b = 0 ↔ b = 0 :=
let ⟨u, hu⟩ := ha in hu ▸ u.mul_right_eq_zero

lemma mul_left_eq_zero {a b : M₀} (hb : is_unit b) : a * b = 0 ↔ a = 0 :=
let ⟨u, hu⟩ := hb in hu ▸ u.mul_left_eq_zero

end is_unit

@[simp] theorem is_unit_zero_iff : is_unit (0 : M₀) ↔ (0:M₀) = 1 :=
⟨λ ⟨⟨_, a, (a0 : 0 * a = 1), _⟩, rfl⟩, by rwa zero_mul at a0,
 λ h, @is_unit_of_subsingleton _ _ (subsingleton_of_zero_eq_one h) 0⟩

@[simp] theorem not_is_unit_zero [nontrivial M₀] : ¬ is_unit (0 : M₀) :=
mt is_unit_zero_iff.1 zero_ne_one

namespace ring
open_locale classical

/-- Introduce a function `inverse` on a monoid with zero `M₀`, which sends `x` to `x⁻¹` if `x` is
invertible and to `0` otherwise.  This definition is somewhat ad hoc, but one needs a fully (rather
than partially) defined inverse function for some purposes, including for calculus.

Note that while this is in the `ring` namespace for brevity, it requires the weaker assumption
`monoid_with_zero M₀` instead of `ring M₀`. -/
noncomputable def inverse : M₀ → M₀ :=
λ x, if h : is_unit x then ((h.unit⁻¹ : M₀ˣ) : M₀) else 0

/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/
@[simp] lemma inverse_unit (u : M₀ˣ) : inverse (u : M₀) = (u⁻¹ : M₀ˣ) :=
begin
  simp only [units.is_unit, inverse, dif_pos],
  exact units.inv_unique rfl
end

/-- By definition, if `x` is not invertible then `inverse x = 0`. -/
@[simp] lemma inverse_non_unit (x : M₀) (h : ¬(is_unit x)) : inverse x = 0 := dif_neg h

lemma mul_inverse_cancel (x : M₀) (h : is_unit x) : x * inverse x = 1 :=
by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.mul_inv], }

lemma inverse_mul_cancel (x : M₀) (h : is_unit x) : inverse x * x = 1 :=
by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.inv_mul], }

lemma mul_inverse_cancel_right (x y : M₀) (h : is_unit x) : y * x * inverse x = y :=
by rw [mul_assoc, mul_inverse_cancel x h, mul_one]

lemma inverse_mul_cancel_right (x y : M₀) (h : is_unit x) : y * inverse x * x = y :=
by rw [mul_assoc, inverse_mul_cancel x h, mul_one]

lemma mul_inverse_cancel_left (x y : M₀) (h : is_unit x) : x * (inverse x * y) = y :=
by rw [← mul_assoc, mul_inverse_cancel x h, one_mul]

lemma inverse_mul_cancel_left (x y : M₀) (h : is_unit x) : inverse x * (x * y) = y :=
by rw [← mul_assoc, inverse_mul_cancel x h, one_mul]

lemma inverse_mul_eq_iff_eq_mul (x y z : M₀) (h : is_unit x) :
  inverse x * y = z ↔ y = x * z :=
⟨λ h1, by rw [← h1, mul_inverse_cancel_left _ _ h], λ h1, by rw [h1, inverse_mul_cancel_left _ _ h]⟩

lemma eq_mul_inverse_iff_mul_eq (x y z : M₀) (h : is_unit z) :
  x = y * inverse z ↔ x * z = y :=
⟨λ h1, by rw [h1, inverse_mul_cancel_right _ _ h],
  λ h1, by rw [← h1, mul_inverse_cancel_right _ _ h]⟩

variables (M₀)

@[simp] lemma inverse_one : inverse (1 : M₀) = 1 :=
inverse_unit 1

@[simp] lemma inverse_zero : inverse (0 : M₀) = 0 :=
by { nontriviality, exact inverse_non_unit _ not_is_unit_zero }

variables {M₀}

end ring

lemma is_unit.ring_inverse {a : M₀} : is_unit a → is_unit (ring.inverse a)
| ⟨u, hu⟩ := hu ▸ ⟨u⁻¹, (ring.inverse_unit u).symm⟩

@[simp] lemma is_unit_ring_inverse {a : M₀} : is_unit (ring.inverse a) ↔ is_unit a :=
⟨λ h, begin
  casesI subsingleton_or_nontrivial M₀,
  { convert h },
  { contrapose h,
    rw ring.inverse_non_unit _ h,
    exact not_is_unit_zero, },
end, is_unit.ring_inverse⟩

namespace units
variables [group_with_zero G₀]
variables {a b : G₀}

/-- Embed a non-zero element of a `group_with_zero` into the unit group.
  By combining this function with the operations on units,
  or the `/ₚ` operation, it is possible to write a division
  as a partial function with three arguments. -/
def mk0 (a : G₀) (ha : a ≠ 0) : G₀ˣ :=
⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩

@[simp] lemma mk0_one (h := one_ne_zero) :
  mk0 (1 : G₀) h = 1 :=
by { ext, refl }

@[simp] lemma coe_mk0 {a : G₀} (h : a ≠ 0) : (mk0 a h : G₀) = a := rfl

@[simp] lemma mk0_coe (u : G₀ˣ) (h : (u : G₀) ≠ 0) : mk0 (u : G₀) h = u :=
units.ext rfl

@[simp] lemma mul_inv' (u : G₀ˣ) : (u : G₀) * u⁻¹ = 1 := mul_inv_cancel u.ne_zero

@[simp] lemma inv_mul' (u : G₀ˣ) : (u⁻¹ : G₀) * u = 1 := inv_mul_cancel u.ne_zero

@[simp] lemma mk0_inj {a b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) :
  units.mk0 a ha = units.mk0 b hb ↔ a = b :=
⟨λ h, by injection h, λ h, units.ext h⟩

/-- In a group with zero, an existential over a unit can be rewritten in terms of `units.mk0`. -/
lemma exists0 {p : G₀ˣ → Prop} : (∃ g : G₀ˣ, p g) ↔ ∃ (g : G₀) (hg : g ≠ 0), p (units.mk0 g hg) :=
⟨λ ⟨g, pg⟩, ⟨g, g.ne_zero, (g.mk0_coe g.ne_zero).symm ▸ pg⟩, λ ⟨g, hg, pg⟩, ⟨units.mk0 g hg, pg⟩⟩

/-- An alternative version of `units.exists0`. This one is useful if Lean cannot
figure out `p` when using `units.exists0` from right to left. -/
lemma exists0' {p : Π g : G₀, g ≠ 0 → Prop} :
  (∃ (g : G₀) (hg : g ≠ 0), p g hg) ↔ ∃ g : G₀ˣ, p g g.ne_zero :=
iff.trans (by simp_rw [coe_mk0]) exists0.symm

@[simp] lemma exists_iff_ne_zero {x : G₀} : (∃ u : G₀ˣ, ↑u = x) ↔ x ≠ 0 :=
by simp [exists0]

lemma _root_.group_with_zero.eq_zero_or_unit (a : G₀) :
  a = 0 ∨ ∃ u : G₀ˣ, a = u :=
begin
  by_cases h : a = 0,
  { left,
    exact h },
  { right,
    simpa only [eq_comm] using units.exists_iff_ne_zero.mpr h }
end

end units

section group_with_zero
variables [group_with_zero G₀] {a b c : G₀}

lemma is_unit.mk0 (x : G₀) (hx : x ≠ 0) : is_unit x := (units.mk0 x hx).is_unit

lemma is_unit_iff_ne_zero : is_unit a ↔ a ≠ 0 := units.exists_iff_ne_zero

alias is_unit_iff_ne_zero ↔ _ ne.is_unit

attribute [protected] ne.is_unit

@[priority 10] -- see Note [lower instance priority]
instance group_with_zero.no_zero_divisors : no_zero_divisors G₀ :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h,
    begin
      contrapose! h,
      exact ((units.mk0 a h.1) * (units.mk0 b h.2)).ne_zero
    end,
  .. (‹_› : group_with_zero G₀) }

@[priority 10] -- see Note [lower instance priority]
instance group_with_zero.cancel_monoid_with_zero : cancel_monoid_with_zero G₀ :=
{ mul_left_cancel_of_ne_zero := λ x y z hx h,
    by rw [← inv_mul_cancel_left₀ hx y, h, inv_mul_cancel_left₀ hx z],
  mul_right_cancel_of_ne_zero := λ x y z hy h,
    by rw [← mul_inv_cancel_right₀ hy x, h, mul_inv_cancel_right₀ hy z],
  .. (‹_› : group_with_zero G₀) }

-- Can't be put next to the other `mk0` lemmas because it depends on the
-- `no_zero_divisors` instance, which depends on `mk0`.
@[simp] lemma units.mk0_mul (x y : G₀) (hxy) :
  units.mk0 (x * y) hxy =
    units.mk0 x (mul_ne_zero_iff.mp hxy).1 * units.mk0 y (mul_ne_zero_iff.mp hxy).2 :=
by { ext, refl }

lemma div_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 :=
by { rw div_eq_mul_inv, exact mul_ne_zero ha (inv_ne_zero hb) }

@[simp] lemma div_eq_zero_iff : a / b = 0 ↔ a = 0 ∨ b = 0:=
by simp [div_eq_mul_inv]

lemma div_ne_zero_iff : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
div_eq_zero_iff.not.trans not_or_distrib

lemma ring.inverse_eq_inv (a : G₀) : ring.inverse a = a⁻¹ :=
begin
  obtain rfl | ha := eq_or_ne a 0,
  { simp },
  { exact ring.inverse_unit (units.mk0 a ha) }
end

@[simp] lemma ring.inverse_eq_inv' : (ring.inverse : G₀ → G₀) = has_inv.inv :=
funext ring.inverse_eq_inv

end group_with_zero

section comm_group_with_zero -- comm
variables [comm_group_with_zero G₀] {a b c d : G₀}

@[priority 10] -- see Note [lower instance priority]
instance comm_group_with_zero.cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero G₀ :=
{ ..group_with_zero.cancel_monoid_with_zero, ..comm_group_with_zero.to_comm_monoid_with_zero G₀ }

@[priority 100] -- See note [lower instance priority]
instance comm_group_with_zero.to_division_comm_monoid : division_comm_monoid G₀ :=
{ ..‹comm_group_with_zero G₀›, ..group_with_zero.to_division_monoid }

end comm_group_with_zero

section noncomputable_defs

open_locale classical
variables {M : Type*} [nontrivial M]

/-- Constructs a `group_with_zero` structure on a `monoid_with_zero`
  consisting only of units and 0. -/
noncomputable def group_with_zero_of_is_unit_or_eq_zero [hM : monoid_with_zero M]
  (h : ∀ (a : M), is_unit a ∨ a = 0) : group_with_zero M :=
{ inv := λ a, if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹,
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ a h0, by
  { change a * (if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹) = 1,
    rw [dif_neg h0, units.mul_inv_eq_iff_eq_mul, one_mul, is_unit.unit_spec] },
  exists_pair_ne := nontrivial.exists_pair_ne,
.. hM }

/-- Constructs a `comm_group_with_zero` structure on a `comm_monoid_with_zero`
  consisting only of units and 0. -/
noncomputable def comm_group_with_zero_of_is_unit_or_eq_zero [hM : comm_monoid_with_zero M]
  (h : ∀ (a : M), is_unit a ∨ a = 0) : comm_group_with_zero M :=
{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hM }

end noncomputable_defs

-- Guard against import creep
assert_not_exists multiplicative


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales, Benjamin Davidson
-/
import geometry.euclidean.sphere.power
import geometry.euclidean.triangle

/-!
# Ptolemy's theorem

This file proves Ptolemy's theorem on the lengths of the diagonals and sides of a cyclic
quadrilateral.

## Main theorems

* `mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`: Ptolemy’s Theorem (Freek No. 95).

TODO: The current statement of Ptolemy’s theorem works around the lack of a "cyclic polygon" concept
in mathlib, which is what the theorem statement would naturally use (or two such concepts, since
both a strict version, where all vertices must be distinct, and a weak version, where consecutive
vertices may be equal, would be useful; Ptolemy's theorem should then use the weak one).

An API needs to be built around that concept, which would include:
- strict cyclic implies weak cyclic,
- weak cyclic and consecutive points distinct implies strict cyclic,
- weak/strict cyclic implies weak/strict cyclic for any subsequence,
- any three points on a sphere are weakly or strictly cyclic according to whether they are distinct,
- any number of points on a sphere intersected with a two-dimensional affine subspace are cyclic in
  some order,
- a list of points is cyclic if and only if its reversal is,
- a list of points is cyclic if and only if any cyclic permutation is, while other permutations
  are not when the points are distinct,
- a point P where the diagonals of a cyclic polygon cross exists (and is unique) with weak/strict
  betweenness depending on weak/strict cyclicity,
- four points on a sphere with such a point P are cyclic in the appropriate order,
and so on.
-/

open real
open_locale euclidean_geometry real_inner_product_space real

namespace euclidean_geometry

variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
variables {P : Type*} [metric_space P] [normed_add_torsor V P]
include V

/-- **Ptolemy’s Theorem**. -/
theorem mul_dist_add_mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
  (h : cospherical ({a, b, c, d} : set P))
  (hapc : ∠ a p c = π) (hbpd : ∠ b p d = π) :
  dist a b * dist c d + dist b c * dist d a = dist a c * dist b d :=
begin
  have h' : cospherical ({a, c, b, d} : set P), { rwa set.insert_comm c b {d} },
  have hmul := mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi h' hapc hbpd,
  have hbp := left_dist_ne_zero_of_angle_eq_pi hbpd,
  have h₁ : dist c d = dist c p / dist b p * dist a b,
  { rw [dist_mul_of_eq_angle_of_dist_mul b p a c p d, dist_comm a b],
    { rw [angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi hbpd hapc, angle_comm] },
    all_goals { field_simp [mul_comm, hmul] } },
  have h₂ : dist d a = dist a p / dist b p * dist b c,
  { rw [dist_mul_of_eq_angle_of_dist_mul c p b d p a, dist_comm c b],
    { rwa [angle_comm, angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi], rwa angle_comm },
    all_goals { field_simp [mul_comm, hmul] } },
  have h₃ : dist d p = dist a p * dist c p / dist b p, { field_simp [mul_comm, hmul] },
  have h₄ : ∀ x y : ℝ, x * (y * x) = x * x * y := λ x y, by rw [mul_left_comm, mul_comm],
  field_simp [h₁, h₂, dist_eq_add_dist_of_angle_eq_pi hbpd, h₃, hbp, dist_comm a b,
              h₄, ← sq, dist_sq_mul_dist_add_dist_sq_mul_dist b, hapc],
end

end euclidean_geometry