/-
Copyright (c) 2022 Henry Pearson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Henry Pearson.
-/

import analysis.asymptotics.asymptotics
import order.filter.basic
import init.data.set
import data.nat.log
import avltree.init

/-!
# AVL node basic theorems

This file follows from `avltree.init.lean`, as well as the avlnode module and contains a proof
that for an avltree t, depth t = O(log (size t)) (i.e. why the structure is beneficial). It
contains multiple private lemmas/defintions that are used in the proof, but do not have general
applications.

## Main definitions

* `dep_is_O_with_size` is a proof that depth t = O(log 2 (size t)) for all non empty trees t.

-/

open avltree
open asymptotics

universe u

namespace avltree
variables {α : Type u} [linear_order α]
/--
Function that returns a prop that is true if a tree is a 'max unbalanced' tree - i.e. a tree where
the balance factor of every node that isn't a leaf is either 1 or -1. This is used for a proof later
-/
private def avlnode.max_unbalanced : avlnode α → Prop
  | avlnode.nil := true
  | (avlnode.node avlnode.nil _ avlnode.nil) := true
  | (avlnode.node l val r) := (avlnode.balance_factor (avlnode.node l val r) = 1 ∨ avlnode.balance_factor (avlnode.node l val r) = -1)
                                 ∧ avlnode.max_unbalanced r ∧ avlnode.max_unbalanced l

/--
Same function as `avlnode.max_unbalanced` except defined on avltrees
-/
private def max_unbalanced : avltree α → Prop
  | ⟨n, _⟩ := avlnode.max_unbalanced n

private lemma avlnode.if_mu_properties_then_mu (l r : avlnode α) (val : α)
  : (avlnode.balance_factor (avlnode.node l val r) = 1 ∨ avlnode.balance_factor (avlnode.node l val r) = -1)
    ∧ avlnode.max_unbalanced r ∧ avlnode.max_unbalanced l → avlnode.max_unbalanced (avlnode.node l val r) :=
begin
  intro h,
  cases l,
  cases r,
  rw avlnode.max_unbalanced,
  trivial,
  rw avlnode.max_unbalanced,
  exact h,
  cases r,
  rw avlnode.max_unbalanced,
  exact h,
  rw avlnode.max_unbalanced,
  exact h,
end

private lemma avlnode.mu_l_val_r_then_mu_l_and_mu_r (l r : avlnode α) (val : α) (h : avlnode.max_unbalanced (avlnode.node l val r))
  : (avlnode.max_unbalanced r ∧ avlnode.max_unbalanced l) :=
begin
  cases l,
  cases r,
  rw avlnode.max_unbalanced,
  split,
  trivial,
  trivial,
  rw [avlnode.max_unbalanced] at h,
  exact (and.elim_right h),
  rw [avlnode.max_unbalanced] at h,
  exact (and.elim_right h),
end

/--
Proof that given a max unbalanced tree n, for every tree with greater than or equal depth to n, the
size of that tree is greater than or equal to n.
-/
private lemma avlnode.mu_n_for_dep_is_min_size
  : ∀ (n n2 : avlnode α), avlnode.well_balanced n → avlnode.well_balanced n2 → avlnode.max_unbalanced n → n.depth ≤ n2.depth → avlnode.size n ≤ avlnode.size n2
| (avlnode.nil) (avlnode.nil) :=
  begin
    intros wb_n wb_n2 mu_t h,
    rw avlnode.size,
  end
| (avlnode.node l val r) (avlnode.nil) :=
  begin
    intros wb_n wb_n2 mu_t h,
    have h3 := avlnode.neg_1_le_dep_n l,
    have h4 := avlnode.dep_l_add_1_le_dep_l_v_r l r val,
    rw [avlnode.depth, avlnode.depth] at h,
    rw avlnode.depth at h4,
    linarith,
  end
| (avlnode.nil) (avlnode.node l2 val2 r2) :=
  begin
    intros wb_n wb_n2 mu_t h,
    repeat {rw avlnode.size},
    linarith,
  end
| (avlnode.node l val r) (avlnode.node l2 val2 r2) :=
  begin
    intros wb_n wb_n2 mu_t h,

    cases l,
    cases r,

    repeat {rw avlnode.size},
    linarith,

    rw avlnode.well_balanced at wb_n,
    have h2 := and.elim_left wb_n,
    have h3l := avlnode.dep_l_add_1_le_dep_l_v_r r_left r_right r_val,
    have h3r := avlnode.dep_r_add_1_le_dep_l_v_r r_left r_right r_val,
    rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h2,
    rw avlnode.depth at h3l,
    rw avlnode.depth at h3r,
    have h4r := avlnode.neg_1_le_dep_n r_right,
    have h4l := avlnode.neg_1_le_dep_n r_left,
    have h5r : r_right.depth = -1 := begin linarith, end,
    have h5l : r_left.depth = -1 := begin linarith, end,
    rw avlnode.dep_n_eq_neg_1_iff_n_nil at h5r,
    rw avlnode.dep_n_eq_neg_1_iff_n_nil at h5l,
    rw [h5r, h5l],
    have h6 := avlnode.dep_nil_v_r_eq_dep_r_add_1 (r_left.node r_val r_right) val,
    rw [h6, h5l, h5r, avlnode.depth, if_pos, avlnode.depth, avlnode.depth] at h,
    cases classical.em (l2.depth ≤ r2.depth),
    have h7 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h_1,
    rw avlnode.depth at h7,
    rw h7 at h,
    cases r2,
    rw avlnode.depth at h,
    linarith,
    repeat {rw avlnode.size},
    linarith,
    have h7 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 l2 r2 val2 (le_of_not_le h_1),
    rw avlnode.depth at h7,
    rw h7 at h,
    cases l2,
    rw avlnode.depth at h,
    linarith,
    repeat {rw avlnode.size},
    linarith,
    refl,

    cases r,

    rw avlnode.well_balanced at wb_n,
    have h2 := and.elim_left (and.elim_right wb_n),
    have h3l := avlnode.dep_l_add_1_le_dep_l_v_r l_left l_right l_val,
    have h3r := avlnode.dep_r_add_1_le_dep_l_v_r l_left l_right l_val,
    rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h2,
    rw avlnode.depth at h3l,
    rw avlnode.depth at h3r,
    have h4r := avlnode.neg_1_le_dep_n l_right,
    have h4l := avlnode.neg_1_le_dep_n l_left,
    have h5r : l_right.depth = -1 := begin linarith, end,
    have h5l : l_left.depth = -1 := begin linarith, end,
    rw avlnode.dep_n_eq_neg_1_iff_n_nil at h5r,
    rw avlnode.dep_n_eq_neg_1_iff_n_nil at h5l,
    rw [h5r, h5l],
    have h6 := avlnode.dep_l_v_nil_eq_dep_l_add_1 (l_left.node l_val l_right) val,
    rw [h6, h5l, h5r, avlnode.depth, if_pos, avlnode.depth, avlnode.depth] at h,
    cases classical.em (l2.depth ≤ r2.depth),
    have h7 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h_1,
    rw avlnode.depth at h7,
    rw h7 at h,
    cases r2,
    rw avlnode.depth at h,
    linarith,
    repeat {rw avlnode.size},
    linarith,
    have h7 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 l2 r2 val2 (le_of_not_le h_1),
    rw avlnode.depth at h7,
    rw h7 at h,
    cases l2,
    rw avlnode.depth at h,
    linarith,
    repeat {rw avlnode.size},
    linarith,
    refl,

    cases classical.em ((l_left.node l_val l_right).depth ≤ (r_left.node r_val r_right).depth),

    have h2 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 (l_left.node l_val l_right) (r_left.node r_val r_right) val h_1,
    rw [avlnode.max_unbalanced, avlnode.balance_factor] at mu_t,
    cases (and.elim_left mu_t),
    rw [avlnode.well_balanced, avlnode.balance_factor] at wb_n2,
    cases classical.em (r2.depth - l2.depth = 1),

    have h3 : l2.depth ≤ r2.depth := begin linarith, end,
    have h4 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth r2 := begin linarith, end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) r2 h5 h6 (and.elim_left (and.elim_right mu_t)) h7,
    have h10 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth l2 := begin linarith, end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) l2 h10 h11 (and.elim_right (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    cases classical.em (r2.depth - l2.depth = 0),

    have h3 : l2.depth ≤ r2.depth := begin linarith, end,
    have h4 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth r2 := begin linarith, end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) r2 h5 h6 (and.elim_left (and.elim_right mu_t)) h7,
    have h10 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth l2 := begin linarith, end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) l2 h10 h11 (and.elim_right (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    cases classical.em (r2.depth - l2.depth = -1),

    have h3 : r2.depth ≤ l2.depth := begin linarith, end,
    have h4 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth l2 := begin linarith, end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) l2 h5 h6 (and.elim_left (and.elim_right mu_t)) h7,
    have h10 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth r2 := begin linarith, end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) r2 h10 h11 (and.elim_right (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    exfalso,
    have h3 := ne.intro h_3,
    have h4 := ne.intro h_4,
    have h5 := ne.intro h_5,
    rw ne_iff_lt_or_gt at h3,
    rw ne_iff_lt_or_gt at h4,
    rw ne_iff_lt_or_gt at h5,

    cases h5,
    linarith,
    cases h4,
    linarith,
    cases h3,
    linarith,
    linarith,

    linarith,

    have h2 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 (l_left.node l_val l_right) (r_left.node r_val r_right) val (le_of_not_le h_1),
    rw [avlnode.max_unbalanced, avlnode.balance_factor] at mu_t,
    cases (and.elim_left mu_t),
    linarith,
    rw [avlnode.well_balanced, avlnode.balance_factor] at wb_n2,
    cases classical.em (r2.depth - l2.depth = 1),

    have h3 : l2.depth ≤ r2.depth := begin linarith, end,
    have h4 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth r2 := begin linarith, end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) r2 h5 h6 (and.elim_right (and.elim_right mu_t)) h7,
    have h10 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth l2 := begin linarith, end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) l2 h10 h11 (and.elim_left (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    cases classical.em (r2.depth - l2.depth = 0),

    have h3 : l2.depth ≤ r2.depth := begin linarith, end,
    have h4 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth r2 := begin linarith, end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) r2 h5 h6 (and.elim_right (and.elim_right mu_t)) h7,
    have h10 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth l2 := begin linarith, end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) l2 h10 h11 (and.elim_left (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    cases classical.em (r2.depth - l2.depth = -1),

    have h3 : r2.depth ≤ l2.depth := begin linarith, end,
    have h4 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 l2 r2 val2 h3,
    rw [h2, h4] at h,
    rw avlnode.well_balanced at wb_n,
    have h5 := and.elim_left (and.elim_right (and.elim_right wb_n)),
    have h6 := and.elim_left (and.elim_right (and.elim_right wb_n2)),
    have h7 : avlnode.depth (l_left.node l_val l_right) ≤ avlnode.depth l2 := begin linarith,end,
    have h9 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) l2 h5 h6 (and.elim_right (and.elim_right mu_t)) h7,
    have h10 := and.elim_right (and.elim_right (and.elim_right wb_n)),
    have h11 := and.elim_right (and.elim_right (and.elim_right wb_n2)),
    have h12 : avlnode.depth (r_left.node r_val r_right) ≤ avlnode.depth r2 := begin linarith,end,
    have h14 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) r2 h10 h11 (and.elim_left (and.elim_right mu_t)) h12,
    rw avlnode.size at h9,
    rw avlnode.size at h14,
    repeat {rw avlnode.size},
    linarith,

    exfalso,
    have h3 := ne.intro h_3,
    have h4 := ne.intro h_4,
    have h5 := ne.intro h_5,
    rw ne_iff_lt_or_gt at h3,
    rw ne_iff_lt_or_gt at h4,
    rw ne_iff_lt_or_gt at h5,

    cases h5,
    linarith,
    cases h4,
    linarith,
    cases h3,
    linarith,
    linarith,
  end

private lemma avlnode.construct_mu_n_with_eq_dep
  : ∀ (n : avlnode α), (∃ (n2 : avlnode α), avlnode.depth n = avlnode.depth n2 ∧ avlnode.max_unbalanced n2)
| (avlnode.nil) :=
  begin
    use (avlnode.nil),
    rw avlnode.max_unbalanced,
    split,
    refl,
    trivial,
  end
| (avlnode.node l val r) :=
  begin
    cases classical.em (l.depth ≤ r.depth),
    have h_l := avlnode.construct_mu_n_with_eq_dep r,
    have h2 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 l r val h,
    cases h_l with nl hl,
    cases nl,
    use (avlnode.node avlnode.nil val avlnode.nil),
    rw [avlnode.depth, if_pos, avlnode.depth, if_pos, avlnode.depth],
    split,
    rw avlnode.depth at hl,
    linarith,
    rw avlnode.max_unbalanced,
    trivial,
    refl,
    exact h,
    cases classical.em (nl_left.depth ≤ nl_right.depth),
    use (avlnode.node (nl_left.node nl_val nl_right) val nl_right),
    split,
    have h3 := avlnode.dep_r_add_1_le_dep_l_v_r nl_left nl_right nl_val,
    rw [h2, avlnode.depth, if_neg],
    linarith,
    linarith,
    have h3 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 nl_left nl_right nl_val h_1,
    have h4 : ((nl_left.node nl_val nl_right).node val nl_right).balance_factor = -1 :=
      begin
        rw avlnode.balance_factor,
        linarith,
      end,
    have h5 := or.intro_right (((nl_left.node nl_val nl_right).node val nl_right).balance_factor = 1) h4,
    have h6 := and.elim_left (avlnode.mu_l_val_r_then_mu_l_and_mu_r nl_left nl_right nl_val (and.elim_right hl)),
    exact avlnode.if_mu_properties_then_mu (nl_left.node nl_val nl_right) nl_right val (and.intro h5 (and.intro h6 (and.elim_right hl))),

    use (avlnode.node (nl_left.node nl_val nl_right) val nl_left),
    split,
    have h3 := avlnode.dep_l_add_1_le_dep_l_v_r nl_left nl_right nl_val,
    rw [h2, avlnode.depth, if_neg],
    linarith,
    linarith,
    have h3 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 nl_left nl_right nl_val (le_of_not_le h_1),
    have h4 : ((nl_left.node nl_val nl_right).node val nl_left).balance_factor = -1 :=
      begin
        rw avlnode.balance_factor,
        linarith,
      end,
    have h5 := or.intro_right (((nl_left.node nl_val nl_right).node val nl_left).balance_factor = 1) h4,
    have h6 := and.elim_right (avlnode.mu_l_val_r_then_mu_l_and_mu_r nl_left nl_right nl_val (and.elim_right hl)),
    exact avlnode.if_mu_properties_then_mu (nl_left.node nl_val nl_right) nl_left val (and.intro h5 (and.intro h6 (and.elim_right hl))),

    have h_l := avlnode.construct_mu_n_with_eq_dep l,
    have h2 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 l r val (le_of_not_le h),
    cases h_l with nl hl,
    cases nl,
    rw [(and.elim_left hl), avlnode.depth] at h,
    have h3 := avlnode.neg_1_le_dep_n r,
    linarith,
    cases classical.em (nl_left.depth ≤ nl_right.depth),
    use (avlnode.node (nl_left.node nl_val nl_right) val nl_right),
    split,
    have h3 := avlnode.dep_r_add_1_le_dep_l_v_r nl_left nl_right nl_val,
    rw [h2, avlnode.depth, if_neg],
    linarith,
    linarith,
    have h3 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 nl_left nl_right nl_val h_1,
    have h4 : ((nl_left.node nl_val nl_right).node val nl_right).balance_factor = -1 :=
      begin
        rw avlnode.balance_factor,
        linarith,
      end,
    have h5 := or.intro_right (((nl_left.node nl_val nl_right).node val nl_right).balance_factor = 1) h4,
    have h6 := and.elim_left (avlnode.mu_l_val_r_then_mu_l_and_mu_r nl_left nl_right nl_val (and.elim_right hl)),
    exact avlnode.if_mu_properties_then_mu (nl_left.node nl_val nl_right) nl_right val (and.intro h5 (and.intro h6 (and.elim_right hl))),

    use (avlnode.node (nl_left.node nl_val nl_right) val nl_left),
    split,
    have h3 := avlnode.dep_l_add_1_le_dep_l_v_r nl_left nl_right nl_val,
    rw [h2, avlnode.depth, if_neg],
    linarith,
    linarith,
    have h3 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 nl_left nl_right nl_val (le_of_not_le h_1),
    have h4 : ((nl_left.node nl_val nl_right).node val nl_left).balance_factor = -1 :=
      begin
        rw avlnode.balance_factor,
        linarith,
      end,
    have h5 := or.intro_right (((nl_left.node nl_val nl_right).node val nl_left).balance_factor = 1) h4,
    have h6 := and.elim_right (avlnode.mu_l_val_r_then_mu_l_and_mu_r nl_left nl_right nl_val (and.elim_right hl)),
    exact avlnode.if_mu_properties_then_mu (nl_left.node nl_val nl_right) nl_left val (and.intro h5 (and.intro h6 (and.elim_right hl))),
  end

private lemma avlnode.mu_n_then_wb_n (n : avlnode α) (h : avlnode.max_unbalanced n)
  : avlnode.well_balanced n :=
begin
  induction n with l v r lh rh,
  rw avlnode.well_balanced,
  trivial,
  rw avlnode.well_balanced,
  cases l,
  cases r,
  rw [avlnode.balance_factor, avlnode.depth, avlnode.well_balanced],
  split,
  linarith,
  split,
  linarith,
  split,
  trivial,
  trivial,
  rw avlnode.max_unbalanced at h,
  cases (and.elim_left h),
  any_goals {
    split,
    linarith,
    split,
    linarith,
    split,
    rw avlnode.well_balanced,
    trivial,
    exact (rh (and.elim_left (and.elim_right h))),
  },
  rw avlnode.max_unbalanced at h,
  cases (and.elim_left h),
  any_goals {
    split,
    linarith,
    split,
    linarith,
    split,
    exact (lh (and.elim_right (and.elim_right h))),
    exact (rh (and.elim_left (and.elim_right h))),
  },
end

/--
Proof that depth t = O(log 2 (size t)) for all non empty trees t.
-/
theorem dep_is_O_with_size
 : is_O depth ((int.of_nat ∘ (nat.log 2) ∘ size) : avltree α → int) (filter.principal (non_empty : set (avltree α))) :=
 begin
  rw is_O_iff,
  use 2,
  intros x h,
  cases x with n nh,
  have new_mu_h := avlnode.construct_mu_n_with_eq_dep n,
  cases new_mu_h with n2 h_dep_mu,
  have n2_wb := avlnode.mu_n_then_wb_n n2 (and.elim_right h_dep_mu),
  simp *,
  rw [int.norm_eq_abs, int.norm_eq_abs],
  induction n2 with l val r lh rh generalizing n,
  exfalso,
  rw avlnode.depth at h_dep_mu,
  have h2 := and.elim_left h_dep_mu,
  rw avlnode.dep_n_eq_neg_1_iff_n_nil at h2,
  simp [h2] at h,
  cases h,

  norm_num,

  have mu_lr := avlnode.mu_l_val_r_then_mu_l_and_mu_r l r val (and.elim_right h_dep_mu),
  have lwb := avlnode.mu_n_then_wb_n l (and.elim_right mu_lr),
  have rwb := avlnode.mu_n_then_wb_n r (and.elim_left mu_lr),
  have lh2 := lh lwb l lwb,
  have rh2 := rh rwb r rwb,
  /- case analysis on left and right subtree - trivial when both nil -/
  cases l,
  cases r,

  have h_dep := and.elim_left h_dep_mu,
  rw [avlnode.depth, if_pos, avlnode.depth] at h_dep,
  have h_n_leaf : ∃ (val : α), n = (avlnode.node avlnode.nil val avlnode.nil) :=
    begin
      rw ← avlnode.dep_n_eq_0_iff_n_leaf,
      linarith,
    end,
  cases h_n_leaf with val2 h2,
  rw [depth, size, h2, avlnode.depth, if_pos, avlnode.depth, avlnode.size, avlnode.size],
  simp,
  refl,

  have mu_n2 := and.elim_right h_dep_mu,
  rw avlnode.max_unbalanced at mu_n2,
  cases (and.elim_left mu_n2),
  have h2 : ∃ (val2 : α), (r_left.node r_val r_right) = (avlnode.node avlnode.nil val2 avlnode.nil) :=
    begin
      rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h_1,
      rw ← avlnode.dep_n_eq_0_iff_n_leaf,
      rw avlnode.depth,
      linarith,
    end,
  cases h2 with val2 h3,
  rw [depth, size, (and.elim_left h_dep_mu), h3, avlnode.depth, if_pos, avlnode.depth, if_pos, avlnode.depth],
  have h_dep := and.elim_left h_dep_mu,
  have h4 := avlnode.dep_nil_v_r_eq_dep_r_add_1 (r_left.node r_val r_right) val,
  rw [h4, h3] at h_dep,
  have h5 : avlnode.depth (avlnode.nil.node val (r_left.node r_val r_right)) ≤ avlnode.depth n := begin linarith, end,
  have h6 := avlnode.mu_n_for_dep_is_min_size (avlnode.nil.node val (r_left.node r_val r_right)) n n2_wb nh (and.elim_right h_dep_mu) h5,
  repeat {rw avlnode.size at h6},
  have h7 : 2 ≤ n.size := begin linarith, end,
  have h8 := nat.log_le_log_of_le h7,
  have h9 : 2 < 2 * 2 ∧ 1 < 2 ∧ 2 ≤ 2 :=
    begin
      repeat {split},
      all_goals {linarith},
    end,
  rw ← nat.log_eq_one_iff at h9,
  rw h9 at h8,
  norm_cast,
  have h11 : 1 ≤ 2 * nat.log 2 n.size := begin linarith, end,
  rw ← int.coe_nat_le_coe_nat_iff at h11,
  rw (int.coe_nat_mul 2 (nat.log 2 n.size)) at h11,
  norm_num *,
  exact h11,
  refl,
  rw [avlnode.depth, if_pos, avlnode.depth],
  linarith,
  refl,

  rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h_1,
  have h2 := avlnode.neg_1_le_dep_n (r_left.node r_val r_right),
  rw avlnode.depth at h2,
  linarith,

  cases r,

  have mu_n2 := and.elim_right h_dep_mu,
  rw avlnode.max_unbalanced at mu_n2,
  cases (and.elim_left mu_n2),
  rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h_1,
  have h2 := avlnode.neg_1_le_dep_n (l_left.node l_val l_right),
  rw avlnode.depth at h2,
  linarith,

  have h2 : ∃ (val2 : α), (l_left.node l_val l_right) = (avlnode.node avlnode.nil val2 avlnode.nil) :=
    begin
      rw [avlnode.balance_factor, avlnode.depth, avlnode.depth] at h_1,
      rw ← avlnode.dep_n_eq_0_iff_n_leaf,
      rw avlnode.depth,
      linarith,
    end,
  cases h2 with val2 h3,
  rw [depth, size, (and.elim_left h_dep_mu), h3, avlnode.depth, if_neg, avlnode.depth, if_pos, avlnode.depth],
  have h_dep := and.elim_left h_dep_mu,
  have h4 := avlnode.dep_l_v_nil_eq_dep_l_add_1 (l_left.node l_val l_right) val,
  rw [h4, h3] at h_dep,
  have h5 : avlnode.depth ((l_left.node l_val l_right).node val avlnode.nil) ≤ avlnode.depth n := begin linarith, end,
  have h6 := avlnode.mu_n_for_dep_is_min_size ((l_left.node l_val l_right).node val avlnode.nil) n n2_wb nh (and.elim_right h_dep_mu) h5,
  repeat {rw avlnode.size at h6},
  have h7 : 2 ≤ n.size := begin linarith, end,
  have h8 := nat.log_le_log_of_le h7,
  have h9 : 2 < 2 * 2 ∧ 1 < 2 ∧ 2 ≤ 2 :=
    begin
      repeat {split},
      all_goals {linarith},
    end,
  rw ← nat.log_eq_one_iff at h9,
  rw h9 at h8,
  norm_cast,
  have h11 : 1 ≤ 2 * nat.log 2 n.size := begin linarith, end,
  rw ← int.coe_nat_le_coe_nat_iff at h11,
  rw (int.coe_nat_mul 2 (nat.log 2 n.size)) at h11,
  norm_num *,
  exact h11,
  refl,
  rw [avlnode.depth, if_pos, avlnode.depth],
  linarith,
  refl,

  have mu_n2 := and.elim_right h_dep_mu,
  rw avlnode.max_unbalanced at mu_n2,
  cases (and.elim_left mu_n2),

  rw avlnode.balance_factor at h_1,
  have h2 : (l_left.node l_val l_right).depth ≤ (r_left.node r_val r_right).depth := begin linarith, end,
  have h3 := avlnode.dep_l_le_dep_r_then_dep_l_v_r_eq_dep_r_add_1 (l_left.node l_val l_right) (r_left.node r_val r_right) val h2,
  have h4 : non_empty (⟨l_left.node l_val l_right, lwb⟩ : avltree α) :=
    begin
      rw [non_empty, avlnode.non_empty],
      trivial,
    end,
  have lh3 := lh2 h4 (and.intro (eq.refl (l_left.node l_val l_right).depth) (and.elim_right mu_lr)),
  rw [depth, size] at lh3,
  norm_cast at lh3,
  have lh4 := int.add_le_add_right lh3 (↑(2 : nat)),
  rw ← (int.coe_nat_add (2 * nat.log 2 (l_left.node l_val l_right).size) 2) at lh4,
  have h5 : 2 * nat.log 2 (l_left.node l_val l_right).size + 2 = 2 * (nat.log 2 (l_left.node l_val l_right).size + 1) := begin linarith, end,
  have h6 : 1 < 2 := begin linarith, end,
  have h7 := eq.symm (nat.log_pow h6 (nat.log 2 (l_left.node l_val l_right).size + 1)),
  rw [pow_add, pow_one, mul_comm] at h7,
  have h8 : 0 < (l_left.node l_val l_right).size :=
    begin
      rw avlnode.size,
      linarith,
    end,
  have h9 := nat.pow_log_le_self h6 h8,
  have h10 : 2 * (2 ^ nat.log 2 (l_left.node l_val l_right).size) ≤ 2 * (l_left.node l_val l_right).size := begin linarith, end,
  rw [h5, h7] at lh4,
  have h11 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h10,
  have h12 := nat.mul_le_mul_left 2 h11,
  have h13 := avlnode.mu_n_for_dep_is_min_size (l_left.node l_val l_right) (r_left.node r_val r_right) lwb rwb (and.elim_right mu_lr) h2,
  have h14 : 2 * (l_left.node l_val l_right).size ≤ (l_left.node l_val l_right).size + (r_left.node r_val r_right).size + 1 := begin linarith, end,
  have h15 : |((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth| ≤ ↑(2 * nat.log 2 (((l_left.node l_val l_right).node val (r_left.node r_val r_right)).size)) :=
    begin
      have h16 : ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth = (l_left.node l_val l_right).depth + 2 :=
        begin
          rw h3,
          linarith,
        end,
      rw [h16, avlnode.size],
      transitivity (|(l_left.node l_val l_right).depth| + 2 : int),
      have h17 := abs_add (l_left.node l_val l_right).depth 2,
      norm_cast at h17,
      exact h17,
      transitivity ↑(2 * nat.log 2 (2 * 2 ^ nat.log 2 (l_left.node l_val l_right).size)),
      exact lh4,
      norm_cast,
      transitivity 2 * nat.log 2 (2 * (l_left.node l_val l_right).size),
      exact h12,
      have h18 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h14,
      exact nat.mul_le_mul_left 2 h18,
    end,
  have h16 : ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth ≤ n.depth := begin linarith, end,
  have h17 := avlnode.mu_n_for_dep_is_min_size ((l_left.node l_val l_right).node val (r_left.node r_val r_right)) n (avlnode.mu_n_then_wb_n ((l_left.node l_val l_right).node val (r_left.node r_val r_right)) (and.elim_right h_dep_mu)) nh (and.elim_right (h_dep_mu)) h16,
  have h18 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h17,
  have h19 := nat.mul_le_mul_left 2 h18,
  rw [depth, size, (and.elim_left h_dep_mu)],
  norm_cast,
  transitivity (↑(2 * nat.log 2 ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).size) : int),
  exact h15,
  norm_cast,
  exact h19,

  rw avlnode.balance_factor at h_1,
  have h2 : (r_left.node r_val r_right).depth ≤ (l_left.node l_val l_right).depth := begin linarith, end,
  have h3 := avlnode.dep_r_le_dep_l_then_dep_l_v_r_eq_dep_l_add_1 (l_left.node l_val l_right) (r_left.node r_val r_right) val h2,
  have h4 : non_empty (⟨r_left.node r_val r_right, rwb⟩ : avltree α) :=
    begin
      rw [non_empty, avlnode.non_empty],
      trivial,
    end,
  have rh3 := rh2 h4 (and.intro (eq.refl (r_left.node r_val r_right).depth) (and.elim_left mu_lr)),
  rw [depth, size] at rh3,
  norm_cast at rh3,
  have rh4 := int.add_le_add_right rh3 (↑(2 : nat)),
  rw ← (int.coe_nat_add (2 * nat.log 2 (r_left.node r_val r_right).size) 2) at rh4,
  have h5 : 2 * nat.log 2 (r_left.node r_val r_right).size + 2 = 2 * (nat.log 2 (r_left.node r_val r_right).size + 1) := begin linarith, end,
  have h6 : 1 < 2 := begin linarith, end,
  have h7 := eq.symm (nat.log_pow h6 (nat.log 2 (r_left.node r_val r_right).size + 1)),
  rw [pow_add, pow_one, mul_comm] at h7,
  have h8 : 0 < (r_left.node r_val r_right).size :=
    begin
      rw avlnode.size,
      linarith,
    end,
  have h9 := nat.pow_log_le_self h6 h8,
  have h10 : 2 * (2 ^ nat.log 2 (r_left.node r_val r_right).size) ≤ 2 * (r_left.node r_val r_right).size := begin linarith, end,
  rw [h5, h7] at rh4,
  have h11 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h10,
  have h12 := nat.mul_le_mul_left 2 h11,
  have h13 := avlnode.mu_n_for_dep_is_min_size (r_left.node r_val r_right) (l_left.node l_val l_right) rwb lwb (and.elim_left mu_lr) h2,
  have h14 : 2 * (r_left.node r_val r_right).size ≤ (l_left.node l_val l_right).size + (r_left.node r_val r_right).size + 1 := begin linarith, end,
  have h15 : |((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth| ≤ ↑(2 * nat.log 2 (((l_left.node l_val l_right).node val (r_left.node r_val r_right)).size)) :=
    begin
      have h16 : ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth = (r_left.node r_val r_right).depth + 2 :=
        begin
          rw h3,
          linarith,
        end,
      rw [h16, avlnode.size],
      transitivity (|(r_left.node r_val r_right).depth| + 2 : int),
      have h17 := abs_add (r_left.node r_val r_right).depth 2,
      norm_cast at h17,
      exact h17,
      transitivity ↑(2 * nat.log 2 (2 * 2 ^ nat.log 2 (r_left.node r_val r_right).size)),
      exact rh4,
      norm_cast,
      transitivity 2 * nat.log 2 (2 * (r_left.node r_val r_right).size),
      exact h12,
      have h18 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h14,
      exact nat.mul_le_mul_left 2 h18,
    end,
  have h16 : ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).depth ≤ n.depth := begin linarith, end,
  have h17 := avlnode.mu_n_for_dep_is_min_size ((l_left.node l_val l_right).node val (r_left.node r_val r_right)) n (avlnode.mu_n_then_wb_n ((l_left.node l_val l_right).node val (r_left.node r_val r_right)) (and.elim_right h_dep_mu)) nh (and.elim_right (h_dep_mu)) h16,
  have h18 : nat.log 2 _ ≤ nat.log 2 _ := nat.log_le_log_of_le h17,
  have h19 := nat.mul_le_mul_left 2 h18,
  rw [depth, size, (and.elim_left h_dep_mu)],
  norm_cast,
  transitivity (↑(2 * nat.log 2 ((l_left.node l_val l_right).node val (r_left.node r_val r_right)).size) : int),
  exact h15,
  norm_cast,
  exact h19,
 end

end avltree


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/

import algebra.module.pi
import data.polynomial.basic
import group_theory.group_action.prod
import group_theory.group_action.units
import data.complex.module

/-! # Tests that instances do not form diamonds -/

/-! ## Scalar action instances -/
section has_scalar

example :
  (sub_neg_monoid.has_scalar_int : has_scalar ℤ ℂ) = (complex.has_scalar : has_scalar ℤ ℂ) :=
rfl

example (α β : Type*) [add_monoid α] [add_monoid β] :
  (prod.has_scalar : has_scalar ℕ (α × β)) = add_monoid.has_scalar_nat := rfl

example (α β : Type*) [sub_neg_monoid α] [sub_neg_monoid β] :
  (prod.has_scalar : has_scalar ℤ (α × β)) = sub_neg_monoid.has_scalar_int := rfl

example (α : Type*) (β : α → Type*) [Π a, add_monoid (β a)] :
  (pi.has_scalar : has_scalar ℕ (Π a, β a)) = add_monoid.has_scalar_nat := rfl

example (α : Type*) (β : α → Type*) [Π a, sub_neg_monoid (β a)] :
  (pi.has_scalar : has_scalar ℤ (Π a, β a)) = sub_neg_monoid.has_scalar_int := rfl

section units

example (α : Type*) [monoid α] :
  (units.mul_action : mul_action αˣ (α × α)) = prod.mul_action := rfl

example (R α : Type*) (β : α → Type*) [monoid R] [Π i, mul_action R (β i)] :
  (units.mul_action : mul_action Rˣ (Π i, β i)) = pi.mul_action _ := rfl

example (R α : Type*) (β : α → Type*) [monoid R] [semiring α] [distrib_mul_action R α] :
  (units.distrib_mul_action : distrib_mul_action Rˣ (polynomial α)) =
    polynomial.distrib_mul_action :=
rfl

/-!
TODO: https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/units.2Emul_action'.20diamond/near/246402813
```lean
example {α : Type*} [comm_monoid α] :
  (units.mul_action' : mul_action αˣ αˣ) = monoid.to_mul_action _ :=
rfl -- fails
```
-/

end units

end has_scalar

/-! ## `with_top` (Type with point at infinity) instances -/
section with_top

example (R : Type*) [h : ordered_semiring R] :
  (@with_top.add_comm_monoid R
    (@non_unital_non_assoc_semiring.to_add_comm_monoid R
      (@non_assoc_semiring.to_non_unital_non_assoc_semiring R
        (@semiring.to_non_assoc_semiring R
          (@ordered_semiring.to_semiring R h)))))
        =
  (@ordered_add_comm_monoid.to_add_comm_monoid (with_top R)
    (@with_top.ordered_add_comm_monoid R
      (@ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid R
        (@ordered_semiring.to_ordered_cancel_add_comm_monoid R h)))) :=
rfl

end with_top

/-! ## `multiplicative` instances -/
section multiplicative

example :
  @monoid.to_mul_one_class (multiplicative ℕ) (comm_monoid.to_monoid _) =
    multiplicative.mul_one_class :=
rfl

-- `dunfold` can still break unification, but it's better to have `dunfold` break it than have the
-- above example fail.
example :
  @monoid.to_mul_one_class (multiplicative ℕ) (comm_monoid.to_monoid _) =
    multiplicative.mul_one_class :=
begin
  dunfold has_one.one multiplicative.mul_one_class,
  success_if_fail { refl, },
  ext,
  refl
end

end multiplicative


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky, Chris Hughes
-/
import data.list.nodup

/-!
# List duplicates

## Main definitions

* `list.duplicate x l : Prop` is an inductive property that holds when `x` is a duplicate in `l`

## Implementation details

In this file, `x ∈+ l` notation is shorthand for `list.duplicate x l`.

-/

variable {α : Type*}

namespace list

/-- Property that an element `x : α` of `l : list α` can be found in the list more than once. -/
inductive duplicate (x : α) : list α → Prop
| cons_mem {l : list α} : x ∈ l → duplicate (x :: l)
| cons_duplicate {y : α} {l : list α} : duplicate l → duplicate (y :: l)

local infix ` ∈+ `:50 := list.duplicate

variables {l : list α} {x : α}

lemma mem.duplicate_cons_self (h : x ∈ l) : x ∈+ x :: l := duplicate.cons_mem h

lemma duplicate.duplicate_cons (h : x ∈+ l) (y : α) : x ∈+ y :: l := duplicate.cons_duplicate h

lemma duplicate.mem (h : x ∈+ l) : x ∈ l :=
begin
  induction h with l' h y l' h hm,
  { exact mem_cons_self _ _ },
  { exact mem_cons_of_mem _ hm }
end

lemma duplicate.mem_cons_self (h : x ∈+ x :: l) : x ∈ l :=
begin
  cases h with _ h _ _ h,
  { exact h },
  { exact h.mem }
end

@[simp] lemma duplicate_cons_self_iff : x ∈+ x :: l ↔ x ∈ l :=
⟨duplicate.mem_cons_self, mem.duplicate_cons_self⟩

lemma duplicate.ne_nil (h : x ∈+ l) : l ≠ [] :=
λ H, (mem_nil_iff x).mp (H ▸ h.mem)

@[simp] lemma not_duplicate_nil (x : α) : ¬ x ∈+ [] :=
λ H, H.ne_nil rfl

lemma duplicate.ne_singleton (h : x ∈+ l) (y : α) : l ≠ [y] :=
begin
  induction h with l' h z l' h hm,
  { simp [ne_nil_of_mem h] },
  { simp [ne_nil_of_mem h.mem] }
end

@[simp] lemma not_duplicate_singleton (x y : α) : ¬ x ∈+ [y] :=
λ H, H.ne_singleton _ rfl

lemma duplicate.elim_nil (h : x ∈+ []) : false :=
not_duplicate_nil x h

lemma duplicate.elim_singleton {y : α} (h : x ∈+ [y]) : false :=
not_duplicate_singleton x y h

lemma duplicate_cons_iff {y : α} : x ∈+ y :: l ↔ (y = x ∧ x ∈ l) ∨ x ∈+ l :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { cases h with _ hm _ _ hm,
    { exact or.inl ⟨rfl, hm⟩ },
    { exact or.inr hm } },
  { rcases h with ⟨rfl|h⟩|h,
    { simpa },
    { exact h.cons_duplicate } }
end

lemma duplicate.of_duplicate_cons {y : α} (h : x ∈+ y :: l) (hx : x ≠ y) : x ∈+ l :=
by simpa [duplicate_cons_iff, hx.symm] using h

lemma duplicate_cons_iff_of_ne {y : α} (hne : x ≠ y) : x ∈+ y :: l ↔ x ∈+ l :=
by simp [duplicate_cons_iff, hne.symm]

lemma duplicate.mono_sublist {l' : list α} (hx : x ∈+ l) (h : l <+ l') : x ∈+ l' :=
begin
  induction h with l₁ l₂ y h IH l₁ l₂ y h IH,
  { exact hx },
  { exact (IH hx).duplicate_cons _ },
  { rw duplicate_cons_iff at hx ⊢,
    rcases hx with ⟨rfl, hx⟩|hx,
    { simp [h.subset hx] },
    { simp [IH hx] } }
end

/-- The contrapositive of `list.nodup_iff_sublist`. -/
lemma duplicate_iff_sublist : x ∈+ l ↔ [x, x] <+ l :=
begin
  induction l with y l IH,
  { simp },
  { by_cases hx : x = y,
    { simp [hx, cons_sublist_cons_iff, singleton_sublist] },
    { rw [duplicate_cons_iff_of_ne hx, IH],
      refine ⟨sublist_cons_of_sublist y, λ h, _⟩,
      cases h,
      { assumption },
      { contradiction } } }
end

lemma nodup_iff_forall_not_duplicate : nodup l ↔ ∀ (x : α), ¬ x ∈+ l :=
by simp_rw [nodup_iff_sublist, duplicate_iff_sublist]

lemma exists_duplicate_iff_not_nodup : (∃ (x : α), x ∈+ l) ↔ ¬ nodup l :=
by simp [nodup_iff_forall_not_duplicate]

lemma duplicate.not_nodup (h : x ∈+ l) : ¬ nodup l :=
λ H, nodup_iff_forall_not_duplicate.mp H _ h

lemma duplicate_iff_two_le_count [decidable_eq α] : (x ∈+ l) ↔ 2 ≤ count x l :=
by simp [duplicate_iff_sublist, le_count_iff_repeat_sublist]

instance decidable_duplicate [decidable_eq α] (x : α) : ∀ (l : list α), decidable (x ∈+ l)
| []       := is_false (not_duplicate_nil x)
| (y :: l) := match decidable_duplicate l with
  | is_true  h := is_true (h.duplicate_cons y)
  | is_false h := if hx : y = x ∧ x ∈ l
      then is_true (hx.left.symm ▸ hx.right.duplicate_cons_self)
      else is_false (by simpa [duplicate_cons_iff, h] using hx)
  end

end list


class category (C : Type) :=
( hom : C → C → Type )
( id : (X : C) → hom X X )
( comp : {X Y Z : C} → hom X Y → hom Y Z → hom X Z )
( id_comp {X Y : C} (f : hom X Y) : comp (id X) f = f )
( comp_id {X Y : C} (f : hom X Y) : comp f (id Y) = f )
( assoc {W X Y Z : C} (f : hom W X) (g : hom X Y) (h : hom Y Z) :
    comp (comp f g) h = comp f (comp g h) )

notation " 𝟙 " => category.id
infixr: 80 " ≫ " => category.comp
infixr: 10 " ⟶ " => category.hom

variable (C : Type) [category C]

inductive prod_coprod : Type
| of_cat : C → prod_coprod
| prod : prod_coprod → prod_coprod → prod_coprod
| coprod : prod_coprod → prod_coprod → prod_coprod

variable {C}

namespace prod_coprod

@[simp] def size : prod_coprod C → Nat
| of_cat _ => 1
| prod X Y => size X + size Y + 1
| coprod X Y => size X + size Y + 1

inductive syn : (X Y : prod_coprod C) → Type
| map {X Y : C} : (X ⟶ Y) → syn (of_cat X) (of_cat Y)
| prod_mk {X Y Z : prod_coprod C} : syn X Y → syn X Z → syn X (Y.prod Z)
| fst {X Y : prod_coprod C} : syn (X.prod Y) X
| snd {X Y : prod_coprod C} : syn (X.prod Y) Y
| coprod_mk {X Y Z : prod_coprod C} : syn X Z → syn Y Z → syn (X.coprod Y) Z
| inl {X Y : prod_coprod C} : syn X (X.coprod Y)
| inr {X Y : prod_coprod C} : syn Y (X.coprod Y)
| id (X : prod_coprod C) : syn X X
| comp {X Y Z : prod_coprod C} : syn X Y → syn Y Z → syn X Z

namespace syn

inductive rel : {X Y : prod_coprod C} → syn X Y → syn X Y → Prop
| refl {X Y : prod_coprod C} (f : syn X Y) : rel f f
| symm {X Y : prod_coprod C} {f g : syn X Y} : rel f g → rel g f
| trans {X Y : prod_coprod C} {f g h : syn X Y} : rel f g → rel g h → rel f h
| comp_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.comp g₁) (f₂.comp g₂)
| prod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn X Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.prod_mk g₁) (f₂.prod_mk g₂)
| coprod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Z} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.coprod_mk g₁) (f₂.coprod_mk g₂)
| id_comp {X Y : prod_coprod C} (f : syn X Y) : rel ((syn.id X).comp f) f
| comp_id {X Y : prod_coprod C} (f : syn X Y) : rel (f.comp (syn.id Y)) f
| assoc {W X Y Z : prod_coprod C} (f : syn W X) (g : syn X Y) (h : syn Y Z) :
  rel ((f.comp g).comp h) (f.comp (g.comp h))
| of_cat_id {X : C} : rel (syn.map (𝟙 X)) (syn.id (of_cat X))
| of_cat_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  rel (syn.map (f ≫ g)) (syn.comp (syn.map f) (syn.map g))
| mk_fst_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.fst) f
| mk_snd_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.snd) g
| prod_eta {X Y Z : prod_coprod C} (f : syn X (Y.prod Z)) :
  rel (syn.prod_mk (f.comp syn.fst) (f.comp syn.snd)) f
| inl_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inl (syn.coprod_mk f g)) f
| inr_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inr (syn.coprod_mk f g)) g
| coprod_eta {X Y Z : prod_coprod C} (f : syn (X.coprod Y) Z) :
  rel (syn.coprod_mk (syn.inl.comp f) (syn.inr.comp f)) f

infixl:50 " ♥ " => rel

instance : Trans (@rel C _ X Y) (@rel C _ X Y) (@rel C _ X Y) where
  trans := rel.trans

theorem rel_prod {X Y Z : prod_coprod C} {f g : syn X (Y.prod Z)}
  (h₁ : rel (f.comp syn.fst) (g.comp syn.fst))
  (h₂ : rel (f.comp syn.snd) (g.comp syn.snd)) :
  rel f g :=
rel.trans (rel.symm (rel.prod_eta f)) (rel.trans (rel.prod_mk_congr h₁ h₂) (rel.prod_eta g))

theorem rel_coprod {X Y Z : prod_coprod C} {f g : syn (X.coprod Y) Z}
  (h₁ : rel (syn.inl.comp f) (syn.inl.comp g))
  (h₂ : rel (syn.inr.comp f) (syn.inr.comp g)) :
  rel f g :=
rel.trans (rel.symm (rel.coprod_eta f)) (rel.trans (rel.coprod_mk_congr h₁ h₂) (rel.coprod_eta g))

end syn

inductive biprod (C : Type) [category C] : Type
| of_cat : C → biprod C
| sum : biprod C → biprod C → biprod C

namespace biprod

variable {C : Type} [category C]

@[simp] def size : biprod C → Nat
| of_cat _ => 1
| sum X Y => size X + size Y + 1

inductive hom : biprod C → biprod C → Type
| zero (X Y : C) : hom (of_cat X) (of_cat Y)
| scalar {X Y : C} : (X ⟶ Y) → hom (of_cat X) (of_cat Y)
| column {X : C} {Y Z : biprod C} : hom (of_cat X) Y → hom (of_cat X) Z →
  hom (of_cat X) (sum Y Z)
| row {X Y : biprod C} {Z : C} : hom X (of_cat Z) → hom Y (of_cat Z) →
  hom (sum X Y) (of_cat Z)
| matrix {W X Y Z : biprod C} : hom W Y → hom X Y → hom W Z → hom X Z →
  hom (sum W X) (sum Y Z)

open hom

def add : {X Y : biprod C} → hom X Y → hom X Y → hom X Y
| of_cat _, of_cat _, zero _ _, g => g
| of_cat _, of_cat _, scalar f, zero _ _ => scalar f
| of_cat _, of_cat _, scalar _, scalar _ => zero _ _
| of_cat _, sum _ _, column f g, column h i =>
  column (add f h) (add g i)
| sum _ _, of_cat _, row f g, row h i =>
  row (add f h) (add g i)
| sum _ _, sum _ _, matrix a₁ b₁ c₁ d₁, matrix a₂ b₂ c₂ d₂ =>
  matrix (add a₁ a₂) (add b₁ b₂) (add c₁ c₂) (add d₁ d₂)

def zero : {X Y : biprod C} → hom X Y
| of_cat _, of_cat _ => hom.zero _ _
| of_cat _, sum _ _ => column zero zero
| sum _ _, of_cat _ => row zero zero
| sum _ _, sum _ _ => matrix zero zero zero zero
termination_by zero X Y => (size X, size Y)

@[simp] theorem add_zero : {X Y : biprod C} → (f : hom X Y) →
  add f zero = f
| of_cat _, of_cat _, hom.zero _ _ => rfl
| of_cat _, of_cat _, scalar f => rfl
| of_cat _, sum _ _, column f g => by rw [zero, add, add_zero, add_zero]
| sum _ _, of_cat _, row f g => by rw [zero, add, add_zero, add_zero]
| sum _ _, sum _ _, matrix a₁ b₁ c₁ d₁ =>
  by rw [zero, add, add_zero, add_zero, add_zero, add_zero]
termination_by add_zero X Y f => (size X, size Y)

@[simp] theorem zero_add : {X Y : biprod C} → (f : hom X Y) →
  add zero f = f
| _, _, hom.zero _ _ => rfl
| _, _, scalar f => rfl
| _, _, column f g => by rw [zero, add, zero_add, zero_add]
| _, _, row f g => by rw [zero, add, zero_add, zero_add]
| _, _, matrix a₁ b₁ c₁ d₁ =>
  by rw [zero, add, zero_add, zero_add, zero_add, zero_add]
termination_by zero_add X Y f => (size X, size Y)

def prod_mk : {X Y Z : biprod C} → (f : hom X Y) → (g : hom X Z) → hom X (sum Y Z)
| of_cat _, _, _, f, g => column f g
| sum _ _, _, _, row a b, row c d => matrix a b c d
| sum _ _, _, _, matrix a b c d, row e f => matrix (prod_mk a c) (prod_mk b d) e f
| sum _ _, _, _, matrix a b c d, matrix e f g h =>
  matrix (prod_mk a c) (prod_mk b d) (prod_mk e g) (prod_mk f h)
| sum _ _, _, _, row a b, matrix c d e f => matrix a b (prod_mk c e) (prod_mk d f)

def coprod_mk : {X Y Z : biprod C} → (f : hom X Z) → (g : hom Y Z) → hom (sum X Y) Z
| _, _, of_cat _, f, g => row f g
| _, _, sum _ _, column a b, column c d => matrix a c b d
| _, _, sum _ _, column a b, matrix c d e f =>
  matrix a (coprod_mk c d) b (coprod_mk e f)
| _, _, sum _ _, matrix a b c d, matrix e f g h =>
  matrix (coprod_mk a b) (coprod_mk e f) (coprod_mk c d) (coprod_mk g h)
| _, _, sum _ _, matrix a b c d, column e f =>
  matrix (coprod_mk a b) e (coprod_mk c d) f

def comp {X Y Z : biprod C} : hom X Y → hom Y Z → hom X Z
| hom.zero _ _,  g => zero
| scalar f, hom.zero _ _ => zero
| scalar f, scalar g => scalar (f ≫ g)
| scalar f, column a b => column (comp (scalar f) a) (comp (scalar f) b)
| column a b, row c d => add (comp a c) (comp b d)
| column a b, matrix c d e f => column (add (comp a c) (comp b d))
  (add (comp a e) (comp b f))
| row a b, scalar c => row (comp a (scalar c)) (comp b (scalar c))
| row _ _, hom.zero _ _ => zero
| row a b, column c d => matrix (comp a c) (comp b c) (comp a d) (comp b d)
| matrix a b c d, row e f => row (add (comp a e) (comp c f))
  (add (comp b e) (comp d f))
| matrix a b c d, matrix e f g h =>
  matrix
    (add (comp a e) (comp c f))
    (add (comp b e) (comp d f))
    (add (comp a g) (comp c h))
    (add (comp b g) (comp d h))
termination_by comp X Y Z f g => (size X, size Y, size Z)

@[simp] theorem comp_zero : {X Y Z : biprod C} → (f : hom X Y) →
  comp f (@zero _ _ Y Z) = zero
| _, _, _, hom.zero _ _ => by rw [comp]
| _, _, of_cat _, matrix _ _ _ _ => by
  rw [zero, comp, zero, comp_zero, zero_add, comp_zero, comp_zero, zero_add, comp_zero]
| _, _, sum _ _, matrix _ _ _ _ => by
  rw [zero, comp, zero, comp_zero, zero_add, comp_zero, comp_zero, zero_add, comp_zero,
     comp_zero, zero_add, comp_zero, comp_zero, zero_add, comp_zero]
| _, _, of_cat _, row _ _ => by rw [zero, comp]
| _, _, sum _ _, row _ _ => by rw [zero, comp, comp_zero, comp_zero, comp_zero, comp_zero]; rfl
| _, _, of_cat _, column _ _ => by rw [zero, zero, comp, comp_zero, zero_add, comp_zero, zero]
| _, _, sum _ _, column _ _ => by rw [zero, zero, comp, comp_zero, zero_add, comp_zero,
  comp_zero, zero_add, comp_zero]
| _, _, of_cat _, scalar _ => by rw [zero, comp]
| _, _, sum _ _, scalar _ => by rw [zero, comp, comp_zero, comp_zero]; rfl
termination_by comp_zero X Y Z f => (size X, size Y, size Z)

@[simp] theorem zero_comp : {X Y Z : biprod C} → (f : hom Y Z) →
  comp (@zero _ _ X Y) f = zero
| of_cat _, _, _, hom.zero _ _ => by rw [zero, comp]
| of_cat _, _, _, matrix _ _ _ _ => by
  rw [zero, comp, zero_comp, zero_add, zero_comp, zero_comp, zero_add, zero_comp]; rfl
| sum _ _, _, _, matrix _ _ _ _ => by
  rw [zero, comp, zero, zero_comp, zero_add, zero_comp, zero_comp, zero_add, zero_comp,
     zero_comp, zero_add, zero_comp, zero_comp, zero_add, zero_comp]
| of_cat _, _, _, row _ _ => by rw [zero, zero, comp, zero_comp, zero_add, zero_comp, zero]
| sum _ _, _, _, row _ _ => by rw [zero, zero, comp, zero_comp, zero_add, zero_comp, zero_comp,
  zero_add, zero_comp]
| of_cat _, _, _, column _ _ => by rw [zero, zero, comp, zero]
| sum _ _, _, _, column _ _ => by rw [zero, comp, zero_comp, zero_comp, zero_comp, zero_comp, zero]
| of_cat _, _, _, scalar _ => by rw [zero, comp]
| sum _ _, _, _, scalar _ => by rw [zero, comp, zero_comp, zero_comp]; rfl
| sum _ _, _, _, hom.zero _ _ => rfl
termination_by zero_comp X Y Z f => (size X, size Y, size Z)

def inl : {X Y : biprod C} → hom X (sum X Y)
| of_cat _, _ => column (scalar (𝟙 _)) zero
| sum _ _, _ => matrix inl zero zero zero

def inr : {X Y : biprod C} → hom Y (sum X Y)
| _, of_cat _ => column zero (scalar (𝟙 _))
| _, sum _ _ => matrix zero zero zero inr

def fst : {X Y : biprod C} → hom (sum X Y) X
| of_cat _, _ => row (scalar (𝟙 _)) zero
| sum _ _, _ => matrix fst zero zero zero

def snd : {X Y : biprod C} → hom (sum X Y) Y
| _, of_cat _ => row zero (scalar (𝟙 _))
| _, sum _ _ => matrix zero zero zero snd

theorem coprod_mk_comp_inl : {W X Y Z : biprod C} → (f : hom X Z) → (g : hom Y Z) →
  comp (coprod_mk f g) (inl : hom Z (sum Z W)) =
  coprod_mk (comp f inl) (comp g inl)
| _, _, _, of_cat _, f, g => by
  rw [inl, coprod_mk, comp]
| _, _, _, sum _ _, column a b, column c d => _
| _, _, _, sum _ _, column a b, matrix c d e f => _
| _, _, _, sum _ _, matrix a b c d, matrix e f g h => _
| _, _, _, sum _ _, matrix a b c d, column e f => _

-- | comp_inr_coprod_mk {X Y Z : prod_coprod C} (f : norm_hom2 X Z) (g : norm_hom2 Y Z) :
--   norm_hom2.rel (@norm_hom2.comp_inr _ _ _ Y _ (norm_hom2.coprod_mk f g))
--     (norm_hom2.coprod_mk f.comp_inr g.comp_inr)
-- | fst_comp_prod_mk {X Y Z : prod_coprod C} (f : norm_hom2 X Y) (g : norm_hom2 X Z) :
--   norm_hom2.rel (@norm_hom2.fst_comp _ _ _ Y _ (norm_hom2.prod_mk f g))
--     (norm_hom2.prod_mk f.fst_comp g.fst_comp)
-- | snd_comp_prod_mk {X Y Z : prod_coprod C} (f : norm_hom2 X Y) (g : norm_hom2 X Z) :
--   norm_hom2.rel (@norm_hom2.snd_comp _ _ Y _ _ (norm_hom2.prod_mk f g))
--     (norm_hom2.prod_mk f.snd_comp g.snd_comp)
-- | fst_comp_comp_inl {W X Y Z : prod_coprod C} (f : norm_hom2 X Y) :
--   norm_hom2.rel (f.fst_comp.comp_inl : norm_hom2 (prod X W) (coprod Y Z)) f.comp_inl.fst_comp
-- | snd_comp_comp_inl {W X Y Z : prod_coprod C} (f : norm_hom2 X Y) :
--   norm_hom2.rel (f.snd_comp.comp_inl : norm_hom2 (prod W X) (coprod Y Z)) f.comp_inl.snd_comp
-- | fst_comp_comp_inr {W X Y Z : prod_coprod C} (f : norm_hom2 X Y) :
--   norm_hom2.rel (f.fst_comp.comp_inr : norm_hom2 (prod X W) (coprod Z Y)) f.comp_inr.fst_comp
-- | snd_comp_comp_inr {W X Y Z : prod_coprod C} (f : norm_hom2 X Y) :
--   norm_hom2.rel (f.snd_comp.comp_inr : norm_hom2 (prod W X) (coprod Z Y)) f.comp_inr.snd_comp

end biprod


/-
Copyright (c) 2019 Abhimanyu Pallavi Sudhir. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Abhimanyu Pallavi Sudhir
-/
import order.filter.filter_product
import analysis.specific_limits.basic

/-!
# Construction of the hyperreal numbers as an ultraproduct of real sequences.
-/

open filter filter.germ
open_locale topological_space classical

/-- Hyperreal numbers on the ultrafilter extending the cofinite filter -/
@[derive [linear_ordered_field, inhabited]]
def hyperreal : Type := germ (hyperfilter ℕ : filter ℕ) ℝ

namespace hyperreal

notation `ℝ*` := hyperreal

noncomputable instance : has_coe_t ℝ ℝ* := ⟨λ x, (↑x : germ _ _)⟩

@[simp, norm_cast]
lemma coe_eq_coe {x y : ℝ} : (x : ℝ*) = y ↔ x = y :=
germ.const_inj

@[simp, norm_cast] lemma coe_eq_zero {x : ℝ} : (x : ℝ*) = 0 ↔ x = 0 := coe_eq_coe
@[simp, norm_cast] lemma coe_eq_one {x : ℝ} : (x : ℝ*) = 1 ↔ x = 1 := coe_eq_coe

@[simp, norm_cast] lemma coe_one : ↑(1 : ℝ) = (1 : ℝ*) := rfl
@[simp, norm_cast] lemma coe_zero : ↑(0 : ℝ) = (0 : ℝ*) := rfl
@[simp, norm_cast] lemma coe_inv (x : ℝ) : ↑(x⁻¹) = (x⁻¹ : ℝ*) := rfl
@[simp, norm_cast] lemma coe_neg (x : ℝ) : ↑(-x) = (-x : ℝ*) := rfl
@[simp, norm_cast] lemma coe_add (x y : ℝ) : ↑(x + y) = (x + y : ℝ*) := rfl
@[simp, norm_cast] lemma coe_bit0 (x : ℝ) : ↑(bit0 x) = (bit0 x : ℝ*) := rfl
@[simp, norm_cast] lemma coe_bit1 (x : ℝ) : ↑(bit1 x) = (bit1 x : ℝ*) := rfl
@[simp, norm_cast] lemma coe_mul (x y : ℝ) : ↑(x * y) = (x * y : ℝ*) := rfl
@[simp, norm_cast] lemma coe_div (x y : ℝ) : ↑(x / y) = (x / y : ℝ*) := rfl
@[simp, norm_cast] lemma coe_sub (x y : ℝ) : ↑(x - y) = (x - y : ℝ*) := rfl

@[simp, norm_cast] lemma coe_lt_coe {x y : ℝ} : (x : ℝ*) < y ↔ x < y := germ.const_lt
@[simp, norm_cast] lemma coe_pos {x : ℝ} : 0 < (x : ℝ*) ↔ 0 < x :=
coe_lt_coe
@[simp, norm_cast] lemma coe_le_coe {x y : ℝ} : (x : ℝ*) ≤ y ↔ x ≤ y := germ.const_le_iff
@[simp, norm_cast] lemma coe_abs (x : ℝ) : ((|x| : ℝ) : ℝ*) = |x| :=
begin
  convert const_abs x,
  apply linear_order.to_lattice_eq_filter_germ_lattice,
end
@[simp, norm_cast] lemma coe_max (x y : ℝ) : ((max x y : ℝ) : ℝ*) = max x y := germ.const_max _ _
@[simp, norm_cast] lemma coe_min (x y : ℝ) : ((min x y : ℝ) : ℝ*) = min x y := germ.const_min _ _

/-- Construct a hyperreal number from a sequence of real numbers. -/
noncomputable def of_seq (f : ℕ → ℝ) : ℝ* := (↑f : germ (hyperfilter ℕ : filter ℕ) ℝ)

/-- A sample infinitesimal hyperreal-/
noncomputable def epsilon : ℝ* := of_seq $ λ n, n⁻¹

/-- A sample infinite hyperreal-/
noncomputable def omega : ℝ* := of_seq coe

localized "notation `ε` := hyperreal.epsilon" in hyperreal
localized "notation `ω` := hyperreal.omega" in hyperreal

lemma epsilon_eq_inv_omega : ε = ω⁻¹ := rfl

lemma inv_epsilon_eq_omega : ε⁻¹ = ω := @inv_inv _ _ ω

lemma epsilon_pos : 0 < ε :=
suffices ∀ᶠ i in hyperfilter ℕ, (0 : ℝ) < (i : ℕ)⁻¹, by rwa lt_def,
have h0' : {n : ℕ | ¬ 0 < n} = {0} :=
by simp only [not_lt, (set.set_of_eq_eq_singleton).symm]; ext; exact nat.le_zero_iff,
begin
  simp only [inv_pos, nat.cast_pos],
  exact mem_hyperfilter_of_finite_compl (by convert set.finite_singleton _),
end

lemma epsilon_ne_zero : ε ≠ 0 := ne_of_gt epsilon_pos

lemma omega_pos : 0 < ω := by rw ←inv_epsilon_eq_omega; exact inv_pos.2 epsilon_pos

lemma omega_ne_zero : ω ≠ 0 := ne_of_gt omega_pos

theorem epsilon_mul_omega : ε * ω = 1 := @inv_mul_cancel _ _ ω omega_ne_zero

lemma lt_of_tendsto_zero_of_pos {f : ℕ → ℝ} (hf : tendsto f at_top (𝓝 0)) :
  ∀ {r : ℝ}, 0 < r → of_seq f < (r : ℝ*) :=
begin
  simp only [metric.tendsto_at_top, real.dist_eq, sub_zero, lt_def] at hf ⊢,
  intros r hr, cases hf r hr with N hf',
  have hs : {i : ℕ | f i < r}ᶜ ⊆ {i : ℕ | i ≤ N} :=
    λ i hi1, le_of_lt (by simp only [lt_iff_not_ge];
    exact λ hi2, hi1 (lt_of_le_of_lt (le_abs_self _) (hf' i hi2)) : i < N),
  exact mem_hyperfilter_of_finite_compl
    ((set.finite_le_nat N).subset hs)
end

lemma neg_lt_of_tendsto_zero_of_pos {f : ℕ → ℝ} (hf : tendsto f at_top (𝓝 0)) :
  ∀ {r : ℝ}, 0 < r → (-r : ℝ*) < of_seq f :=
λ r hr, have hg : _ := hf.neg,
neg_lt_of_neg_lt (by rw [neg_zero] at hg; exact lt_of_tendsto_zero_of_pos hg hr)

lemma gt_of_tendsto_zero_of_neg {f : ℕ → ℝ} (hf : tendsto f at_top (𝓝 0)) :
  ∀ {r : ℝ}, r < 0 → (r : ℝ*) < of_seq f :=
λ r hr, by rw [←neg_neg r, coe_neg];
exact neg_lt_of_tendsto_zero_of_pos hf (neg_pos.mpr hr)

lemma epsilon_lt_pos (x : ℝ) : 0 < x → ε < x :=
lt_of_tendsto_zero_of_pos tendsto_inverse_at_top_nhds_0_nat

/-- Standard part predicate -/
def is_st (x : ℝ*) (r : ℝ) := ∀ δ : ℝ, 0 < δ → (r - δ : ℝ*) < x ∧ x < r + δ

/-- Standard part function: like a "round" to ℝ instead of ℤ -/
noncomputable def st : ℝ* → ℝ :=
λ x, if h : ∃ r, is_st x r then classical.some h else 0

/-- A hyperreal number is infinitesimal if its standard part is 0 -/
def infinitesimal (x : ℝ*) := is_st x 0

/-- A hyperreal number is positive infinite if it is larger than all real numbers -/
def infinite_pos (x : ℝ*) := ∀ r : ℝ, ↑r < x

/-- A hyperreal number is negative infinite if it is smaller than all real numbers -/
def infinite_neg (x : ℝ*) := ∀ r : ℝ, x < r

/-- A hyperreal number is infinite if it is infinite positive or infinite negative -/
def infinite (x : ℝ*) := infinite_pos x ∨ infinite_neg x

/-!
### Some facts about `st`
-/

private lemma is_st_unique' (x : ℝ*) (r s : ℝ) (hr : is_st x r) (hs : is_st x s) (hrs : r < s) :
  false :=
have hrs' : _ := half_pos $ sub_pos_of_lt hrs,
have hr' : _ := (hr _ hrs').2,
have hs' : _ := (hs _ hrs').1,
have h : s - ((s - r) / 2) = r + (s - r) / 2 := by linarith,
begin
  norm_cast at *,
  rw h at hs',
  exact not_lt_of_lt hs' hr'
end

theorem is_st_unique {x : ℝ*} {r s : ℝ} (hr : is_st x r) (hs : is_st x s) : r = s :=
begin
  rcases lt_trichotomy r s with h | h | h,
  { exact false.elim (is_st_unique' x r s hr hs h) },
  { exact h },
  { exact false.elim (is_st_unique' x s r hs hr h) }
end

theorem not_infinite_of_exists_st {x : ℝ*} : (∃ r : ℝ, is_st x r) → ¬ infinite x :=
λ he hi, Exists.dcases_on he $ λ r hr, hi.elim
   (λ hip, not_lt_of_lt (hr 2 zero_lt_two).2 (hip $ r + 2))
   (λ hin, not_lt_of_lt (hr 2 zero_lt_two).1 (hin $ r - 2))

theorem is_st_Sup {x : ℝ*} (hni : ¬ infinite x) : is_st x (Sup {y : ℝ | (y : ℝ*) < x}) :=
let S : set ℝ := {y : ℝ | (y : ℝ*) < x} in
let R : _ := Sup S in
have hnile : _ := not_forall.mp (not_or_distrib.mp hni).1,
have hnige : _ := not_forall.mp (not_or_distrib.mp hni).2,
Exists.dcases_on hnile $ Exists.dcases_on hnige $ λ r₁ hr₁ r₂ hr₂,
have HR₁ : S.nonempty :=
  ⟨r₁ - 1, lt_of_lt_of_le (coe_lt_coe.2 $ sub_one_lt _) (not_lt.mp hr₁) ⟩,
have HR₂ : bdd_above S :=
  ⟨ r₂, λ y hy, le_of_lt (coe_lt_coe.1 (lt_of_lt_of_le hy (not_lt.mp hr₂))) ⟩,
λ δ hδ,
  ⟨ lt_of_not_ge' $ λ c,
      have hc : ∀ y ∈ S, y ≤ R - δ := λ y hy, coe_le_coe.1 $ le_of_lt $ lt_of_lt_of_le hy c,
      not_lt_of_le (cSup_le HR₁ hc) $ sub_lt_self R hδ,
    lt_of_not_ge' $ λ c,
      have hc : ↑(R + δ / 2) < x :=
        lt_of_lt_of_le (add_lt_add_left (coe_lt_coe.2 (half_lt_self hδ)) R) c,
      not_lt_of_le (le_cSup HR₂ hc) $ (lt_add_iff_pos_right _).mpr $ half_pos hδ⟩

theorem exists_st_of_not_infinite {x : ℝ*} (hni : ¬ infinite x) : ∃ r : ℝ, is_st x r :=
⟨Sup {y : ℝ | (y : ℝ*) < x}, is_st_Sup hni⟩

theorem st_eq_Sup {x : ℝ*} : st x = Sup {y : ℝ | (y : ℝ*) < x} :=
begin
unfold st, split_ifs,
{ exact is_st_unique (classical.some_spec h) (is_st_Sup (not_infinite_of_exists_st h)) },
{ cases not_imp_comm.mp exists_st_of_not_infinite h with H H,
  { rw (set.ext (λ i, ⟨λ hi, set.mem_univ i, λ hi, H i⟩) : {y : ℝ | (y : ℝ*) < x} = set.univ),
    exact real.Sup_univ.symm },
  { rw (set.ext (λ i, ⟨λ hi, false.elim (not_lt_of_lt (H i) hi),
    λ hi, false.elim (set.not_mem_empty i hi)⟩) : {y : ℝ | (y : ℝ*) < x} = ∅),
    exact real.Sup_empty.symm } }
end

theorem exists_st_iff_not_infinite {x : ℝ*} : (∃ r : ℝ, is_st x r) ↔ ¬ infinite x :=
⟨ not_infinite_of_exists_st, exists_st_of_not_infinite ⟩

theorem infinite_iff_not_exists_st {x : ℝ*} : infinite x ↔ ¬ ∃ r : ℝ, is_st x r :=
iff_not_comm.mp exists_st_iff_not_infinite

theorem st_infinite {x : ℝ*} (hi : infinite x) : st x = 0 :=
begin
  unfold st, split_ifs,
  { exact false.elim ((infinite_iff_not_exists_st.mp hi) h) },
  { refl }
end

lemma st_of_is_st {x : ℝ*} {r : ℝ} (hxr : is_st x r) : st x = r :=
begin
  unfold st, split_ifs,
  { exact is_st_unique (classical.some_spec h) hxr },
  { exact false.elim (h ⟨r, hxr⟩) }
end

lemma is_st_st_of_is_st {x : ℝ*} {r : ℝ} (hxr : is_st x r) : is_st x (st x) :=
by rwa [st_of_is_st hxr]

lemma is_st_st_of_exists_st {x : ℝ*} (hx : ∃ r : ℝ, is_st x r) : is_st x (st x) :=
Exists.dcases_on hx (λ r, is_st_st_of_is_st)

lemma is_st_st {x : ℝ*} (hx : st x ≠ 0) : is_st x (st x) :=
begin
  unfold st, split_ifs,
  { exact classical.some_spec h },
  { exact false.elim (hx (by unfold st; split_ifs; refl)) }
end

lemma is_st_st' {x : ℝ*} (hx : ¬ infinite x) : is_st x (st x) :=
is_st_st_of_exists_st $ exists_st_of_not_infinite hx

lemma is_st_refl_real (r : ℝ) : is_st r r :=
λ δ hδ, ⟨ sub_lt_self _ (coe_lt_coe.2 hδ), (lt_add_of_pos_right _ (coe_lt_coe.2 hδ)) ⟩

lemma st_id_real (r : ℝ) : st r = r := st_of_is_st (is_st_refl_real r)

lemma eq_of_is_st_real {r s : ℝ} : is_st r s → r = s := is_st_unique (is_st_refl_real r)

lemma is_st_real_iff_eq {r s : ℝ} : is_st r s ↔ r = s :=
⟨eq_of_is_st_real, λ hrs, by rw [hrs]; exact is_st_refl_real s⟩

lemma is_st_symm_real {r s : ℝ} : is_st r s ↔ is_st s r :=
by rw [is_st_real_iff_eq, is_st_real_iff_eq, eq_comm]

lemma is_st_trans_real {r s t : ℝ} : is_st r s → is_st s t → is_st r t :=
by rw [is_st_real_iff_eq, is_st_real_iff_eq, is_st_real_iff_eq]; exact eq.trans

lemma is_st_inj_real {r₁ r₂ s : ℝ} (h1 : is_st r₁ s) (h2 : is_st r₂ s) : r₁ = r₂ :=
eq.trans (eq_of_is_st_real h1) (eq_of_is_st_real h2).symm

lemma is_st_iff_abs_sub_lt_delta {x : ℝ*} {r : ℝ} :
  is_st x r ↔ ∀ (δ : ℝ), 0 < δ → |x - r| < δ :=
by simp only [abs_sub_lt_iff, sub_lt_iff_lt_add, is_st, and_comm, add_comm]

lemma is_st_add {x y : ℝ*} {r s : ℝ} : is_st x r → is_st y s → is_st (x + y) (r + s) :=
λ hxr hys d hd,
have hxr' : _ := hxr (d / 2) (half_pos hd),
have hys' : _ := hys (d / 2) (half_pos hd),
⟨by convert add_lt_add hxr'.1 hys'.1 using 1; norm_cast; linarith,
 by convert add_lt_add hxr'.2 hys'.2 using 1; norm_cast; linarith⟩

lemma is_st_neg {x : ℝ*} {r : ℝ} (hxr : is_st x r) : is_st (-x) (-r) :=
λ d hd, show -(r : ℝ*) - d < -x ∧ -x < -r + d, by cases (hxr d hd); split; linarith

lemma is_st_sub {x y : ℝ*} {r s : ℝ} : is_st x r → is_st y s → is_st (x - y) (r - s) :=
λ hxr hys, by rw [sub_eq_add_neg, sub_eq_add_neg]; exact is_st_add hxr (is_st_neg hys)

/- (st x < st y) → (x < y) → (x ≤ y) → (st x ≤ st y) -/

lemma lt_of_is_st_lt {x y : ℝ*} {r s : ℝ} (hxr : is_st x r) (hys : is_st y s) :
  r < s → x < y :=
λ hrs, have hrs' : 0 < (s - r) / 2 := half_pos (sub_pos.mpr hrs),
have hxr' : _ := (hxr _ hrs').2, have hys' : _ := (hys _ hrs').1,
have H1 : r + ((s - r) / 2) = (r + s) / 2 := by linarith,
have H2 : s - ((s - r) / 2) = (r + s) / 2 := by linarith,
begin
  norm_cast at *,
  rw H1 at hxr',
  rw H2 at hys',
  exact lt_trans hxr' hys'
end

lemma is_st_le_of_le {x y : ℝ*} {r s : ℝ} (hrx : is_st x r) (hsy : is_st y s) :
  x ≤ y → r ≤ s := by rw [←not_lt, ←not_lt, not_imp_not]; exact lt_of_is_st_lt hsy hrx

lemma st_le_of_le {x y : ℝ*} (hix : ¬ infinite x) (hiy : ¬ infinite y) :
  x ≤ y → st x ≤ st y :=
have hx' : _ := is_st_st' hix, have hy' : _ := is_st_st' hiy,
is_st_le_of_le hx' hy'

lemma lt_of_st_lt {x y : ℝ*} (hix : ¬ infinite x) (hiy : ¬ infinite y) :
  st x < st y → x < y :=
have hx' : _ := is_st_st' hix, have hy' : _ := is_st_st' hiy,
lt_of_is_st_lt hx' hy'

/-!
### Basic lemmas about infinite
-/

lemma infinite_pos_def {x : ℝ*} : infinite_pos x ↔ ∀ r : ℝ, ↑r < x := by rw iff_eq_eq; refl

lemma infinite_neg_def {x : ℝ*} : infinite_neg x ↔ ∀ r : ℝ, x < r := by rw iff_eq_eq; refl

lemma ne_zero_of_infinite {x : ℝ*} : infinite x → x ≠ 0 :=
λ hI h0, or.cases_on hI
  (λ hip, lt_irrefl (0 : ℝ*) ((by rwa ←h0 : infinite_pos 0) 0))
  (λ hin, lt_irrefl (0 : ℝ*) ((by rwa ←h0 : infinite_neg 0) 0))

lemma not_infinite_zero : ¬ infinite 0 := λ hI, ne_zero_of_infinite hI rfl

lemma pos_of_infinite_pos {x : ℝ*} : infinite_pos x → 0 < x := λ hip, hip 0

lemma neg_of_infinite_neg {x : ℝ*} : infinite_neg x → x < 0 := λ hin, hin 0

lemma not_infinite_pos_of_infinite_neg {x : ℝ*} : infinite_neg x → ¬ infinite_pos x :=
λ hn hp, not_lt_of_lt (hn 1) (hp 1)

lemma not_infinite_neg_of_infinite_pos {x : ℝ*} : infinite_pos x → ¬ infinite_neg x :=
imp_not_comm.mp not_infinite_pos_of_infinite_neg

lemma infinite_neg_neg_of_infinite_pos {x : ℝ*} : infinite_pos x → infinite_neg (-x) :=
λ hp r, neg_lt.mp (hp (-r))

lemma infinite_pos_neg_of_infinite_neg {x : ℝ*} : infinite_neg x → infinite_pos (-x) :=
λ hp r, lt_neg.mp (hp (-r))

lemma infinite_pos_iff_infinite_neg_neg {x : ℝ*} : infinite_pos x ↔ infinite_neg (-x) :=
⟨ infinite_neg_neg_of_infinite_pos, λ hin, neg_neg x ▸ infinite_pos_neg_of_infinite_neg hin ⟩

lemma infinite_neg_iff_infinite_pos_neg {x : ℝ*} : infinite_neg x ↔ infinite_pos (-x) :=
⟨ infinite_pos_neg_of_infinite_neg, λ hin, neg_neg x ▸ infinite_neg_neg_of_infinite_pos hin ⟩

lemma infinite_iff_infinite_neg {x : ℝ*} : infinite x ↔ infinite (-x) :=
⟨ λ hi, or.cases_on hi
  (λ hip, or.inr (infinite_neg_neg_of_infinite_pos hip))
  (λ hin, or.inl (infinite_pos_neg_of_infinite_neg hin)),
 λ hi, or.cases_on hi
  (λ hipn, or.inr (infinite_neg_iff_infinite_pos_neg.mpr hipn))
  (λ hinp, or.inl (infinite_pos_iff_infinite_neg_neg.mpr hinp))⟩

lemma not_infinite_of_infinitesimal {x : ℝ*} : infinitesimal x → ¬ infinite x :=
λ hi hI, have hi' : _ := (hi 2 zero_lt_two), or.dcases_on hI
  (λ hip, have hip' : _ := hip 2, not_lt_of_lt hip' (by convert hi'.2; exact (zero_add 2).symm))
  (λ hin, have hin' : _ := hin (-2), not_lt_of_lt hin' (by convert hi'.1; exact (zero_sub 2).symm))

lemma not_infinitesimal_of_infinite_pos {x : ℝ*} : infinite_pos x → ¬ infinitesimal x :=
λ hp, not_infinitesimal_of_infinite (or.inl hp)

lemma not_infinitesimal_of_infinite_neg {x : ℝ*} : infinite_neg x → ¬ infinitesimal x :=
λ hn, not_infinitesimal_of_infinite (or.inr hn)

lemma infinite_pos_iff_infinite_and_pos {x : ℝ*} : infinite_pos x ↔ (infinite x ∧ 0 < x) :=
⟨ λ hip, ⟨or.inl hip, hip 0⟩,
  λ ⟨hi, hp⟩, hi.cases_on (λ hip, hip) (λ hin, false.elim (not_lt_of_lt hp (hin 0))) ⟩

lemma infinite_neg_iff_infinite_and_neg {x : ℝ*} : infinite_neg x ↔ (infinite x ∧ x < 0) :=
⟨ λ hip, ⟨or.inr hip, hip 0⟩,
  λ ⟨hi, hp⟩, hi.cases_on (λ hin, false.elim (not_lt_of_lt hp (hin 0))) (λ hip, hip) ⟩

lemma infinite_pos_iff_infinite_of_pos {x : ℝ*} (hp : 0 < x) : infinite_pos x ↔ infinite x :=
by rw [infinite_pos_iff_infinite_and_pos]; exact ⟨λ hI, hI.1, λ hI, ⟨hI, hp⟩⟩

lemma infinite_pos_iff_infinite_of_nonneg {x : ℝ*} (hp : 0 ≤ x) : infinite_pos x ↔ infinite x :=
or.cases_on (lt_or_eq_of_le hp) (infinite_pos_iff_infinite_of_pos)
  (λ h, by rw h.symm; exact
  ⟨λ hIP, false.elim (not_infinite_zero (or.inl hIP)), λ hI, false.elim (not_infinite_zero hI)⟩)

lemma infinite_neg_iff_infinite_of_neg {x : ℝ*} (hn : x < 0) : infinite_neg x ↔ infinite x :=
by rw [infinite_neg_iff_infinite_and_neg]; exact ⟨λ hI, hI.1, λ hI, ⟨hI, hn⟩⟩

lemma infinite_pos_abs_iff_infinite_abs {x : ℝ*} : infinite_pos (|x|) ↔ infinite (|x|) :=
infinite_pos_iff_infinite_of_nonneg (abs_nonneg _)

lemma infinite_iff_infinite_pos_abs {x : ℝ*} : infinite x ↔ infinite_pos (|x|) :=
⟨ λ hi d, or.cases_on hi
   (λ hip, by rw [abs_of_pos (hip 0)]; exact hip d)
   (λ hin, by rw [abs_of_neg (hin 0)]; exact lt_neg.mp (hin (-d))),
  λ hipa, by { rcases (lt_trichotomy x 0) with h | h | h,
    { exact or.inr (infinite_neg_iff_infinite_pos_neg.mpr (by rwa abs_of_neg h at hipa)) },
    { exact false.elim (ne_zero_of_infinite (or.inl (by rw [h]; rwa [h, abs_zero] at hipa)) h) },
    { exact or.inl (by rwa abs_of_pos h at hipa) } } ⟩

lemma infinite_iff_infinite_abs {x : ℝ*} : infinite x ↔ infinite (|x|) :=
by rw [←infinite_pos_iff_infinite_of_nonneg (abs_nonneg _), infinite_iff_infinite_pos_abs]

lemma infinite_iff_abs_lt_abs {x : ℝ*} : infinite x ↔ ∀ r : ℝ, (|r| : ℝ*) < |x| :=
⟨ λ hI r, (coe_abs r) ▸ infinite_iff_infinite_pos_abs.mp hI (|r|),
  λ hR, or.cases_on (max_choice x (-x))
  (λ h, or.inl $ λ r, lt_of_le_of_lt (le_abs_self _) (h ▸ (hR r)))
  (λ h, or.inr $ λ r, neg_lt_neg_iff.mp $ lt_of_le_of_lt (neg_le_abs_self _) (h ▸ (hR r)))⟩

lemma infinite_pos_add_not_infinite_neg {x y : ℝ*} :
  infinite_pos x → ¬ infinite_neg y → infinite_pos (x + y) :=
begin
  intros hip hnin r,
  cases not_forall.mp hnin with r₂ hr₂,
  convert add_lt_add_of_lt_of_le (hip (r + -r₂)) (not_lt.mp hr₂) using 1,
  simp
end

lemma not_infinite_neg_add_infinite_pos {x y : ℝ*} :
  ¬ infinite_neg x → infinite_pos y → infinite_pos (x + y) :=
λ hx hy, by rw [add_comm]; exact infinite_pos_add_not_infinite_neg hy hx

lemma infinite_neg_add_not_infinite_pos {x y : ℝ*} :
  infinite_neg x → ¬ infinite_pos y → infinite_neg (x + y) :=
by rw [@infinite_neg_iff_infinite_pos_neg x, @infinite_pos_iff_infinite_neg_neg y,
       @infinite_neg_iff_infinite_pos_neg (x + y), neg_add];
exact infinite_pos_add_not_infinite_neg

lemma not_infinite_pos_add_infinite_neg {x y : ℝ*} :
  ¬ infinite_pos x → infinite_neg y → infinite_neg (x + y) :=
λ hx hy, by rw [add_comm]; exact infinite_neg_add_not_infinite_pos hy hx

lemma infinite_pos_add_infinite_pos {x y : ℝ*} :
  infinite_pos x → infinite_pos y → infinite_pos (x + y) :=
λ hx hy, infinite_pos_add_not_infinite_neg hx (not_infinite_neg_of_infinite_pos hy)

lemma infinite_neg_add_infinite_neg {x y : ℝ*} :
  infinite_neg x → infinite_neg y → infinite_neg (x + y) :=
λ hx hy, infinite_neg_add_not_infinite_pos hx (not_infinite_pos_of_infinite_neg hy)

lemma infinite_pos_add_not_infinite {x y : ℝ*} :
  infinite_pos x → ¬ infinite y → infinite_pos (x + y) :=
λ hx hy, infinite_pos_add_not_infinite_neg hx (not_or_distrib.mp hy).2

lemma infinite_neg_add_not_infinite {x y : ℝ*} :
  infinite_neg x → ¬ infinite y → infinite_neg (x + y) :=
λ hx hy, infinite_neg_add_not_infinite_pos hx (not_or_distrib.mp hy).1

theorem infinite_pos_of_tendsto_top {f : ℕ → ℝ} (hf : tendsto f at_top at_top) :
  infinite_pos (of_seq f) :=
λ r, have hf' : _ := tendsto_at_top_at_top.mp hf,
Exists.cases_on (hf' (r + 1)) $ λ i hi,
  have hi' : ∀ (a : ℕ), f a < (r + 1) → a < i :=
    λ a, by rw [←not_le, ←not_le]; exact not_imp_not.mpr (hi a),
  have hS : {a : ℕ | r < f a}ᶜ ⊆ {a : ℕ | a ≤ i} :=
    by simp only [set.compl_set_of, not_lt];
    exact λ a har, le_of_lt (hi' a (lt_of_le_of_lt har (lt_add_one _))),
  germ.coe_lt.2 $ mem_hyperfilter_of_finite_compl $
  (set.finite_le_nat _).subset hS

theorem infinite_neg_of_tendsto_bot {f : ℕ → ℝ} (hf : tendsto f at_top at_bot) :
  infinite_neg (of_seq f) :=
λ r, have hf' : _ := tendsto_at_top_at_bot.mp hf,
Exists.cases_on (hf' (r - 1)) $ λ i hi,
  have hi' : ∀ (a : ℕ), r - 1 < f a → a < i :=
    λ a, by rw [←not_le, ←not_le]; exact not_imp_not.mpr (hi a),
  have hS : {a : ℕ | f a < r}ᶜ ⊆ {a : ℕ | a ≤ i} :=
    by simp only [set.compl_set_of, not_lt];
    exact λ a har, le_of_lt (hi' a (lt_of_lt_of_le (sub_one_lt _) har)),
  germ.coe_lt.2 $ mem_hyperfilter_of_finite_compl $
  (set.finite_le_nat _).subset hS

lemma not_infinite_neg {x : ℝ*} : ¬ infinite x → ¬ infinite (-x) :=
not_imp_not.mpr infinite_iff_infinite_neg.mpr

lemma not_infinite_add {x y : ℝ*} (hx : ¬ infinite x) (hy : ¬ infinite y) :
  ¬ infinite (x + y) :=
have hx' : _ := exists_st_of_not_infinite hx, have hy' : _ := exists_st_of_not_infinite hy,
Exists.cases_on hx' $ Exists.cases_on hy' $
λ r hr s hs, not_infinite_of_exists_st $ ⟨s + r, is_st_add hs hr⟩

theorem not_infinite_iff_exist_lt_gt {x : ℝ*} : ¬ infinite x ↔ ∃ r s : ℝ, (r : ℝ*) < x ∧ x < s :=
⟨ λ hni,
Exists.dcases_on (not_forall.mp (not_or_distrib.mp hni).1) $
Exists.dcases_on (not_forall.mp (not_or_distrib.mp hni).2) $ λ r hr s hs,
by rw [not_lt] at hr hs; exact ⟨r - 1, s + 1,
  ⟨ lt_of_lt_of_le (by rw sub_eq_add_neg; norm_num) hr,
    lt_of_le_of_lt hs (by norm_num)⟩ ⟩,
λ hrs, Exists.dcases_on hrs $ λ r hr, Exists.dcases_on hr $ λ s hs,
  not_or_distrib.mpr ⟨not_forall.mpr ⟨s, lt_asymm (hs.2)⟩, not_forall.mpr ⟨r, lt_asymm (hs.1) ⟩⟩⟩

theorem not_infinite_real (r : ℝ) : ¬ infinite r := by rw not_infinite_iff_exist_lt_gt; exact
⟨ r - 1, r + 1, coe_lt_coe.2 $ sub_one_lt r, coe_lt_coe.2 $ lt_add_one r⟩

theorem not_real_of_infinite {x : ℝ*} : infinite x → ∀ r : ℝ, x ≠ r :=
λ hi r hr,  not_infinite_real r $ @eq.subst _ infinite _ _ hr hi

/-!
### Facts about `st` that require some infinite machinery
-/

private lemma is_st_mul' {x y : ℝ*} {r s : ℝ} (hxr : is_st x r) (hys : is_st y s) (hs : s ≠ 0) :
  is_st (x * y) (r * s) :=
have hxr' : _ := is_st_iff_abs_sub_lt_delta.mp hxr,
have hys' : _ := is_st_iff_abs_sub_lt_delta.mp hys,
have h : _ := not_infinite_iff_exist_lt_gt.mp $ not_imp_not.mpr infinite_iff_infinite_abs.mpr $
not_infinite_of_exists_st ⟨r, hxr⟩,
Exists.cases_on h $ λ u h', Exists.cases_on h' $ λ t ⟨hu, ht⟩,
is_st_iff_abs_sub_lt_delta.mpr $ λ d hd,
   calc |x * y - r * s|
      = |x * (y - s) + (x - r) * s| :
        by rw [mul_sub, sub_mul, add_sub, sub_add_cancel]
  ... ≤ |x * (y - s)| + |(x - r) * s| : abs_add _ _
  ... ≤ |x| * |y - s| + |x - r| * |s| : by simp only [abs_mul]
  ... ≤ |x| * ((d / t) / 2 : ℝ) + ((d / |s|) / 2 : ℝ) * |s| : add_le_add
        (mul_le_mul_of_nonneg_left (le_of_lt $ hys' _ $ half_pos $ div_pos hd $
          coe_pos.1 $ lt_of_le_of_lt (abs_nonneg x) ht) $ abs_nonneg _)
        (mul_le_mul_of_nonneg_right (le_of_lt $ hxr' _ $ half_pos $ div_pos hd $
          abs_pos.2 hs) $ abs_nonneg _)
  ... = (d / 2 * (|x| / t) + d / 2 : ℝ*) : by
      { push_cast [-filter.germ.const_div], -- TODO: Why wasn't `hyperreal.coe_div` used?
        have : (|s| : ℝ*) ≠ 0, by simpa,
        have : (2 : ℝ*) ≠ 0 := two_ne_zero,
        field_simp [*, add_mul, mul_add, mul_assoc, mul_comm, mul_left_comm] }
  ... < (d / 2 * 1 + d / 2 : ℝ*) :
        add_lt_add_right (mul_lt_mul_of_pos_left
        ((div_lt_one $ lt_of_le_of_lt (abs_nonneg x) ht).mpr ht) $
        half_pos $ coe_pos.2 hd) _
  ... = (d : ℝ*) : by rw [mul_one, add_halves]

lemma is_st_mul {x y : ℝ*} {r s : ℝ} (hxr : is_st x r) (hys : is_st y s) :
  is_st (x * y) (r * s) :=
have h : _ := not_infinite_iff_exist_lt_gt.mp $
  not_imp_not.mpr infinite_iff_infinite_abs.mpr $ not_infinite_of_exists_st ⟨r, hxr⟩,
Exists.cases_on h $ λ u h', Exists.cases_on h' $ λ t ⟨hu, ht⟩,
begin
  by_cases hs : s = 0,
  { apply is_st_iff_abs_sub_lt_delta.mpr, intros d hd,
    have hys' : _ := is_st_iff_abs_sub_lt_delta.mp hys (d / t)
      (div_pos hd (coe_pos.1 (lt_of_le_of_lt (abs_nonneg x) ht))),
    rw [hs, coe_zero, sub_zero] at hys',
    rw [hs, mul_zero, coe_zero, sub_zero, abs_mul, mul_comm,
        ←div_mul_cancel (d : ℝ*) (ne_of_gt (lt_of_le_of_lt (abs_nonneg x) ht)),
        ←coe_div],
    exact mul_lt_mul'' hys' ht (abs_nonneg _) (abs_nonneg _) },
  exact is_st_mul' hxr hys hs,
end

--AN INFINITE LEMMA THAT REQUIRES SOME MORE ST MACHINERY
lemma not_infinite_mul {x y : ℝ*} (hx : ¬ infinite x) (hy : ¬ infinite y) :
  ¬ infinite (x * y) :=
have hx' : _ := exists_st_of_not_infinite hx, have hy' : _ := exists_st_of_not_infinite hy,
Exists.cases_on hx' $ Exists.cases_on hy' $ λ r hr s hs, not_infinite_of_exists_st $
⟨s * r, is_st_mul hs hr⟩
---

lemma st_add {x y : ℝ*} (hx : ¬infinite x) (hy : ¬infinite y) : st (x + y) = st x + st y :=
have hx' : _ := is_st_st' hx,
have hy' : _ := is_st_st' hy,
have hxy : _ := is_st_st' (not_infinite_add hx hy),
have hxy' : _ := is_st_add hx' hy',
is_st_unique hxy hxy'

lemma st_neg (x : ℝ*) : st (-x) = - st x :=
if h : infinite x
then by rw [st_infinite h, st_infinite (infinite_iff_infinite_neg.mp h), neg_zero]
else is_st_unique (is_st_st' (not_infinite_neg h)) (is_st_neg (is_st_st' h))

lemma st_mul {x y : ℝ*} (hx : ¬infinite x) (hy : ¬infinite y) : st (x * y) = (st x) * (st y) :=
have hx' : _ := is_st_st' hx,
have hy' : _ := is_st_st' hy,
have hxy : _ := is_st_st' (not_infinite_mul hx hy),
have hxy' : _ := is_st_mul hx' hy',
is_st_unique hxy hxy'

/-!
### Basic lemmas about infinitesimal
-/

theorem infinitesimal_def {x : ℝ*} :
  infinitesimal x ↔ (∀ r : ℝ, 0 < r → -(r : ℝ*) < x ∧ x < r) :=
⟨ λ hi r hr, by { convert (hi r hr); simp },
  λ hi d hd, by { convert (hi d hd); simp } ⟩

theorem lt_of_pos_of_infinitesimal {x : ℝ*} : infinitesimal x → ∀ r : ℝ, 0 < r → x < r :=
λ hi r hr, ((infinitesimal_def.mp hi) r hr).2

theorem lt_neg_of_pos_of_infinitesimal {x : ℝ*} : infinitesimal x → ∀ r : ℝ, 0 < r → -↑r < x :=
λ hi r hr, ((infinitesimal_def.mp hi) r hr).1

theorem gt_of_neg_of_infinitesimal {x : ℝ*} : infinitesimal x → ∀ r : ℝ, r < 0 → ↑r < x :=
λ hi r hr, by convert ((infinitesimal_def.mp hi) (-r) (neg_pos.mpr hr)).1;
exact (neg_neg ↑r).symm

theorem abs_lt_real_iff_infinitesimal {x : ℝ*} :
  infinitesimal x ↔ ∀ r : ℝ, r ≠ 0 → |x| < |r| :=
⟨ λ hi r hr, abs_lt.mpr (by rw ←coe_abs;
  exact infinitesimal_def.mp hi (|r|) (abs_pos.2 hr)),
  λ hR, infinitesimal_def.mpr $ λ r hr, abs_lt.mp $
  (abs_of_pos $ coe_pos.2 hr) ▸ hR r $ ne_of_gt hr ⟩

lemma infinitesimal_zero : infinitesimal 0 := is_st_refl_real 0

lemma zero_of_infinitesimal_real {r : ℝ} : infinitesimal r → r = 0 := eq_of_is_st_real

lemma zero_iff_infinitesimal_real {r : ℝ} : infinitesimal r ↔ r = 0 :=
⟨zero_of_infinitesimal_real, λ hr, by rw hr; exact infinitesimal_zero⟩

lemma infinitesimal_add {x y : ℝ*} (hx : infinitesimal x) (hy : infinitesimal y) :
  infinitesimal (x + y) :=
by simpa only [add_zero] using is_st_add hx hy

lemma infinitesimal_neg {x : ℝ*} (hx : infinitesimal x) : infinitesimal (-x) :=
by simpa only [neg_zero] using is_st_neg hx

lemma infinitesimal_neg_iff {x : ℝ*} : infinitesimal x ↔ infinitesimal (-x) :=
⟨infinitesimal_neg, λ h, (neg_neg x) ▸ @infinitesimal_neg (-x) h⟩

lemma infinitesimal_mul {x y : ℝ*} (hx : infinitesimal x) (hy : infinitesimal y) :
  infinitesimal (x * y) :=
by simpa only [mul_zero] using is_st_mul hx hy

theorem infinitesimal_of_tendsto_zero {f : ℕ → ℝ} :
  tendsto f at_top (𝓝 0) → infinitesimal (of_seq f) :=
λ hf d hd, by rw [sub_eq_add_neg, ←coe_neg, ←coe_add, ←coe_add, zero_add, zero_add];
exact ⟨neg_lt_of_tendsto_zero_of_pos hf hd, lt_of_tendsto_zero_of_pos hf hd⟩

theorem infinitesimal_epsilon : infinitesimal ε :=
infinitesimal_of_tendsto_zero tendsto_inverse_at_top_nhds_0_nat

lemma not_real_of_infinitesimal_ne_zero (x : ℝ*) :
  infinitesimal x → x ≠ 0 → ∀ r : ℝ, x ≠ r :=
λ hi hx r hr, hx $ hr.trans $ coe_eq_zero.2 $
is_st_unique (hr.symm ▸ is_st_refl_real r : is_st x r) hi

theorem infinitesimal_sub_is_st {x : ℝ*} {r : ℝ} (hxr : is_st x r) : infinitesimal (x - r) :=
show is_st (x - r) 0,
by { rw [sub_eq_add_neg, ← add_neg_self r], exact is_st_add hxr (is_st_refl_real (-r)) }

theorem infinitesimal_sub_st {x : ℝ*} (hx : ¬infinite x) : infinitesimal (x - st x) :=
infinitesimal_sub_is_st $ is_st_st' hx

lemma infinite_pos_iff_infinitesimal_inv_pos {x : ℝ*} :
  infinite_pos x ↔ (infinitesimal x⁻¹ ∧ 0 < x⁻¹) :=
⟨ λ hip, ⟨ infinitesimal_def.mpr $ λ r hr,
  ⟨ lt_trans (coe_lt_coe.2 (neg_neg_of_pos hr)) (inv_pos.2 (hip 0)),
    (inv_lt (coe_lt_coe.2 hr) (hip 0)).mp (by convert hip r⁻¹) ⟩,
  inv_pos.2 $ hip 0 ⟩,
  λ ⟨hi, hp⟩ r, @classical.by_cases (r = 0) (↑r < x) (λ h, eq.substr h (inv_pos.mp hp)) $
  λ h, lt_of_le_of_lt (coe_le_coe.2 (le_abs_self r))
  ((inv_lt_inv (inv_pos.mp hp) (coe_lt_coe.2 (abs_pos.2 h))).mp
  ((infinitesimal_def.mp hi) ((|r|)⁻¹) (inv_pos.2 (abs_pos.2 h))).2) ⟩

lemma infinite_neg_iff_infinitesimal_inv_neg {x : ℝ*} :
  infinite_neg x ↔ (infinitesimal x⁻¹ ∧ x⁻¹ < 0) :=
⟨ λ hin, have hin' : _ := infinite_pos_iff_infinitesimal_inv_pos.mp
  (infinite_pos_neg_of_infinite_neg hin),
  by rwa [infinitesimal_neg_iff, ←neg_pos, neg_inv],
  λ hin, by rwa [←neg_pos, infinitesimal_neg_iff, neg_inv,
    ←infinite_pos_iff_infinitesimal_inv_pos, ←infinite_neg_iff_infinite_pos_neg] at hin ⟩

theorem infinitesimal_inv_of_infinite {x : ℝ*} : infinite x → infinitesimal x⁻¹ :=
λ hi, or.cases_on hi
 (λ hip, (infinite_pos_iff_infinitesimal_inv_pos.mp hip).1)
 (λ hin, (infinite_neg_iff_infinitesimal_inv_neg.mp hin).1)

theorem infinite_of_infinitesimal_inv {x : ℝ*} (h0 : x ≠ 0) (hi : infinitesimal x⁻¹ ) :
  infinite x :=
begin
  cases (lt_or_gt_of_ne h0) with hn hp,
  { exact or.inr (infinite_neg_iff_infinitesimal_inv_neg.mpr ⟨hi, inv_lt_zero.mpr hn⟩) },
  { exact or.inl (infinite_pos_iff_infinitesimal_inv_pos.mpr ⟨hi, inv_pos.mpr hp⟩) }
end

theorem infinite_iff_infinitesimal_inv {x : ℝ*} (h0 : x ≠ 0) : infinite x ↔ infinitesimal x⁻¹ :=
⟨ infinitesimal_inv_of_infinite, infinite_of_infinitesimal_inv h0 ⟩

lemma infinitesimal_pos_iff_infinite_pos_inv {x : ℝ*} :
  infinite_pos x⁻¹ ↔ (infinitesimal x ∧ 0 < x) :=
by convert infinite_pos_iff_infinitesimal_inv_pos; simp only [inv_inv]

lemma infinitesimal_neg_iff_infinite_neg_inv {x : ℝ*} :
  infinite_neg x⁻¹ ↔ (infinitesimal x ∧ x < 0) :=
by convert infinite_neg_iff_infinitesimal_inv_neg; simp only [inv_inv]

theorem infinitesimal_iff_infinite_inv {x : ℝ*} (h : x ≠ 0) : infinitesimal x ↔ infinite x⁻¹ :=
by convert (infinite_iff_infinitesimal_inv (inv_ne_zero h)).symm; simp only [inv_inv]

/-!
### `st` stuff that requires infinitesimal machinery
-/

theorem is_st_of_tendsto {f : ℕ → ℝ} {r : ℝ} (hf : tendsto f at_top (𝓝 r)) :
  is_st (of_seq f) r :=
have hg : tendsto (λ n, f n - r) at_top (𝓝 0) :=
  (sub_self r) ▸ (hf.sub tendsto_const_nhds),
by rw [←(zero_add r), ←(sub_add_cancel f (λ n, r))];
exact is_st_add (infinitesimal_of_tendsto_zero hg) (is_st_refl_real r)

lemma is_st_inv {x : ℝ*} {r : ℝ} (hi : ¬ infinitesimal x) : is_st x r → is_st x⁻¹ r⁻¹ :=
λ hxr, have h : x ≠ 0 := (λ h, hi (h.symm ▸ infinitesimal_zero)),
have H : _ := exists_st_of_not_infinite $ not_imp_not.mpr (infinitesimal_iff_infinite_inv h).mpr hi,
Exists.cases_on H $ λ s hs,
have H' : is_st 1 (r * s) := mul_inv_cancel h ▸ is_st_mul hxr hs,
have H'' : s = r⁻¹ := one_div r ▸ eq_one_div_of_mul_eq_one (eq_of_is_st_real H').symm,
H'' ▸ hs

lemma st_inv (x : ℝ*) : st x⁻¹ = (st x)⁻¹ :=
begin
  by_cases h0 : x = 0,
  rw [h0, inv_zero, ←coe_zero, st_id_real, inv_zero],
  by_cases h1 : infinitesimal x,
  rw [st_infinite ((infinitesimal_iff_infinite_inv h0).mp h1), st_of_is_st h1, inv_zero],
  by_cases h2 : infinite x,
  rw [st_of_is_st (infinitesimal_inv_of_infinite h2), st_infinite h2, inv_zero],
  exact st_of_is_st (is_st_inv h1 (is_st_st' h2)),
end

/-!
### Infinite stuff that requires infinitesimal machinery
-/

lemma infinite_pos_omega : infinite_pos ω :=
infinite_pos_iff_infinitesimal_inv_pos.mpr ⟨infinitesimal_epsilon, epsilon_pos⟩

lemma infinite_omega : infinite ω :=
(infinite_iff_infinitesimal_inv omega_ne_zero).mpr infinitesimal_epsilon

lemma infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos {x y : ℝ*} :
  infinite_pos x → ¬ infinitesimal y → 0 < y → infinite_pos (x * y) :=
λ hx hy₁ hy₂ r, have hy₁' : _ := not_forall.mp (by rw infinitesimal_def at hy₁; exact hy₁),
Exists.dcases_on hy₁' $ λ r₁ hy₁'',
have hyr : _ := by rw [not_imp, ←abs_lt, not_lt, abs_of_pos hy₂] at hy₁''; exact hy₁'',
by rw [←div_mul_cancel r (ne_of_gt hyr.1), coe_mul];
exact mul_lt_mul (hx (r / r₁)) hyr.2 (coe_lt_coe.2 hyr.1) (le_of_lt (hx 0))

lemma infinite_pos_mul_of_not_infinitesimal_pos_infinite_pos {x y : ℝ*} :
  ¬ infinitesimal x → 0 < x → infinite_pos y → infinite_pos (x * y) :=
λ hx hp hy, by rw mul_comm; exact infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos hy hx hp

lemma infinite_pos_mul_of_infinite_neg_not_infinitesimal_neg {x y : ℝ*} :
  infinite_neg x → ¬ infinitesimal y → y < 0 → infinite_pos (x * y) :=
by rw [infinite_neg_iff_infinite_pos_neg, ←neg_pos, ←neg_mul_neg, infinitesimal_neg_iff];
exact infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos

lemma infinite_pos_mul_of_not_infinitesimal_neg_infinite_neg {x y : ℝ*} :
  ¬ infinitesimal x → x < 0 → infinite_neg y → infinite_pos (x * y) :=
λ hx hp hy, by rw mul_comm; exact infinite_pos_mul_of_infinite_neg_not_infinitesimal_neg hy hx hp

lemma infinite_neg_mul_of_infinite_pos_not_infinitesimal_neg {x y : ℝ*} :
  infinite_pos x → ¬ infinitesimal y → y < 0 → infinite_neg (x * y) :=
by rw [infinite_neg_iff_infinite_pos_neg, ←neg_pos, neg_mul_eq_mul_neg, infinitesimal_neg_iff];
exact infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos

lemma infinite_neg_mul_of_not_infinitesimal_neg_infinite_pos {x y : ℝ*} :
  ¬ infinitesimal x → x < 0 → infinite_pos y → infinite_neg (x * y) :=
λ hx hp hy, by rw mul_comm; exact infinite_neg_mul_of_infinite_pos_not_infinitesimal_neg hy hx hp

lemma infinite_neg_mul_of_infinite_neg_not_infinitesimal_pos {x y : ℝ*} :
  infinite_neg x → ¬ infinitesimal y → 0 < y → infinite_neg (x * y) :=
by rw [infinite_neg_iff_infinite_pos_neg, infinite_neg_iff_infinite_pos_neg, neg_mul_eq_neg_mul];
exact infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos

lemma infinite_neg_mul_of_not_infinitesimal_pos_infinite_neg {x y : ℝ*} :
  ¬ infinitesimal x → 0 < x → infinite_neg y → infinite_neg (x * y) :=
λ hx hp hy, by rw mul_comm; exact infinite_neg_mul_of_infinite_neg_not_infinitesimal_pos hy hx hp

lemma infinite_pos_mul_infinite_pos {x y : ℝ*} :
  infinite_pos x → infinite_pos y → infinite_pos (x * y) :=
λ hx hy, infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos
hx (not_infinitesimal_of_infinite_pos hy) (hy 0)

lemma infinite_neg_mul_infinite_neg {x y : ℝ*} :
  infinite_neg x → infinite_neg y → infinite_pos (x * y) :=
λ hx hy, infinite_pos_mul_of_infinite_neg_not_infinitesimal_neg
hx (not_infinitesimal_of_infinite_neg hy) (hy 0)

lemma infinite_pos_mul_infinite_neg {x y : ℝ*} :
  infinite_pos x → infinite_neg y → infinite_neg (x * y) :=
λ hx hy, infinite_neg_mul_of_infinite_pos_not_infinitesimal_neg
hx (not_infinitesimal_of_infinite_neg hy) (hy 0)

lemma infinite_neg_mul_infinite_pos {x y : ℝ*} :
  infinite_neg x → infinite_pos y → infinite_neg (x * y) :=
λ hx hy, infinite_neg_mul_of_infinite_neg_not_infinitesimal_pos
hx (not_infinitesimal_of_infinite_pos hy) (hy 0)

lemma infinite_mul_of_infinite_not_infinitesimal {x y : ℝ*} :
  infinite x → ¬ infinitesimal y → infinite (x * y) :=
λ hx hy, have h0 : y < 0 ∨ 0 < y := lt_or_gt_of_ne (λ H0, hy (eq.substr H0 (is_st_refl_real 0))),
or.dcases_on hx
  (or.dcases_on h0
    (λ H0 Hx, or.inr (infinite_neg_mul_of_infinite_pos_not_infinitesimal_neg Hx hy H0))
    (λ H0 Hx, or.inl (infinite_pos_mul_of_infinite_pos_not_infinitesimal_pos Hx hy H0)))
  (or.dcases_on h0
    (λ H0 Hx, or.inl (infinite_pos_mul_of_infinite_neg_not_infinitesimal_neg Hx hy H0))
    (λ H0 Hx, or.inr (infinite_neg_mul_of_infinite_neg_not_infinitesimal_pos Hx hy H0)))

lemma infinite_mul_of_not_infinitesimal_infinite {x y : ℝ*} :
  ¬ infinitesimal x → infinite y → infinite (x * y) :=
λ hx hy, by rw [mul_comm]; exact infinite_mul_of_infinite_not_infinitesimal hy hx

lemma infinite_mul_infinite {x y : ℝ*} : infinite x → infinite y → infinite (x * y) :=
λ hx hy, infinite_mul_of_infinite_not_infinitesimal hx (not_infinitesimal_of_infinite hy)

end hyperreal